"Fossies" - the Fresh Open Source Software Archive

Member "install-tl-20200916/tlpkg/TeXLive/TLPOBJ.pm" (15 Apr 2020, 58761 Bytes) of package /windows/misc/install-tl.zip:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 # $Id: TLPOBJ.pm 54748 2020-04-15 03:02:45Z preining $
    2 # TeXLive::TLPOBJ.pm - module for using tlpobj files
    3 # Copyright 2007-2019 Norbert Preining
    4 # This file is licensed under the GNU General Public License version 2
    5 # or any later version.
    6 
    7 package TeXLive::TLPOBJ;
    8 
    9 my $svnrev = '$Revision: 54748 $';
   10 my $_modulerevision = ($svnrev =~ m/: ([0-9]+) /) ? $1 : "unknown";
   11 sub module_revision { return $_modulerevision; }
   12 
   13 use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp 
   14                          $MetaCategoriesRegexp $InfraLocation 
   15                          %Compressors $DefaultCompressorFormat
   16                          $RelocPrefix $RelocTree);
   17 use TeXLive::TLCrypto;
   18 use TeXLive::TLTREE;
   19 use TeXLive::TLUtils;
   20 
   21 our $_tmp;
   22 my $_containerdir;
   23 
   24 
   25 sub new {
   26   my $class = shift;
   27   my %params = @_;
   28   my $self = {
   29     name        => $params{'name'},
   30     category    => defined($params{'category'}) ? $params{'category'} : $DefaultCategory,
   31     shortdesc   => $params{'shortdesc'},
   32     longdesc    => $params{'longdesc'},
   33     catalogue   => $params{'catalogue'},
   34     relocated   => $params{'relocated'},
   35     runfiles    => defined($params{'runfiles'}) ? $params{'runfiles'} : [],
   36     runsize     => $params{'runsize'},
   37     srcfiles    => defined($params{'srcfiles'}) ? $params{'srcfiles'} : [],
   38     srcsize     => $params{'srcsize'},
   39     docfiles    => defined($params{'docfiles'}) ? $params{'docfiles'} : [],
   40     docsize     => $params{'docsize'},
   41     executes    => defined($params{'executes'}) ? $params{'executes'} : [],
   42     postactions => defined($params{'postactions'}) ? $params{'postactions'} : [],
   43     # note that binfiles is a HASH with keys of $arch!
   44     binfiles    => defined($params{'binfiles'}) ? $params{'binfiles'} : {},
   45     binsize     => defined($params{'binsize'}) ? $params{'binsize'} : {},
   46     depends     => defined($params{'depends'}) ? $params{'depends'} : [],
   47     revision    => $params{'revision'},
   48     cataloguedata => defined($params{'cataloguedata'}) ? $params{'cataloguedata'} : {},
   49   };
   50   $_containerdir = $params{'containerdir'} if defined($params{'containerdir'});
   51   bless $self, $class;
   52   return $self;
   53 }
   54 
   55 
   56 sub copy {
   57   my $self = shift;
   58   my $bla = {};
   59   %$bla = %$self;
   60   bless $bla, "TeXLive::TLPOBJ";
   61   return $bla;
   62 }
   63 
   64 
   65 sub from_file {
   66   my $self = shift;
   67   if (@_ != 1) {
   68     die("TLPOBJ:from_file: Need a filename for initialization");
   69   }
   70   open(TMP,"<$_[0]") || die("Cannot open tlpobj file: $_[0]");
   71   $self->from_fh(\*TMP);
   72 }
   73 
   74 sub from_fh {
   75   my ($self,$fh,$multi) = @_;
   76   my $started = 0;
   77   my $lastcmd = "";
   78   my $arch;
   79   my $size;
   80 
   81   while (my $line = <$fh>) {
   82     # we do not worry about whitespace at the end of a line;
   83     # that would be a bug in the db creation, and it takes some
   84     # noticeable time to get rid of it.  So just chomp.
   85     chomp($line);
   86     
   87     # we call tllog only when something will be logged, to speed things up.
   88     # this is the inner loop bounding the time to read tlpdb.
   89     dddebug("reading line: >>>$line<<<\n") if ($::opt_verbosity >= 3);
   90     $line =~ /^#/ && next;          # skip comment lines
   91     if ($line =~ /^\s*$/) {
   92       if (!$started) { next; }
   93       if (defined($multi)) {
   94         # we may read from a tldb file
   95         return 1;
   96       } else {
   97         # we are reading one tldb file, nothing else allowed
   98         die("No empty line allowed within tlpobj files!");
   99       }
  100     }
  101 
  102     my ($cmd, $arg) = split(/\s+/, $line, 2);
  103     # first command must be name
  104     $started || $cmd eq 'name'
  105       or die("First directive needs to be 'name', not $line");
  106 
  107     # now the big switch, ordered by decreasing number of occurences
  108     if ($cmd eq '') {
  109       if ($lastcmd eq "runfiles" || $lastcmd eq "srcfiles") {
  110         push @{$self->{$lastcmd}}, $arg;
  111       } elsif ($lastcmd eq "docfiles") {
  112         my ($f, $rest) = split(' ', $arg, 2);
  113         push @{$self->{'docfiles'}}, $f;
  114         # docfiles can have tags, but the parse_line function is so
  115         # time intense that we try to call it only when necessary
  116         if (defined $rest) {
  117           # parse_line has problems with double quotes in double quotes
  118           # my @words = &TeXLive::TLUtils::parse_line('\s+', 0, $rest);
  119           # do manual parsing
  120           # this is not optimal, but since we support only two tags there
  121           # are not so many cases
  122           # Warning: need tp check the double cases first!!!
  123           if ($rest =~ m/^language="(.*)"\s+details="(.*)"\s*$/) {
  124             $self->{'docfiledata'}{$f}{'details'} = $2;
  125             $self->{'docfiledata'}{$f}{'language'} = $1;
  126           } elsif ($rest =~ m/^details="(.*)"\s+language="(.*)"\s*$/) {
  127             $self->{'docfiledata'}{$f}{'details'} = $1;
  128             $self->{'docfiledata'}{$f}{'language'} = $2;
  129           } elsif ($rest =~ m/^details="(.*)"\s*$/) {
  130             $self->{'docfiledata'}{$f}{'details'} = $1;
  131           } elsif ($rest =~ m/^language="(.*)"\s*$/) {
  132             $self->{'docfiledata'}{$f}{'language'} = $1;
  133           } else {
  134             tlwarn("$0: Unparsable tagging in TLPDB line: $line\n");
  135           }
  136         }
  137       } elsif ($lastcmd eq "binfiles") {
  138         push @{$self->{'binfiles'}{$arch}}, $arg;
  139       } else {
  140         die("Continuation of $lastcmd not allowed, please fix tlpobj: line = $line!\n");
  141       }
  142     } elsif ($cmd eq "longdesc") {
  143       my $desc = defined $arg ? $arg : '';
  144       if (defined($self->{'longdesc'})) {
  145         $self->{'longdesc'} .= " $desc";
  146       } else {
  147         $self->{'longdesc'} = $desc;
  148       }
  149     } elsif ($cmd =~ /^catalogue-(.+)$/o) {
  150       $self->{'cataloguedata'}{$1} = $arg if defined $arg;
  151     } elsif ($cmd =~ /^(doc|src|run)files$/o) {
  152       my $type = $1;
  153       for (split ' ', $arg) {
  154         my ($k, $v) = split('=', $_, 2);
  155         if ($k eq 'size') {
  156         $self->{"${type}size"} = $v;
  157         } else {
  158           die "Unknown tag: $line";
  159         }
  160       }
  161     } elsif ($cmd eq 'containersize' || $cmd eq 'srccontainersize'
  162         || $cmd eq 'doccontainersize') {
  163       $arg =~ /^[0-9]+$/ or die "Invalid size value: $line!";
  164       $self->{$cmd} = $arg;
  165     } elsif ($cmd eq 'containermd5' || $cmd eq 'srccontainermd5'
  166         || $cmd eq 'doccontainermd5') {
  167       $arg =~ /^[a-f0-9]{32}$/ or die "Invalid md5 value: $line!";
  168       $self->{$cmd} = $arg;
  169     } elsif ($cmd eq 'containerchecksum' || $cmd eq 'srccontainerchecksum'
  170         || $cmd eq 'doccontainerchecksum') {
  171       $arg =~ /^[a-f0-9]{$TeXLive::TLConfig::ChecksumLength}$/
  172         or die "Invalid checksum value: $line!";
  173       $self->{$cmd} = $arg;
  174     } elsif ($cmd eq 'name') {
  175       $arg =~ /^([-.\w]+)$/ or die("Invalid name: $line!");
  176       $self->{'name'} = $arg;
  177       $started && die("Cannot have two name directives: $line!");
  178       $started = 1;
  179     } elsif ($cmd eq 'category') {
  180       $self->{'category'} = $arg;
  181       if ($self->{'category'} !~ /^$CategoriesRegexp/o) {
  182         tlwarn("Unknown category " . $self->{'category'} . " for package "
  183           . $self->name . " found.\nPlease update texlive.infra.\n");
  184       }
  185     } elsif ($cmd eq 'revision') {
  186       $self->{'revision'} = $arg;
  187     } elsif ($cmd eq 'shortdesc') {
  188       $self->{'shortdesc'} .= defined $arg ? $arg : ' ';
  189     } elsif ($cmd eq 'execute' || $cmd eq 'postaction'
  190         || $cmd eq 'depend') {
  191       push @{$self->{$cmd . 's'}}, $arg if defined $arg;
  192     } elsif ($cmd eq 'binfiles') {
  193       for (split ' ', $arg) {
  194         my ($k, $v) = split('=', $_, 2);
  195         if ($k eq 'arch') {
  196           $arch = $v;
  197         } elsif ($k eq 'size') {
  198           $size = $v;
  199         } else {
  200           die "Unknown tag: $line";
  201         }
  202       }
  203       if (defined($size)) {
  204         $self->{'binsize'}{$arch} = $size;
  205       }
  206     } elsif ($cmd eq 'relocated') {
  207       ($arg eq '0' || $arg eq '1') or die "Invalid value: $line!";
  208       $self->{'relocated'} = $arg;
  209     } elsif ($cmd eq 'catalogue') {
  210       $self->{'catalogue'} = $arg;
  211     } else {
  212       die("Unknown directive ...$line... , please fix it!");
  213     }
  214     $lastcmd = $cmd unless $cmd eq '';
  215   }
  216   return $started;
  217 }
  218 
  219 sub recompute_revision {
  220   my ($self,$tltree, $revtlpsrc) = @_;
  221   my @files = $self->all_files;
  222   my $filemax = 0;
  223   $self->revision(0);
  224   foreach my $f (@files) {
  225     $filemax = $tltree->file_svn_lastrevision($f);
  226     $self->revision(($filemax > $self->revision) ? $filemax : $self->revision);
  227   }
  228   if (defined($revtlpsrc)) {
  229     if ($self->revision < $revtlpsrc) {
  230       $self->revision($revtlpsrc);
  231     }
  232   }
  233 }
  234 
  235 sub recompute_sizes {
  236   my ($self,$tltree) = @_;
  237   $self->{'docsize'} = $self->_recompute_size("doc",$tltree);
  238   $self->{'srcsize'} = $self->_recompute_size("src",$tltree);
  239   $self->{'runsize'} = $self->_recompute_size("run",$tltree);
  240   foreach $a ($tltree->architectures) {
  241     $self->{'binsize'}{$a} = $self->_recompute_size("bin",$tltree,$a);
  242   }
  243 }
  244 
  245 
  246 sub _recompute_size {
  247   my ($self,$type,$tltree,$arch) = @_;
  248   my $nrivblocks = 0;
  249   if ($type eq "bin") {
  250     my %binfiles = %{$self->{'binfiles'}};
  251     if (defined($binfiles{$arch})) {
  252       foreach $f (@{$binfiles{$arch}}) {
  253         my $s = $tltree->size_of($f);
  254         $nrivblocks += int($s/$TeXLive::TLConfig::BlockSize);
  255         $nrivblocks++ if (($s%$TeXLive::TLConfig::BlockSize) > 0);
  256       }
  257     }
  258   } else {
  259     if (defined($self->{"${type}files"}) && (@{$self->{"${type}files"}})) {
  260       foreach $f (@{$self->{"${type}files"}}) {
  261         my $s = $tltree->size_of($f);
  262         if (defined($s)) {
  263           $nrivblocks += int($s/$TeXLive::TLConfig::BlockSize);
  264           $nrivblocks++ if (($s%$TeXLive::TLConfig::BlockSize) > 0);
  265         } else {
  266         tlwarn("$0: (TLPOBJ::_recompute_size) size of $type $f undefined?!\n");
  267         }
  268       }
  269     }
  270   }
  271   return $nrivblocks;
  272 }
  273 
  274 sub writeout {
  275   my $self = shift;
  276   my $fd = (@_ ? $_[0] : STDOUT);
  277   print $fd "name ", $self->name, "\n";
  278   print $fd "category ", $self->category, "\n";
  279   defined($self->{'revision'}) && print $fd "revision $self->{'revision'}\n";
  280   defined($self->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n";
  281   defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n";
  282   defined($self->{'license'}) && print $fd "license $self->{'license'}\n";
  283   defined($self->{'relocated'}) && $self->{'relocated'} && print $fd "relocated 1\n";
  284   # don't want to use FileHandle.pm; see man perlform
  285   #format_name $fd "multilineformat";
  286   select((select($fd),$~ = "multilineformat")[0]);
  287   $fd->format_lines_per_page (99999); # no pages in this format
  288   if (defined($self->{'longdesc'})) {
  289     $_tmp = "$self->{'longdesc'}";
  290     write $fd;  # use that multilineformat
  291   }
  292   if (defined($self->{'depends'})) {
  293     foreach (sort @{$self->{'depends'}}) {
  294       print $fd "depend $_\n";
  295     }
  296   }
  297   if (defined($self->{'executes'})) {
  298     foreach (sort @{$self->{'executes'}}) {
  299       print $fd "execute $_\n";
  300     }
  301   }
  302   if (defined($self->{'postactions'})) {
  303     foreach (sort @{$self->{'postactions'}}) {
  304       print $fd "postaction $_\n";
  305     }
  306   }
  307   if (defined($self->{'containersize'})) {
  308     print $fd "containersize $self->{'containersize'}\n";
  309   }
  310   if (defined($self->{'containermd5'})) {
  311     print $fd "containermd5 $self->{'containermd5'}\n";
  312   }
  313   if (defined($self->{'containerchecksum'})) {
  314     print $fd "containerchecksum $self->{'containerchecksum'}\n";
  315   }
  316   if (defined($self->{'doccontainersize'})) {
  317     print $fd "doccontainersize $self->{'doccontainersize'}\n";
  318   }
  319   if (defined($self->{'doccontainermd5'})) {
  320     print $fd "doccontainermd5 $self->{'doccontainermd5'}\n";
  321   }
  322   if (defined($self->{'doccontainerchecksum'})) {
  323     print $fd "doccontainerchecksum $self->{'doccontainerchecksum'}\n";
  324   }
  325   if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) {
  326     print $fd "docfiles size=$self->{'docsize'}\n";
  327     foreach my $f (sort @{$self->{'docfiles'}}) {
  328       print $fd " $f";
  329       if (defined($self->{'docfiledata'}{$f}{'details'})) {
  330         my $tmp = $self->{'docfiledata'}{$f}{'details'};
  331         #$tmp =~ s/\"/\\\"/g;
  332         print $fd ' details="', $tmp, '"';
  333       }
  334       if (defined($self->{'docfiledata'}{$f}{'language'})) {
  335         my $tmp = $self->{'docfiledata'}{$f}{'language'};
  336         #$tmp =~ s/\"/\\\"/g;
  337         print $fd ' language="', $tmp, '"';
  338       }
  339       print $fd "\n";
  340     }
  341   }
  342   if (defined($self->{'srccontainersize'})) {
  343     print $fd "srccontainersize $self->{'srccontainersize'}\n";
  344   }
  345   if (defined($self->{'srccontainermd5'})) {
  346     print $fd "srccontainermd5 $self->{'srccontainermd5'}\n";
  347   }
  348   if (defined($self->{'srccontainerchecksum'})) {
  349     print $fd "srccontainerchecksum $self->{'srccontainerchecksum'}\n";
  350   }
  351   if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) {
  352     print $fd "srcfiles size=$self->{'srcsize'}\n";
  353     foreach (sort @{$self->{'srcfiles'}}) {
  354       print $fd " $_\n";
  355     }
  356   }
  357   if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) {
  358     print $fd "runfiles size=$self->{'runsize'}\n";
  359     foreach (sort @{$self->{'runfiles'}}) {
  360       print $fd " $_\n";
  361     }
  362   }
  363   foreach my $arch (sort keys %{$self->{'binfiles'}}) {
  364     if (@{$self->{'binfiles'}{$arch}}) {
  365       print $fd "binfiles arch=$arch size=", $self->{'binsize'}{$arch}, "\n";
  366       foreach (sort @{$self->{'binfiles'}{$arch}}) {
  367         print $fd " $_\n";
  368       }
  369     }
  370   }
  371   # writeout all the catalogue keys
  372   foreach my $k (sort keys %{$self->cataloguedata}) {
  373     next if $k eq "date";
  374     print $fd "catalogue-$k ", $self->cataloguedata->{$k}, "\n";
  375   }
  376 }
  377 
  378 sub writeout_simple {
  379   my $self = shift;
  380   my $fd = (@_ ? $_[0] : STDOUT);
  381   print $fd "name ", $self->name, "\n";
  382   print $fd "category ", $self->category, "\n";
  383   if (defined($self->{'depends'})) {
  384     foreach (sort @{$self->{'depends'}}) {
  385       print $fd "depend $_\n";
  386     }
  387   }
  388   if (defined($self->{'executes'})) {
  389     foreach (sort @{$self->{'executes'}}) {
  390       print $fd "execute $_\n";
  391     }
  392   }
  393   if (defined($self->{'postactions'})) {
  394     foreach (sort @{$self->{'postactions'}}) {
  395       print $fd "postaction $_\n";
  396     }
  397   }
  398   if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) {
  399     print $fd "docfiles\n";
  400     foreach (sort @{$self->{'docfiles'}}) {
  401       print $fd " $_\n";
  402     }
  403   }
  404   if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) {
  405     print $fd "srcfiles\n";
  406     foreach (sort @{$self->{'srcfiles'}}) {
  407       print $fd " $_\n";
  408     }
  409   }
  410   if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) {
  411     print $fd "runfiles\n";
  412     foreach (sort @{$self->{'runfiles'}}) {
  413       print $fd " $_\n";
  414     }
  415   }
  416   foreach my $arch (sort keys %{$self->{'binfiles'}}) {
  417     if (@{$self->{'binfiles'}{$arch}}) {
  418       print $fd "binfiles arch=$arch\n";
  419       foreach (sort @{$self->{'binfiles'}{$arch}}) {
  420         print $fd " $_\n";
  421       }
  422     }
  423   }
  424 }
  425 
  426 sub as_json {
  427   my $self = shift;
  428   my %addargs = @_;
  429   my %foo = %{$self};
  430   # set the additional args
  431   for my $k (keys %addargs) {
  432     if (defined($addargs{$k})) {
  433       $foo{$k} = $addargs{$k};
  434     } else {
  435       delete($foo{$k});
  436     }
  437   }
  438   # make sure numbers are encoded as numbers
  439   for my $k (qw/revision runsize docsize srcsize containersize lrev rrev
  440                 srccontainersize doccontainersize runcontainersize/) {
  441     $foo{$k} += 0 if exists($foo{$k});
  442   }
  443   for my $k (keys %{$foo{'binsize'}}) {
  444     $foo{'binsize'}{$k} += 0;
  445   }
  446   # encode boolean as boolean flags
  447   if (exists($foo{'relocated'})) {
  448     if ($foo{'relocated'}) {
  449       $foo{'relocated'} = TeXLive::TLUtils::True();
  450     } else {
  451       $foo{'relocated'} = TeXLive::TLUtils::False();
  452     }
  453   }
  454   # adjust the docfiles entry to the specification in JSON-formats
  455   my @docf = $self->docfiles;
  456   my $dfd = $self->docfiledata;
  457   my @newdocf;
  458   for my $f ($self->docfiles) {
  459     my %newd;
  460     $newd{'file'} = $f;
  461     if (defined($dfd->{$f})) {
  462       # "details" and "language" keys now, but more could be added any time.
  463       # (Such new keys would have to be added in update_from_catalogue.)
  464       for my $k (keys %{$dfd->{$f}}) {
  465         $newd{$k} = $dfd->{$f}->{$k};
  466       }
  467     }
  468     push @newdocf, \%newd;
  469   }
  470   $foo{'docfiles'} = [ @newdocf ];
  471   delete($foo{'docfiledata'});
  472   #
  473   my $utf8_encoded_json_text = TeXLive::TLUtils::encode_json(\%foo);
  474   return $utf8_encoded_json_text;
  475 }
  476 
  477 
  478 sub cancel_reloc_prefix {
  479   my $self = shift;
  480   my @docfiles = $self->docfiles;
  481   for (@docfiles) { s:^$RelocPrefix/::; }
  482   $self->docfiles(@docfiles);
  483   my @runfiles = $self->runfiles;
  484   for (@runfiles) { s:^$RelocPrefix/::; }
  485   $self->runfiles(@runfiles);
  486   my @srcfiles = $self->srcfiles;
  487   for (@srcfiles) { s:^$RelocPrefix/::; }
  488   $self->srcfiles(@srcfiles);
  489   # if there are bin files they have definitely NOT the
  490   # texmf-dist prefix, so we cannot cancel it anyway
  491 }
  492 
  493 sub replace_reloc_prefix {
  494   my $self = shift;
  495   my @docfiles = $self->docfiles;
  496   for (@docfiles) { s:^$RelocPrefix/:$RelocTree/:; }
  497   $self->docfiles(@docfiles);
  498   my @runfiles = $self->runfiles;
  499   for (@runfiles) { s:^$RelocPrefix/:$RelocTree/:; }
  500   $self->runfiles(@runfiles);
  501   my @srcfiles = $self->srcfiles;
  502   for (@srcfiles) { s:^$RelocPrefix/:$RelocTree/:; }
  503   $self->srcfiles(@srcfiles);
  504   # docfiledata needs to be adapted too
  505   my $data = $self->docfiledata;
  506   my %newdata;
  507   while (my ($k, $v) = each %$data) {
  508     $k =~ s:^$RelocPrefix/:$RelocTree/:;
  509     $newdata{$k} = $v;
  510   }
  511   $self->docfiledata(%newdata);
  512   # if there are bin files they have definitely NOT the
  513   # texmf-dist prefix, so no reloc to replace
  514 }
  515 
  516 sub cancel_common_texmf_tree {
  517   my $self = shift;
  518   my @docfiles = $self->docfiles;
  519   for (@docfiles) { s:^$RelocTree/:$RelocPrefix/:; }
  520   $self->docfiles(@docfiles);
  521   my @runfiles = $self->runfiles;
  522   for (@runfiles) { s:^$RelocTree/:$RelocPrefix/:; }
  523   $self->runfiles(@runfiles);
  524   my @srcfiles = $self->srcfiles;
  525   for (@srcfiles) { s:^$RelocTree/:$RelocPrefix/:; }
  526   $self->srcfiles(@srcfiles);
  527   # docfiledata needs to be adapted too
  528   my $data = $self->docfiledata;
  529   my %newdata;
  530   while (my ($k, $v) = each %$data) {
  531     $k =~ s:^$RelocTree/:$RelocPrefix/:;
  532     $newdata{$k} = $v;
  533   }
  534   $self->docfiledata(%newdata);
  535   # if there are bin files they have definitely NOT the
  536   # texmf-dist prefix, so we cannot cancel it anyway
  537 }
  538 
  539 sub common_texmf_tree {
  540   my $self = shift;
  541   my $tltree;
  542   my $dd = 0;
  543   my @files = $self->all_files;
  544   foreach ($self->all_files) {
  545     my $tmp;
  546     ($tmp) = split m@/@;
  547     if (defined($tltree) && ($tltree ne $tmp)) {
  548       return;
  549     } else {
  550       $tltree = $tmp;
  551     }
  552   }
  553   # if there are no files then it is by default relocatable, so 
  554   # return the right tree
  555   if (!@files) {
  556     $tltree = $RelocTree;
  557   }
  558   return $tltree;
  559 }
  560 
  561 
  562 sub make_container {
  563   my ($self, $type, $instroot, %other) = @_;
  564   my $destdir = ($other{'destdir'} || undef);
  565   my $containername = ($other{'containername'} || undef);
  566   my $relative = ($other{'relative'} || undef);
  567   my $user = ($other{'user'} || undef);
  568   my $copy_instead_of_link = ($other{'copy_instead_of_link'} || undef);
  569   if (!($type eq 'tar' ||
  570         TeXLive::TLUtils::member($type, @{$::progs{'working_compressors'}}))) {
  571     tlwarn "$0: TLPOBJ supports @{$::progs{'working_compressors'}} and tar containers, not $type\n";
  572     tlwarn "$0: falling back to $DefaultCompressorFormat as container type!\n";
  573     $type = $DefaultCompressorFormat;
  574   }
  575 
  576   if (!defined($containername)) {
  577     $containername = $self->name;
  578   }
  579   my @files = $self->all_files;
  580   my $compresscmd;
  581   my $tlpobjdir = "$InfraLocation/tlpobj";
  582   @files = TeXLive::TLUtils::sort_uniq(@files);
  583   # we do relative packages ONLY if the files do NOT span multiple
  584   # texmf trees. check this here
  585   my $tltree;
  586   if ($relative) {
  587     $tltree = $self->common_texmf_tree;
  588     if (!defined($tltree)) {
  589       die ("$0: package $containername spans multiple trees, "
  590            . "relative generation not allowed");
  591     }
  592     if ($tltree ne $RelocTree) {
  593       die ("$0: building $containername container relocatable but the common"
  594            . " prefix is not $RelocTree");
  595     } 
  596     s,^$RelocTree/,, foreach @files;
  597   }
  598   # load Cwd only if necessary ...
  599   require Cwd;
  600   my $cwd = &Cwd::getcwd;
  601   if ("$destdir" !~ m@^(.:)?[/\\]@) {
  602     # we have an relative containerdir, so we have to make it absolute
  603     $destdir = "$cwd/$destdir";
  604   }
  605   &TeXLive::TLUtils::mkdirhier("$destdir");
  606   chdir($instroot);
  607   # in the relative case we have to chdir to the respective tltree
  608   # and put the tlpobj into the root!
  609   my $removetlpkgdir = 0;
  610   if ($relative) {
  611     chdir("./$tltree");
  612     # in the relocatable case we will probably create the tlpkg dir
  613     # in texmf-dist/tlpkg and want to remove it afterwards.
  614     $removetlpkgdir = 1;
  615     # we don't need to change the $tlpobjdir because we put it in
  616     # all cases into tlpkg/tlpobj
  617     #$tlpobjdir = "./tlpkg/tlpobj";
  618   }
  619   # we add the .tlpobj into the .tlpobj directory
  620   my $removetlpobjdir = 0;
  621   if (! -d "$tlpobjdir") {
  622     &TeXLive::TLUtils::mkdirhier("$tlpobjdir");
  623     $removetlpobjdir = 1;
  624   }
  625   open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") 
  626   || die "$0: create($tlpobjdir/$self->{'name'}.tlpobj) failed: $!";
  627   # when we do relative we have to cancel the prefix before writing out
  628   my $selfcopy = $self->copy;
  629   if ($relative) {
  630     $selfcopy->cancel_common_texmf_tree;
  631     $selfcopy->relocated($relative);
  632   }
  633   $selfcopy->writeout(\*TMP);
  634   close(TMP);
  635   push(@files, "$tlpobjdir/$self->{'name'}.tlpobj");
  636   # Switch to versioned containers
  637   # $tarname = "$containername.tar";
  638   $tarname = "$containername.r" . $self->revision . ".tar";
  639   my $unversionedtar;
  640   $unversionedtar = "$containername.tar" if (! $user);
  641 
  642   # start the fun
  643   my $tar = $::progs{'tar'};
  644   if (!defined($tar)) {
  645     tlwarn("$0: programs not set up, trying \"tar\".\n");
  646     $tar = "tar";
  647   }
  648 
  649   $containername = $tarname;
  650 
  651   # Here we need to distinguish between making the master containers for
  652   # tlnet (where we can assume GNU tar) and making backups on a user's
  653   # machine (where we can assume nothing).  We determine this by whether
  654   # there's a revision suffix in the container name.
  655   # 
  656   # For the master containers, we want to set the owner/group, exclude
  657   # .svn directories, and force ustar format.  This last is for the sake
  658   # of packages such as pgf which have filenames long enough that they
  659   # overflow standard tar format and result in special things being
  660   # done.  We don't want the GNU-specific special things.
  661   #
  662   # We use versioned containers throughout, user mode is determined by
  663   # argument.
  664   my $is_user_container = $user;
  665   my @attrs
  666     = $is_user_container
  667       ? ()
  668       : ( "--owner", "0",  "--group", "0",  "--exclude", ".svn",
  669           "--format", "ustar" );
  670   my @cmdline = ($tar, "-cf", "$destdir/$tarname", @attrs);
  671   
  672   # Get list of files and symlinks to back up.  Nothing else should be
  673   # in the list.
  674   my @files_to_backup = ();
  675   for my $f (@files) {
  676     if (-f $f || -l $f) {
  677       push(@files_to_backup, $f);
  678     } elsif (! -e $f) {
  679       tlwarn("$0: (make_container $containername) $f does not exist\n");
  680     } else {
  681       tlwarn("$0: (make_container $containername) $f not file or symlink\n");
  682     }
  683   }
  684   
  685   my $tartempfile = "";
  686   if (win32()) {
  687     # Since we provide our own (GNU) tar on Windows, we know it has -T.
  688     my $tmpdir = TeXLive::TLUtils::tl_tmpdir();
  689     $tartempfile = "$tmpdir/mc$$";
  690     open(TMP, ">$tartempfile") || die "open(>$tartempfile) failed: $!";
  691     print TMP map { "$_\n" } @files_to_backup;
  692     close(TMP) || warn "close(>$tartempfile) failed: $!";
  693     push(@cmdline, "-T", $tartempfile);
  694   } else {
  695     # For Unix, we pass all the files on the command line, because there
  696     # is no portable (across different platforms and different tars)  way
  697     # to pass them on stdin.  Unfortunately, this can be too lengthy of
  698     # a command line -- our biggest package is tex4ht, which needs about
  699     # 200k.  CentOS 5.2, at least, starts complaining around 140k.
  700     # 
  701     # Therefore, if the command is likely to be too long, we call
  702     # our collapse_dirs routine; in practice, this eliminates
  703     # essentially all the individual files, leaving just a few
  704     # directories, which is no problem.  (For example, tex4ht collapses
  705     # down to five directories and one file.)
  706     # 
  707     # Although in principle we could do this in all cases, collapse_dirs
  708     # isn't the most thoroughly tested function in the world.  It seems
  709     # safer to only do it in the (few) potentially problematic cases.
  710     # 
  711     if (length ("@files_to_backup") > 50000) {
  712       @files_to_backup = TeXLive::TLUtils::collapse_dirs(@files_to_backup);
  713       # A complication, as always.  collapse_dirs returns absolute paths.
  714       # We want to change them back to relative so that the backup tar
  715       # has the same structure.
  716       # In relative mode we have to remove the texmf-dist prefix, too.
  717       s,^$instroot/,, foreach @files_to_backup;
  718       if ($relative) {
  719         s,^$RelocTree/,, foreach @files_to_backup;
  720       }
  721     }
  722     push(@cmdline, @files_to_backup);
  723   }
  724 
  725   # Run tar. Unlink both here in case the container is also plain tar.
  726   unlink("$destdir/$tarname");
  727   unlink("$destdir/$unversionedtar") if (! $user);
  728   unlink("$destdir/$containername");
  729   xsystem(@cmdline);
  730 
  731   if ($type ne 'tar') {
  732     # compress it
  733     my $compressor = $::progs{$type};
  734     if (!defined($compressor)) {
  735       # fall back to $type as compressor, but that shouldn't happen
  736       tlwarn("$0: programs not set up, trying \"$type\".\n");
  737       $compressor = $type;
  738     }
  739     my @compressorargs = @{$Compressors{$type}{'compress_args'}};
  740     my $compressorextension = $Compressors{$type}{'extension'};
  741     $containername = "$tarname.$compressorextension";
  742     debug("selected compressor: $compressor with @compressorargs, "
  743           . "on $destdir/$tarname\n");
  744   
  745     # compress it.
  746     if (-r "$destdir/$tarname") {
  747       # system return 0 on success
  748       if (system($compressor, @compressorargs, "$destdir/$tarname")) {
  749         tlwarn("$0: Couldn't compress $destdir/$tarname\n");
  750         return (0,0, "");
  751       }
  752       # make sure we remove the original tar since old lz4 versions
  753       # cannot automatically delete it.
  754       # We remove the tar file only when the compressed file was
  755       # correctly created, something that should only happen in the
  756       # most strange cases.
  757       unlink("$destdir/$tarname")
  758         if ((-r "$destdir/$tarname") && (-r "$destdir/$containername"));
  759       # in case of system containers also create the links to the 
  760       # versioned containers
  761       if (! $user) {
  762         my $linkname = "$destdir/$unversionedtar.$compressorextension";
  763         unlink($linkname) if (-r $linkname);
  764         if ($copy_instead_of_link) {
  765           TeXLive::TLUtils::copy("-f", "$destdir/$containername", $linkname)
  766         } else {
  767           if (!symlink($containername, $linkname)) {
  768             tlwarn("$0: Couldn't generate link $linkname -> $containername?\n");
  769           }
  770         }
  771       }
  772     } else {
  773       tlwarn("$0: Couldn't find $destdir/$tarname to run $compressor\n");
  774       return (0, 0, "");
  775     }
  776   }
  777   
  778   # compute the size.
  779   if (! -r "$destdir/$containername") {
  780     tlwarn ("$0: Couldn't find $destdir/$containername\n");
  781     return (0, 0, "");
  782   }
  783   my $size = (stat "$destdir/$containername") [7];
  784   #
  785   # if we are creating a system container, or there is a way to
  786   # compute the checksums, do it
  787   my $checksum = "";
  788   if (!$is_user_container || $::checksum_method) {
  789     $checksum = TeXLive::TLCrypto::tlchecksum("$destdir/$containername");
  790   }
  791   
  792   # cleaning up
  793   unlink("$tlpobjdir/$self->{'name'}.tlpobj");
  794   unlink($tartempfile) if $tartempfile;
  795   rmdir($tlpobjdir) if $removetlpobjdir;
  796   rmdir($InfraLocation) if $removetlpkgdir;
  797   xchdir($cwd);
  798 
  799   debug(" done $containername, size $size, csum $checksum\n");
  800   return ($size, $checksum, "$destdir/$containername");
  801 }
  802 
  803 
  804 
  805 sub is_arch_dependent {
  806   my $self = shift;
  807   if (keys %{$self->{'binfiles'}}) {
  808     return 1;
  809   } else {
  810     return 0;
  811   }
  812 }
  813 
  814 # computes the total size of a package
  815 # if no arguments are given this is
  816 #   docsize + runsize + srcsize + max of binsize
  817 sub total_size {
  818   my ($self,@archs) = @_;
  819   my $ret = $self->docsize + $self->runsize + $self->srcsize;
  820   if ($self->is_arch_dependent) {
  821     my $max = 0;
  822     my %foo = %{$self->binsize};
  823     foreach my $k (keys %foo) {
  824       $max = $foo{$k} if ($foo{$k} > $max);
  825     }
  826     $ret += $max;
  827   }
  828   return($ret);
  829 }
  830 
  831 
  832 # update_from_catalogue($tlc)
  833 # Update the current TLPOBJ object with the information from the
  834 # corresponding entry in C<$tlc->entries>.
  835 #
  836 sub update_from_catalogue {
  837   my ($self, $tlc) = @_;
  838   my $tlcname = $self->name;
  839   if (defined($self->catalogue)) {
  840     $tlcname = $self->catalogue;
  841   } elsif ($tlcname =~ m/^bin-(.*)$/) {
  842     if (!defined($tlc->entries->{$tlcname})) {
  843       $tlcname = $1;
  844     }
  845   }
  846   $tlcname = lc($tlcname);
  847   if (defined($tlc->entries->{$tlcname})) {
  848     my $entry = $tlc->entries->{$tlcname};
  849     # Record the id of the catalogue entry if it's found.
  850     if ($entry->entry->{'id'} ne $tlcname) {
  851       $self->catalogue($entry->entry->{'id'});
  852     }
  853     if (defined($entry->license)) {
  854       $self->cataloguedata->{'license'} = $entry->license;
  855     }
  856     if (defined($entry->version) && $entry->version ne "") {
  857       $self->cataloguedata->{'version'} = $entry->version;
  858     }
  859     if (defined($entry->ctan) && $entry->ctan ne "") {
  860       $self->cataloguedata->{'ctan'} = $entry->ctan;
  861     }
  862     # TODO TODO TODO
  863     # we should rewrite the also fields to TeX Live package names ...
  864     # for now these are CTAN package names!
  865     # warning, we expect that cataloguedata entries are strings, 
  866     # so stringify these lists
  867     if (@{$entry->also}) {
  868       $self->cataloguedata->{'also'} = "@{$entry->also}";
  869     }
  870     if (@{$entry->alias}) {
  871       $self->cataloguedata->{'alias'} = "@{$entry->alias}";
  872     }
  873     if (@{$entry->topics}) {
  874       $self->cataloguedata->{'topics'} = "@{$entry->topics}";
  875     }
  876     if (%{$entry->contact}) {
  877       for my $k (keys %{$entry->contact}) {
  878         $self->cataloguedata->{"contact-$k"} = $entry->contact->{$k};
  879       }
  880     }
  881     #if (defined($entry->texlive)) {
  882     # $self->cataloguedata->{'texlive'} = $entry->texlive;
  883     #}
  884     #if (defined($entry->miktex)) {
  885     #  $self->cataloguedata->{'miktex'} = $entry->miktex;
  886     #}
  887     if (defined($entry->caption) && $entry->caption ne "") {
  888       $self->{'shortdesc'} = $entry->caption unless $self->{'shortdesc'};
  889     }
  890     if (defined($entry->description) && $entry->description ne "") {
  891       $self->{'longdesc'} = $entry->description unless $self->{'longdesc'};
  892     }
  893     #
  894     # we need to do the following:
  895     # - take the href entry for a documentation file entry in the TC
  896     # - remove the 'ctan:' prefix
  897     # - remove the <ctan path='...'> part
  898     # - match the rest against all docfiles in an intelligent way
  899     #
  900     # Example:
  901     # juramisc.xml contains:
  902     # <documentation details='Package documentation' language='de'
  903     #   href='ctan:/macros/latex/contrib/juramisc/doc/jmgerdoc.pdf'/>
  904     # <ctan path='/macros/latex/contrib/juramisc'/>
  905     my @tcdocfiles = keys %{$entry->docs};  # Catalogue doc files.
  906     my %tcdocfilebasenames;                 # basenames of those, as we go.
  907     my @tlpdocfiles = $self->docfiles;      # TL doc files.
  908     foreach my $tcdocfile (sort @tcdocfiles) {  # sort so shortest first
  909       #warn "looking at tcdocfile $tcdocfile\n";
  910       my $tcdocfilebasename = $tcdocfile;
  911       $tcdocfilebasename =~ s/^ctan://;  # remove ctan: prefix
  912       $tcdocfilebasename =~ s,.*/,,;     # remove all but the base file name
  913       #warn "  got basename $tcdocfilebasename\n";
  914       #
  915       # If we've already seen this basename, skip.  This is for the sake
  916       # of README files, which can exist in different directories but
  917       # get renamed into different files in TL for various annoying reasons;
  918       # e.g., ibygrk, rsfs, songbook.  In these cases, it turns out we
  919       # always prefer the first entry (top-level README).
  920       next if exists $tcdocfilebasenames{$tcdocfilebasename};
  921       $tcdocfilebasenames{$tcdocfilebasename} = 1;
  922       #
  923       foreach my $tlpdocfile (@tlpdocfiles) {
  924         #warn "considering merge into tlpdocfile $tlpdocfile\n";
  925         if ($tlpdocfile =~ m,/$tcdocfilebasename$,) {
  926           # update the language/detail tags from Catalogue if present.
  927           if (defined($entry->docs->{$tcdocfile}{'details'})) {
  928             my $tmp = $entry->docs->{$tcdocfile}{'details'};
  929             #warn "merging details for $tcdocfile: $tmp\n";
  930             # remove all embedded quotes, they are just a pain
  931             $tmp =~ s/"//g;
  932             $self->{'docfiledata'}{$tlpdocfile}{'details'} = $tmp;
  933           }
  934           if (defined($entry->docs->{$tcdocfile}{'language'})) {
  935             my $tmp = $entry->docs->{$tcdocfile}{'language'};
  936             #warn "merging lang for $tcdocfile: $tmp\n";
  937             $self->{'docfiledata'}{$tlpdocfile}{'language'} = $tmp;
  938           }
  939         }
  940       }
  941     }
  942   }
  943 }
  944 
  945 sub is_meta_package {
  946   my $self = shift;
  947   if ($self->category =~ /^$MetaCategoriesRegexp$/) {
  948     return 1;
  949   }
  950   return 0;
  951 }
  952 
  953 sub docfiles_package {
  954   my $self = shift;
  955   if (not($self->docfiles)) { return ; }
  956   my $tlp = new TeXLive::TLPOBJ;
  957   $tlp->name($self->name . ".doc");
  958   $tlp->shortdesc("doc files of " . $self->name);
  959   $tlp->revision($self->revision);
  960   $tlp->category($self->category);
  961   $tlp->add_docfiles($self->docfiles);
  962   $tlp->docsize($self->docsize);
  963   # $self->clear_docfiles();
  964   # $self->docsize(0);
  965   return($tlp);
  966 }
  967 
  968 sub srcfiles_package {
  969   my $self = shift;
  970   if (not($self->srcfiles)) { return ; }
  971   my $tlp = new TeXLive::TLPOBJ;
  972   $tlp->name($self->name . ".source");
  973   $tlp->shortdesc("source files of " . $self->name);
  974   $tlp->revision($self->revision);
  975   $tlp->category($self->category);
  976   $tlp->add_srcfiles($self->srcfiles);
  977   $tlp->srcsize($self->srcsize);
  978   # $self->clear_srcfiles();
  979   # $self->srcsize(0);
  980   return($tlp);
  981 }
  982 
  983 sub split_bin_package {
  984   my $self = shift;
  985   my %binf = %{$self->binfiles};
  986   my @retlist;
  987   foreach $a (keys(%binf)) {
  988     my $tlp = new TeXLive::TLPOBJ;
  989     $tlp->name($self->name . ".$a");
  990     $tlp->shortdesc("$a files of " . $self->name);
  991     $tlp->revision($self->revision);
  992     $tlp->category($self->category);
  993     $tlp->add_binfiles($a,@{$binf{$a}});
  994     $tlp->binsize( $a => $self->binsize->{$a} );
  995     push @retlist, $tlp;
  996   }
  997   if (keys(%binf)) {
  998     push @{$self->{'depends'}}, $self->name . ".ARCH";
  999   }
 1000   $self->clear_binfiles();
 1001   return(@retlist);
 1002 }
 1003 
 1004 
 1005 # Helpers.
 1006 #
 1007 sub add_files {
 1008   my ($self,$type,@files) = @_;
 1009   die("Cannot use add_files for binfiles, we need that arch!")
 1010     if ($type eq "bin");
 1011   &TeXLive::TLUtils::push_uniq(\@{ $self->{"${type}files"} }, @files);
 1012 }
 1013 
 1014 sub remove_files {
 1015   my ($self,$type,@files) = @_;
 1016   die("Cannot use remove_files for binfiles, we need that arch!")
 1017     if ($type eq "bin");
 1018   my @finalfiles;
 1019   foreach my $f (@{$self->{"${type}files"}}) {
 1020     if (not(&TeXLive::TLUtils::member($f,@files))) {
 1021       push @finalfiles,$f;
 1022     }
 1023   }
 1024   $self->{"${type}files"} = [ @finalfiles ];
 1025 }
 1026 
 1027 sub contains_file {
 1028   my ($self,$fn) = @_;
 1029   # if the filename already contains a / do not add it at the beginning
 1030   my $ret = "";
 1031   if ($fn =~ m!/!) {
 1032     return(grep(m!$fn$!, $self->all_files));
 1033   } else {
 1034     return(grep(m!(^|/)$fn$!,$self->all_files));
 1035   }
 1036 }
 1037 
 1038 sub all_files {
 1039   my ($self) = shift;
 1040   my @ret = ();
 1041 
 1042   push (@ret, $self->docfiles);
 1043   push (@ret, $self->runfiles);
 1044   push (@ret, $self->srcfiles);
 1045   push (@ret, $self->allbinfiles);
 1046 
 1047   return @ret;
 1048 }
 1049 
 1050 sub allbinfiles {
 1051   my $self = shift;
 1052   my @ret = ();
 1053   my %binfiles = %{$self->binfiles};
 1054 
 1055   foreach my $arch (keys %binfiles) {
 1056     push (@ret, @{$binfiles{$arch}});
 1057   }
 1058 
 1059   return @ret;
 1060 }
 1061 
 1062 sub format_definitions {
 1063   my $self = shift;
 1064   my $pkg = $self->name;
 1065   my @ret;
 1066   for my $e ($self->executes) {
 1067     if ($e =~ m/AddFormat\s+(.*)\s*/) {
 1068       my %r = TeXLive::TLUtils::parse_AddFormat_line("$1");
 1069       if (defined($r{"error"})) {
 1070         die "$r{'error'}, package $pkg, execute $e";
 1071       }
 1072       push @ret, \%r;
 1073     }
 1074   }
 1075   return @ret;
 1076 }
 1077 
 1078 #
 1079 # execute stuff
 1080 #
 1081 sub fmtutil_cnf_lines {
 1082   my $obj = shift;
 1083   my @disabled = @_;
 1084   my @fmtlines = ();
 1085   my $first = 1;
 1086   my $pkg = $obj->name;
 1087   foreach my $e ($obj->executes) {
 1088     if ($e =~ m/AddFormat\s+(.*)\s*/) {
 1089       my %r = TeXLive::TLUtils::parse_AddFormat_line("$1");
 1090       if (defined($r{"error"})) {
 1091         die "$r{'error'}, package $pkg, execute $e";
 1092       }
 1093       if ($first) {
 1094         push @fmtlines, "#\n# from $pkg:\n";
 1095         $first = 0;
 1096       }
 1097       my $mode = ($r{"mode"} ? "" : "#! ");
 1098       $mode = "#! " if TeXLive::TLUtils::member ($r{'name'}, @disabled);
 1099       push @fmtlines, "$mode$r{'name'} $r{'engine'} $r{'patterns'} $r{'options'}\n";
 1100     }
 1101   }
 1102   return @fmtlines;
 1103 }
 1104 
 1105 
 1106 sub updmap_cfg_lines {
 1107   my $obj = shift;
 1108   my @disabled = @_;
 1109   my %maps;
 1110   foreach my $e ($obj->executes) {
 1111     if ($e =~ m/addMap (.*)$/) {
 1112       $maps{$1} = 1;
 1113     } elsif ($e =~ m/addMixedMap (.*)$/) {
 1114       $maps{$1} = 2;
 1115     } elsif ($e =~ m/addKanjiMap (.*)$/) {
 1116       $maps{$1} = 3;
 1117     }
 1118     # others are ignored here
 1119   }
 1120   my @updmaplines;
 1121   foreach (sort keys %maps) {
 1122     next if TeXLive::TLUtils::member($_, @disabled);
 1123     if ($maps{$_} == 1) {
 1124       push @updmaplines, "Map $_\n";
 1125     } elsif ($maps{$_} == 2) {
 1126       push @updmaplines, "MixedMap $_\n";
 1127     } elsif ($maps{$_} == 3) {
 1128       push @updmaplines, "KanjiMap $_\n";
 1129     } else {
 1130       tlerror("Should not happen!\n");
 1131     }
 1132   }
 1133   return(@updmaplines);
 1134 }
 1135 
 1136 
 1137 sub language_dat_lines {
 1138   my $self = shift;
 1139   local @disabled = @_;  # we use @disabled in the nested sub
 1140   my @lines = $self->_parse_hyphen_execute(\&make_dat_lines, 'dat');
 1141   return @lines;
 1142 
 1143   sub make_dat_lines {
 1144     my ($name, $lhm, $rhm, $file, $syn) = @_;
 1145     my @ret;
 1146     return if TeXLive::TLUtils::member($name, @disabled);
 1147     push @ret, "$name $file\n";
 1148     foreach (@$syn) {
 1149       push @ret, "=$_\n";
 1150     }
 1151     return @ret;
 1152   }
 1153 }
 1154 
 1155 
 1156 sub language_def_lines {
 1157   my $self = shift;
 1158   local @disabled = @_;  # we use @disabled in the nested sub
 1159   my @lines = $self->_parse_hyphen_execute(\&make_def_lines, 'def');
 1160   return @lines;
 1161 
 1162   sub make_def_lines {
 1163     my ($name, $lhm, $rhm, $file, $syn) = @_;
 1164     return if TeXLive::TLUtils::member($name, @disabled);
 1165     my $exc = "";
 1166     my @ret;
 1167     push @ret, "\\addlanguage\{$name\}\{$file\}\{$exc\}\{$lhm\}\{$rhm\}\n";
 1168     foreach (@$syn) {
 1169       # synonyms in language.def ???
 1170       push @ret, "\\addlanguage\{$_\}\{$file\}\{$exc\}\{$lhm\}\{$rhm\}\n";
 1171       #debug("Ignoring synonym $_ for $name when creating language.def\n");
 1172     }
 1173     return @ret;
 1174   }
 1175 }
 1176 
 1177 
 1178 sub language_lua_lines {
 1179   my $self = shift;
 1180   local @disabled = @_;  # we use @disabled in the nested sub
 1181   my @lines = $self->_parse_hyphen_execute(\&make_lua_lines, 'lua', '--');
 1182   return @lines;
 1183 
 1184   sub make_lua_lines {
 1185     my ($name, $lhm, $rhm, $file, $syn, $patt, $hyph, $special) = @_;
 1186     return if TeXLive::TLUtils::member($name, @disabled);
 1187     my @syn = (@$syn); # avoid modifying the original
 1188     map { $_ = "'$_'" } @syn;
 1189     my @ret;
 1190     push @ret, "['$name'] = {", "\tloader = '$file',",
 1191                "\tlefthyphenmin = $lhm,", "\trighthyphenmin = $rhm,",
 1192                "\tsynonyms = { " . join(', ', @syn) . " },";
 1193     push @ret, "\tpatterns = '$patt'," if defined $patt;
 1194     push @ret, "\thyphenation = '$hyph'," if defined $hyph;
 1195     push @ret, "\tspecial = '$special'," if defined $special;
 1196     push @ret, '},';
 1197     map { $_ = "\t$_\n" } @ret;
 1198     return @ret;
 1199   }
 1200 }
 1201 
 1202 
 1203 sub _parse_hyphen_execute {
 1204   my ($obj, $coderef, $db, $cc) = @_;
 1205   $cc ||= '%'; # default comment char
 1206   my @langlines = ();
 1207   my $pkg = $obj->name;
 1208   my $first = 1;
 1209   foreach my $e ($obj->executes) {
 1210     if ($e =~ m/AddHyphen\s+(.*)\s*/) {
 1211       my %r = TeXLive::TLUtils::parse_AddHyphen_line("$1");
 1212       if (defined($r{"error"})) {
 1213         die "$r{'error'}, package $pkg, execute $e";
 1214       }
 1215       if (not TeXLive::TLUtils::member($db, @{$r{"databases"}})) {
 1216         next;
 1217       }
 1218       if ($first) {
 1219         push @langlines, "$cc from $pkg:\n";
 1220         $first = 0;
 1221       }
 1222       if ($r{"comment"}) {
 1223           push @langlines, "$cc $r{comment}\n";
 1224       }
 1225       my @foo = &$coderef ($r{"name"}, $r{"lefthyphenmin"},
 1226                            $r{"righthyphenmin"}, $r{"file"}, $r{"synonyms"},
 1227                            $r{"file_patterns"}, $r{"file_exceptions"},
 1228                            $r{"luaspecial"});
 1229       push @langlines, @foo;
 1230     }
 1231   }
 1232   return @langlines;
 1233 }
 1234 
 1235 
 1236 
 1237 # member access functions
 1238 #
 1239 sub _set_get_array_value {
 1240   my $self = shift;
 1241   my $key = shift;
 1242   if (@_) { 
 1243     if (defined($_[0])) {
 1244       $self->{$key} = [ @_ ];
 1245     } else {
 1246       $self->{$key} = [ ];
 1247     }
 1248   }
 1249   return @{ $self->{$key} };
 1250 }
 1251 sub name {
 1252   my $self = shift;
 1253   if (@_) { $self->{'name'} = shift }
 1254   return $self->{'name'};
 1255 }
 1256 sub category {
 1257   my $self = shift;
 1258   if (@_) { $self->{'category'} = shift }
 1259   return $self->{'category'};
 1260 }
 1261 sub shortdesc {
 1262   my $self = shift;
 1263   if (@_) { $self->{'shortdesc'} = shift }
 1264   return $self->{'shortdesc'};
 1265 }
 1266 sub longdesc {
 1267   my $self = shift;
 1268   if (@_) { $self->{'longdesc'} = shift }
 1269   return $self->{'longdesc'};
 1270 }
 1271 sub revision {
 1272   my $self = shift;
 1273   if (@_) { $self->{'revision'} = shift }
 1274   return $self->{'revision'};
 1275 }
 1276 sub relocated {
 1277   my $self = shift;
 1278   if (@_) { $self->{'relocated'} = shift }
 1279   return ($self->{'relocated'} ? 1 : 0);
 1280 }
 1281 sub catalogue {
 1282   my $self = shift;
 1283   if (@_) { $self->{'catalogue'} = shift }
 1284   return $self->{'catalogue'};
 1285 }
 1286 sub srcfiles {
 1287   _set_get_array_value(shift, "srcfiles", @_);
 1288 }
 1289 sub containersize {
 1290   my $self = shift;
 1291   if (@_) { $self->{'containersize'} = shift }
 1292   return ( defined($self->{'containersize'}) ? $self->{'containersize'} : -1 );
 1293 }
 1294 sub srccontainersize {
 1295   my $self = shift;
 1296   if (@_) { $self->{'srccontainersize'} = shift }
 1297   return ( defined($self->{'srccontainersize'}) ? $self->{'srccontainersize'} : -1 );
 1298 }
 1299 sub doccontainersize {
 1300   my $self = shift;
 1301   if (@_) { $self->{'doccontainersize'} = shift }
 1302   return ( defined($self->{'doccontainersize'}) ? $self->{'doccontainersize'} : -1 );
 1303 }
 1304 sub containermd5 {
 1305   my $self = shift;
 1306   if (@_) { $self->{'containermd5'} = shift }
 1307   if (defined($self->{'containermd5'})) {
 1308     return ($self->{'containermd5'});
 1309   } else {
 1310     tlwarn("TLPOBJ: MD5 sums are no longer supported, please adapt your code!\n");
 1311     return ("");
 1312   }
 1313 }
 1314 sub srccontainermd5 {
 1315   my $self = shift;
 1316   if (@_) { $self->{'srccontainermd5'} = shift }
 1317   if (defined($self->{'srccontainermd5'})) {
 1318     return ($self->{'srccontainermd5'});
 1319   } else {
 1320     tlwarn("TLPOBJ: MD5 sums are no longer supported, please adapt your code!\n");
 1321     return ("");
 1322   }
 1323 }
 1324 sub doccontainermd5 {
 1325   my $self = shift;
 1326   if (@_) { $self->{'doccontainermd5'} = shift }
 1327   if (defined($self->{'doccontainermd5'})) {
 1328     return ($self->{'doccontainermd5'});
 1329   } else {
 1330     tlwarn("TLPOBJ: MD5 sums are no longer supported, please adapt your code!\n");
 1331     return ("");
 1332   }
 1333 }
 1334 sub containerchecksum {
 1335   my $self = shift;
 1336   if (@_) { $self->{'containerchecksum'} = shift }
 1337   return ( defined($self->{'containerchecksum'}) ? $self->{'containerchecksum'} : "" );
 1338 }
 1339 sub srccontainerchecksum {
 1340   my $self = shift;
 1341   if (@_) { $self->{'srccontainerchecksum'} = shift }
 1342   return ( defined($self->{'srccontainerchecksum'}) ? $self->{'srccontainerchecksum'} : "" );
 1343 }
 1344 sub doccontainerchecksum {
 1345   my $self = shift;
 1346   if (@_) { $self->{'doccontainerchecksum'} = shift }
 1347   return ( defined($self->{'doccontainerchecksum'}) ? $self->{'doccontainerchecksum'} : "" );
 1348 }
 1349 sub srcsize {
 1350   my $self = shift;
 1351   if (@_) { $self->{'srcsize'} = shift }
 1352   return ( defined($self->{'srcsize'}) ? $self->{'srcsize'} : 0 );
 1353 }
 1354 sub clear_srcfiles {
 1355   my $self = shift;
 1356   $self->{'srcfiles'} = [ ] ;
 1357 }
 1358 sub add_srcfiles {
 1359   my ($self,@files) = @_;
 1360   $self->add_files("src",@files);
 1361 }
 1362 sub remove_srcfiles {
 1363   my ($self,@files) = @_;
 1364   $self->remove_files("src",@files);
 1365 }
 1366 sub docfiles {
 1367   _set_get_array_value(shift, "docfiles", @_);
 1368 }
 1369 sub clear_docfiles {
 1370   my $self = shift;
 1371   $self->{'docfiles'} = [ ] ;
 1372 }
 1373 sub docsize {
 1374   my $self = shift;
 1375   if (@_) { $self->{'docsize'} = shift }
 1376   return ( defined($self->{'docsize'}) ? $self->{'docsize'} : 0 );
 1377 }
 1378 sub add_docfiles {
 1379   my ($self,@files) = @_;
 1380   $self->add_files("doc",@files);
 1381 }
 1382 sub remove_docfiles {
 1383   my ($self,@files) = @_;
 1384   $self->remove_files("doc",@files);
 1385 }
 1386 sub docfiledata {
 1387   my $self = shift;
 1388   my %newfiles = @_;
 1389   if (@_) { $self->{'docfiledata'} = \%newfiles }
 1390   return $self->{'docfiledata'};
 1391 }
 1392 sub binfiles {
 1393   my $self = shift;
 1394   my %newfiles = @_;
 1395   if (@_) { $self->{'binfiles'} = \%newfiles }
 1396   return $self->{'binfiles'};
 1397 }
 1398 sub clear_binfiles {
 1399   my $self = shift;
 1400   $self->{'binfiles'} = { };
 1401 }
 1402 sub binsize {
 1403   my $self = shift;
 1404   my %newsizes = @_;
 1405   if (@_) { $self->{'binsize'} = \%newsizes }
 1406   return $self->{'binsize'};
 1407 }
 1408 sub add_binfiles {
 1409   my ($self,$arch,@files) = @_;
 1410   &TeXLive::TLUtils::push_uniq(\@{ $self->{'binfiles'}{$arch} }, @files);
 1411 }
 1412 sub remove_binfiles {
 1413   my ($self,$arch,@files) = @_;
 1414   my @finalfiles;
 1415   foreach my $f (@{$self->{'binfiles'}{$arch}}) {
 1416     if (not(&TeXLive::TLUtils::member($f,@files))) {
 1417       push @finalfiles,$f;
 1418     }
 1419   }
 1420   $self->{'binfiles'}{$arch} = [ @finalfiles ];
 1421 }
 1422 sub runfiles {
 1423   _set_get_array_value(shift, "runfiles", @_);
 1424 }
 1425 sub clear_runfiles {
 1426   my $self = shift;
 1427   $self->{'runfiles'} = [ ] ;
 1428 }
 1429 sub runsize {
 1430   my $self = shift;
 1431   if (@_) { $self->{'runsize'} = shift }
 1432   return ( defined($self->{'runsize'}) ? $self->{'runsize'} : 0 );
 1433 }
 1434 sub add_runfiles {
 1435   my ($self,@files) = @_;
 1436   $self->add_files("run",@files);
 1437 }
 1438 sub remove_runfiles {
 1439   my ($self,@files) = @_;
 1440   $self->remove_files("run",@files);
 1441 }
 1442 sub depends {
 1443   _set_get_array_value(shift, "depends", @_);
 1444 }
 1445 sub executes {
 1446   _set_get_array_value(shift, "executes", @_);
 1447 }
 1448 sub postactions {
 1449   _set_get_array_value(shift, "postactions", @_);
 1450 }
 1451 sub containerdir {
 1452   my @self = shift;
 1453   if (@_) { $_containerdir = $_[0] }
 1454   return $_containerdir;
 1455 }
 1456 sub cataloguedata {
 1457   my $self = shift;
 1458   my %ct = @_;
 1459   if (@_) { $self->{'cataloguedata'} = \%ct }
 1460   return $self->{'cataloguedata'};
 1461 }
 1462 
 1463 $: = " \n"; # don't break at -
 1464 format multilineformat =
 1465 longdesc ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
 1466 $_tmp
 1467 .
 1468 
 1469 1;
 1470 __END__
 1471 
 1472 
 1473 =head1 NAME
 1474 
 1475 C<TeXLive::TLPOBJ> -- TeX Live Package Object access module
 1476 
 1477 =head1 SYNOPSIS
 1478 
 1479   use TeXLive::TLPOBJ;
 1480 
 1481   my $tlpobj=TeXLive::TLPOBJ->new(name => "foobar");
 1482 
 1483 =head1 DESCRIPTION
 1484 
 1485 The L<TeXLive::TLPOBJ> module provide access to TeX Live Package Object
 1486 files describing a self-contained package.
 1487 
 1488 =head1 FILE SPECIFICATION
 1489 
 1490 See L<TeXLive::TLPSRC> documentation for the general syntax and
 1491 specification. The differences are:
 1492 
 1493 =over 4
 1494 
 1495 =item The various C<*pattern> keys are invalid.
 1496 
 1497 =item Instead, there are respective C<*files> keys described below.
 1498 All the C<*files> keys are followed by a list of files in the given
 1499 category, one per line, each line I<indented> by one space.
 1500 
 1501 =item Several new keys beginning with C<catalogue-> specify information
 1502 automatically taken from the TeX Catalogue.
 1503 
 1504 =item A new key C<revision> is defined (automatically computed),
 1505 which specifies the maximum of all the last-changed revisions of files
 1506 contained in the package, plus possible other changes. By default,
 1507 Catalogue-only changes do not change the revision.
 1508 
 1509 =item A new key C<relocated>, either 0 or 1, which indicates that this
 1510 packages has been relocated, i.e., in the containers the initial
 1511 C<texmf-dist> directory has been stripped off and replaced with static
 1512 string C<RELOC>.
 1513 
 1514 =back
 1515 
 1516 =over 4
 1517 
 1518 =item C<srcfiles>, C<runfiles>, C<binfiles>, C<docfiles>
 1519 each of these items contains addition the sum of sizes of the single
 1520 files (in units of C<TeXLive::TLConfig::BlockSize> blocks, currently 4k).
 1521 
 1522   srcfiles size=NNNNNN
 1523   runfiles size=NNNNNN
 1524 
 1525 =item C<docfiles>
 1526 
 1527 The docfiles line itself is similar to the C<srcfiles> and C<runfiles> lines
 1528 above:
 1529 
 1530   docfiles size=NNNNNN
 1531 
 1532 But the lines listing the files are allowed to have additional tags,
 1533 (which in practice come from the TeX Catalogue)
 1534 
 1535   /------- excerpt from achemso.tlpobj
 1536   |...
 1537   |docfiles size=220
 1538   | texmf-dist/doc/latex/achemso/achemso.pdf details="Package documentation" language="en"
 1539   |...
 1540 
 1541 Currently only the tags C<details> and C<language> are supported. These
 1542 additional information can be accessed via the C<docfiledata> function
 1543 returning a hash with the respective files (including path) as key.
 1544 
 1545 =item C<binfiles>
 1546 
 1547 Since C<binfiles> can be different for different architectures, a single
 1548 C<tlpobj> file can, and typically does, contain C<binfiles> lines for
 1549 all available architectures. The architecture is specified on the
 1550 C<binfiles> using the C<arch=>I<XXX> tag. Thus, C<binfiles> lines look
 1551 like
 1552 
 1553   binfiles arch=XXXX size=NNNNN
 1554 
 1555 =back
 1556 
 1557 Here is an excerpt from the representation of the C<dvipsk> package,
 1558 with C<|> characters inserted to show the indentation:
 1559 
 1560   |name dvipsk
 1561   |category TLCore
 1562   |revision 52851
 1563   |docfiles size=285
 1564   | texmf-dist/doc/dvips/dvips.html
 1565   | ...
 1566   |runfiles size=93
 1567   | texmf-dist/dvips/base/color.pro
 1568   | ...
 1569   | texmf-dist/scripts/pkfix/pkfix.pl
 1570   |binfiles arch=i386-solaris size=87
 1571   | bin/i386-solaris/afm2tfm
 1572   | bin/i386-solaris/dvips
 1573   |binfiles arch=win32 size=51
 1574   | bin/win32/afm2tfm.exe
 1575   | bin/win32/dvips.exe
 1576   |...
 1577 
 1578 =head1 PACKAGE VARIABLES
 1579 
 1580 TeXLive::TLPOBJ has one package-wide variable, C<containerdir>, which is
 1581 where generated container files are saved (if not otherwise specified).
 1582 
 1583   TeXLive::TLPOBJ->containerdir("path/to/container/dir");
 1584 
 1585 =head1 MEMBER ACCESS FUNCTIONS
 1586 
 1587 For any of the I<keys> a function
 1588 
 1589   $tlpobj->key
 1590 
 1591 is available, which returns the current value when called without an argument,
 1592 and sets the respective value when called with an argument. For the
 1593 TeX Catalogue Data the function
 1594 
 1595   $tlpobj->cataloguedata
 1596 
 1597 returns and takes as argument a hash.
 1598 
 1599 Arguments and return values for C<name>, C<category>, C<shortdesc>,
 1600 C<longdesc>, C<catalogue>, C<revision> are single scalars.
 1601 
 1602 Arguments and return values for C<depends>, C<executes> are lists.
 1603 
 1604 Arguments and return values for C<docfiles>, C<runfiles>, C<srcfiles>
 1605 are lists.
 1606 
 1607 Arguments and return values for C<binfiles> is a hash with the
 1608 architectures as keys.
 1609 
 1610 Arguments and return values for C<docfiledata> is a hash with the
 1611 full file names of docfiles as key, and the value is again a hash.
 1612 
 1613 The size values are handled with these functions:
 1614 
 1615   $tlpobj->docsize
 1616   $tlpobj->runsize
 1617   $tlpobj->srcsize
 1618   $tlpobj->binsize("arch1" => size1, "arch2" => size2, ...)
 1619 
 1620 which set or get the current value of the respective sizes. Note that also
 1621 the C<binsize> function returns (and takes as argument) a hash with the
 1622 architectures as keys, similar to the C<runfiles> functions (see above).
 1623 
 1624 Futhermore, if the tlpobj is contained ina tlpdb which describes a media
 1625 where the files are distributed in packed format (usually as .tar.xz),
 1626 there are 6 more possible keys:
 1627 
 1628   $tlpobj->containersize
 1629   $tlpobj->doccontainersize
 1630   $tlpobj->srccontainersize
 1631   $tlpobj->containerchecksum
 1632   $tlpobj->doccontainerchecksum
 1633   $tlpobj->srccontainerchecksum
 1634 
 1635 describing the respective sizes and checksums in bytes and as hex string, resp.
 1636 The latter two are only present if src/doc file container splitting is
 1637 activated for that install medium.
 1638 
 1639 =head1 OTHER FUNCTIONS
 1640 
 1641 The following functions can be called for a C<TLPOBJ> object:
 1642 
 1643 =over 4
 1644 
 1645 =item C<new>
 1646 
 1647 The constructor C<new> returns a new C<TLPSRC> object. The arguments
 1648 to the C<new> constructor can be in the usual hash representation for
 1649 the different keys above:
 1650 
 1651   $tlpobj=TLPOBJ->new(name => "foobar", shortdesc => "The foobar package");
 1652 
 1653 =item C<from_file("filename")>
 1654 
 1655 reads a C<tlpobj> file.
 1656 
 1657   $tlpobj = new TLPOBJ;
 1658   $tlpobj->from_file("path/to/the/tlpobj/file");
 1659 
 1660 =item C<from_fh($filehandle[, $multi])>
 1661 
 1662 read the textual representation of a TLPOBJ from an already opened
 1663 file handle.  If C<$multi> is undef (i.e., not given) then multiple
 1664 tlpobj in the same file are treated as errors. If C<$multi> is defined,
 1665 then returns after reading one tlpobj.
 1666 
 1667 Returns C<1> if it found a C<tlpobj>, otherwise C<0>.
 1668 
 1669 =item C<writeout>
 1670 
 1671 writes the textual representation of a C<TLPOBJ> object to C<stdout>,
 1672 or the filehandle if given:
 1673 
 1674   $tlpsrc->writeout;
 1675   $tlpsrc->writeout(\*FILEHANDLE);
 1676 
 1677 =item C<writeout_simple>
 1678 
 1679 debugging function for comparison with C<tpm>/C<tlps>, will go away.
 1680 
 1681 =item C<as_json>
 1682 
 1683 returns the representation of the C<TLPOBJ> in JSON format.
 1684 
 1685 =item C<common_texmf_tree>
 1686 
 1687 if all files of the package are from the same texmf tree, this tree 
 1688 is returned, otherwise an undefined value. That is also a check
 1689 whether a package is relocatable.
 1690 
 1691 =item C<make_container($type,$instroot, [ destdir => $destdir, containername => $containername, relative => 0|1, user => 0|1 ])>
 1692 
 1693 creates a container file of the all files in the C<TLPOBJ>
 1694 in C<$destdir> (if not defined then C<< TLPOBJ->containerdir >> is used).
 1695 
 1696 The C<$type> variable specifies the type of container to be used.
 1697 Currently only C<zip> or C<xz> are allowed, and generate
 1698 zip files and tar.xz files, respectively.
 1699 
 1700 The file name of the created container file is C<$containername.extension>,
 1701 where extension is either C<.zip> or C<.tar.xz>, depending on the
 1702 setting of C<$type>. If no C<$containername> is specified the package name
 1703 is used.
 1704 
 1705 All container files B<also> contain the respective
 1706 C<TLPOBJ> file in C<tlpkg/tlpobj/$name.tlpobj>.
 1707 
 1708 The argument C<$instroot> specifies the root of the installation from
 1709 which the files should be taken.
 1710 
 1711 If the argument C<$relative> is passed and true (perlish true) AND the
 1712 packages does not span multiple texmf trees (i.e., all the first path
 1713 components of all files are the same) then a relative packages is created,
 1714 i.e., the first path component is stripped. In this case the tlpobj file
 1715 is placed into the root of the installation.
 1716 
 1717 This is used to distribute packages which can be installed in any arbitrary
 1718 texmf tree (of other distributions, too).
 1719 
 1720 If user is present and true, no extra arguments for container generation are
 1721 passed to tar (to make sure that user tar doesn't break).
 1722 
 1723 Return values are the size, the checksum, and the full name of the container.
 1724 
 1725 =item C<recompute_sizes($tltree)>
 1726 
 1727 recomputes the sizes based on the information present in C<$tltree>.
 1728 
 1729 =item C<recompute_revision($tltree [, $revtlpsrc ])>
 1730 
 1731 recomputes the revision based on the information present in C<$tltree>.
 1732 The optional argument C<$rectlpsrc> can be an additional revision number
 1733 which is taken into account. C<$tlpsrc->make_tlpobj> adds the revision
 1734 number of the C<tlpsrc> file here so that collections (which do not
 1735 contain files) also have revision number.
 1736 
 1737 =item C<update_from_catalogue($texcatalogue)>
 1738 
 1739 adds information from a C<TeXCatalogue> object
 1740 (currently license, version, url, and updates docfiles with details and
 1741 languages tags if present in the Catalogue).
 1742 
 1743 =item C<split_bin_package>
 1744 
 1745 splits off the binfiles of C<TLPOBJ> into new independent C<TLPOBJ> with
 1746 the original name plus ".arch" for every arch for which binfiles are present.
 1747 The original package is changed in two respects: the binfiles are removed
 1748 (since they are now in the single name.arch packages), and an additional
 1749 depend on "name.ARCH" is added. Note that the ARCH is a placeholder.
 1750 
 1751 =item C<srcfiles_package>
 1752 
 1753 =item C<docfiles_package>
 1754 
 1755 splits off the srcfiles or docfiles of C<TLPOBJ> into new independent
 1756 C<TLPOBJ> with
 1757 the original name plus ".sources". The source/doc files are
 1758 B<not> removed from the original package, since these functions are only
 1759 used for the creation of split containers.
 1760 
 1761 =item C<is_arch_dependent>
 1762 
 1763 returns C<1> if there are C<binfiles>, otherwise C<0>.
 1764 
 1765 =item C<total_size>
 1766 
 1767 If no argument is given returns the sum of C<srcsize>, C<docsize>,
 1768 C<runsize>.
 1769 
 1770 If arguments are given, they are assumed to be architecture names, and
 1771 it returns the above plus the sum of sizes of C<binsize> for those
 1772 architectures.
 1773 
 1774 =item C<is_meta_package>
 1775 
 1776 Returns true if the package is a meta package as defined in TLConfig
 1777 (Currently Collection and Scheme).
 1778 
 1779 =item C<clear_{src,run,doc,bin}files>
 1780 
 1781 Removes all the src/run/doc/binfiles from the C<TLPOBJ>.
 1782 
 1783 =item C<{add,remove}_{src,run,doc}files(@files)>
 1784 
 1785 adds or removes files to the respective list of files.
 1786 
 1787 =item C<{add,remove}_binfiles($arch, @files)>
 1788 
 1789 adds or removes files from the list of C<binfiles> for the given architecture.
 1790 
 1791 =item C<{add,remove}_files($type, $files)>
 1792 
 1793 adds or removes files for the given type (only for C<run>, C<src>, C<doc>).
 1794 
 1795 =item C<contains_file($filename)>
 1796 
 1797 returns the list of files matching $filename which are contained in
 1798 the package. If $filename contains a / the matching is only anchored
 1799 at the end with $. Otherwise it is prefix with a / and anchored at the end.
 1800 
 1801 =item C<all_files>
 1802 
 1803 returns a list of all files of all types.  However, binary files won't
 1804 be found until dependencies have been expanded via (most likely)
 1805 L<TeXLive::TLPDB::expand_dependencies>.  For a more or less standalone
 1806 example, see the C<find_old_files> function in the
 1807 script C<Master/tlpkg/libexec/place>.
 1808 
 1809 =item C<allbinfiles>
 1810 
 1811 returns a list of all binary files.
 1812 
 1813 =item C<< $tlpobj->format_definitions  >>
 1814 
 1815 The function C<format_definitions> returns a list of references to hashes
 1816 where each hash is a format definition.
 1817 
 1818 =item C<< $tlpobj->fmtutil_cnf_lines >>
 1819 
 1820 The function C<fmtutil_cnf_lines> returns the lines for fmtutil.cnf 
 1821 for this package.
 1822 
 1823 =item C<< $tlpobj->updmap_cfg_lines >>
 1824 
 1825 The function C<updmap_cfg_lines> returns the list lines for updmap.cfg
 1826 for the given package.
 1827 
 1828 =item C<< $tlpobj->language_dat_lines >>
 1829 
 1830 The function C<language_dat_lines> returns the list of all
 1831 lines for language.dat that can be generated from the tlpobj
 1832 
 1833 =item C<< $tlpobj->language_def_lines >>
 1834 
 1835 The function C<language_def_lines> returns the list of all
 1836 lines for language.def that can be generated from the tlpobj.
 1837 
 1838 =item C<< $tlpobj->language_lua_lines >>
 1839 
 1840 The function C<language_lua_lines> returns the list of all
 1841 lines for language.dat.lua that can be generated from the tlpobj.
 1842 
 1843 =back
 1844 
 1845 =head1 SEE ALSO
 1846 
 1847 The other modules in C<Master/tlpkg/TeXLive/> (L<TeXLive::TLConfig> and
 1848 the rest), and the scripts in C<Master/tlpkg/bin/> (especially
 1849 C<tl-update-tlpdb>), the documentation in C<Master/tlpkg/doc/>, etc.
 1850 
 1851 =head1 AUTHORS AND COPYRIGHT
 1852 
 1853 This script and its documentation were written for the TeX Live
 1854 distribution (L<http://tug.org/texlive>) and both are licensed under the
 1855 GNU General Public License Version 2 or later.
 1856 
 1857 =cut
 1858 
 1859 ### Local Variables:
 1860 ### perl-indent-level: 2
 1861 ### tab-width: 2
 1862 ### indent-tabs-mode: nil
 1863 ### End:
 1864 # vim:set tabstop=2 expandtab: #