diff options
Diffstat (limited to 'Master/setuptl/TLPM/inst.pm')
-rw-r--r-- | Master/setuptl/TLPM/inst.pm | 237 |
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 = \©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; |