diff options
Diffstat (limited to 'Master/tlpkg')
-rw-r--r-- | Master/tlpkg/TeXLive/TLCrypto.pm | 6 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 8 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 110 | ||||
-rw-r--r-- | Master/tlpkg/installer/install-menu-extl.pl | 2 | ||||
-rw-r--r-- | Master/tlpkg/installer/install-menu-text.pl | 32 |
6 files changed, 99 insertions, 61 deletions
diff --git a/Master/tlpkg/TeXLive/TLCrypto.pm b/Master/tlpkg/TeXLive/TLCrypto.pm index a75c8507b8a..cb31e1efc5f 100644 --- a/Master/tlpkg/TeXLive/TLCrypto.pm +++ b/Master/tlpkg/TeXLive/TLCrypto.pm @@ -9,7 +9,7 @@ package TeXLive::TLCrypto; use Digest::MD5; use TeXLive::TLConfig; -use TeXLive::TLUtils qw(debug ddebug win32 which platform +use TeXLive::TLUtils qw(debug ddebug wndws which platform conv_to_w32_path tlwarn tldie); my $svnrev = '$Revision$'; @@ -421,7 +421,7 @@ sub setup_gpg { # Set up the gpg invocation: my $gpghome = ($ENV{'TL_GNUPGHOME'} ? $ENV{'TL_GNUPGHOME'} : "$master/tlpkg/gpg" ); - $gpghome =~ s!/!\\!g if win32(); + $gpghome =~ s!/!\\!g if wndws(); my $gpghome_quote = "\"$gpghome\""; # mind the final space for following args $::gpg = "$prg --homedir $gpghome_quote "; @@ -568,7 +568,7 @@ Internal routine running gpg to verify signature C<$sig> of C<$file>. sub gpg_verify_signature { my ($file, $sig) = @_; my ($file_quote, $sig_quote); - if (win32()) { + if (wndws()) { $file =~ s!/!\\!g; $sig =~ s!/!\\!g; } diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index be818fccaed..110d5f2f6b4 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -98,7 +98,7 @@ use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory $InfraLocation $RelocPrefix $RelocTree); use TeXLive::TLCrypto; use TeXLive::TLPOBJ; -use TeXLive::TLUtils qw(dirname mkdirhier member win32 info log debug ddebug +use TeXLive::TLUtils qw(dirname mkdirhier member wndws info log debug ddebug tlwarn basename download_file merge_into tldie system_pipe); use TeXLive::TLWinGoo; @@ -1682,7 +1682,7 @@ sub install_package_files { # Run the post installation code in the postaction tlpsrc entries # in case we are on w32 and the admin did install for himself only # we switch off admin mode - if (win32() && admin() && !$self->option("w32_multi_user")) { + if (wndws() && admin() && !$self->option("w32_multi_user")) { non_admin(); } # for now desktop_integration maps to both installation @@ -1914,7 +1914,7 @@ sub not_virtual_install_package { # Run the post installation code in the postaction tlpsrc entries # in case we are on w32 and the admin did install for himself only # we switch off admin mode - if (win32() && admin() && !$totlpdb->option("w32_multi_user")) { + if (wndws() && admin() && !$totlpdb->option("w32_multi_user")) { non_admin(); } # for now desktop_integration maps to both installation @@ -2125,7 +2125,7 @@ sub remove_package { # Run the post installation code in the postaction tlpsrc entries # in case we are on w32 and the admin did install for himself only # we switch off admin mode - if (win32() && admin() && !$localtlpdb->option("w32_multi_user")) { + if (wndws() && admin() && !$localtlpdb->option("w32_multi_user")) { non_admin(); } # diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index f90c0b94d50..9f6ff093adb 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -684,7 +684,7 @@ sub make_container { } my $tartempfile = ""; - if (win32()) { + if (wndws()) { # Since we provide our own (GNU) tar on Windows, we know it has -T. my $tmpdir = TeXLive::TLUtils::tl_tmpdir(); $tartempfile = "$tmpdir/mc$$"; diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index 4751574b681..a3d9572995d 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -27,7 +27,9 @@ C<TeXLive::TLUtils> - TeX Live infrastructure miscellany TeXLive::TLUtils::platform(); TeXLive::TLUtils::platform_name($canonical_host); TeXLive::TLUtils::platform_desc($platform); - TeXLive::TLUtils::win32(); + TeXLive::TLUtils::tl_w32(); + TeXLive::TLUtils::tl_w64(); + TeXLive::TLUtils::wndws(); TeXLive::TLUtils::unix(); =head2 System tools @@ -260,7 +262,7 @@ BEGIN { @EXPORT = qw(setup_programs download_file process_logging_options tldie tlwarn info log debug ddebug dddebug debug debug_hash_str debug_hash - win32 xchdir xsystem run_cmd system_pipe sort_archs); + wndws tl_w32 tl_w64 xchdir xsystem run_cmd system_pipe sort_archs); } use Cwd; @@ -545,14 +547,50 @@ sub platform_desc { } -=item C<win32> +=item C<tl_w32> + +Return C<1> if platform is Windows32 and C<0> otherwise. The test is +currently based on the value of Perl's C<$^O> variable. + +=cut + +sub tl_w32 { + if ($^O =~ /^MSWin/i) { + # TODO check 32bit + return 1; + } else { + return 0; + } + # the following needs config.guess, which is quite bad ... + # return (&platform eq "win32")? 1:0; +} + +=item C<tl_w64> + +Return C<1> if platform is Windows64 and C<0> otherwise. The test is +currently based on the value of Perl's C<$^O> variable. + +=cut + +sub tl_w64 { + if ($^O =~ /^MSWin/i) { + # TODO check 64bit + return 1; + } else { + return 0; + } + # the following needs config.guess, which is quite bad ... + # return (&platform eq "win32")? 1:0; +} + +=item C<wndws> Return C<1> if platform is Windows and C<0> otherwise. The test is currently based on the value of Perl's C<$^O> variable. =cut -sub win32 { +sub wndws { if ($^O =~ /^MSWin/i) { return 1; } else { @@ -594,7 +632,7 @@ sub getenv { my $envvar=shift; my $var=$ENV{"$envvar"}; return 0 unless (defined $var); - if (&win32) { + if (wndws()) { $var=~s!\\!/!g; # change \ -> / (required by Perl) } return "$var"; @@ -616,7 +654,7 @@ sub which { my @PATH; my $PATH = getenv('PATH'); - if (&win32) { + if (wndws()) { my @PATHEXT = split (';', getenv('PATHEXT')); push (@PATHEXT, ''); # in case argument contains an extension @PATH = split (';', $PATH); @@ -783,7 +821,7 @@ sub system_pipe { my ($prog, $infile, $outfile, $removeIn, @extraargs) = @_; my $progQuote = quotify_path_with_spaces($prog); - if (win32()) { + if (wndws()) { $infile =~ s!/!\\!g; $outfile =~ s!/!\\!g; } @@ -903,7 +941,7 @@ Return both C<dirname> and C<basename>. Example: sub dirname_and_basename { my $path=shift; my ($share, $base) = ("", ""); - if (win32) { + if (wndws()) { $path=~s!\\!/!g; } # do not try to make sense of paths ending with /.. @@ -912,7 +950,7 @@ sub dirname_and_basename { # eliminate `/.' path components while ($path =~ s!/\./!/!) {}; # UNC path? => first split in $share = //xxx/yy and $path = /zzzz - if (win32() and $path =~ m!^(//[^/]+/[^/]+)(.*)$!) { + if (wndws() and $path =~ m!^(//[^/]+/[^/]+)(.*)$!) { ($share, $path) = ($1, $2); if ($path =~ m!^/?$!) { $path = $share; @@ -970,7 +1008,7 @@ sub basename { sub tl_abs_path { my $path = shift; - if (win32) { + if (wndws()) { $path=~s!\\!/!g; } if (-e $path) { @@ -984,9 +1022,9 @@ sub tl_abs_path { # (//?/ path prefix) die "Unsupported path syntax" if $path =~ m!/\.\./! || $path =~ m!/\.\.$! || $path =~ m!^\.\.!; - die "Unsupported path syntax" if win32() && $path =~ m!^//\?/!; + die "Unsupported path syntax" if wndws() && $path =~ m!^//\?/!; if ($path !~ m!^(.:)?/!) { # relative path - if (win32() && $path =~ /^.:/) { # drive letter + if (wndws() && $path =~ /^.:/) { # drive letter my $dcwd; # starts with drive letter: current dir on drive $dcwd = Cwd::getdcwd ($1); @@ -1020,7 +1058,7 @@ sub dir_slash { sub dir_creatable { my $path=shift; #print STDERR "testing $path\n"; - $path =~ s!\\!/!g if win32; + $path =~ s!\\!/!g if wndws(); return 0 unless -d $path; $path .= '/' unless $path =~ m!/$!; #print STDERR "testing $path\n"; @@ -1062,7 +1100,7 @@ a fileserver. sub dir_writable { my ($path) = @_; return 0 unless -d $path; - $path =~ s!\\!/!g if win32; + $path =~ s!\\!/!g if wndws(); $path .= '/' unless $path =~ m!/$!; my $i = 0; my $f; @@ -1108,7 +1146,7 @@ sub mkdirhier { my $subdir = ""; # win32 is special as usual: we need to separate //servername/ part # from the UNC path, since (! -d //servername/) tests true - $subdir = $& if ( win32() && ($tree =~ s!^//[^/]+/!!) ); + $subdir = $& if ( wndws() && ($tree =~ s!^//[^/]+/!!) ); my @dirs = split (/[\/\\]/, $tree); for my $dir (@dirs) { @@ -1587,7 +1625,7 @@ sub removed_dirs { # c:\tl test\... # and not forward slashes, while, if there is already a forward / # in the path, also the rest is done with forward slashes. - $abs_f =~ s!\\!/!g if win32(); + $abs_f =~ s!\\!/!g if wndws(); if (!$abs_f) { warn ("oops, no abs_path($f) from " . `pwd`); next; @@ -1847,7 +1885,7 @@ sub do_postaction { sub _do_postaction_fileassoc { my ($how, $mode, $tlpobj, $pa) = @_; - return 1 unless win32(); + return 1 unless wndws(); my ($errors, %keyval) = parse_into_keywords($pa, qw/extension filetype/); @@ -1885,7 +1923,7 @@ sub _do_postaction_fileassoc { sub _do_postaction_filetype { my ($how, $tlpobj, $pa) = @_; - return 1 unless win32(); + return 1 unless wndws(); my ($errors, %keyval) = parse_into_keywords($pa, qw/name cmd/); @@ -1930,7 +1968,7 @@ sub _do_postaction_filetype { # associated program shows up in `open with' menu sub _do_postaction_progid { my ($how, $tlpobj, $pa) = @_; - return 1 unless win32(); + return 1 unless wndws(); my ($errors, %keyval) = parse_into_keywords($pa, qw/extension filetype/); @@ -1980,7 +2018,7 @@ sub _do_postaction_script { return 0; } my $file = $keyval{'file'}; - if (win32() && defined($keyval{'filew32'})) { + if (wndws() && defined($keyval{'filew32'})) { $file = $keyval{'filew32'}; } my $texdir = `kpsewhich -var-value=TEXMFROOT`; @@ -2010,7 +2048,7 @@ sub _do_postaction_script { sub _do_postaction_shortcut { my ($how, $tlpobj, $do_menu, $do_desktop, $pa) = @_; - return 1 unless win32(); + return 1 unless wndws(); my ($errors, %keyval) = parse_into_keywords($pa, qw/type name icon cmd args hide/); @@ -2281,7 +2319,7 @@ sub add_remove_symlinks { my $plat_bindir = "$Master/bin/$arch"; # nothing to do with symlinks on Windows, of course. - return if win32(); + return if wndws(); my $info_dir = "$Master/texmf-dist/doc/info"; if ($mode eq "add") { @@ -2367,7 +2405,7 @@ be called to make the changes immediately visible. sub w32_add_to_path { my ($bindir, $multiuser) = @_; - return if (!win32()); + return if (!wndws()); my $path = TeXLive::TLWinGoo::get_system_env() -> {'/Path'}; $path =~ s/[\s\x00]+$//; @@ -2612,7 +2650,7 @@ sub untar { # on w32 don't extract file modified time, because AV soft can open # files in the mean time causing time stamp modification to fail - my $taropt = win32() ? "xmf" : "xf"; + my $taropt = wndws() ? "xmf" : "xf"; if (system($tar, $taropt, $tarfile) != 0) { tlwarn("TLUtils::untar: $tar $taropt $tarfile failed (in $targetdir)\n"); $ret = 0; @@ -3110,7 +3148,7 @@ sub _download_file_lwp { sub _download_file_program { my ($url, $dest, $type) = @_; - if (win32()) { + if (wndws()) { $dest =~ s!/!\\!g; } @@ -3159,7 +3197,7 @@ Return C</dev/null> on Unix and C<nul> on Windows. =cut sub nulldev { - return (&win32()) ? 'nul' : '/dev/null'; + return (&wndws()) ? 'nul' : '/dev/null'; } =item C<get_full_line ($fh)> @@ -4022,7 +4060,7 @@ sub texdir_check { # Unfortunately we have lots of special characters. # On Windows, backslashes are normal but will already have been changed # to slashes by tl_abs_path. And we should only check for : on Unix. - my $colon = win32() ? "" : ":"; + my $colon = wndws() ? "" : ":"; if ($texdir =~ /[,$colon;\\{}\$]/) { if ($warn) { print " !! TEXDIR value has problematic characters: $orig_texdir\n"; @@ -4035,7 +4073,7 @@ sub texdir_check { return 0; } # w32: for now, reject the root of a samba share - return 0 if win32() && $texdir =~ m!^//[^/]+/[^/]+$!; + return 0 if wndws() && $texdir =~ m!^//[^/]+/[^/]+$!; # if texdir already exists, make sure we can write into it. return dir_writable($texdir) if (-d $texdir); @@ -4066,7 +4104,7 @@ are (erroneously) eradicated. sub quotify_path_with_spaces { my $p = shift; - my $m = win32() ? '[+=^&();,!%\s]' : '.'; + my $m = wndws() ? '[+=^&();,!%\s]' : '.'; if ( $p =~ m/$m/ ) { $p =~ s/"//g; # remove any existing double quotes $p = "\"$p\""; @@ -4114,13 +4152,13 @@ slashes after reading a path. They both are no-ops on Unix. sub native_slashify { my ($r) = @_; - $r =~ s!/!\\!g if win32(); + $r =~ s!/!\\!g if wndws(); return $r; } sub forward_slashify { my ($r) = @_; - $r =~ s!\\!/!g if win32(); + $r =~ s!\\!/!g if wndws(); return $r; } @@ -4202,7 +4240,7 @@ END_NO_SSL # sub query_ctan_mirror_curl { my $max_trial = 3; - my $warg = (win32() ? '-w "%{url_effective}" ' : "-w '%{url_effective}' "); + my $warg = (wndws() ? '-w "%{url_effective}" ' : "-w '%{url_effective}' "); for (my $i = 1; $i <= $max_trial; $i++) { # -L -> follow redirects # -s -> silent @@ -4809,7 +4847,7 @@ sub mktexupd { die "mktexupd: exec file does not exist: $file" if (! -f $file); } } - my $delim= (&win32)? ';' : ':'; + my $delim= (&wndws)? ';' : ':'; my $TEXMFDBS; chomp($TEXMFDBS=`kpsewhich --show-path="ls-R"`); @@ -4819,8 +4857,8 @@ sub mktexupd { foreach my $path (keys %files) { foreach my $db (@texmfdbs) { $db=substr($db, -1) if ($db=~m|/$|); # strip leading / - $db = lc($db) if win32(); - my $up = (win32() ? lc($path) : $path); + $db = lc($db) if wndws(); + my $up = (wndws() ? lc($path) : $path); if (substr($up, 0, length("$db/")) eq "$db/") { # we appended a / because otherwise "texmf" is recognized as a # substring of "texmf-dist". @@ -4952,7 +4990,7 @@ directory for PATH. sub prepend_own_path { my $bindir = dirname(Cwd::abs_path(which('kpsewhich'))); - if (win32()) { + if (wndws()) { $bindir =~ s!\\!/!g; $ENV{'PATH'} = "$bindir;$ENV{PATH}"; } else { diff --git a/Master/tlpkg/installer/install-menu-extl.pl b/Master/tlpkg/installer/install-menu-extl.pl index 4dd16ade9c7..5417d59ae6d 100644 --- a/Master/tlpkg/installer/install-menu-extl.pl +++ b/Master/tlpkg/installer/install-menu-extl.pl @@ -123,7 +123,7 @@ sub run_menu_extl { print "year: $texlive_release\n"; print "svn: $::installerrevision\n"; # for windows, add a key indicating elevated permissions - if (win32()) { + if (wndws()) { print "admin: ". TeXLive::TLWinGoo::admin() . "\n"; } print_descs(); diff --git a/Master/tlpkg/installer/install-menu-text.pl b/Master/tlpkg/installer/install-menu-text.pl index a47eb11e467..b5ea98f1b9c 100644 --- a/Master/tlpkg/installer/install-menu-text.pl +++ b/Master/tlpkg/installer/install-menu-text.pl @@ -40,7 +40,7 @@ $::fileassocdesc[2] = __("All"); $::deskintdesc[0] = __("None"); $::deskintdesc[1] = __("Menu shortcuts"); -if (win32()) { $::deskintdesc[2] = __("Launcher"); } +if (wndws()) { $::deskintdesc[2] = __("Launcher"); } sub clear_screen { return 0 if ($::opt_no_cls); @@ -532,7 +532,7 @@ EOF EOF - if (win32) { + if (wndws()) { print " Note: ~ will expand to %USERPROFILE%\n"; } else { print " Note: ~ will expand to \$HOME (or to %USERPROFILE% on Windows)\n"; @@ -620,11 +620,11 @@ sub input_dirname chomp (my $answer = <STDIN>); return "" if $answer eq ""; - $answer =~ s!\\!/!g if win32(); # switch to forward slashes + $answer =~ s!\\!/!g if wndws(); # switch to forward slashes if (!$noexpansion) { my $home = getenv('HOME'); - $home = getenv('USERPROFILE') if win32(); + $home = getenv('USERPROFILE') if wndws(); $home ||= '~'; $answer =~ s/^~/$home/; # $home expansion } @@ -820,7 +820,7 @@ EOF EOF ; } - if ((win32() && !$vars{'instopt_portable'}) || $::opt_all_options) { + if ((wndws() && !$vars{'instopt_portable'}) || $::opt_all_options) { print " <M> Start menu shortcuts / launcher: ".obutton( $vars{'tlpdbopt_desktop_integration'}, \@::deskintdesc)."\n"; print " <N> update file associations: ".obutton( @@ -831,7 +831,7 @@ EOF } } } - if (win32() || $::opt_all_options) { + if (wndws() || $::opt_all_options) { print " <W> install TeXworks front end: $b_addoneditor\n"; } if ($media ne "NET") { @@ -845,14 +845,14 @@ EOF if (unix()) { if (("\u$answer" eq 'L') and !$vars{'instopt_portable'}) { my $home = getenv('HOME'); - $home = getenv('USERPROFILE') if (win32()); + $home = getenv('USERPROFILE') if (wndws()); $home ||= '~'; toggle 'instopt_adjustpath'; if ($vars{'instopt_adjustpath'}) { print "New value for binary directory [$sys_bin]: "; chomp($answer=<STDIN>); $vars{'tlpdbopt_sys_bin'} = "$answer" if (length $answer); - $vars{'tlpdbopt_sys_bin'} =~ s@\\@/@g if (win32()); + $vars{'tlpdbopt_sys_bin'} =~ s@\\@/@g if (wndws()); $vars{'tlpdbopt_sys_bin'} =~ s/^~/$home/; if ($vars{'tlpdbopt_sys_bin'}=~/^(.*)\/bin$/) { $vars{'tlpdbopt_sys_man'}="$1/man"; @@ -861,13 +861,13 @@ EOF print "New value for man directory [$vars{'tlpdbopt_sys_man'}]: "; chomp($answer=<STDIN>); $vars{'tlpdbopt_sys_man'}="$answer" if (length $answer); - $vars{'tlpdbopt_sys_man'} =~ s@\\@/@g if (win32()); + $vars{'tlpdbopt_sys_man'} =~ s@\\@/@g if (wndws()); $vars{'tlpdbopt_sys_man'} =~ s/^~/$home/; print "New value for info directory [$vars{'tlpdbopt_sys_info'}]: "; chomp($answer=<STDIN>); $vars{'tlpdbopt_sys_info'}="$answer" if (length $answer); - $vars{'tlpdbopt_sys_info'} =~ s@\\@/@g if (win32()); + $vars{'tlpdbopt_sys_info'} =~ s@\\@/@g if (wndws()); $vars{'tlpdbopt_sys_info'} =~ s/^~/$home/; } return $command{'self'}; @@ -875,7 +875,7 @@ EOF } else { if (("\u$answer" eq 'L') and !$vars{'instopt_portable'}) { my $home = getenv('HOME'); - $home = getenv('USERPROFILE') if (win32()); + $home = getenv('USERPROFILE') if (wndws()); $home ||= '~'; toggle 'instopt_adjustpath'; return $command{'self'}; @@ -884,7 +884,7 @@ EOF # # tlpdbopt_desktop_integration, tlpdbopt_file_assocs # -# if (win32() || $::opt_all_options) { +# if (wndws() || $::opt_all_options) { # if ("\u$answer" eq 'M' and !$vars{'instopt_portable'}) { # toggle 'tlpdbopt_desktop_integration'; # return $command{'self'}; @@ -940,7 +940,7 @@ EOF } elsif (defined $command{"\u$answer"}) { return $command{"\u$answer"}; - } elsif (("\u$answer" eq 'W') && ($::opt_all_options || win32()) && + } elsif (("\u$answer" eq 'W') && ($::opt_all_options || wndws()) && !$opt_in_place ) { toggle 'collection-texworks'; return $command{'self'}; @@ -1028,7 +1028,7 @@ sub main_menu { my $b_fmt=button($vars{'tlpdbopt_create_formats'}); my $b_letter=button($vars{'instopt_letter'}); my $b_deskint=button($vars{'tlpdbopt_desktop_integration'}, \@::deskintdesc); - if (win32()) { + if (wndws()) { my $b_fileassoc=button($vars{'tlpdbopt_file_assocs'}, \@::fileassocdesc); } my $b_admin=button($vars{'tlpdbopt_w32_multi_user'}); @@ -1138,7 +1138,7 @@ EOF print " $b_src install macro/font source tree\n"; } } - if (win32()) { + if (wndws()) { if (!$vars{'instopt_portable'}) { print " $b_path adjust search path\n"; print " $b_deskint add menu items, shortcuts, etc.\n"; @@ -1151,7 +1151,7 @@ EOF } print " $b_path create symlinks to standard directories\n" - unless ($vars{'instopt_portable'} || win32()); + unless ($vars{'instopt_portable'} || wndws()); print " $b_adjustrepo after install, set CTAN as source " . "for package updates\n" |