diff options
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPOBJ.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPOBJ.pm | 84 |
1 files changed, 63 insertions, 21 deletions
diff --git a/Master/tlpkg/TeXLive/TLPOBJ.pm b/Master/tlpkg/TeXLive/TLPOBJ.pm index 92feea61427..86b097df993 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'} : [], @@ -165,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"; @@ -305,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]); @@ -432,6 +440,37 @@ 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 @files = $self->all_files; + foreach ($self->all_files) { + my $tmp; + ($tmp) = split m@/@; + if (defined($tltree) && ($tltree ne $tmp)) { + return; + } else { + $tltree = $tmp; + } + } + return $tltree; +} + sub make_container { my ($self,$type,$instroot,$destdir,$containername,$relative) = @_; @@ -441,30 +480,18 @@ sub make_container { 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; @@ -483,7 +510,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; @@ -895,6 +924,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 } @@ -1089,9 +1123,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 @@ -1264,6 +1300,12 @@ 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> |