summaryrefslogtreecommitdiff
path: root/Master/setuptl/TLPM/inst.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/setuptl/TLPM/inst.pm')
-rw-r--r--Master/setuptl/TLPM/inst.pm237
1 files changed, 0 insertions, 237 deletions
diff --git a/Master/setuptl/TLPM/inst.pm b/Master/setuptl/TLPM/inst.pm
deleted file mode 100644
index 3b47a2d5961..00000000000
--- a/Master/setuptl/TLPM/inst.pm
+++ /dev/null
@@ -1,237 +0,0 @@
-# This file belongs to TLPM v2.21, TeX Live Package Manager
-# Public Domain, P.Jackowski@gust.org.pl
-
-# inst <pkg> [-jrou]
-# install <pkg> respecting dependencies
-
-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;