diff options
author | Norbert Preining <norbert@preining.info> | 2020-04-11 03:09:12 +0000 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2020-04-11 03:09:12 +0000 |
commit | c2697fc286a1e2c94fd9968b76be6f4a6d2114cd (patch) | |
tree | 1dc2cfb07cb032740483dd8be7c74aff66b70352 /systems/texlive/tlnet/tlpkg/TeXLive/TLWinGoo.pm | |
parent | 25111608e6aa05042b0c6f83009262e1973d7a45 (diff) |
CTAN sync 202004110309
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/TeXLive/TLWinGoo.pm')
-rw-r--r-- | systems/texlive/tlnet/tlpkg/TeXLive/TLWinGoo.pm | 21 |
1 files changed, 10 insertions, 11 deletions
diff --git a/systems/texlive/tlnet/tlpkg/TeXLive/TLWinGoo.pm b/systems/texlive/tlnet/tlpkg/TeXLive/TLWinGoo.pm index 1354a89255..9afc47f11e 100644 --- a/systems/texlive/tlnet/tlpkg/TeXLive/TLWinGoo.pm +++ b/systems/texlive/tlnet/tlpkg/TeXLive/TLWinGoo.pm @@ -1,4 +1,4 @@ -# $Id: TLWinGoo.pm 53076 2019-12-10 06:20:44Z preining $ +# $Id: TLWinGoo.pm 54289 2020-03-14 10:46:20Z siepo $ # TeXLive::TLWinGoo.pm - Windows goop. # Copyright 2008-2018 Siep Kroonenberg, Norbert Preining # This file is licensed under the GNU General Public License version 2 @@ -11,7 +11,7 @@ package TeXLive::TLWinGoo; -my $svnrev = '$Revision: 53076 $'; +my $svnrev = '$Revision: 54289 $'; my $_modulerevision; if ($svnrev =~ m/: ([0-9]+) /) { $_modulerevision = $1; @@ -140,7 +140,6 @@ BEGIN { $Registry->Delimiter('/'); $Registry->ArrayValues(0); $Registry->FixSzNulls(1); - require Win32::OLE::NLS; require Win32::Shortcut; Win32::Shortcut->import( qw( SW_SHOWNORMAL SW_SHOWMINNOACTIVE ) ); require Time::HiRes; @@ -164,18 +163,20 @@ my $is_win = ($^O =~ /^MSWin/i); # Win32: import some wrappers for API functions # failed to get Win32::API::More to work with raw API functions; -# for now, use a tiny dll with perl-friendly wrappers # import failures return a null result; # call imported functions only if true/non-null my $SendMessage = 0; my $update_fu = 0; +my $getlang = 0; if ($is_win) { $SendMessage = new Win32::API('user32', 'SendMessageTimeout', 'LLPPLLP', 'L'); debug ("Import failure SendMessage\n") unless $SendMessage; $update_fu = new Win32::API('shell32', 'SHChangeNotify', 'LIPP', 'V'); debug ("Import failure assoc_notify\n") unless $update_fu; + $getlang = Win32::API::More->new('kernel32', 'long GetUserDefaultLangID()'); + debug ("Import failure GetUserDefaultLangID\n") unless $getlang; } =pod @@ -306,7 +307,8 @@ Two-letter country code representing the locale of the current user =cut sub reg_country { - my $value = Win32::OLE::NLS::GetUserDefaultLangID(); + my $value = 0; + if ($getlang) {$value = $getlang->Call();} return unless $value; $value = sprintf ("%04x", $value); my $lmkey = $Registry -> Open("HKEY_CLASSES_ROOT/MIME/Database/Rfc1766/", @@ -1416,16 +1418,13 @@ sub maybe_make_ro { # S-1-5-11 Authenticated users # S-1-5-32-545 Users # S-1-5-32-544 administrators - # S-1-3-0 creator owner + # S-1-3-0 creator owner (does not work right) # S-1-3-1 creator group - # useful explanations at http://timbolton.net/2010/06/23/ - # /icacls-changing-permissions-on-files-and-folders - # /reset is necessary for removing non-standard existing permissions my $cmd = 'cmd /c "icacls . /reset && icacls . /inheritance:r'. - ' /grant:r *S-1-5-32-544:(OI)(CI)F /grant *S-1-3-0:(OI)(CI)F'. - ' /grant *S-1-5-11:(OI)(CI)RX"'; + ' /grant:r *S-1-5-32-544:(OI)(CI)F'. + ' /grant:r *S-1-5-11:(OI)(CI)RX /grant:r *S-1-5-32-545:(OI)(CI)RX /T"'; log "Making read-only\n".`$cmd`."\n"; # go back to original directory |