From 7e5585bcd4f8ba119cad8f0a7e13b6a7a610776f Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Tue, 12 May 2009 15:53:11 +0000 Subject: Move most of the stuff from tlpkg, tlmgr from branch to trunk git-svn-id: svn://tug.org/texlive/trunk@13054 c570f23f-e606-0410-a88d-b1316a301751 --- Master/tlpkg/TeXLive/TLPOBJ.pm | 168 +++++++++++++++++++++++++++++------------ 1 file changed, 121 insertions(+), 47 deletions(-) (limited to 'Master/tlpkg/TeXLive/TLPOBJ.pm') diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index 06233187de8..6b08caf8067 100644 --- a/Master/tlpkg/TeXLive/TLPOBJ.pm +++ b/Master/tlpkg/TeXLive/TLPOBJ.pm @@ -6,7 +6,9 @@ package TeXLive::TLPOBJ; -use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp $MetaCategoriesRegexp $InfraLocation); +use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp + $MetaCategoriesRegexp $InfraLocation + $RelocPrefix $RelocTree); use TeXLive::TLUtils; use TeXLive::TLTREE; @@ -22,6 +24,7 @@ sub new { shortdesc => $params{'shortdesc'}, longdesc => $params{'longdesc'}, catalogue => $params{'catalogue'}, + relocated => $params{'relocated'}, runfiles => defined($params{'runfiles'}) ? $params{'runfiles'} : [], runsize => $params{'runsize'}, srcfiles => defined($params{'srcfiles'}) ? $params{'srcfiles'} : [], @@ -29,6 +32,7 @@ sub new { docfiles => defined($params{'docfiles'}) ? $params{'docfiles'} : [], docsize => $params{'docsize'}, executes => defined($params{'executes'}) ? $params{'executes'} : [], + postactions => defined($params{'postactions'}) ? $params{'postactions'} : [], # note that binfiles is a HASH with keys of $arch! binfiles => defined($params{'binfiles'}) ? $params{'binfiles'} : {}, binsize => defined($params{'binsize'}) ? $params{'binsize'} : {}, @@ -92,6 +96,7 @@ sub from_fh { ($lastcmd eq "docfiles") || ($lastcmd eq "srcfiles") || ($lastcmd eq "executes") || + ($lastcmd eq "postaction") || ($lastcmd eq "depend") ) { $line =~ s/^ /${lastcmd}continued /; } else { @@ -163,6 +168,10 @@ sub from_fh { $self->{'category'} = "$1"; $lastcmd = "category"; next; + } elsif ($line =~ /^relocated\s+([01])\s*/o) { + $self->relocated("$1"); + $lastcmd = "relocated"; + next; } elsif ($line =~ /^revision\s+(.*)\s*/o) { $self->{'revision'} = "$1"; $lastcmd = "revision"; @@ -216,6 +225,10 @@ sub from_fh { push @{$self->{'executes'}}, "$2" unless "$2" eq ""; $lastcmd = "execute"; next; + } elsif ($line =~ /^postaction(continued)?\s*(.*)\s*/o) { + push @{$self->{'postactions'}}, "$2" unless "$2" eq ""; + $lastcmd = "postaction"; + next; } elsif ($line =~ /^depend(continued)?\s*(.*)\s*/o) { push @{$self->{'depends'}}, "$2" unless "$2" eq ""; $lastcmd = "depend"; @@ -299,6 +312,7 @@ sub writeout { defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n"; defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n"; defined($self->{'license'}) && print $fd "license $self->{'license'}\n"; + defined($self->{'relocated'}) && $self->{'relocated'} && print $fd "relocated 1\n"; # ugly hack to get rid of use FileHandle; see man perlform #format_name $fd "multilineformat"; select((select($fd),$~ = "multilineformat")[0]); @@ -316,6 +330,11 @@ sub writeout { print $fd "execute $_\n"; } } + if (defined($self->{'postactions'})) { + foreach (@{$self->{'postactions'}}) { + print $fd "postaction $_\n"; + } + } if (defined($self->{'containersize'})) { print $fd "containersize $self->{'containersize'}\n"; } @@ -388,6 +407,11 @@ sub writeout_simple { print $fd "execute $_\n"; } } + if (defined($self->{'postactions'})) { + foreach (@{$self->{'postactions'}}) { + print $fd "postaction $_\n"; + } + } if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) { print $fd "docfiles\n"; foreach (sort @{$self->{'docfiles'}}) { @@ -416,44 +440,70 @@ sub writeout_simple { } } +sub cancel_common_texmf_tree { + my $self = shift; + my @docfiles = $self->docfiles; + for (@docfiles) { s:^$RelocTree/:$RelocPrefix/:; } + $self->docfiles(@docfiles); + my @runfiles = $self->runfiles; + for (@runfiles) { s:^$RelocTree/:$RelocPrefix/:; } + $self->runfiles(@runfiles); + my @srcfiles = $self->srcfiles; + for (@srcfiles) { s:^$RelocTree/:$RelocPrefix/:; } + $self->srcfiles(@srcfiles); + # if there are bin files they have definitely NOT the + # texmf-dist prefix, so we cannot cancel it anyway +} + +sub common_texmf_tree { + my $self = shift; + my $tltree; + my $dd = 0; + my @files = $self->all_files; + foreach ($self->all_files) { + my $tmp; + ($tmp) = split m@/@; + if (defined($tltree) && ($tltree ne $tmp)) { + return; + } else { + $tltree = $tmp; + } + } + # if there are no files then it is by default relocatable, so + # return the right tree + if (!@files) { + $tltree = $RelocTree; + } + return $tltree; +} + -sub make_container -{ +sub make_container { my ($self,$type,$instroot,$destdir,$containername,$relative) = @_; - if (($type ne "lzma") && ($type ne "tar")) { - die "$0: TLPOBJ supports tar and lzma containers, not $type"; + if (($type ne "xz") && ($type ne "tar")) { + die "$0: TLPOBJ supports tar and xz containers, not $type"; } if (!defined($containername)) { $containername = $self->name; } - my @files = (); + my @files = $self->all_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; @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 ("$0: package $containername spans multiple trees, " - . "relative generation not allowed"); - } else { - $tltree = $tmp; - } + $tltree = $self->common_texmf_tree; + if (!defined($tltree)) { + die ("$0: package $containername spans multiple trees, " + . "relative generation not allowed"); } - my @nf; - map { s@^$tltree/@@ ; push @nf, $_; } @files; - @files = @nf; + if ($tltree ne $RelocTree) { + die ("$0: building $pkg container relocatable but the comon prefix" + . "is not $RelocTree"); + } + s,^$RelocTree/,, foreach @files; } # load Cwd only if necessary ... require Cwd; @@ -468,7 +518,9 @@ sub make_container # and put the tlpobj into the root! if ($relative) { chdir("./$tltree"); - $tlpobjdir = "."; + # we don't need to change the $tlpobjdir because we put it in + # all cases into tlpkg/tlpobj + #$tlpobjdir = "./tlpkg/tlpobj"; } # we add the .tlpobj into the .tlpobj directory my $removetlpobjdir = 0; @@ -485,33 +537,33 @@ sub make_container if ($type eq "tar") { $containername = $tarname; } else { - $containername = "$tarname.lzma"; + $containername = "$tarname.xz"; } # start the fun my $tar = $::progs{'tar'}; - my $lzma; + my $xz; if (!defined($tar)) { tlwarn("$0: programs not set up, trying \"tar\".\n"); $tar = "tar"; } - if ($type eq "lzma") { - $lzma = $::progs{'lzma'}; - if (!defined($lzma)) { - tlwarn("$0: programs not set up, trying \"lzma\".\n"); - $lzma = "lzma"; + if ($type eq "xz") { + $xz = $::progs{'xz'}; + if (!defined($xz)) { + tlwarn("$0: programs not set up, trying \"xz\".\n"); + $xz = "xz"; } } # No owner/group options if we are being called on a user's machine to # make a backup. We only want these when we are making the master - # containers for tlnet. Also exclude .svn directories when making the + # containers for tlnet. Also exclude .svn directories when making the # masters. We determine user vs. master by whether there's a revision # suffix in the container name. my @attrs = $containername =~ /\.r[0-9]/ ? () : ("--owner", "0", "--group", "0", "--exclude", ".svn"); my @cmdline = ($tar, "-cf", "$destdir/$tarname", @attrs); - + # Get list of files and symlinks to back up. Nothing else should be # in the list. my @files_to_backup = (); @@ -553,10 +605,14 @@ sub make_container # if (length ("@files_to_backup") > 50000) { @files_to_backup = TeXLive::TLUtils::collapse_dirs(@files_to_backup); - # Yet another complication. collapse_dirs returns absolute paths. + # A complication, as always. collapse_dirs returns absolute paths. # We want to change them back to relative so that the backup tar # has the same structure. + # in relative mode we have to remove the texmf-dist prefix, too s,^$instroot/,, foreach @files_to_backup; + if ($relative) { + s,^$RelocTree/,, foreach @files_to_backup; + } } push(@cmdline, @files_to_backup); } @@ -567,11 +623,11 @@ sub make_container xsystem(@cmdline); # compress it. - if ($type eq "lzma") { + if ($type eq "xz") { if (-r "$destdir/$tarname") { - system($lzma, "--force", "-z", "$destdir/$tarname"); + system($xz, "--force", "-z", "$destdir/$tarname"); } else { - tlwarn("$0: Couldn't find $destdir/$tarname to run $lzma\n"); + tlwarn("$0: Couldn't find $destdir/$tarname to run $xz\n"); return (0, 0, ""); } } @@ -745,7 +801,7 @@ sub split_bin_package { foreach $a (keys(%binf)) { my $tlp = new TeXLive::TLPOBJ; $tlp->name($self->name . ".$a"); - $tlp->shortdesc("binary files of " . $self->name . " for $a"); + $tlp->shortdesc("$a files of " . $self->name); $tlp->revision($self->revision); $tlp->category($self->category); $tlp->add_binfiles($a,@{$binf{$a}}); @@ -840,7 +896,7 @@ sub make_return_hash_from_executes { } else { push @maps, "disable $3"; } - } elsif ($e =~ m/^BuildFormat\s+([^\s]+)\s*$/) { + } elsif ($e =~ m/^AddFormat\s+([^\s]+)\s*$/) { push @formats, $1; } elsif ($e =~ m/^AddHyphen\s+(.*)\s*$/) { push @dats, $1; @@ -882,6 +938,11 @@ sub revision { if (@_) { $self->{'revision'} = shift } return $self->{'revision'}; } +sub relocated { + my $self = shift; + if (@_) { $self->{'relocated'} = shift } + return ($self->{'relocated'} ? 1 : 0); +} sub catalogue { my $self = shift; if (@_) { $self->{'catalogue'} = shift } @@ -1029,6 +1090,11 @@ sub executes { if (@_) { $self->{'executes'} = [ @_ ] } return @{ $self->{'executes'} }; } +sub postactions { + my $self = shift; + if (@_) { $self->{'postactions'} = [ @_ ] } + return @{ $self->{'postactions'} }; +} sub containerdir { my @self = shift; if (@_) { $_containerdir = $_[0] } @@ -1071,9 +1137,11 @@ Please see L documentation for the specification. The only differences are that the various C<*pattern> keys are invalid, and instead there are the respective C<*files> keys described below. Furthermore some more I is allowed: C which specifies the maximum of -all last changed revision of files contained in the package, and anything +all last changed revision of files contained in the package, anything starting with C specifying information coming from the -TeX Catalogue. +TeX Catalogue, and C taking either 0 or 1 indicating that +this packages has been relocated, i.e., in the containers the +initial C directory has been stripped off. All these keys have in common that they are followed by a list of files I by one space. They differ only in the first line itself @@ -1190,7 +1258,7 @@ the C function returns (and takes as argument) a hash with the architectures as keys, similar to the C functions (see above). Futhermore, if the tlpobj is contained ina tlpdb which describes a media -where the files are distributed in packed format (usually as .tar.lzma), +where the files are distributed in packed format (usually as .tar.xz), there are 6 more possible keys: $tlpobj->containersize @@ -1246,17 +1314,23 @@ or the filehandle if given: debugging function for comparison with C/C, will go away. +=item C + +if all files of the package are from the same texmf tree, this tree +is returned, otherwise an undefined value. That is also a check +whether a package is relocatable. + =item C creates a container file of the all files in the C in C<$destdir> (if not defined then C<< TLPOBJ->containerdir >> is used). The C<$type> variable specifies the type of container to be used. -Currently only C or C are allowed, and are generating -zip files and tar.lzma files, respectively. +Currently only C or C are allowed, and are generating +zip files and tar.xz files, respectively. The file name of the created container file is C<$containername.extension>, -where extension is either C<.zip> or C<.tar.lzma>, depending on the +where extension is either C<.zip> or C<.tar.xz>, depending on the setting of C<$type>. If no C<$containername> is specified the package name is used. -- cgit v1.2.3