diff options
-rw-r--r-- | Master/texmf/scripts/texlive/NEWS | 1 | ||||
-rwxr-xr-x | Master/texmf/scripts/texlive/tlmgr.pl | 7 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 190 | ||||
-rw-r--r-- | Master/tlpkg/TeXLive/TLUtils.pm | 103 |
4 files changed, 229 insertions, 72 deletions
diff --git a/Master/texmf/scripts/texlive/NEWS b/Master/texmf/scripts/texlive/NEWS index 5012f4e0908..dbbc498dc31 100644 --- a/Master/texmf/scripts/texlive/NEWS +++ b/Master/texmf/scripts/texlive/NEWS @@ -3,6 +3,7 @@ Karl Berry, 2010-2012.) <p><b>tlmgr revision NEXT (released 12monDD):</b><br> <li>multiple repository support +<li>tlmgr can now install a package from a file <p><b>tlmgr revision 24419 (released 12nov01):</b><br> <li>support addKanjiMap execute diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl index d5ddab04825..35930655bd7 100755 --- a/Master/texmf/scripts/texlive/tlmgr.pl +++ b/Master/texmf/scripts/texlive/tlmgr.pl @@ -149,6 +149,7 @@ sub main { "gui" => { "load" => 1 }, "install" => { "no-depends" => 1, "no-depends-at-all" => 1, + "file" => 1, "reinstall" => 1, "force" => 1, "dry-run|n" => 1 }, @@ -3253,6 +3254,12 @@ sub action_install { } } + # + # installation from a .tar.xz + if ($opts{"file"}) { + return $localtlpdb->install_package_files(@ARGV); + } + $opts{"no-depends"} = 1 if $opts{"no-depends-at-all"}; info("install: dry run, no changes will be made\n") if $opts{"dry-run"}; diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index 7722c0fdf2b..72bf5390204 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -72,6 +72,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages $tlpdb->sizes_of_packages($opt_src, $opt_doc [, @packs ]); $tlpdb->install_package($pkg, $dest_tlpdb); $tlpdb->remove_package($pkg, %options); + $tlpdb->install_package_files($file [, $file ]); TeXLive::TLPDB->listdir([$dir]); $tlpdb->generate_listfiles([$destdir]); @@ -1299,6 +1300,105 @@ sub size_of_one_package { =pod +=item C<< $tlpdb->install_package_files($f [, $f]) >> + +Install a package from a package file, i.e. a .tar.xz. +Returns the number of packages actually installed successfully. + +=cut + +sub install_package_files { + my ($self, @files) = @_; + + my $ret = 0; + + my $opt_src = $self->option("install_srcfiles"); + my $opt_doc = $self->option("install_docfiles"); + + for my $f (@files) { + + # - create a tmp directory + my $tmpdir = TeXLive::TLUtils::tl_tmpdir(); + # - unpack everything there + if (!TeXLive::TLUtils::unpack($f, $tmpdir)) { + tlwarn("TLPDB::install_package_files: couldn't install $f\n"); + next; + } + # we are still here, so the files have been unpacked properly + # we need now to find the tlpobj in $tmpdir/tlpkg/tlpobj/ + my ($tlpobjfile, $anotherfile) = <$tmpdir/tlpkg/tlpobj/*.tlpobj>; + if (defined($anotherfile)) { + # we found several tlpobj files, that is not allowed, stop + tlwarn("TLPDB::install_package_files: several tlpobj files in $what in tlpkg/tlpobj/, stopping!\n"); + next; + } + # - read the tlpobj from there + my $tlpobj = TeXLive::TLPOBJ->new; + $tlpobj->from_file($tlpobjfile); + # we didn't die in this process, so that seems to be a proper tlpobj + # (btw, why didn't I work on proper return values!?!) + + # + # we are now ready for installation + # if this package existed before, remove it from the tlpdb + if ($self->get_package($tlpobj->name)) { + $self->remove_package($tlpobj->name); + } + + # code partially from TLPDB->not_virtual_install_package!!! + my @installfiles = (); + my $reloc = 1 if $tlpobj->relocated; + foreach ($tlpobj->runfiles) { push @installfiles, $_; }; + foreach ($tlpobj->allbinfiles) { push @installfiles, $_; }; + if ($opt_src) { foreach ($tlpobj->srcfiles) { push @installfiles, $_; } } + if ($opt_doc) { foreach ($tlpobj->docfiles) { push @installfiles, $_; } } + # + # remove the RELOC prefix, but do NOT replace it with RelocTree + @installfiles = map { s!^$TeXLive::TLConfig::RelocPrefix/!!; $_; } @installfiles; + # if the first argument of _install_package is scalar, it is the + # place from where files should be installed + if (!_install_package ($tmpdir, \@installfiles, $reloc, \@installfiles, $self)) { + tlwarn("TLPDB::install_package_files: couldn't install $what!\n"); + next; + } + if ($tlpobj->relocated) { + $tlpobj->cancel_reloc_prefix; + $tlpobj->relocated(0); + } + my $tlpod = $self->root . "/tlpkg/tlpobj"; + mkdirhier( $tlpod ); + open(TMP,">$tlpod/".$tlpobj->name.".tlpobj") or + die("Cannot open tlpobj file for ".$tlpobj->name); + $tlpobj->writeout(\*TMP); + close(TMP); + $self->add_tlpobj($tlpobj); + $self->save; + TeXLive::TLUtils::announce_execute_actions("enable", $tlpobj); + # do the postinstallation actions + # + # Run the post installation code in the postaction tlpsrc entries + # in case we are on w32 and the admin did install for himself only + # we switch off admin mode + if (win32() && admin() && !$totlpdb->option("w32_multi_user")) { + non_admin(); + } + # for now desktop_integration maps to both installation + # of desktop shortcuts and menu items, but we can split them later + &TeXLive::TLUtils::do_postaction("install", $tlpobj, + $self->option("file_assocs"), + $self->option("desktop_integration"), + $self->option("desktop_integration"), + $self->option("post_code")); + + # remember that we installed this package correctly + $ret++; + } + return $ret; +} + + +=pod + =item C<< $tlpdb->install_package($pkg, $dest_tlpdb [, $tag]) >> Installs the package $pkg into $dest_tlpdb. @@ -1487,7 +1587,6 @@ sub not_virtual_install_package { sub _install_package { my ($self, $what, $reloc, $filelistref, $totlpdb) = @_; - my $media = $self->media; my $target = $totlpdb->root; my $tempdir = "$target/temp"; @@ -1502,8 +1601,19 @@ sub _install_package { } if (ref $what) { - # we are getting a ref to a list of files, so install from DVD - my $root = $self->root; + # determine the root from where we install + # if the first argument $self is a string, then it should be the + # root from where to install the files, otherwise it should be + # a TLPDB object (installation from DVD) + my $root; + if (!ref($self)) { + $root = $self; + } else { + $root = $self->root; + } + # if we are installing a reloc, add the RelocTree to the target + $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc; + foreach my $file (@$what) { # @what is taken, not @filelist! # is this still needed? @@ -1514,78 +1624,16 @@ sub _install_package { # we always assume that copy will work return(1); } elsif ($what =~ m,\.tar(\.xz)?$,) { - my $type = defined($1) ? "xz" : "tar"; - $target .= "/$TeXLive::TLConfig::RelocTree" if $reloc; - - # this is the case when we install from local_compressed or the NET, or a backup - # - # in all other cases we create temp files .tar.xz (or use the present - # one), xzdec them, and then call tar - - my $fn = basename($what); - my $pkg = $fn; - $pkg =~ s/\.tar(\.xz)?$//; - mkdirhier("$tempdir"); - my $tarfile; - my $remove_tarfile = 1; - if ($type eq "xz") { - my $xzfile = "$tempdir/$fn"; - $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.xz$//; - my $xzfile_quote = $xzfile; - my $tarfile_quote = $tarfile; - my $target_quote = $target; - if (win32()) { - $xzfile =~ s!/!\\!g; - $tarfile =~ s!/!\\!g; - $target =~ s!/!\\!g; - } - $xzfile_quote = "\"$xzfile\""; - $tarfile_quote = "\"$tarfile\""; - $target_quote = "\"$target\""; - if ($what =~ m,http://|ftp://,) { - # we are installing from the NET - # download the file and put it into temp - if (!download_file($what, $xzfile) || (! -r $xzfile)) { - tlwarn("Downloading \n"); - tlwarn(" $what\n"); - tlwarn("did not succeed, please retry.\n"); - unlink($tarfile, $xzfile); - return(0); - } - } else { - # we are installing from local compressed files - # copy it to temp - TeXLive::TLUtils::copy($what, $tempdir); - } - debug("un-xzing $xzfile to $tarfile\n"); - system("$xzdec < $xzfile_quote > $tarfile_quote"); - if (! -f $tarfile) { - tlwarn("_install_package: Unpacking $xzfile failed, please retry.\n"); - unlink($tarfile, $xzfile); - return(0); - } - unlink($xzfile); - } else { - $tarfile = "$tempdir/$fn"; - if ($what =~ m,http://|ftp://,) { - if (!download_file($what, $tarfile) || (! -r $tarfile)) { - tlwarn("Downloading \n"); - tlwarn(" $what\n"); - tlwarn("failed, please retry.\n"); - unlink($tarfile); - return(0); - } - } else { - $tarfile = $what; - $remove_tarfile = 0; - } + my $pkg = TeXLive::TLUtils::unpack($what, $target); + if (!$pkg) { + tlwarn("TLPDB::_install_package: couldn't unpack $what to $target\n"); + return(0); } - my $ret = TeXLive::TLUtils::untar($tarfile, $target, $remove_tarfile); # remove the $pkg.tlpobj, we recreate it anyway again unlink ("$target/tlpkg/tlpobj/$pkg.tlpobj") if (-r "$target/tlpkg/tlpobj/$pkg.tlpobj"); - return $ret; + return(1); } else { tlwarn("_install_package: Don't know how to install $what\n"); return(0); @@ -1596,7 +1644,7 @@ sub _install_package { =item << $tlpdb->remove_package($pkg, %options) >> -removes a single pacakge with all the files and the entry in the db. +removes a single package with all the files and the entry in the db. =cut diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm index ee004737b29..9565d56bead 100644 --- a/Master/tlpkg/TeXLive/TLUtils.pm +++ b/Master/tlpkg/TeXLive/TLUtils.pm @@ -164,6 +164,7 @@ BEGIN { &forward_slashify &conv_to_w32_path &untar + &unpack &merge_into &give_ctan_mirror &give_ctan_mirror_base @@ -2072,12 +2073,112 @@ sub w32_remove_from_path { TeXLive::TLWinGoo::adjust_reg_path_for_texlive('remove', $bindir, $mode); } +=pod + +=item C<unpack($what, $targetdir> + +If necessary, downloads C$what>, and then unpacks it into C<$targetdir>. +Returns the name of the unpacked package (determined from the name of C<$what>) +in case of success, otherwise undefined. + +=cut + +sub unpack { + my ($what, $target) = @_; + + if (!defined($what)) { + tlwarn("TLUtils::unpack: nothing to unpack!\n"); + return; + } + + # we assume that $::progs has been set up! + my $wget = $::progs{'wget'}; + my $xzdec = TeXLive::TLUtils::quotify_path_with_spaces($::progs{'xzdec'}); + if (!defined($wget) || !defined($xzdec)) { + tlwarn("_install_package: programs not set up properly, strange.\n"); + return; + } + + my $type; + if ($what =~ m,\.tar(\.xz)?$,) { + $type = defined($what) ? "xz" : "tar"; + } else { + tlwarn("TLUtils::unpack: don't know how to unpack this: $what\n"); + return; + } + + my $tempdir = tl_tmpdir(); + + # we are still here, so something was handed in and we have either .tar or .tar.xz + my $fn = basename($what); + my $pkg = $fn; + $pkg =~ s/\.tar(\.xz)?$//; + my $tarfile; + my $remove_tarfile = 1; + if ($type eq "xz") { + my $xzfile = "$tempdir/$fn"; + $tarfile = "$tempdir/$fn"; $tarfile =~ s/\.xz$//; + my $xzfile_quote = $xzfile; + my $tarfile_quote = $tarfile; + my $target_quote = $target; + if (win32()) { + $xzfile =~ s!/!\\!g; + $tarfile =~ s!/!\\!g; + $target =~ s!/!\\!g; + } + $xzfile_quote = "\"$xzfile\""; + $tarfile_quote = "\"$tarfile\""; + $target_quote = "\"$target\""; + if ($what =~ m,http://|ftp://,) { + # we are installing from the NET + # download the file and put it into temp + if (!download_file($what, $xzfile) || (! -r $xzfile)) { + tlwarn("Downloading \n"); + tlwarn(" $what\n"); + tlwarn("did not succeed, please retry.\n"); + unlink($tarfile, $xzfile); + return; + } + } else { + # we are installing from local compressed files + # copy it to temp + TeXLive::TLUtils::copy($what, $tempdir); + } + debug("un-xzing $xzfile to $tarfile\n"); + system("$xzdec < $xzfile_quote > $tarfile_quote"); + if (! -f $tarfile) { + tlwarn("TLUtils::unpack: Unpacking $xzfile failed, please retry.\n"); + unlink($tarfile, $xzfile); + return; + } + unlink($xzfile); + } else { + $tarfile = "$tempdir/$fn"; + if ($what =~ m,http://|ftp://,) { + if (!download_file($what, $tarfile) || (! -r $tarfile)) { + tlwarn("Downloading \n"); + tlwarn(" $what\n"); + tlwarn("failed, please retry.\n"); + unlink($tarfile); + return; + } + } else { + $tarfile = $what; + $remove_tarfile = 0; + } + } + if (untar($tarfile, $target, $remove_tarfile)) { + return "$pkg"; + } else { + return; + } +} =pod =item C<untar($tarfile, $targetdir, $remove_tarfile)> -Unpacke C<$tarfile> in C<$targetdir> (changing directories to +Unpacks C<$tarfile> in C<$targetdir> (changing directories to C<$targetdir> and then back to the original directory). If C<$remove_tarfile> is true, unlink C<$tarfile> after unpacking. |