From 8a7c60c46ef0b8e1eb91b1cfbf28fafa75f6c4f7 Mon Sep 17 00:00:00 2001 From: Staszek Wawrykiewicz Date: Wed, 27 Dec 2006 17:58:42 +0000 Subject: setuptl installers added git-svn-id: svn://tug.org/texlive/trunk@2984 c570f23f-e606-0410-a88d-b1316a301751 --- Master/setuptl/TLPM/blng.pm | 36 +++ Master/setuptl/TLPM/check.pm | 67 ++++++ Master/setuptl/TLPM/cmdl.pm | 149 +++++++++++++ Master/setuptl/TLPM/common.pm | 221 ++++++++++++++++++ Master/setuptl/TLPM/constants.pm | 101 +++++++++ Master/setuptl/TLPM/help.pm | 439 ++++++++++++++++++++++++++++++++++++ Master/setuptl/TLPM/incl.pm | 60 +++++ Master/setuptl/TLPM/info.pm | 39 ++++ Master/setuptl/TLPM/inst.pm | 237 ++++++++++++++++++++ Master/setuptl/TLPM/list.pm | 58 +++++ Master/setuptl/TLPM/pkg.pm | 469 +++++++++++++++++++++++++++++++++++++++ Master/setuptl/TLPM/reg.pm | 51 +++++ Master/setuptl/TLPM/uninst.pm | 117 ++++++++++ 13 files changed, 2044 insertions(+) create mode 100644 Master/setuptl/TLPM/blng.pm create mode 100644 Master/setuptl/TLPM/check.pm create mode 100644 Master/setuptl/TLPM/cmdl.pm create mode 100644 Master/setuptl/TLPM/common.pm create mode 100644 Master/setuptl/TLPM/constants.pm create mode 100644 Master/setuptl/TLPM/help.pm create mode 100644 Master/setuptl/TLPM/incl.pm create mode 100644 Master/setuptl/TLPM/info.pm create mode 100644 Master/setuptl/TLPM/inst.pm create mode 100644 Master/setuptl/TLPM/list.pm create mode 100644 Master/setuptl/TLPM/pkg.pm create mode 100644 Master/setuptl/TLPM/reg.pm create mode 100644 Master/setuptl/TLPM/uninst.pm (limited to 'Master/setuptl/TLPM') diff --git a/Master/setuptl/TLPM/blng.pm b/Master/setuptl/TLPM/blng.pm new file mode 100644 index 00000000000..5743fdda2c4 --- /dev/null +++ b/Master/setuptl/TLPM/blng.pm @@ -0,0 +1,36 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# blng [-pf] +# display which package belongs to one given + +sub blng +{ + my ($arg,$pkg); + my $count = 0; + local $inclby_method = \&get_pkg_belongs; + local $is_method = \&is_pkg; + my $pkges = $source_pkges; + while(defined($arg = shift)) + { + $arg eq '' and next + or &no_opt($arg) and $pkg = $arg + or &is_opt($arg,'p','package') and $inclby_method = \&get_pkg_belongs + and $is_method = \&is_pkg + or &is_opt($arg,'f','file') and $inclby_method = \&get_file_belongs + and $is_method = \&is_file + or &is_opt($arg,'h','help') and return $heeelp -> ('blng') + or &rem_opt($arg) and return $error{'wrong_opt'} -> ($arg,'blng --help'); + } + return $error{'pkg_unspec'} -> () if $pkg eq ''; + return if &read_source(); + $is_method -> ($pkg,$pkges) or return $error{'not_found'} -> ($pkg); + $mess -> (map {++$count;$_} $inclby_method -> ($pkg,$pkges)); + $mess -> ("\n"); + if($tlpm_redir < 2) + { + $message -> (&one_or_more($count,'parent bundle','parent bundles')); + } +} + +1; diff --git a/Master/setuptl/TLPM/check.pm b/Master/setuptl/TLPM/check.pm new file mode 100644 index 00000000000..9000369dd3b --- /dev/null +++ b/Master/setuptl/TLPM/check.pm @@ -0,0 +1,67 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# check [-pf] +# check the installation consistency + +sub check +{ + my $arg; + local $tl_target_new; + $check_method = \&check_pkges; + while(defined($arg = shift)) + { + $arg eq '' and next + or &is_opt($arg,'f','files') and $check_method = \&check_files + or &is_opt($arg,'p','packages') and $check_method = \&check_pkges + or &is_opt($arg,'d','directory') and do {$tl_target_new = shift;1} + or &is_opt($arg,'h','help') and return $heeelp -> ('check') + or &rem_opt($arg) and return $error{'wrong_opt'} -> ($arg,'check --help'); + }# force reading the target, even if already defined + $tl_target_new ||= $tl_target; + $tl_target_indeed = $false; + return if &read_target(); + return if &open_log(); + $check_method -> (); + &close_log(); +} + +sub check_files +{ + my ($fcount,$pcount) = (0,0); + my $pkg; + my @miss; + foreach $pkg (&get_pkg_all($target_pkges)) + { + @miss = grep {not(-f "$tl_target$chr_dirsep$_")} &get_pkg_contains($pkg,$target_pkges); + next unless scalar @miss; + ++$pcount; + $fcount += scalar @miss; + $messf -> ($row_fmt . "missing %s\n",$pkg,join(",\n" . ' ' x ($row_skip + 8),@miss)); + } + if($tlpm_redir < 2) + { + $message -> (&one_or_more($fcount,'missing file','missing files') . ' in ' . + &one_or_more($pcount,'package','packages')); + } +} + +sub check_pkges +{ + my $pcount = 0; + my $pkg; + my @miss; + foreach $pkg (&get_pkg_all($target_pkges)) + { + @miss = &get_pkg_miss($pkg,$target_pkges); + next unless scalar @miss; + ++$pcount; + $messf -> ($row_fmt . "missing %s\n",$pkg,join(",\n" . ' ' x ($row_skip + 8),@miss)); + } + if($tlpm_redir < 2) + { + $message -> ("$pcount missing " . ($pcount == 1 ? "package" : "packages")); + } +} + +1; diff --git a/Master/setuptl/TLPM/cmdl.pm b/Master/setuptl/TLPM/cmdl.pm new file mode 100644 index 00000000000..141e7b1a9e3 --- /dev/null +++ b/Master/setuptl/TLPM/cmdl.pm @@ -0,0 +1,149 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# cmdline parsing + +# surely we can't rely on windows shell behaviour, so we make all the parsing. +# some day I'd like to use native shell for u*x though... + +sub resolve_env # resolve environment variables +{ + my $str = \$_[0]; + while($$str =~ s/$reg_envvar/$ENV{$1}/){} +} + +*OUT; +*LOG; +$tlpm_output = undef; + +$reg_redir = qr/(>>?|\|)\s*(.+?)\s*\z/; + +sub set_out +{ + my $str = \$_[0]; + if($$str =~ s/$reg_redir//) + { + $tlpm_output = $2; + if($1 eq '|') + { + $tlpm_redir = 2; + } + else + { + $tlpm_redir = 1; + &norm_path($tlpm_output); + # $tlpm_output = &rel2abs($tlpm_output,$curr_dir); + } + $tlpm_output = $1 . $tlpm_output; + } + else + { + $tlpm_redir = 0; + } +} + +sub open_out +{ + if(defined $tlpm_output) + { + if(open(OUT,$tlpm_output)) + { + select OUT; + } + else + { + &close_out; + return $error{'wrong_out'} -> ($tlpm_output); + } + } +} + +sub close_out +{ + close OUT; + $tlpm_output = undef; + select STDOUT; +} + +sub open_log +{ + my $log = $tl_target . $tlpm_log; + if(open(LOG,">>$log")) + { + printf LOG ($row_fmt . "%s\n" , $message_prefix . $tlpm_prompt . $cmd_line , "[" . &date . "]"); + &talk2log(); + return(0); + } + else + { + &undef_target(); + return $error{'wrong_out'} -> ($log); + } +} + +sub close_log +{ + printf LOG ($row_fmt . "%s\n" , $message_prefix . "done" , "[" . &date . "]"); + close LOG; + ¬2log(); +} + + +$reg_white = qr/\A\s+|\A=/; +$reg_dquot = qr/\A\"(.*?)\"/; +$reg_squot = qr/\A\'(.*?)\'/; +$reg_param = qr/\A([^-]\S*)/; +$reg_sopts = qr/\A[-](\w+)/; +$reg_dopts = qr/\A[-]{2}(\w+)/; + +sub parse_cmd +{ + my $str = shift; + my (@opt,@opts); + while($str ne '') + { + $str =~ s/$reg_white// and next + or $str =~ s/$reg_squot// and push(@opt,"$1") + or $str =~ s/$reg_dquot// and push(@opt,"$1") + or $str =~ s/$reg_param// and push(@opt,"$1") + or $str =~ s/$reg_dopts// and push(@opt,"$opt_prefix$1") + or $str =~ s/$reg_sopts// and @opt = (@opt,map {"$opt_prefix$_"} split('',$1)) + or $error{'wrong_syn'} -> ($str) and return(); + } + while(defined($str = shift @opt)) + { + push(@opts,$str); + if($str =~ /$reg_option/ && $opt[0] =~ /$reg_option/) + { + push(@opts,''); + } + } + return @opts; +} + +sub is_opt +{ + my $arg = shift; + my $reg; + foreach(@_) + { + $reg = qr/$_\z/; + return $true if $arg =~ /$reg_option$reg/; + } + return $false; +} + +sub no_opt +{ + return ($_[0] =~ /$reg_option/ ? $false : $true); +} + +sub rem_opt +{ + map {s/$reg_option//} @_; +} + +$opt_prefix = 'opt:'; +$reg_option = qr/\A$opt_prefix/o; + +1; diff --git a/Master/setuptl/TLPM/common.pm b/Master/setuptl/TLPM/common.pm new file mode 100644 index 00000000000..b1cd93a09a6 --- /dev/null +++ b/Master/setuptl/TLPM/common.pm @@ -0,0 +1,221 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# common procedures; +# to avoid any stdlib dependencies, we implement a couple of trivial procedures here + +# trivial operations on paths + +sub dirsep2dirsep +{ + my $path = shift; + $path =~ s/$reg_dirsep/$chr_dirsep/g; + return $path; +} + +sub split_path +{ + return split(/$reg_dirsep/,$_[0]); +} + +sub join_path +{ + return join($chr_dirsep,@_); +} + +sub join_list +{ + return join(" ",@_); +} + +sub norm_path +{ + map + { + chomp;s/\A\s+//; + #s/$reg_dirsep+/$chr_dirsep/g; + s/$reg_dirsep\z//g; + s/\"//g; + # s/\A\'(.*?)\'\z/$1/; + } @_; +} + +sub make_tree +{ + my $path = shift; + &norm_path($path); + $path = &rel2abs($path,$curr_dir); + return(0) if -d $path; + my @dirs = &split_path($path); + $path = ''; + foreach(@dirs) + { + $path .= "$_$chr_dirsep"; + unless(-d $path) + { + mkdir($path,0777) or return $error{'cant_mdir'} -> ($path); + } + } + chop $path; + $message ->("Directory '$path' has been created"); + return(0); +} + +sub rel2abs +{ + return $_[0] if $_[0] =~ /$reg_abs/; # is absolute + my @rel = &split_path($_[0]); + my @abs = &split_path($_[1]); + foreach(@rel) + { + next if /\A\.\z/; + if(/\A\.\.\z/) + { + pop(@abs); + next; + } + push(@abs, $_); + } + if(@abs) + { + return &join_path(@abs); + } + else + { + @abs = &split_path($_[1]); # just drive + return $abs[0]; + } +} + +# system command + +sub sys +{ + system(&join_list(@_)); + return $?; +} + +# messaging + +$message_prefix = '% '; +$warning_prefix = '! '; + +$_message = sub {return "$message_prefix$_[0]\n"}; +$_warning = sub {return "$warning_prefix$_[0]\n"}; + +# printing to non-existing handle produce 'Bad file descriptor' error; +# we don't have fork so printing to log and terminal needs to be parallel; +# because of somewhat weird STRERR behaviour under windows, everything is +# printed to STDOUT (for tlpmgui) or to file; +# later we throw progress information to STRERR while installing from DVD + +sub _mess {print @_} +sub _logmess {print @_;print LOG @_} + +sub _messf{printf @_} +sub _logmessf {printf @_;printf LOG @_} + +sub _message +{ + print STDOUT $_message -> (@_); +} + +sub _logmessage +{ + print STDOUT $_message -> (@_); + print LOG $_message -> (@_); +} + +sub _warning +{ + print STDOUT $_warning -> (@_); +} + +sub _logwarning +{ + print STDOUT $_warning -> (@_); + print LOG $_warning -> (@_); +}; + +sub talk2log +{ + $mess = \&_logmess; + $messf = \&_logmessf; + $message = \&_logmessage; + $warning = \&_logwarning; +} + +sub not2log +{ + $mess = \&_mess; + $messf = \&_messf; + $message = \&_message; + $warning = \&_warning; +} + +¬2log(); + +# singular vs plural + +sub one_or_more +{ + return $_[0] . ' ' . ($_[0] == 1 ? $_[1] : $_[2]); +} + +# ...meybe someday we will use returned error codes +# errcode 0 is ok, 1 is help, negative means something went wrong + +%error = +( + 'tl_not_found' => sub {$warning -> ("TeX Live CD/DVD not found"); -1}, + 'not_tl_source' => sub {$warning -> ("TeX Live source not found at '$_[0]'"); -1}, + 'cant_odir' => sub {$warning -> ("Can't open directory '$_[0]'"); -2}, + 'cant_mdir' => sub {$warning -> ("Can't create directory '$_[0]'"); -3}, +# 'cant_wdir' => sub {$warning -> ("Directory '$_[0]' is not writable"); ?}, +# 'dir_unspec' => sub {$warning -> ("Target directory unspecified"); ?}, +# 'file_not_found' => sub {$warning -> ("Can't find file '$_[0]'"); ?}, + 'miss_dir' => sub {$warning -> ("Directory '$_[0]' does not exist"); -4}, + 'empty_dir' => sub {$warning -> ("Directory '$_[0]' contains no packages"); -5}, + 'wrong_out' => sub {$warning -> ("Can't write to '$_[0]'"); -6}, + 'wrong_inp' => sub {$warning -> ("Can't read from '$_[0]'"); -7}, + 'pkg_unspec' => sub {$warning -> ("Package unspecified"); -8}, + 'pkg_not_inst' => sub {$warning -> ("Package '$_[0]' is not installed"); -9}, + 'pkg_not_found' => sub {$warning -> ("Can't find package '$_[0]'"); -10}, + 'not_found' => sub {$warning -> ("Can't find '$_[0]'"); -11}, + 'wrong_opt' => sub {$warning -> ("Unknown option '$_[0]'. Type '$_[1]'"); -12}, + 'wrong_cmd' => sub {$warning -> ("Unknown command '$_[0]'. Type '$_[1]'"); -13}, + 'wrong_syn' => sub {$warning -> ("Incorrect phrase '$_[0]'"); -14}, + 'wrong_reg' => sub {$warning -> ("Incorrect expression '$_[0]'"); -15}, + 'not_supp' => sub {$warning -> ("Sorry, $_[0] not yet supported"); -16} +); + +# date handling + +sub date +{ + my ($min,$hr,$day,$mon,$year) = (localtime)[1,2,3,4,5]; + $year += 1900; + ($min,$hr,$day,$mon) = map {sprintf "%02d",$_} ($min,$hr,$day,$mon + 1); + return "$day.$mon.$year, $hr:$min"; +} + +# quoting + +sub doubleq {return '"' . $_[0] . '"'} +sub singleq {return "'" . $_[0] . "'"} + +# progress + +sub percent +{ + return sprintf("%d%%",$_[0]*100/$_[1]); +} + +# -) + +sub relax +{ + return; # not zero +} + +1; diff --git a/Master/setuptl/TLPM/constants.pm b/Master/setuptl/TLPM/constants.pm new file mode 100644 index 00000000000..532f81ca13e --- /dev/null +++ b/Master/setuptl/TLPM/constants.pm @@ -0,0 +1,101 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# widely used constants + +$true = 1; +$false = 0; + +# general files handling + +$reg_file = qr/([^\/\\]+)\z/o; +$reg_dirsep = qr/[\/\\]/o; # not /(\/|\\)/ +# TLPM was originally windowish and is tested mostly on windows so +unless(defined $tlpm_os){$tlpm_os = 'win32'} # if in distribution, always defined in BEGIN block +if($tlpm_os eq 'win32'){$win32 = $true} + +if($win32) +{ + $chr_dirsep = "\\"; # directory separator + $reg_abs = qr/\A[a-z]:/io; # absolute path + $reg_envvar = qr/\%(\w+)\%/o; # environment variable + $curr_dir = `cd`; # current directory +} +else # assuming the rest of the world +{ + $chr_dirsep = "/"; + $reg_abs = qr/\A$chr_dirsep/io; + $reg_envvar = qr/\$(\w+)/o; + $curr_dir = `pwd`; +} + +&norm_path($curr_dir); +$parent_dir = &rel2abs('..',$curr_dir); + +# tlpm related constants + +$tlpm_prompt = "tlpm>"; + +$tlpm_log = $chr_dirsep . "tlpm.log"; # log file +$tlpm_dbg = $chr_dirsep . "tlpm.debug"; # debug file + +# relative paths to lists and tpms + +$tl_texmf = $chr_dirsep . "texmf"; +$tl_lists = $tl_texmf . $chr_dirsep . "lists"; +@tl_tpms = ($chr_dirsep . "texmf" . $chr_dirsep . "tpm", + $chr_dirsep . "texmf-dist" . $chr_dirsep . "tpm", + $chr_dirsep . "texmf-doc" . $chr_dirsep . "tpm"); + +# paths to source TL directory (relative to mounting point / drive) + +@tl_roots = ('', + $chr_dirsep . "texlive", + $chr_dirsep . "texlive2004"); + +# ZIP archive + +$tl_archive = $chr_dirsep . "archive"; + +# unzipper is always available in ./support directory + +if($win32) +{ + $tl_unzip = sub {return $tl_source . $chr_dirsep . "support" . $chr_dirsep . "unzip.exe"}; + $tl_xcopy = "xcopy"; # wrrrr + $sys_redir = '>nul'; +} +else +{ + $tl_unzip = sub {return "unzip"}; # assuming in system + $tl_xcopy = "cp"; + $sys_redir = '>/dev/null'; +} + +# handling package names heuristic do NOT match TL2003 and older! + +$reg_binary = qr/\Abin-[^.]+(.*)/io; # on TL2004 there is ie. bin-.sparc-solaris2.7.zip +$reg_library = qr/\Alib-[^.]+(.*)/io; +$reg_scheme = qr/\Ascheme-/io; +# no longer used +#$reg_win32 = qr/\.win32/io; # also 'win32-static' +#$reg_collec = qr/\Acollection-/io; + +# handling package list files +$reg_require = qr/\A[+-]/o; +$reg_action = qr/\A!/o; +$reg_about = qr/\A\*/o; +$reg_empty = qr/\A\s*\z/o; + +$, = "\n"; +$| = 1; + +# formatting + +$row_length = 80; +$row_skip = 42; +$wrd_skip = 12; +$row_fmt = "%-${row_skip}s"; +$wrd_fmt = "%-${wrd_skip}s"; + +1; diff --git a/Master/setuptl/TLPM/help.pm b/Master/setuptl/TLPM/help.pm new file mode 100644 index 00000000000..25fc1a2c754 --- /dev/null +++ b/Master/setuptl/TLPM/help.pm @@ -0,0 +1,439 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# help + +sub help +{ + my $arg = shift; + $arg eq '' and return $heeelp -> ('tlpm') + or &no_opt($arg) and return $heeelp -> ($arg) + or &is_opt($arg,'h','help') and return $heeelp -> ('help') + or &is_opt($arg,'H','Help','readme') and return &readme() + or &rem_opt($arg) and return $error{'wrong_opt'} -> ($arg,'help --help') +} + +$heeelp = sub +{ + my $topic = shift; + if(defined $help{$topic}) + { + $mess -> ($help{$topic} . "\n\n"); + return(1); + } + else + { + return $error{'wrong_cmd'} -> ($topic,'help'); + } +}; + +%help = +( +'tlpm_banner' => "This is TeX Live Package Manager, v$tlpm_version +Public Domain, P.Jackowski\@gust.org.pl", + +'type_help' => "Type 'help' or other command.", + +'technical_notes' => "TECHNICAL NOTES: + +* About TLPM +TLPM (TeX Live Package Manager) helps to search, trace dependencies, and install +TeX Live packages. It works with TeX Live 2004-2006. Initially, TLPM was a Perl script +just for controlling the mass of TeX Live packages repository. Since there were no +win-installer on TeX Live 2004, TLPM became a rescue solution. Starting from version 2.11, +TLPM works, with some restrictions, under Unix shells as well. + +Since there is no consistent versioning system withing TeX Live distribution, TLPM does +NOT support upgrades or downgrades. TLPM fully relies on the information retrieved from +the TPM files (actually from text files stored in the 'texmf/lists' directory). If you don't +trust TPMs, do NOT trust TLPM either! + +All the configuration is beyond the scope of TLPM functionality. TLPM doesn't perform +any post-installation actions such as setting of environment variables, building formats +or updating fontmap files. All those tasks are made by TLPMGUI program written +by Tomek \\{}Luczak. + +* Usage +TLPM tries to detect the CD/DVD drive with TeX Live disk automagically. If the magic +fails, TLPM prompts to provide a mounting point, unless one use the '--source' +command-line option or the 'tl_source' environment variable (which might be useful +while installing from local hard drive resources). + +The target installation directory can be specified with the '--directory' command-line +option or the 'tl_target' environment variable. If both are missing, one is prompted +for the target directory during runtime (interactive mode) or it is initialized +to current directory (batch mode). + +TLPM can be run in batch mode. In such a case, each line of the batch file +is treated as a TLPM command, unless empty or starts with the '%' or '#' characters. +The range of commands and options available in batch mode is the same as in +the interactive mode. Mentioned TLPMGUI program communicates with TLPM via batches. + +The history of installed and uninstalled packages is saved in the tlpm.log file +stored in the TeX Live target directory. TLPM does not reuse this file and +reads the current installation state from disk in each run. + +TLPM is self documented -- 'help []' informs about usage details. + +* Command line +TLPM respects quotations (both double quotes and single quotes) used in command +line. Quotation is necessary while using path names with spaces (strongly not +recommended!) or other strange characters that may conflict with the command +syntax. If so, please quote the entire phrase. Whenever analysing the command, +TLPM also resolves environment variables expressed as '%variable%' or '\$variable'. +Shell specific expansions are not performed. + +* License +I have done my best to make TLPM functional and reliable, but can NOT warrant +anything. If you like TLPM, feel free to redistribute it without any restrictions. +TLPM is in Public Domain. + +* Thanks +Big THANK YOU to Jolanta Szelaty\\n{}ska, Staszek Wawrykiewicz, Tomek \\L{}uczak, +Jerzy Ludwichowski and all other nice souls for all their help. + +* Bugs +Bugs reports and comments are welcome (tlpmgui\@gust.org.pl) + +* History +23.02.2005, 1.00 -- first beta release +06.04.2005, 1.01 -- bugfix; 'inst' function couldn't be executed twice + because of incorrect error code returned +06.05.2005, 1.02 -- bugfix; some of messages redirected to files were stored in + texmf/lists instead of the runtime directory +15.09.2005, 1.03 -- TLPM seems to work fine with TL2005; changed messages. +30.09.2005, 1.04 -- tiny changes in CD detection routine +05.10.2005, 2.00 -- general rework; mostly in messaging system and installation; + now TLPM supports also TeX Live DVD (slooow...) +06.10.2005, 2.01 -- again, changes in CD/DVD detction routine because of removing + tlpm(gui) stuff from TL root directory +08.10.2005, 2.02 -- bugfix; while removing standalone packages, uninstall + routine was performed twice +10.10.2005, 2.03 -- bugfix; now paths are internally separated by `\\' (\$chr_dirsep) + because of win98 archeology +11.10.2005, 2.04 -- debug version made to fix hanging under win98 +12.10.2005, 2.05 -- yet another temporary debug version +13.10.2005, 2.06 -- experimental progress info while installing from DVD +14.10.2005, 2.07 -- progress info while installing from CD and DVD + and --quiet option for 'inst' command +25.10.2005, 2.08 -- give up to with hanging on DVD instalation under Win98; + just note added +26.10.2005, 2.09 -- yet another slight correction +27.10.2005, 2.10 -- Karl confirmed that 'texlive2005' directory + need no longer to be checked +19.03.2006, 2.11 -- some experimental rework; allows to extract binaries for other + platforms, can work under Linux, prompts for source drive + or mounting point unless found automatically +23.04.2006, 2.12 -- addedd installation from DVD support for Linux; still slow, + as in Windows +08.05.2006, 2.13 -- bugfix; changes 2.12 spoil installation from cd +04.06.2006, 2.14 -- code commented + +* Known issues +1. Installation from DVD is much slower than from CD. Sorry... +2. Under Windows; if there are two CD drives (ie. 'E:\\' and 'F:\\') and TeX Live +disk is in the second one, system may throw 'Insert CD to E:\\' message and block +the program. Can't help that... Put the CD into 'F:\\' instead, use '--source' +option or 'tl_source' environment variable. +3. While sending the command output to pipe (ie. 'list | grep' or 'incl | more'), +by design, no summary is displayed. The summary might be irrelevant if affected +by grep or something. +4. While running via tlpmgui with DVD, installation (xcopy) hangs on Win98. Any ideas? +5. While installing from DVD, strange message 'Cannot perform INPAGE operation'. +Hardly reproducable... + +* Hope for the future +0. New TL package model +1. Shell-specific cmd-line expansion (?) +2. More robust and platform independent copying mechanism (DVD)", + +'tlpm' => +"USAGE: +tlpm [platforms] [-s \] [-d \] [-b \] + +DESCRIPTION: +TLPM help searching for, installing and uninstalling TeX Live packages. It +should be used in conjunction with the TeX Live 2004-2005 CD/DVD. + +COMMANDS: +list list packages or files with names matching the given phrase +incl list packages or files included in the given bundle +blng show to which bundle the given package or file belongs +inst install a package in specified target directory (just extract) +uninst uninstall a package from specified target directory +check check installation dependencies and consistency +info show package info +help show this help or the given command description +cmd execute a system command +quit leave the program + +Type 'help \' for details. + +OPTIONS: +-s --source set default TeX Live source path +-d --directory set default TeX Live target path +-b --batch enter batch mode +-h --help display this help and quit +-H --Help display the entire readme and quit +-v --version display the version info and quit + +EXAMPLES: +% start in interactive mode +tlpm + +% start in batch mode reading commands from 'file.lst' +tlpm -b file.lst + +% set TeX Live target directory (do not prompt during runtime) +tlpm -d /usr/share/TeX +tlpm -d D:\\TeX + +% set TeX Live source and target (current directory) +tlpm -s /mnt/cd -d . +tlpm -s E:\\ -d . + +% respect binary packages for listed platforms (depends on TeX Live naming convention) +tlpm win32 i386-linux -s /mnt/cd +tlpm win32 i386-linux -s E:\\ + +% execute just one TLPM \ and quit +echo \ | tlpm", + +'list' => +"USAGE: +list [-pfe] [\] [-d \] + +DESCRIPTION: +Lists files or packages from TeX Live CD/DVD or installation directory. + +OPTIONS: +-p --packages search for packages matching \ (default) +-f --files search for files matching \ +-e --expression treat \ as a Perl regular expression (regex) +-d --directory list packages or files installed in the \ directory + +EXAMPLES: +% display a list of all packages available on TeX Live CD/DVD +list + +% the same via a pager +list -p * | more + +% output all PFB file names on the CD/DVD into font.log +list -f *.pfb \>font.log + +% the same, but matching regex instead of a mask +list -fe ^.*\\.pfb$ \>font.log + +% list package collections installed in \ +list coll* -d /usr/share/TeX +list coll* -d D:\\TeX + +% the same, assuming that the target directory has already been specified +list coll* -d + +% yet one more alternative via grep +list -d | grep coll", + +'incl' => +"USAGE: +incl \ [-pferj] [\] + +DESCRIPTION: +Displays a list of \ requirements and contents. + +OPTIONS: +-p --packages show required packages matching \ (default) +-f --files show included files matching \ +-e --expression treat \ as a Perl regex +-r --recurse follow dependencies recursively (default) +-j --justone do not recurse + +EXAMPLES: +% display all packages required by collection-basic (via pager) +incl collection-basic | more + +% display packages directly required by the collection-basic +incl collection-basic -j + +% write all TFM files included in the collection-basic to tfms.lst +incl collection-basic -f *.tfm \> tfms.lst + +% display a list of collections included in the GUST scheme +incl scheme-gust.scheme -p coll", + +'blng' => +"USAGE: +blng [-pf] \ + +DESCRIPTION: +Shows parent bundle(s) of a package or file given by \ (not \). + +OPTIONS: +-p --package treat \ as a package (default) +-f --file treat \ as a file + +EXAMPLES: +% show bundles that include collection-context +blng collection-context + +% show the package that contains the 'manfnt.tfm' file +blng -f manfnt.tfm", + +'inst' => +"USAGE: +inst \ [-rjou] [-d \] + +DESCRIPTION: +Install \ in the specified target directory. +By default, already installed packages are skipped. + +OPTIONS: +-r --recurse follow dependencies recursively (default) +-j --justone do not recurse +-o --overwrite reinstall existing packages +-u --update refresh older, create missing files (implies --overwrite) +-d --directory install the packages in \ directory +-q --quiet disable progress info + +EXAMPLES: +% install entire collection-basic in \ +inst collection-basic -d /usr/share/TeX +inst collection-basic -d D:\\TeX + +% reinstall collection-basic and prompt for the target directory (if not given already) +inst collection-basic -o + +% just update the ComputerModern fonts package +inst cm -ju", + +'uninst' => +"USAGE: +uninst \ [-rjiI] [-d \] + +DESCRIPTION: +Uninstalls \ from the specified target directory. + +OPTIONS: +-r --recurse follow dependencies recursively (default) +-j --justone do not recurse +-i --ignore ignore dependencies +-I --Ignore ignore dependencies indeed +-d --directory uninstall packages from \ directory + +EXAMPLES: +% remove the LaTeX collection with all components, unless required by other packages +uninst collection-latex + +% force removal of the LaTeX collection but leave shared packages untouched +uninst collection-latex -i + +% force removal of the LaTeX collection and all its components, even if shared (dangerous) +uninst collection-latex -I + +% remove just the 'ltxmisc' package from \ +uninst ltxmisc -j -d /ust/share/TeX +uninst ltxmisc -j -d D:\\TeX", + +'check' => +"USAGE: +check [-pf][-d \] + +DESCRIPTION: +Check installation dependencies and consistency. + +OPTIONS: +-p --packages check packages (default) +-f --files check files +-d --directory check given \ directory + +EXAMPLES: +% display packages missing from \ +check -d /usr/share/TeX +check -d D:\\TeX + +% almost the same (prompt for directory, if not specified already) +check + +% display files that should exist but can not be found +check -f", + +'help' => +"USAGE: +help [\] + +DESCRIPTION: +Displays general help or usage details for a given command. + +OPTIONS: +-H --Help display the entire readme + +EXAMPLES: +% display general help (via pager) +help | more + +% tell me more about the 'inst' command +help inst + +% exactly the same +inst --help", + +'info' => +"USAGE: +info \ + +DESCRIPTION: +Displays the information available for a given package. + +EXAMPLES: +% tell me something about ConTeXt +info context", + +'quit' => +"USAGE: +quit + +DESCRIPTION: +Leaves the program. + +EXAMPLES: +% say goodbye +quit", + +'cmd' => +"USAGE: +cmd \ + +DESCRIPTION: +Executes a system command without exiting the TLPM session. + +EXAMPLES: +% mount TeX Live source +cmd mount /dev/cd /mnt/cd + +% test TeX +cmd tex \\input story \\end + +% clear screen +cmd clear" +); + +sub readme +{ + my $z; + my $sep = '#'; + my @topics = qw( technical_notes tlpm list incl blng inst uninst check help info cmd quit); + $heeelp -> (shift @topics); + $mess -> ("\n" . $sep x $row_length . "\n" . ' ' x 30 . "COMMANDS IN DETAILS\n" . $sep x $row_length ); + foreach(@topics) + { + $z = $row_length - length($_) - 2; + ($z % 2 == 1 ? $z = ($z-1)/2 : $z = $z/2); + $mess -> ("\n\n" . $sep x $z . ' ' . $_ . ' ' . $sep x $z . "\n"); + $heeelp -> ($_); + } + $mess -> ("\n"); + return(1); +} + +1; diff --git a/Master/setuptl/TLPM/incl.pm b/Master/setuptl/TLPM/incl.pm new file mode 100644 index 00000000000..a86c20eab39 --- /dev/null +++ b/Master/setuptl/TLPM/incl.pm @@ -0,0 +1,60 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# incl [-pfer] +# display a list of included packages matching + +sub incl +{ + local $reg_method = \&string2reg; + local $incl_method = \&incl_packages; + local $getp_method = \&get_pkg_requires_all; + local $getf_method = \&get_pkg_contains_all; + my $pkges = $source_pkges; + my ($pkg,$arg,$reg); + while(defined($arg = shift)) + { + $arg eq '' and next + or &no_opt($arg) and (defined $pkg ? $reg = $arg : $pkg = $arg) + or &is_opt($arg,'f','files') and $incl_method = \&incl_files + or &is_opt($arg,'p','packages') and $incl_method = \&incl_packages + or &is_opt($arg,'e','expression') and $reg_method = \&string2preg + or &is_opt($arg,'j','justone') and $getp_method = \&get_pkg_requires + and $getf_method = \&get_pkg_contains + or &is_opt($arg,'r','recurse') and $getp_method = \&get_pkg_requires_all + and $getf_method = \&get_pkg_contains_all + or &is_opt($arg,'h','help') and return $heeelp -> ('incl') + or &rem_opt($arg) and return $error{'wrong_opt'} -> ($arg,'incl --help'); + } + return $error{'pkg_unspec'} -> () if $pkg eq ''; + eval '$reg = $reg_method -> ($reg)'; + if($@){return $error{'wrong_reg'} -> ($reg)} + return if &read_source(); + is_pkg($pkg,$pkges) or return $error{'pkg_not_found'} -> ($pkg); + $incl_method -> ($pkg,$reg,$pkges); +} + +sub incl_packages +{ + my ($pkg,$reg,$pkges) = @_; + my $count = 0; + $mess -> (grep {/$reg/ and ++$count} $getp_method -> ($pkg,$pkges)); + $mess -> ("\n"); + if($tlpm_redir < 2) + { + $message -> (&one_or_more($count,'package','packages')); + } +} + +sub incl_files +{ + my ($pkg,$reg,$pkges) = @_; + my $count = 0; + $mess -> (grep {/$reg/ and ++$count} $getf_method -> ($pkg,$pkges));$mess -> ("\n"); + if($tlpm_redir < 2) + { + $message -> ("$count " . ($count == 1 ? "file" : "files")); + } +} + +1; diff --git a/Master/setuptl/TLPM/info.pm b/Master/setuptl/TLPM/info.pm new file mode 100644 index 00000000000..324d1a68a32 --- /dev/null +++ b/Master/setuptl/TLPM/info.pm @@ -0,0 +1,39 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# info +# retrieve package info from tpm file + +sub info +{ + my ($arg,$pkg,$tpm); + while(defined($arg = shift)) + { + $arg eq '' and next + or &no_opt($arg) and $pkg = $arg + or &is_opt($arg,'h','help') and return $heeelp -> ('info') + or &rem_opt($arg) and return $error{'wrong_opt'} -> ($arg,'info --help'); + } + return $error{'pkg_unspec'} -> () if $pkg eq ''; + if($pkg =~ $reg_scheme) + { + $pkg =~ s/\.scheme\z//; # different list and tpm... wrrrrr + } + $tpm = &get_tpm($pkg); + return $error{'pkg_not_found'} -> ($pkg) if $tpm eq ''; + local *INP; + local $/ = undef; + open(INP,"<$tpm") or return $error{'wrong_inp'} -> ($tpm); + $tpm = ; + close INP; + foreach(qw/Name Title Type Version Date Description/) + { + if($tpm =~ /\s*(.+?)\s*<\/TPM:$_>/si)# rather rough, but do we need more? + { + $messf -> ("%-11s : %s\n",$_,$1); + } + } + $mess -> ("\n"); +} + +1; diff --git a/Master/setuptl/TLPM/inst.pm b/Master/setuptl/TLPM/inst.pm new file mode 100644 index 00000000000..757ebbedb59 --- /dev/null +++ b/Master/setuptl/TLPM/inst.pm @@ -0,0 +1,237 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# inst [-jrou] +# install + +sub inst +{ + my ($arg,$pkg,@pkg_list); + local $tl_target_new; + local ($quiet_mode,$overwrite,$update,$recurse) = (0,0,0,1); + while(defined($arg = shift)) + { + $arg eq '' and next + or &no_opt($arg) and push(@pkg_list,$arg) + or &is_opt($arg,'j','justone') and do {$recurse = 0;1} + or &is_opt($arg,'r','recurse') and $recurse = 1 + or &is_opt($arg,'o','overwrite') and $overwrite = 1 + or &is_opt($arg,'u','update') and $update = 1 and $overwrite = 1 + or &is_opt($arg,'d','directory') and do {$tl_target_new = shift;1} + or &is_opt($arg,'q','quiet') and do {$quiet_mode = 1} + or &is_opt($arg,'h','help') and return $heeelp -> ('inst') + or &rem_opt($arg) and return $error{'wrong_opt'} -> ($arg,'inst --help'); + } + return $error{'pkg_unspec'} -> () unless @pkg_list; + return if &read_source(); + &read_target(); # may be missing + return if &make_tree($tl_target); + return if &open_log(); + &install(@pkg_list); + &close_log; +} + +sub install +{ + my $pkg; + my (@trace,%trace); + foreach $pkg (@_) + { + &is_pkg($pkg,$source_pkges) or $error{'pkg_not_found'} -> ($pkg) and next; + push(@trace,$pkg); + if($recurse) + { + push(@trace,&get_pkg_requires_all($pkg,$source_pkges)); + } + } + local (@inst_pkges,@inst_files); + local ($pskip,$ptotal) = (0,0); + foreach $pkg (@trace) # cleanup; remove duplicates, flush already installed + { + next if exists $trace{$pkg}; + $trace{$pkg} = $true; + ++$ptotal; + if(not $overwrite and &is_pkg($pkg,$target_pkges)) + { + $messf -> ($row_fmt . $wrd_fmt . "\n",$pkg,"skipped"); + ++$pskip; + next; + } + push(@inst_pkges,$pkg); + } + foreach $pkg (@inst_pkges) + { + push(@inst_files,&get_pkg_contains($pkg,$source_pkges)); + } + local ($fdone,$ftodo,$pdone,$ptodo) = (0,0,0,0); # for progress info + $ptodo = scalar @inst_pkges; + $ftodo = scalar @inst_files; + $install_info -> (); + return unless $ptodo; + local $sys_redir = $sys_redir; # to override redirection if debug + if($debug_mode) + { + $sys_redir = '>>' . $tl_target . $tlpm_dbg; + } + local ($extract,$extract_params); + if($tl_type eq 'DVD') + { + $extract = \&extract_dvd; + if($win32) + { + $copying_params = \©ing_params_win32; + $extract_params = '/Y /R ' . ($debug_mode ? '/F' : '/C') . ($update ? ' /D' : ''); + } + else + { + $copying_params = \©ing_params_ux; + $extract_params = '-f -L -r --parents '# force, follow links, recursive, append paths + . ($debug_mode ? '-v' : '') . ($update ? ' -u' : ''); + } + } + else # fortunatelly unzipper setup is common for all lplatforms + { + $extract = \&extract_cd; + $extract_params = ($update ? '-ou' : '-o') . ($debug_mode ? '' : ' -qq'); + } + local ($inst_progress,$copy_progress); + if($quiet_mode) + { + ($inst_progress,$copy_progress) = (\&relax,\&relax); + } + else + { + + ($inst_progress,$copy_progress) = (\&install_progress,\©ing_progress); + } + local (@extract_files,$fextract); + my ($status,$err); + $update and $status = "refreshed" or + $overwrite and $status = "reinstalled" or $status = "installed"; + unless($win32){chdir($tl_source)} # cp uses quite dirrefent relative path approach then xcopy + foreach $pkg (@inst_pkges) + { + $messf -> ($row_fmt,$pkg); + @extract_files = &get_pkg_contains($pkg,$source_pkges); + $fextract = scalar @extract_files; + $extract -> ($pkg); + if($?) + { + $status = "error: $!"; + $messf -> ("%-12s",$status); + } + else + { + $target_pkges -> {$pkg} = $source_pkges -> {$pkg}; + $messf -> ("%-12s",$status); + $inst_progress -> (); + } + $mess -> ("\n"); + } + unless($win32){chdir($curr_dir)} +} + +# extrating from zip files (CD) + +sub extract_cd +{ + my $pkg = shift; + my @cmd = (&doubleq($tl_unzip -> ()),$extract_params, + &doubleq($tl_source . $tl_archive . "$chr_dirsep$pkg.zip"), + '-d',&doubleq($tl_target),$sys_redir); + return sys(@cmd); +} + +# copying files (DVD) + +sub extract_dvd +{ + my $pkg = shift; + local ($path,$file,%xcopy); + local $done = 0; + my $reg = quotemeta($pkg); + $reg = qr/$reg_dirsep$reg$reg_dirsep/i; + # the most expensive here is calling system thousands of times; + # for sake of speed, we gather files into groups matching '/some/dir/*' and pass wildcards to copy + foreach $path (@extract_files) + { + $path =~ s/$reg_file//; + $file = $1; + if($path =~ /$reg/) + { + ++$xcopy{"$path$chr_star"}[0]; + $xcopy{"$path$chr_star"}[1] = $path; + } + else + { + $xcopy{"$path$file"}[0] = 1; + $xcopy{"$path$file"}[1] = $path; + } + } + foreach $path (keys %xcopy) + { + + $done += $xcopy{$path}[0]; + $copy_progress -> (); + return $? if &sys($copying_params -> ()); + } + return(0); +} + +sub copying_params_win32 +{ + return ($tl_xcopy,&doubleq($tl_source . $chr_dirsep . $path), + &doubleq($tl_target . $chr_dirsep . $xcopy{$path}[1]), + $extract_params, + $sys_redir); +} + +sub copying_params_ux +{ + return($tl_xcopy, $extract_params, $path, &doubleq($tl_target), $sys_redir); +} + +sub install_progress +{ + $pdone += 1; + $fdone += $fextract; + printf STDOUT ("%-12s%-12s",&percent($fdone,$ftodo),&percent($pdone,$ptodo)) +} + +# installing from DVD is slow enough to be confused with crash, hence single package progress info + +sub copying_progress # the only things flushed to STDERR +{ + printf STDERR ("\b\b\b\b\b%-5s",&percent($done,$fextract)); +} + +$install_info = sub +{ + if($pskip) + { + $messf -> ($row_fmt , $message_prefix . "$pskip of $ptotal already installed"); + $progres_pre -> (); + } + else + { + $messf -> ($row_fmt , $message_prefix . "checking packages to install..."); + $progres_pre -> (); + } + $mess -> ("\n"); +}; + +$progres_pre = sub +{ + if($ptodo) + { + $messf -> ($wrd_fmt . $wrd_fmt . $wrd_fmt,'to do:', + &one_or_more($ftodo,"file","files"), + &one_or_more($ptodo,"package","packages")); + } + else + { + $mess -> ("nothing to do"); + } +}; + +1; diff --git a/Master/setuptl/TLPM/list.pm b/Master/setuptl/TLPM/list.pm new file mode 100644 index 00000000000..c110b487542 --- /dev/null +++ b/Master/setuptl/TLPM/list.pm @@ -0,0 +1,58 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# list [-pfe] +# display a list of packages matching + +sub list +{ + my ($arg,$reg,$mask); + my $pkges = $source_pkges; + local $tl_target_new; + local $list_method = \&list_packages; + local $reg_method = \&string2reg; + local $read_method = \&read_source; + while(defined($arg = shift)) + { + $arg eq '' and next + or &no_opt($arg) and $mask = $arg + or &is_opt($arg,'f','files') and $list_method = \&list_files + or &is_opt($arg,'p','packages') and $list_method = \&list_packages + or &is_opt($arg,'e','expression') and $reg_method = \&string2preg + or &is_opt($arg,'d','directory') and $read_method = \&read_target + and $pkges = $target_pkges + and do {$tl_target_new = shift;1} + or &is_opt($arg,'h','help') and return $heeelp -> ('list') + or &rem_opt($arg) and return $error{'wrong_opt'} -> ($arg,'list --help'); + } + eval '$reg = $reg_method -> ($mask)'; + if($@){return $error{'wrong_reg'} -> ($mask)} + return if $read_method -> (); + return $list_method -> ($reg,$pkges); +} + +sub list_packages +{ + my ($reg,$pkges) = @_; + my $count = 0; + $mess -> (grep {/$reg/ and ++$count} &get_pkg_all($pkges)); + $mess -> ("\n"); + if($tlpm_redir < 2) + { + $message -> (&one_or_more($count,'matching package','matching packages')); + } +} + +sub list_files +{ + my ($reg,$pkges) = @_; + my $count = 0; + $mess -> (grep {/$reg/ and ++$count} &get_file_all($pkges)); + $mess -> ("\n"); + if($tlpm_redir < 2) + { + $message -> (&one_or_more($count,'matching file','matching files')); + } +} + +1; diff --git a/Master/setuptl/TLPM/pkg.pm b/Master/setuptl/TLPM/pkg.pm new file mode 100644 index 00000000000..b3e53ac200c --- /dev/null +++ b/Master/setuptl/TLPM/pkg.pm @@ -0,0 +1,469 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# reading packages (internal functions) + +# here the main work starts + +%source_packages; # read only once (constant) +%target_packages; # read each time is requested (affected by installing / uninstalling) + +$source_pkges = \%source_packages; +$target_pkges = \%target_packages; + +sub read_pkges # used for reading both source and target packages +{ + my ($dir,$pkges) = @_; # + # Staszek Wawrykiewicz reports that the condition '-d E:' doesn't work in some cases. + # Not reproduced... However, '-d X:\texmf' works fine, so + unless(-d $dir || -d "$dir$tl_texmf") + { + return $error{'miss_dir'} -> ($dir); + } + $dir .= $tl_lists; + unless(-d $dir) + { + return $error{'miss_dir'} -> ($dir); + } + my ($pkg,$fcount,$pcount,$platform); + local (*DIR,*INP); + $message -> ("Reading packages from '$dir'..."); + opendir(DIR,$dir) or return $error{'cant_odir'} -> ($dir); + readdir DIR; readdir DIR; # remove '.' and '..'; dirty but works and make things faster + foreach $pkg (readdir DIR) + { + ($pcount,$fcount) = (0,0); + if($pkg =~ /$reg_binary/) + { + $platform = $1; + if($platform =~ s/\A\.//) # bin-. + { + unless(defined $tl_binaries{$platform}){next} + } + else # bin- + { + foreach(keys %tl_binaries) # binaries are not linked by tmps + { + $pkges -> {$pkg}{'requires'}{"$pkg.$_"} = ++$pcount; + } + } + } + elsif($pkg =~ /$reg_library/) + { + $platform = $1; + if($platform =~ s/\A\.//) # only win32? + { + unless(defined $tl_binaries{$platform}){next} + } + else + { + $platform = 'win32'; + if(defined $tl_binaries{$platform}) + { + $pkges -> {$pkg}{'requires'}{"$pkg.$platform"} = ++$pcount; + } + } + } + open(INP,"<$dir$chr_dirsep$pkg") or next; + foreach() + { + chomp; + if(s/$reg_require//) + { + $pkges -> {$pkg}{'requires'}{$_} = ++$pcount; + } + elsif(/$reg_about|$reg_action|$reg_empty/){} + else + { + $pkges -> {$pkg}{'contains'}{&dirsep2dirsep($_)} = ++$fcount; + } + } + close INP; + } + return $error{'empty_dir'} -> ($dir) unless keys %$pkges; + &find_missing($pkges); # not all bin-packages binaries for all platforms + closedir DIR; + return(0); +} + +sub find_missing +{ + my $pkges = shift; + my $pkg; + foreach $pkg (&get_pkg_all($pkges)) + { + foreach(&get_pkg_requires($pkg,$pkges)) + { + unless(exists $pkges -> {$_}) + { + $pkges -> {$pkg}{'missing'}{$_} = $pkges -> {$pkg}{'requires'}{$_}; + delete $pkges -> {$pkg}{'requires'}{$_}; + } + } + } +} + +sub get_pkg_miss +{ + my ($pkg,$pkges) = @_; + return sort keys %{$pkges -> {$pkg}{'missing'}}; +} + +sub read_source +{ + my $err; + if($err = &set_source()){return $err} + return(0) if %$source_pkges; # read once per session + $err = &read_pkges($tl_source,$source_pkges); + &undef_source if $err; + return $err; +} + +sub read_target +{ + &set_target(); + return(0) if %$target_pkges; # read once per session (except if forced) + return &read_pkges($tl_target,$target_pkges); +} + +sub set_source +{ + return(0) if $tl_source_indeed; + $message -> ("Looking for TeX Live source..."); + if(defined $tl_source) # firt check if predefined one is TL source indeed + { + if(&is_tl_root($tl_source)) + { + return(0); + } + else + { + $error{'not_tl_source'} -> ($tl_source); + } + } + foreach($parent_dir,$curr_dir) # in case TLPM located on CD or DVD + { + if(&is_tl_root($_)){return(0)} + } + if($win32) # sorry, no heuristic for others + { + foreach(D..Z) + { + if(&is_tl_root("$_:")){return(0)} + } + unless($batch_mode) # the last chance is prompt + { + print STDOUT "TeX Live source drive: "; + $tl_source = ;chomp $tl_source; + if(&is_tl_root($tl_source)) + { + return(0); + } + else + { + $error{'not_tl_source'} -> ($tl_source); + } + } + } + else + { + unless($batch_mode) + { + print STDOUT "TeX Live source mounting point: "; + $tl_source = ;chomp $tl_source; + if(&is_tl_root($tl_source)) + { + return(0); + } + else + { + $error{'not_tl_source'} -> ($tl_source); + } + } + } + &undef_source(); # not found anyhow -> reset presets + return $error{'tl_not_found'} -> (); +} + +sub is_tl_root +{ + my $dir = shift; + foreach(@tl_roots) + { + next if &no_source($dir . $_); + $message -> ("Welcome to TeX Live $tl_year $tl_type!"); + return $true; + } + return $false; +} + +sub no_source # strongly heuristic +{ + my $dir = shift; + &norm_path($dir); + $dir = &rel2abs($dir); + if(-f "$dir$chr_dirsep.mkisofsrc") + { + if(-f "$dir$chr_dirsep" . "00INST.TL") + { + $tl_type = 'CD'; + $tl_file = '00INST.TL'; + } + elsif(-f "$dir$chr_dirsep" . "00LIVE.TL") + { + $tl_type = 'DVD'; + $tl_file = '00LIVE.TL'; + } + else + { + return $true; + } + $tl_source = $dir; + $tl_source_indeed = $true; + local *INP; + open(INP,"<$dir$chr_dirsep$tl_file") or return $error{'wrong_inp'} -> ($tl_file); + my @lines = ; + close INP; + foreach(@lines) + { + next unless /\ARelease date: (\d{8}\.)/; + $tl_date = $1; # meybe we will use it + $tl_year = substr($tl_date,0,4); + return $false; + } + } + return $true; +} + +# in opposite to source packages, target is read whenever requested + +sub set_target +{ + if($tl_target_indeed and $tl_target_new eq ''){return 0} # target defined and not provided in cmdline + if($tl_target_new ne '') + { + &undef_target(); + $tl_target = $tl_target_new; + $tl_target_new = undef; + } + my $msg = 'TeX Live installation root directory'; + if($tl_target eq '') + { + if($batch_mode) + { + $tl_target = $curr_dir; # hm... what shall we do? + } + else # prompt for target directory + { + print STDOUT ('Type ' . $msg . ': '); + $tl_target = ; + &set_target_(); + } + } + else + { + &set_target_(); + } + # we tried to test if the directory is writable, but even CD drive respond to be writable... + #unless(-w $tl_target) + #{ + # &undef_target(); + # return $error{'cant_wdir'} -> ($tl_target); + #} + $message -> ($msg . ' set to ' . &singleq($tl_target)); + return(0); +} + +sub set_target_ +{ + &norm_path($tl_target); + $tl_target = &rel2abs($tl_target,$curr_dir); + $tl_target_indeed = $true; +} + +sub undef_source +{ + %source_packages = (); + $tl_source = undef; + $tl_source_indeed = $false; +} + +sub undef_target +{ + %target_packages = (); + $tl_target = undef; + $tl_target_indeed = $false; +} + +# some operations on loaded packages stored in hashes + +sub get_pkg_all +{ + my $pkges = shift; + return sort keys %$pkges; +} + +sub get_file_all +{ + my $pkges = shift; + return map {sort keys %{$pkges -> {$_}{'contains'}}} &get_pkg_all($pkges); +} + +sub get_pkg_requires +{ + my ($pkg,$pkges) = @_; + return sort + { + $pkges -> {$pkg}{'requires'}{$a} <=> $pkges -> {$pkg}{'requires'}{$b} + } + keys %{$pkges -> {$pkg}{'requires'}}; +} + +sub get_pkg_requires_all +{ + my ($pkg,$pkges) = @_; + local (%trace,@trace); + local $level = 0; + &get_pkg_requires_recurse($pkg,$pkges); + # delete $trace{$pkg}; # package never requires itself + shift @trace; + return @trace; +} + +sub get_pkg_requires_recurse +{ + my ($pkg,$pkges) = @_; + return(0) if exists $trace{$pkg}; + #++$level; + $trace{$pkg} = $true; + push(@trace,$pkg); + foreach(&get_pkg_requires($pkg,$pkges)) + { + &get_pkg_requires_recurse($_,$pkges); + } + #--$level; +} + +sub get_pkg_contains +{ + my ($pkg,$pkges) = @_; + return sort keys %{$pkges -> {$pkg}{'contains'}}; +} + +sub get_pkg_contains_all # assuming each file belongs to ONE package! +{ + my ($pkg,$pkges) = @_; + return + ( + &get_pkg_contains($pkg,$pkges), + map {&get_pkg_contains($_,$pkges)} &get_pkg_requires_all($pkg,$pkges) + ); +} + +sub get_pkg_belongs +{ + my ($pkg,$pkges) = @_; + my ($key, @arr); + foreach $key (&get_pkg_all($pkges)) + { + foreach(&get_pkg_requires($key,$pkges)) + { + if($_ eq $pkg) + { + push(@arr,$key); + } + } + } + return @arr; +} + +# no longer used +#sub is_required +#{ +# my $pkg = shift; +# my $key; +# foreach $key (&get_pkg_all($target_pkges)) +# { +# foreach (&get_pkg_requires($key,$target_pkges)) +# { +# return 1 if $_ eq $pkg; +# } +# } +# return 0; +#} + +sub get_file_belongs +{ + my $file = quotemeta(shift @_); + my $pkges = shift; + $file = qr/$reg_dirsep$file\z/i; + my ($key,@arr); + foreach $key (&get_pkg_all($pkges)) + { + foreach(&get_pkg_contains($key,$pkges)) + { + if($_ =~ /$file/) + { + push @arr, $key; + } + } + } + return @arr; +} + +sub is_pkg +{ + my ($pkg,$pkges) = @_; + return $true if exists $pkges -> {$pkg}; + return $false +} + +sub is_file +{ + my ($file,$pkges) = @_; + $file = quotemeta($file); + $file = qr/$reg_dirsep$file\z/i; + foreach(&get_file_all($pkges)) + { + return $true if /$file/; + } + return $false; +} + +# searching for tpm file to show info + +sub get_tpm +{ + my $pkg = shift; + my $file; + if(defined $tl_target) + { + if($file = &get_tpm_($tl_target,$pkg)) + { + return $file; + } + } + return('') if &set_source(); + if($file = &get_tpm_($tl_source,$pkg)) + { + return $file; + } + return(''); +} + +sub get_tpm_ +{ + my ($dir,$pkg) = @_; + my $file; + foreach(@tl_tpms) + { + $file = "$dir$_$chr_dirsep$pkg.tpm"; + if(-f $file) + { + return $file; + } + } + return ''; +} + +1; diff --git a/Master/setuptl/TLPM/reg.pm b/Master/setuptl/TLPM/reg.pm new file mode 100644 index 00000000000..19c7081ab13 --- /dev/null +++ b/Master/setuptl/TLPM/reg.pm @@ -0,0 +1,51 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# regexpresions and masks related functions + +$chr_star = '*'; +$reg_star = qr/.*?/o; +$chr_qust = '?'; +$reg_qust = qr/./o; + +sub string2reg # DOSish wildcards to regex +{ + my @str = split('', shift @_); + return qr/.{0}/ unless(@str); # not qr// since then grep{//} uses last match!! bleee + my ($reg,$chr); + foreach $chr (@str) + { + if($chr eq $chr_star) + { + $reg .= $reg_star; + } + elsif($chr eq $chr_qust) + { + $reg .= $reg_qust; + } + else + { + $reg .= quotemeta $chr; + } + } + $reg = qr/$reg/; + return $reg; +} + +sub string2preg +{ + my $reg = shift; + return qr/.{0}/ if $reg eq ''; + $reg = qr/$reg/; + return $reg; +} + +$reg_method = \&string2reg; + +#sub greg +#{ +# my $reg = $reg_method -> (shift); +# return grep {/$reg/} @_; +#} + +1; diff --git a/Master/setuptl/TLPM/uninst.pm b/Master/setuptl/TLPM/uninst.pm new file mode 100644 index 00000000000..8c2697d6095 --- /dev/null +++ b/Master/setuptl/TLPM/uninst.pm @@ -0,0 +1,117 @@ +# This file belongs to TLPM v2.14, TeX Live Package Manager +# Public Domain, P.Jackowski@gust.org.pl + +# uninst [-rjF] [dir] +# remove given package respecting dependencies + +sub uninst +{ + my ($arg,$pkg,@pkg_list); + local $tl_target_new; + local ($force,$Force) = (0,0); + local $uninst_method = \&uninst_all; + while(defined($arg = shift)) + { + $arg eq '' and next + or &no_opt($arg) and push(@pkg_list,$arg) + or &is_opt($arg,'j','justone') and $uninst_method = \&uninst_one + or &is_opt($arg,'r','recurse') and $uninst_method = \&uninst_all + or &is_opt($arg,'i','ignore') and $force = 1 + or &is_opt($arg,'I','Ignore') and ($Force,$force) = (1,1) + or &is_opt($arg,'d','directory') and do {$tl_target_new = shift;1} + or &is_opt($arg,'h','help') and return $heeelp -> ('uninst') + or &rem_opt($arg) and return $error{'wrong_opt'} -> ($arg,'uninst --help'); + } + return $error{'pkg_unspec'} -> () unless @pkg_list; + &read_target(); + return if &open_log(); + foreach $pkg (@pkg_list) + { + &is_pkg($pkg,$target_pkges) or $error{'pkg_not_inst'} -> ($pkg) and next; + $uninst_method -> ($pkg); + } + &close_log; +} + +sub uninst_all +{ + my $pkg = shift; + my $val; + local %uninst_pkges = map {($_,undef)} &get_pkg_requires_all($pkg,$target_pkges); + $uninst_pkges{$pkg} = undef; + &uninst_next($pkg); + unless($Force){$force = $false} + while(($pkg,$val) = each %uninst_pkges) + { + next if defined $val; + &uninst_next($pkg); + } +} + +sub uninst_one +{ + my $pkg = shift; + local $uninst_pkges{$pkg} = undef; + &uninst_next($pkg); +} + +sub uninst_next +{ + my $pkg = shift; + if($force) + { + &uninst_pkg($pkg); + } + else + { + &try_uninst_pkg($pkg); + } +} + +sub uninst_pkg +{ + my $pkg = shift; + $messf -> ($row_fmt,$pkg); + &rem_files($pkg); + $messf -> ("%s\n","uninstalled"); + $uninst_pkges{$pkg} = 1; + delete $target_pkges -> {$pkg}; +} + +sub leave_pkg +{ + my $pkg = shift; + $messf -> ($row_fmt . "required by %s\n",$pkg,join(",\n" . ' ' x ($row_skip + 12),@_)); + $uninst_pkges{$pkg} = 0; +} + + +sub rem_files +{ + map {unlink "$tl_target$chr_dirsep$_"} &get_pkg_contains($_[0],$target_pkges); +} + +sub try_uninst_pkg +{ + my $pkg = shift; + return(0) unless exists $uninst_pkges{$pkg}; + return $uninst_pkges{$pkg} if defined $uninst_pkges{$pkg}; + my $try = 1; + my @req = &get_pkg_belongs($pkg,$target_pkges); + foreach(@req) + { + $try *= &try_uninst_pkg($_); + } + if($try) + { + &uninst_pkg($pkg); + return(1); + } + else + { + &leave_pkg($pkg,grep {$uninst_pkges{$_} == 0} @req); + return(0); + } +} + +1; -- cgit v1.2.3