summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLPOBJ.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPOBJ.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLPOBJ.pm168
1 files changed, 121 insertions, 47 deletions
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<TeXLive::TLPSRC> 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<keys> is allowed: C<revision> 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<catalogue-> specifying information coming from the
-TeX Catalogue.
+TeX Catalogue, and C<relocated> taking either 0 or 1 indicating that
+this packages has been relocated, i.e., in the containers the
+initial C<texmf-dist> directory has been stripped off.
All these keys have in common that they are followed by a list of files
I<indented> by one space. They differ only in the first line itself
@@ -1190,7 +1258,7 @@ the C<binsize> function returns (and takes as argument) a hash with the
architectures as keys, similar to the C<runfiles> 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<tpm>/C<tlps>, will go away.
+=item C<common_texmf_tree>
+
+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<make_container($type,$instroot[, $destdir[, $containername[, $relative]]])>
creates a container file of the all files in the C<TLPOBJ>
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<zip> or C<lzma> are allowed, and are generating
-zip files and tar.lzma files, respectively.
+Currently only C<zip> or C<xz> 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.