summaryrefslogtreecommitdiff
path: root/Master/setuptl/TLPM
diff options
context:
space:
mode:
Diffstat (limited to 'Master/setuptl/TLPM')
-rw-r--r--Master/setuptl/TLPM/blng.pm36
-rw-r--r--Master/setuptl/TLPM/check.pm67
-rw-r--r--Master/setuptl/TLPM/cmdl.pm149
-rw-r--r--Master/setuptl/TLPM/common.pm221
-rw-r--r--Master/setuptl/TLPM/constants.pm101
-rw-r--r--Master/setuptl/TLPM/help.pm439
-rw-r--r--Master/setuptl/TLPM/incl.pm60
-rw-r--r--Master/setuptl/TLPM/info.pm39
-rw-r--r--Master/setuptl/TLPM/inst.pm237
-rw-r--r--Master/setuptl/TLPM/list.pm58
-rw-r--r--Master/setuptl/TLPM/pkg.pm469
-rw-r--r--Master/setuptl/TLPM/reg.pm51
-rw-r--r--Master/setuptl/TLPM/uninst.pm117
13 files changed, 2044 insertions, 0 deletions
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] <name>
+# 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;
+ &not2log();
+}
+
+
+$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;
+}
+
+&not2log();
+
+# 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-<pkg>.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 [<command>]' 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 \<source\>] [-d \<target\>] [-b \<batch\>]
+
+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 \<command\>' 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 \<command\> and quit
+echo \<command\> | tlpm",
+
+'list' =>
+"USAGE:
+list [-pfe] [\<phrase\>] [-d \<dir\>]
+
+DESCRIPTION:
+Lists files or packages from TeX Live CD/DVD or installation directory.
+
+OPTIONS:
+-p --packages search for packages matching \<phrase\> (default)
+-f --files search for files matching \<phrase\>
+-e --expression treat \<phrase\> as a Perl regular expression (regex)
+-d --directory list packages or files installed in the \<dir\> 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 \<dir\>
+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 \<package\> [-pferj] [\<phrase\>]
+
+DESCRIPTION:
+Displays a list of \<package\> requirements and contents.
+
+OPTIONS:
+-p --packages show required packages matching \<phrase\> (default)
+-f --files show included files matching \<phrase\>
+-e --expression treat \<phrase\> 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] \<name\>
+
+DESCRIPTION:
+Shows parent bundle(s) of a package or file given by \<name\> (not \<phrase\>).
+
+OPTIONS:
+-p --package treat \<name\> as a package (default)
+-f --file treat \<name\> 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 \<package\> [-rjou] [-d \<dir\>]
+
+DESCRIPTION:
+Install \<package\> 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 \<dir\> directory
+-q --quiet disable progress info
+
+EXAMPLES:
+% install entire collection-basic in \<dir\>
+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 \<package\> [-rjiI] [-d \<dir\>]
+
+DESCRIPTION:
+Uninstalls \<package\> 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 \<dir\> 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 \<dir\>
+uninst ltxmisc -j -d /ust/share/TeX
+uninst ltxmisc -j -d D:\\TeX",
+
+'check' =>
+"USAGE:
+check [-pf][-d \<dir\>]
+
+DESCRIPTION:
+Check installation dependencies and consistency.
+
+OPTIONS:
+-p --packages check packages (default)
+-f --files check files
+-d --directory check given \<dir\> directory
+
+EXAMPLES:
+% display packages missing from \<dir\>
+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 [\<command\>]
+
+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 \<package\>
+
+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 \<command\>
+
+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 <pkg> [-pfer] <mask>
+# display a list of included packages matching <mask>
+
+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 <pkg>
+# 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 = <INP>;
+ close INP;
+ foreach(qw/Name Title Type Version Date Description/)
+ {
+ if($tpm =~ /<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 <pkg> [-jrou]
+# install <pkg>
+
+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 = \&copying_params_win32;
+ $extract_params = '/Y /R ' . ($debug_mode ? '/F' : '/C') . ($update ? ' /D' : '');
+ }
+ else
+ {
+ $copying_params = \&copying_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,\&copying_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] <mask>
+# display a list of packages matching <mask>
+
+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) = @_; # <root_directory> <hash_reference>
+ # 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-<pkg>.<platform>
+ {
+ unless(defined $tl_binaries{$platform}){next}
+ }
+ else # bin-<pkg>
+ {
+ 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(<INP>)
+ {
+ 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 = <STDIN>;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 = <STDIN>;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 = <INP>;
+ 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 = <STDIN>;
+ &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 <pkg> [-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;
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 18:17:50 +0000