summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2008-05-11 12:13:08 +0000
committerNorbert Preining <preining@logic.at>2008-05-11 12:13:08 +0000
commitb43c002bf9533d0cbaac8fb502e0a7704f3d8f9f (patch)
treeda0b2041aa3b38749ab3bee27e73355440ffff02
parent9735077b1c5a56b7ba25ae8c9ea1e6ae60e36856 (diff)
rollback implementation, needs testings and polishing. worked on linux
git-svn-id: svn://tug.org/texlive/trunk@8055 c570f23f-e606-0410-a88d-b1316a301751
-rwxr-xr-xMaster/texmf/scripts/texlive/tlmgr.pl10
-rw-r--r--Master/tlpkg/TeXLive/TLPOBJ.pm275
-rw-r--r--Master/tlpkg/TeXLive/TLUtils.pm2
3 files changed, 124 insertions, 163 deletions
diff --git a/Master/texmf/scripts/texlive/tlmgr.pl b/Master/texmf/scripts/texlive/tlmgr.pl
index 81e70769f07..7ff7ce90d98 100755
--- a/Master/texmf/scripts/texlive/tlmgr.pl
+++ b/Master/texmf/scripts/texlive/tlmgr.pl
@@ -475,19 +475,13 @@ sub action_update {
# this way we get rid of useless files
# force the deinstallation since we will reinstall it
if ($opt_rollback) {
- printf STDERR "rollback not implemented by now!!!\n";
- if (0) {
if (! -d $opt_rollback) {
printf STDERR "rollback argument must be an existing directory!\n";
} else {
- # TODO TODO TODO
- # we need to change TLPOBJ so that it uses the same style
- # as TLMedia with $::progs etc etc etc !!!!!!!!!!!!!!!!!
my $tlp = $localtlpdb->get_package($pkg);
$tlp->make_container("lzma", $localtlpdb->root,
- $opt_rollback, "${pkg}_" . $tlp->revision);
- }
- } # if 0, must be removed later
+ $opt_rollback, "${pkg}_rev" . $tlp->revision);
+ }
}
merge_into(\%ret, &remove_package($pkg, $localtlpdb, 1));
merge_into(\%ret, $tlmediasrc->install_package($pkg, $localtlpdb, $opt_nodepends, 1));
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm
index 09fad0aafd5..5866dca2e51 100644
--- a/Master/tlpkg/TeXLive/TLPOBJ.pm
+++ b/Master/tlpkg/TeXLive/TLPOBJ.pm
@@ -375,160 +375,118 @@ sub writeout_simple {
}
}
-###################################################
-## OLD IMPLEMENTATION WITHOUT binfiles packaging split
-## where we generate the $name.$arch packages automatically
-##
-## sub make_container {
-## my ($self,$type,$instroot,$destdir,$containername,$relative) = @_;
-## if (not(defined($containername))) {
-## $containername = $self->name;
-## }
-## if (not(defined($destdir))) {
-## $destdir = TeXLive::TLPOBJ->containerdir;
-## }
-## die("Undefined instroot argument!") if (not(defined($instroot)));
-## # first build the arch independent part
-## $self->_make_container($type,$instroot,$destdir,$containername,$relative,"all");
-## # now the $pkg.$arch.zip
-## if ($self->is_arch_dependent) {
-## foreach my $t (keys %{$self->{'binfiles'}}) {
-## &TeXLive::TLUtils::debug("arch=$t");
-## $self->_make_container($type,$instroot,$destdir,"$containername.$t",$relative,$t);
-## }
-## }
-## }
-##
-## sub _make_container {
-## my ($self,$type,$instroot,$destdir,$containername,$relative,$arch) = @_;
-## my @files = ();
-## my $compresscmd;
-## my $tlpobjdir = "$InfraLocation/tlpobj";
-## if ($arch ne "all") {
-## push @files, @{$self->{'binfiles'}{$arch}};
-## } else {
-## push @files, $self->runfiles;
-## push @files, $self->docfiles;
-## push @files, $self->srcfiles;
-## }
-## # note that the Tpm.pm module had something like
-## # if ($zipname =~ /\/binary/ && $^O !~ /MSWin32/) {
-## # $zipcmd = "| zip -9\@ory "
-## # } else {
-## # $zipcmd = "| zip -9\@or "
-## # }
-## if ($^O =~ /MSWin32/) {
-## $nul = "nul";
-## } else {
-## $nul = "/dev/null";
-## }
-## @files = TeXLive::TLUtils::sort_uniq(@files);
-## if (!@files) {
-## &TeXLive::TLUtils::debug("Not creating empty container file for $containername");
-## return;
-## }
-## # we do relative packages ONLY if the files do NOT span multiple
-## # texmf trees. check this here
-## my $tltree;
-## if ($relative) {
-## foreach (@files) {
-## my $tmp;
-## ($tmp) = split m@/@;
-## if (defined($tltree) && ($tltree ne $tmp)) {
-## die "Not generating relative package for multiple tree spanning packages!\n";
-## } else {
-## $tltree = $tmp;
-## }
-## }
-## my @nf;
-## map { s@^$tltree/@@ ; push @nf, $_; } @files;
-## @files = @nf;
-## }
-## my $cwd = &getcwd;
-## if ("$destdir" !~ m@^/@) {
-## # we have an relative containerdir, so we have to make it absolute
-## $destdir = "$cwd/$destdir";
-## }
-## &mkpath("$destdir") if (! -d "$destdir");
-## chdir($instroot);
-## # in the relative case we have to chdir to the respective tltree
-## # and put the tlpobj into the root!
-## if ($relative) {
-## chdir("./$tltree");
-## $tlpobjdir = ".";
-## }
-## if ($arch eq "all") {
-## # we add the .tlpobj into the .tlpobj directory
-## my $removetlpobjdir = 0;
-## if (! -d "$tlpobjdir") {
-## &mkpath("$tlpobjdir");
-## $removetlpobjdir = 1;
-## }
-## open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") or die "Cannot create $tlpobjdir/$self->{'name'}.tlpobj";
-## $self->writeout(\*TMP);
-## close(TMP);
-## push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
-## }
-## if ($type eq "zip") {
-## $containername .= ".zip";
-## if ($^O =~ /MSWin32/) {
-## $compresscmd = "| zip -9\@or $destdir/$containername > $nul"
-## } else {
-## $compresscmd = "| zip -9\@ory $destdir/$containername > $nul"
-## }
-## } elsif ($type eq "lzma") {
-## $containername .= ".tar.lzma";
-## $compresscmd = "| tar --create --files-from=- | lzma -c > $destdir/$containername ";
-## } else {
-## die("Container method $type unknown!\n");
-## }
-## unlink("$destdir/$containername");
-## print "$compresscmd\n" if ($::opt_debug);
-## open ZIP, $compresscmd ;
-## map {
-## if (! -f $_) {
-## print STDERR "!!!Error: non-existent $_\n";
-## } else {
-## print ZIP "$_\n";
-## }
-## } @files;
-## close ZIP;
-## if ($arch eq "all") {
-## # cleaning up
-## unlink("$tlpobjdir/$self->{'name'}.tlpobj");
-## rmdir("$tlpobjdir") if $removetlpobjdir;
-## }
-## chdir($cwd);
-## print "Done $containername\n" if ($::opt_debug);
-## }
-#######################################################
+###
+### OLD VERSION WITH zip SUPPORT AND WITHOUT USING $::progs
+### sub make_container {
+### my ($self,$type,$instroot,$destdir,$containername,$relative) = @_;
+### my @files = ();
+### my $compresscmd;
+### my $tlpobjdir = "$InfraLocation/tlpobj";
+### my %binf = %{$self->{'binfiles'}};
+### foreach (keys %binf) {
+### push @files, @{$binf{$_}};
+### }
+### push @files, $self->runfiles;
+### push @files, $self->docfiles;
+### push @files, $self->srcfiles;
+### if ($^O =~ /MSWin32/) {
+### $nul = "nul";
+### } else {
+### $nul = "/dev/null";
+### }
+### @files = TeXLive::TLUtils::sort_uniq(@files);
+### # we do relative packages ONLY if the files do NOT span multiple
+### # texmf trees. check this here
+### my $tltree;
+### if ($relative) {
+### foreach (@files) {
+### my $tmp;
+### ($tmp) = split m@/@;
+### if (defined($tltree) && ($tltree ne $tmp)) {
+### die "Not generating relative package for multiple tree spanning packages!\n";
+### } else {
+### $tltree = $tmp;
+### }
+### }
+### my @nf;
+### map { s@^$tltree/@@ ; push @nf, $_; } @files;
+### @files = @nf;
+### }
+### # load Cwd only if necessary ...
+### require Cwd;
+### my $cwd = &Cwd::getcwd;
+### if ("$destdir" !~ m@^/@) {
+### # we have an relative containerdir, so we have to make it absolute
+### $destdir = "$cwd/$destdir";
+### }
+### &TeXLive::TLUtils::mkdirhier("$destdir");
+### chdir($instroot);
+### # in the relative case we have to chdir to the respective tltree
+### # and put the tlpobj into the root!
+### if ($relative) {
+### chdir("./$tltree");
+### $tlpobjdir = ".";
+### }
+### # we add the .tlpobj into the .tlpobj directory
+### my $removetlpobjdir = 0;
+### if (! -d "$tlpobjdir") {
+### &TeXLive::TLUtils::mkdirhier("$tlpobjdir");
+### $removetlpobjdir = 1;
+### }
+### open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") or die "Cannot create $tlpobjdir/$self->{'name'}.tlpobj";
+### $self->writeout(\*TMP);
+### close(TMP);
+### push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
+### if ($type eq "zip") {
+### $containername .= ".zip";
+### if ($^O =~ /MSWin32/) {
+### $compresscmd = "| zip -9\@or $destdir/$containername > $nul"
+### } else {
+### $compresscmd = "| zip -9\@ory $destdir/$containername > $nul"
+### }
+### } elsif ($type eq "lzma") {
+### $containername .= ".tar.lzma";
+### $compresscmd = "| tar --create --files-from=- | lzma -c > $destdir/$containername ";
+### } else {
+### die("Container method $type unknown!\n");
+### }
+### unlink("$destdir/$containername");
+### tllog($::LOG_DDDEBUG, "$compresscmd\n");
+### open ZIP, $compresscmd or die "Cannot open container program $compresscmd: $!\n";
+### map {
+### if (! -f $_) {
+### print STDERR "!!!Error: non-existent $_\n";
+### } else {
+### print ZIP "$_\n";
+### }
+### } @files;
+### close ZIP;
+### # cleaning up
+### unlink("$tlpobjdir/$self->{'name'}.tlpobj");
+### rmdir("$tlpobjdir") if $removetlpobjdir;
+### chdir($cwd);
+### tllog($::LOG_DDDEBUG, "Done $containername\n");
+### }
+###
sub make_container {
my ($self,$type,$instroot,$destdir,$containername,$relative) = @_;
+ if ($type ne "lzma") {
+ die("TLPOBJ currently supports only lzma containers");
+ }
+ if (!defined($containername)) {
+ $containername = $self->name;
+ }
my @files = ();
my $compresscmd;
my $tlpobjdir = "$InfraLocation/tlpobj";
my %binf = %{$self->{'binfiles'}};
- if (!defined($containername)) {
- $containername = $self->name;
- }
foreach (keys %binf) {
push @files, @{$binf{$_}};
}
push @files, $self->runfiles;
push @files, $self->docfiles;
push @files, $self->srcfiles;
- # note that the Tpm.pm module had something like
- # if ($zipname =~ /\/binary/ && $^O !~ /MSWin32/) {
- # $zipcmd = "| zip -9\@ory "
- # } else {
- # $zipcmd = "| zip -9\@or "
- # }
- if ($^O =~ /MSWin32/) {
- $nul = "nul";
- } else {
- $nul = "/dev/null";
- }
@files = TeXLive::TLUtils::sort_uniq(@files);
# we do relative packages ONLY if the files do NOT span multiple
# texmf trees. check this here
@@ -572,22 +530,24 @@ sub make_container {
$self->writeout(\*TMP);
close(TMP);
push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
- if ($type eq "zip") {
- $containername .= ".zip";
- if ($^O =~ /MSWin32/) {
- $compresscmd = "| zip -9\@or $destdir/$containername > $nul"
- } else {
- $compresscmd = "| zip -9\@ory $destdir/$containername > $nul"
- }
- } elsif ($type eq "lzma") {
- $containername .= ".tar.lzma";
- $compresscmd = "| tar --create --files-from=- | lzma -c > $destdir/$containername ";
- } else {
- die("Container method $type unknown!\n");
+ $tarname = "$containername.tar";
+ $containername = "$tarname.lzma";
+
+ # start the whole fun
+ my $tar = $::progs{'tar'};
+ my $lzma = $::progs{'lzma'};
+ if (!defined($tar)) {
+ tllog($::LOG_NORMAL, "Programs have not been set up, trying with \"tar\"!\n");
+ $tar = "tar";
}
+ if (!defined($lzma)) {
+ tllog($::LOG_NORMAL, "Programs have not been set up, trying with \"lzma\"!\n");
+ $lzma = "lzma";
+ }
+ my @cmdline = ($tar, "-c", "-f", "$destdir/$tarname", "--files-from=-");
unlink("$destdir/$containername");
- tllog($::LOG_DDDEBUG, "$compresscmd\n");
- open ZIP, $compresscmd or die "Cannot open container program $compresscmd: $!\n";
+ unlink("$destdir/$tarname");
+ open ZIP, "|-", @cmdline or die "Cannot open container program @cmdline: $!";
map {
if (! -f $_) {
print STDERR "!!!Error: non-existent $_\n";
@@ -596,6 +556,11 @@ sub make_container {
}
} @files;
close ZIP;
+ if (-r "$destdir/$tarname") {
+ system($lzma, "--force", "-z", "$destdir/$tarname");
+ } else {
+ warn("Couldn't find $destdir/$tarname");
+ }
# cleaning up
unlink("$tlpobjdir/$self->{'name'}.tlpobj");
rmdir("$tlpobjdir") if $removetlpobjdir;
diff --git a/Master/tlpkg/TeXLive/TLUtils.pm b/Master/tlpkg/TeXLive/TLUtils.pm
index 0e4ff4713a0..9bf03ad6b8e 100644
--- a/Master/tlpkg/TeXLive/TLUtils.pm
+++ b/Master/tlpkg/TeXLive/TLUtils.pm
@@ -707,11 +707,13 @@ sub setup_programs {
$platform = platform();
}
$::progs{'lzmadec'} = "$bindir/lzmadec.$platform";
+ $::progs{'lzma'} = "$bindir/lzma.$platform";
$::progs{'tar'} = "tar";
if (win32()) {
$::progs{'wget'} = conv_to_win_path("$bindir/wget.exe");
$::progs{'tar'} = conv_to_win_path("$bindir/tar.exe");
$::progs{'lzmadec'} = conv_to_win_path($::progs{'lzmadec'});
+ $::progs{'lzma'} = conv_to_win_path($::progs{'lzma'});
}
}