setuptl installers added

git-svn-id: svn://tug.org/texlive/trunk@2984 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 237 insertions, 0 deletions

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;