path: root/Master/tlpkg/TeXLive/TLPOBJ.pm

# $Id$
# TeXLive::TLPOBJ.pm - module for using tlpobj files
# Copyright 2007 Norbert Preining
# This file is licensed under the GNU General Public License version 2
# or any later version.

package TeXLive::TLPOBJ;

use TeXLive::TLConfig qw($DefaultCategory $CategoriesRegexp $MetaCategoriesRegexp $InfraLocation);
use TeXLive::TLUtils;
use File::Path;
use Cwd;
use TeXLive::TLTREE;
use FileHandle;
use Text::ParseWords;
use File::Basename;

my $_tmp;
my $_zipdir;

sub new { 
  my $class = shift;
  my %params = @_;
  my $self = {
    name        => $params{'name'},
    category    => defined($params{'category'}) ? $params{'category'} : $DefaultCategory,
    shortdesc   => $params{'shortdesc'},
    longdesc    => $params{'longdesc'},
    catalogue   => $params{'catalogue'},
    runfiles    => defined($params{'runfiles'}) ? $params{'runfiles'} : [],
    runsize   => $params{'runsize'},
    srcfiles    => defined($params{'srcfiles'}) ? $params{'srcfiles'} : [],
    srcsize   => $params{'srcsize'},
    docfiles    => defined($params{'docfiles'}) ? $params{'docfiles'} : [],
    docsize   => $params{'docsize'},
    executes    => defined($params{'executes'}) ? $params{'executes'} : [],
    # note that binfiles is a HASH with keys of $arch!
    binfiles    => defined($params{'binfiles'}) ? $params{'binfiles'} : {},
    binsize     => defined($params{'binsize'}) ? $params{'binsize'} : {},
    depends     => defined($params{'depends'}) ? $params{'depends'} : [],
    revision    => $params{'revision'},
    cataloguedata   => defined($params{'cataloguedata'}) ? $params{'cataloguedata'} : {},
  };
  $_zipdir = $params{'zipdir'} if defined($params{'zipdir'});
  bless $self, $class;
  return $self;
}


sub from_file {
  my $self = shift;
  if (@_ != 1) {
    die("Need a filename for initialization!");
  }
  open(TMP,"<$_[0]") || die("Cannot open tlpobj file: $_[0]");
  $self->from_fh(\*TMP);
}
  
sub from_fh {
  my ($self,$fh,$multi) = @_;
  my $started = 0;
  my $lastcmd = "";
  my $arch;
  my $size;

  while (my $line = $fh->getline) {
    &TeXLive::TLUtils::debug("reading line: >>>$line<<<");
    $line =~ /^\s*#/ && next;          # skip comment lines
    if ($line =~ /^\s*$/) {
      if (!$started) { next; }
      if (defined($multi)) {
        # we may read from a tldb file
        return 1;
      } else {
        # we are reading one tldb file, nothing else allowed
        die("No empty line allowed within tlpobj files!");
      }
    }
    if ($line =~ /^ /) {
      if ( ($lastcmd eq "longdesc") ||
           ($lastcmd eq "runfiles") ||
           ($lastcmd eq "binfiles") ||
           ($lastcmd eq "docfiles") ||
           ($lastcmd eq "srcfiles") ||
           ($lastcmd eq "executes") ||
         ($lastcmd eq "depend") ) {
        $line =~ s/^ /${lastcmd}continued /;
      } else {
        die("Continuation of $lastcmd not allowed, please fix tlpobj: line = $line!\n");
      }
    }
    if ($line =~ /^name\s*([-\w]+)$/) {
      $name = "$1";
      $lastcmd = "name";
      $self->name("$name");
      $started && die("Cannot have two name directives: $line!");
      $started = 1;
    } else {
      $started || die("First directive needs to be 'name'");
      if ($line =~ /^shortdesc\s+(.*)$/) {
        $self->{'shortdesc'} .= "$1";
        $lastcmd = "shortdesc";
        next;
      } elsif ($line =~ /^longdesc(continued)?\s+(.*)$/) {
        if (defined($1) && ("$1" eq "continued")) {
          $self->{'longdesc'} .= " $2";
        } else {
          $self->{'longdesc'} = "$2";
        }
        $lastcmd = "longdesc";
        next;
      } elsif ($line =~ /^category\s+$CategoriesRegexp$/) {
        $self->{'category'} = "$1";
        $lastcmd = "category";
        next;
      } elsif ($line =~ /^revision\s+(.*)$/) {
        $self->{'revision'} = "$1";
        $lastcmd = "revision";
        next;
      } elsif ($line =~ /^catalogue\s+(.*)$/) {
        $self->catalogue("$1");
        $lastcmd = "catalogue";
        next;
      } elsif ($line =~ /^(doc|src|run)files\s+/) {
        my $type = $1;
        my @words = split ' ',$line;
        # first entry is "XXXfiles", shift it away
        $lastcmd = shift @words;
        while (@words) {
          $_ = shift @words;
          if (/^size=(.*)$/) {
            $size=$1;
          } else {
            die "Unknown tag: $line";
          }
        }
        if (defined($size)) {
          $self->{"${type}size"} = $size;
        }
        next;
      } elsif ($line =~ /^docfilescontinued\s+(.*)$/) {
        # docfiles can have tags
        my @words = &quotewords('\s+', 0, "$1");
        # the first entry is the file
        my $f = shift @words;
        push @{$self->{'docfiles'}}, $f;
        while (@words) {
          $_ = shift @words;
          if (/^details=(.*)$/) {
            $self->{'docfiledata'}{$f}{'details'} = "$1";
          } elsif (/^language=(.*)$/) {
            $self->{'docfiledata'}{$f}{'href'} = "$1";
          } else {
            die "Unknown docfile tag: $line";
          }
        }
        next;
      } elsif ($line =~ /^(src|run)filescontinued\s+(.*)$/) {
        push @{$self->{$1."files"}}, "$2";
        next;
      } elsif ($line =~ /^binfiles\s+/) {
        my @words = split ' ',$line;
        # first entry is "binfiles", shift it away
        shift @words;
        while (@words) {
          $_ = shift @words;
          if (/^arch=(.*)$/) {
            $arch=$1;
          } elsif (/^size=(.*)$/) {
            $size=$1;
          } else {
            die "Unknown tag: $line";
          }
        }
        if (defined($size)) {
          $self->{'binsize'}{$arch} = $size;
        }
        $lastcmd = "binfiles";
        next;
      } elsif ($line =~ /^binfilescontinued\s+(.*)$/) {
        push @{$self->{'binfiles'}{$arch}}, "$1";
        next;
      } elsif ($line =~ /^execute(continued)?\s*(.*)$/) {
        push @{$self->{'executes'}}, "$2" unless "$2" eq "";
        $lastcmd = "execute";
        next;
      } elsif ($line =~ /^depend(continued)?\s*(.*)$/) {
        push @{$self->{'depends'}}, "$2" unless "$2" eq "";
        $lastcmd = "depend";
        next;
      } elsif ($line =~ /^catalogue-([^\s]+)\s+(.*)$/) {
        $self->{'cataloguedata'}{$1} = "$2";
      } else {
        die("Unknown directive ...$line... , please fix it!");
      }
    }
  }
  return $started;
}

sub recompute_revision {
  my ($self,$tltree, $revtlpsrc) = @_;
  my @files = $self->all_files;
  my $filemax = 0;
  foreach my $f (@files) {
    $filemax = $tltree->file_svn_lastrevision($f);
    $self->revision(($filemax > $self->revision) ? $filemax : $self->revision);
  }
  if (defined($revtlpsrc)) {
    if ($self->revision < $revtlpsrc) {
      $self->revision($revtlpsrc);
    }
  }
}

sub recompute_sizes {
  my ($self,$tltree) = @_;
  $self->{'docsize'} = $self->_recompute_size("doc",$tltree);
  $self->{'srcsize'} = $self->_recompute_size("src",$tltree);
  $self->{'runsize'} = $self->_recompute_size("run",$tltree);
  foreach $a ($tltree->architectures) {
    $self->{'binsize'}{$a} = $self->_recompute_size("bin",$tltree,$a);
  }
}


sub _recompute_size {
  my ($self,$type,$tltree,$arch) = @_;
  my $size = 0;
  if ($type eq "bin") {
    my %binfiles = %{$self->{'binfiles'}};
    if (defined($binfiles{$arch})) {
      foreach $f (@{$binfiles{$arch}}) {
        $size += $tltree->size_of($f);
      }
    } 
  } else {
    if (defined($self->{"${type}files"}) && (@{$self->{"${type}files"}})) {
      foreach $f (@{$self->{"${type}files"}}) {
        my $s = $tltree->size_of($f);
        if (defined($s)) {
          $size += $s;
        } else {
          printf STDERR "size for $f not defined, strange ...\n";
        }
      }
    }
  }
  return $size;
}

sub writeout {
  my $self = shift;
  my $fd = (@_ ? $_[0] : STDOUT);
  format_name $fd "multilineformat";
  print $fd "name ", $self->name, "\n";
  print $fd "category ", $self->category, "\n";
  defined($self->{'revision'}) && print $fd "revision $self->{'revision'}\n";
  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";
  if (defined($self->{'longdesc'})) {
    $_tmp = "$self->{'longdesc'}";
    write $fd;
  }
  if (defined($self->{'depends'})) {
    foreach (@{$self->{'depends'}}) {
      print $fd "depend $_\n";
    }
  }
  if (defined($self->{'executes'})) {
    foreach (@{$self->{'executes'}}) {
      print $fd "execute $_\n";
    }
  }
  if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) {
    print $fd "docfiles size=$self->{'docsize'}\n";
    foreach my $f (sort @{$self->{'docfiles'}}) {
      print $fd " $f";
      if (defined($self->{'docfiledata'}{$f}{'details'})) {
        print $fd ' details="', $self->{'docfiledata'}{$f}{'details'}, '"';
      }
      if (defined($self->{'docfiledata'}{$f}{'language'})) {
        print $fd ' language="', $self->{'docfiledata'}{$f}{'language'}, '"';
      }
      print $fd "\n";
    }
  }
  if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) {
    print $fd "srcfiles size=$self->{'srcsize'}\n";
    foreach (sort @{$self->{'srcfiles'}}) {
      print $fd " $_\n";
    }
  }
  if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) {
    print $fd "runfiles size=$self->{'runsize'}\n";
    foreach (sort @{$self->{'runfiles'}}) {
      print $fd " $_\n";
    }
  }
  foreach my $arch (keys %{$self->{'binfiles'}}) {
    if (@{$self->{'binfiles'}{$arch}}) {
      print $fd "binfiles arch=$arch size=", $self->{'binsize'}{$arch}, "\n";
      foreach (sort @{$self->{'binfiles'}{$arch}}) {
        print $fd " $_\n";
      }
    }
  }
  # writeout all the catalogue keys
  foreach my $k (keys %{$self->cataloguedata}) {
    print $fd "catalogue-$k ", $self->cataloguedata->{$k}, "\n";
  }
}

sub writeout_simple {
  my $self = shift;
  my $fd = (@_ ? $_[0] : STDOUT);
  format_name $fd "multilineformat";
  print $fd "name ", $self->name, "\n";
  print $fd "category ", $self->category, "\n";
  if (defined($self->{'depends'})) {
    foreach (@{$self->{'depends'}}) {
      print $fd "depend $_\n";
    }
  }
  if (defined($self->{'executes'})) {
    foreach (@{$self->{'executes'}}) {
      print $fd "execute $_\n";
    }
  }
  if (defined($self->{'docfiles'}) && (@{$self->{'docfiles'}})) {
    print $fd "docfiles\n";
    foreach (sort @{$self->{'docfiles'}}) {
      print $fd " $_\n";
    }
  }
  if (defined($self->{'srcfiles'}) && (@{$self->{'srcfiles'}})) {
    print $fd "srcfiles\n";
    foreach (sort @{$self->{'srcfiles'}}) {
      print $fd " $_\n";
    }
  }
  if (defined($self->{'runfiles'}) && (@{$self->{'runfiles'}})) {
    print $fd "runfiles\n";
    foreach (sort @{$self->{'runfiles'}}) {
      print $fd " $_\n";
    }
  }
  foreach my $arch (sort keys %{$self->{'binfiles'}}) {
    if (@{$self->{'binfiles'}{$arch}}) {
      print $fd "binfiles arch=$arch\n";
      foreach (sort @{$self->{'binfiles'}{$arch}}) {
        print $fd " $_\n";
      }
    }
  }
}

sub make_zip {
  my ($self,$type,$instroot,$destdir,$zipname) = @_;
  my $zipn;
  if (not(defined($zipname))) {
    $zipname = $self->name;
  }
  if (not(defined($destdir))) {
    $destdir = TeXLive::TLPOBJ->zipdir;
  }
  die("Undefined instroot argument!") if (not(defined($instroot)));
  # first build the arch independent part
  $self->_make_zip($type,$instroot,$destdir,$zipname,"all");
  # now the $pkg.$arch.zip
  if ($self->is_arch_dependent) {
    foreach my $t (keys %{$self->{'binfiles'}}) {
      &TeXLive::TLUtils::debug("arch=$t");
      $self->_make_zip($type,$instroot,$destdir,"$zipname.$t",$t);
    }
  }
}

sub _make_zip {
  my ($self,$type,$instroot,$destdir,$zipname,$arch) = @_;
  my @files = ();
  my $zipcmd;
  my $tlpobjdir = "$InfraLocation/tlpobj";
  if ($arch ne "all") {
    push @files, @{$self->{'binfiles'}{$arch}};
  } else {
    push @files, $self->runfiles;
    push @files, $self->docfiles;
    push @files, $self->srcfiles;
  }
  # note that the Tpm.pm module had something like
  #   if ($zipname =~ /\/binary/ && $^O !~ /MSWin32/) {
  #     $zipcmd = "| zip -9\@ory "
  #   } else {
  #     $zipcmd = "| zip -9\@or "
  #   }
  if ($^O =~ /MSWin32/) {
    $nul = "nul";
  } else {
    $nul = "/dev/null";
  }
  @files = TeXLive::TLUtils::sort_uniq(@files);
  if (!@files) {
    &TeXLive::TLUtils::debug("Not creating empty container file for $zipname");
    return;
  }
  my $cwd = &getcwd;
  if ("$destdir" !~ m@^/@) {
    # we have an relative zipdir, so we have to make it absolute
    $destdir = "$cwd/$destdir";
  }
  &mkpath("$destdir") if (! -d "$destdir");
  chdir($instroot);
  if ($arch eq "all") {
    # we add the .tlpobj into the .tlpobj directory
    my $removetlpobjdir = 0;
    if (! -d "$tlpobjdir") {
      &mkpath("$tlpobjdir");
      $removetlpobjdir = 1;
    }
    open(TMP,">$tlpobjdir/$self->{'name'}.tlpobj") or die "Cannot create $tlpobjdir/$self->{'name'}.tlpobj";
    $self->writeout(\*TMP);
    close(TMP);
    push @files, "$tlpobjdir/$self->{'name'}.tlpobj";
  }
  if ($type eq "zip") {
    $zipname .= ".zip";
      if ($^O =~ /MSWin32/) {
      $zipcmd = "| zip -9\@or $destdir/$zipname > $nul"
    } else {
      $zipcmd = "| zip -9\@ory $destdir/$zipname > $nul"
    }
  } elsif ($type eq "lzma") {
    $zipname .= ".tar.lzma";
    $zipcmd = "| tar --create --files-from=-  | lzma -c > $destdir/$zipname ";
  } else {
    die("Container method $type unknown!\n");
  }
  unlink($zipname);
  print "$zipcmd\n" if ($::opt_debug);
  open ZIP, $zipcmd ;
  map {
    if (! -f $_) {
      print STDERR "!!!Error: non-existent $_\n";
    } else {
      print ZIP "$_\n";
    }
  } @files;
  close ZIP;
  if ($arch eq "all") {
    # cleaning up
    unlink("$tlpobjdir/$self->{'name'}.tlpobj");
    rmdir("$tlpobjdir") if $removetlpobjdir;
  }
  chdir($cwd);
  print "Done $zipname\n" if ($::opt_debug);
}

sub is_arch_dependent {
  my $self = shift;
  if (keys %{$self->{'binfiles'}}) {
    return 1;
  } else {
    return 0;
  }
}

# computes the total size of a package
# if no arguments are given this is
#   docsize + runsize + srcsize + max of binsize
sub total_size {
  my ($self,@archs) = @_;
  my $ret = $self->docsize + $self->runsize + $self->srcsize;
  if ($self->is_arch_dependent) {
    my $max = 0;
    my %foo = %{$self->binsize};
    foreach my $k (keys %foo) {
      $max = $foo{$k} if ($foo{$k} > $max);
    }
    $ret += $max;
  }
  return($ret);
}


sub update_from_catalogue {
  my ($self, $tlc) = @_;
  my $tlcname = defined($self->catalogue) ? $self->catalogue : $self->name;
  if (defined($tlc->entries->{$tlcname})) {
    my $entry = $tlc->entries->{$tlcname};
    if (defined($entry->entry->{'date'})) {
      my $foo = $entry->entry->{'date'};
      $foo =~ s/^.Date: //;
      $foo =~ s/ \(.*\) \$$//;
      $self->cataloguedata->{'date'} = $foo;
    }
    if (defined($entry->license)) {
      $self->cataloguedata->{'license'} = $entry->license;
    }
    if (defined($entry->version)) {
      $self->cataloguedata->{'version'} = $entry->version;
    }
    if (defined($entry->ctan)) {
      $self->cataloguedata->{'ctan'} = $entry->ctan;
    }
    #if (defined($entry->texlive)) {
    # $self->cataloguedata->{'texlive'} = $entry->texlive;
    #}
    #if (defined($entry->miktex)) {
    #  $self->cataloguedata->{'miktex'} = $entry->miktex;
    #}
    if (defined($entry->caption)) {
      $self->{'shortdesc'} = $entry->caption;
    }
    if (defined($entry->description)) {
      $self->{'longdesc'} = $entry->description;
    }
    # 
    # we need to do the following:
    # - take the href entry for a documentation file entry in the TC
    # - remove the 'ctan:' prefix
    # - remove the <ctan path='...'> part
    # - match the rest against all docfiles in an intelligent way
    #
    # Example:
    # juramisc.xml contains:
    # <documentation details='Package documentation' language='de'
    #   href='ctan:/macros/latex/contrib/juramisc/doc/jmgerdoc.pdf'/>
    # <ctan path='/macros/latex/contrib/juramisc'/>
    my @tcdocfiles = keys %{$entry->docs};
    my @tlpdocfiles = $self->docfiles;
    foreach my $tcdocfile (@tcdocfiles) {
      # basename also kills the ctan: prefix!
      my $tcdocfilebasename = $tcdocfile;
      # remove the ctan: prefix
      $tcdocfilebasename =~ s/^ctan://;
      # remove the ctan path if present
      my $tcctanpath = $entry->ctan ? $entry->ctan : "";
      $tcdocfilebasename =~ s/^$tcctanpath//;
      foreach my $tlpdocfile (@tlpdocfiles) {
        if ($tlpdocfile =~ m/$tcdocfilebasename$/) {
          # update the language/detail tags if present!
          if (defined($entry->docs->{$tcdocfile}{'details'})) {
            $self->{'docfiledata'}{$tlpdocfile}{'details'} = $entry->docs->{$tcdocfile}{'details'};
          }
          if (defined($entry->docs->{$tcdocfile}{'language'})) {
            $self->{'docfiledata'}{$tlpdocfile}{'language'} = $entry->docs->{$tcdocfile}{'language'};
          }
        }
      }
    }
  }
}

sub is_meta_package {
  my $self = shift;
  if ($self->category =~ /^$MetaCategoriesRegexp$/) {
    return 1;
  } 
  return 0;
}


# Helpers.
# 
sub add_files {
  my ($self,$type,@files) = @_;
  die("Cannot use add_files for binfiles, we need that arch!")
    if ($type eq "bin");
  &TeXLive::TLUtils::push_uniq(\@{ $self->{"${type}files"} }, @files);
}

sub remove_files {
  my ($self,$type,@files) = @_;
  die("Cannot use remove_files for binfiles, we need that arch!")
    if ($type eq "bin");
  my @finalfiles;
  foreach my $f (@{$self->{"${type}files"}}) {
    if (not(&TeXLive::TLUtils::member($f,@files))) {
      push @finalfiles,$f;
    }
  }
  $self->{"${type}files"} = [ @finalfiles ];
}

sub all_files {
  my ($self) = shift;
  my @ret = ();
  
  push (@ret, $self->docfiles);
  push (@ret, $self->runfiles);
  push (@ret, $self->srcfiles);
  
  my %binfiles = %{$self->binfiles};
  for my $arch (keys %binfiles) {
    push (@ret, @{$binfiles{$arch}});
  }
  
  return @ret;
}


# member access functions
#
sub name {
  my $self = shift;
  if (@_) { $self->{'name'} = shift }
  return $self->{'name'};
}
sub category {
  my $self = shift;
  if (@_) { $self->{'category'} = shift }
  return $self->{'category'};
}
sub shortdesc {
  my $self = shift;
  if (@_) { $self->{'shortdesc'} = shift }
  return $self->{'shortdesc'};
}
sub longdesc {
  my $self = shift;
  if (@_) { $self->{'longdesc'} = shift }
  return $self->{'longdesc'};
}
sub revision {
  my $self = shift;
  if (@_) { $self->{'revision'} = shift }
  return $self->{'revision'};
}
sub catalogue {
  my $self = shift;
  if (@_) { $self->{'catalogue'} = shift }
  return $self->{'catalogue'};
}
sub srcfiles {
  my $self = shift;
  if (@_) { @{ $self->{'srcfiles'} } = @_ }
  return @{ $self->{'srcfiles'} };
}
sub srcsize {
  my $self = shift;
  if (@_) { $self->{'srcsize'} = shift }
  return ( defined($self->{'srcsize'}) ? $self->{'srcsize'} : 0 );
}
sub add_srcfiles {
  my ($self,@files) = @_;
  $self->add_files("src",@files);
}
sub remove_srcfiles {
  my ($self,@files) = @_;
  $self->remove_files("src",@files);
}
sub docfiles {
  my $self = shift;
  if (@_) { @{ $self->{'docfiles'} } = @_ }
  return @{ $self->{'docfiles'} };
}
sub docsize {
  my $self = shift;
  if (@_) { $self->{'docsize'} = shift }
  return ( defined($self->{'docsize'}) ? $self->{'docsize'} : 0 );
}
sub add_docfiles {
  my ($self,@files) = @_;
  $self->add_files("doc",@files);
}
sub remove_docfiles {
  my ($self,@files) = @_;
  $self->remove_files("doc",@files);
}
sub binfiles {
  my $self = shift;
  my %newfiles = @_;
  if (@_) { $self->{'binfiles'} = \%newfiles }
  return $self->{'binfiles'};
}
sub binsize {
  my $self = shift;
  my %newsizes = @_;
  if (@_) { $self->{'binsize'} = \%newsizes }
  return $self->{'binsize'};
}
sub add_binfiles {
  my ($self,$arch,@files) = @_;
  &TeXLive::TLUtils::push_uniq(\@{ $self->{'binfiles'}{$arch} }, @files);
}
sub remove_binfiles {
  my ($self,$arch,@files) = @_;
  my @finalfiles;
  foreach my $f (@{$self->{'binfiles'}{$arch}}) {
    if (not(&TeXLive::TLUtils::member($f,@files))) {
      push @finalfiles,$f;
    }
  }
  $self->{'binfiles'}{$arch} = [ @finalfiles ];
}
sub runfiles {
  my $self = shift;
  if (@_) { @{ $self->{'runfiles'} } = @_ }
  return @{ $self->{'runfiles'} };
}
sub runsize {
  my $self = shift;
  if (@_) { $self->{'runsize'} = shift }
  return ( defined($self->{'runsize'}) ? $self->{'runsize'} : 0 );
}
sub add_runfiles {
  my ($self,@files) = @_;
  $self->add_files("run",@files);
}
sub remove_runfiles {
  my ($self,@files) = @_;
  $self->remove_files("run",@files);
}
sub depends {
  my $self = shift;
  if (@_) { @{ $self->{'depends'} } = @_ }
  return @{ $self->{'depends'} };
}
sub executes {
  my $self = shift;
  if (@_) { @{ $self->{'executes'} } = @_ }
  return @{ $self->{'executes'} };
}
sub zipdir {
  my @self = shift;
  if (@_) { $_zipdir = $_[0] }
  return $_zipdir;
}
sub cataloguedata {
  my $self = shift;
  my %ct = @_;
  if (@_) { $self->{'cataloguedata'} = \%ct }
  return $self->{'cataloguedata'};
}

1;

###### Formats
format multilineformat =
longdesc ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
$_tmp
.
__END__

=head1 NAME

C<TeXLive::TLPOBJ> -- TeX Live Package Object access module

=head1 SYNOPSIS

  use TeXLive::TLPOBJ;

  my $tlpobj=TeXLive::TLPOBJ->new(name => "foobar");

=head1 DESCRIPTION

The L<TeXLive::TLPOBJ> module provide access to TeX Live Package Object
files describing a self-contained package.

=head1 FILE SPECIFICATION

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
starting with C<catalogue-> specifying information coming from the
TeX Catalogue.

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
(described below).

=over

=item C<srcfiles>, C<runfiles>, C<binfiles>, C<docfiles>
each of these items contains addition the sum of sizes of the
single files (currently in bytes).

  srcfiles size=NNNNNN
  runfiles size=NNNNNN

=item C<docfiles>

The docfiles line itself is similar to the C<srcfiles> and C<runfiles> lines
above:

  docfiles size=NNNNNN

But the lines listing the files are allowed to have additional tags:

  /------- excerpt from achemso.tlpobj
  |...
  |docfiles size=1702468
  | texmf-dist/doc/latex/aeguill/README details="Package Readme"
  | texmf-dist/doc/latex/achemso/achemso.pdf details="Package documentation" language="en"
  |...

Currently only the tags C<details> and C<language> are allowed.

=item C<binfiles>

Since C<binfiles> are different for the different architectures one
C<tlpobj> file can contain C<binfiles> lines for different
architectures. The architecture is specified on the C<binfiles> using
the C<arch=>I<XXX> tag. Thus, C<binfiles> lines look like

  binfiles arch=XXXX size=NNNNN

=back

Here is an excerpt from the representation of the C<bin-dvipsk> package,
with C<|> characters inserted to show the indentation:

  |name bin-dvipsk
  |category TLCore
  |revision 4427
  |docfiles size=959434
  | texmf/doc/dvips/dvips.html
  | ...
  |runfiles size=1702468
  | texmf/dvips/base/color.pro
  | ...
  | texmf/scripts/pkfix/pkfix.pl
  |binfiles arch=i386-solaris size=329700
  | bin/i386-solaris/afm2tfm
  | bin/i386-solaris/dvips
  | bin/i386-solaris/pkfix
  |binfiles arch=win32 size=161280
  | bin/win32/afm2tfm.exe
  | bin/win32/dvips.exe
  | bin/win32/pkfix.exe
  |...

=head1 PACKAGE VARIABLES

TeXLive::TLPOBJ has one package wide variable which is C<zipdir> where
generated zip files are saved (if not otherwise specified.

  TeXLive::TLPOBJ->zipdir("path/to/zip/dir");

=head1 MEMBER ACCESS FUNCTIONS

For any of the I<keys> a function

  $tlpobj->key

is available, which returns the current value when called without an argument,
and sets the respective value when called with an argument. For the 
TeX Catalogue Data the function

  $tlpobj->cataloguedata

returns and takes as argument a hash.

Arguments and return values for C<name>, C<category>, C<shortdesc>,
C<longdesc>, C<catalogue>, C<revision> are single scalars.

Arguments and return values for C<depends>, C<executes> are lists.

Arguments and return values for C<docfiles>, C<runfiles>, C<srcfiles>
are lists.

Arguments and return values for C<binfiles> is a hash with the
architectures as keys.

The size values are handled with these functions:

  $tlpobj->docsize
  $tlpobj->runsize
  $tlpobj->srcsize
  $tlpobj->binsize("arch1", ...)

which set or get the current value of the respective sizes. Note that also
the C<binsize> function returns (and takes as argument) a hash with the 
architectures as keys, similar to the C<runfiles> functions (see above).

=head1 OTHER FUNCTIONS

The following functions can be called for an C<TLPOBJ> object:

=over

=item C<new>

The constructor C<new> returns a new C<TLPSRC> object. The arguments
to the C<new> constructor can be in the usual hash representation for
the different keys above:

  $tlpobj=TLPOBJ->new(name => "foobar", shortdesc => "The foobar package");

=item C<from_file("filename")>

reads a C<tlpobj> file.

  $tlpobj = new TLPOBJ;
  $tlpobj->from_file("path/to/the/tlpobj/file");

=item C<from_fh($filehandle[, $multi])>

read the textual representation of a TLPOBJ from an already opened
file handle.  If C<$multi> is undefined (ie not given) then multiple
tlpobj in the same file are treated as errors. If C<$multi> is defined
then returns after reading one tlpobj.

Returns C<1> if it found a C<tlpobj>, otherwise C<0>.

=item C<writeout>

writes the textual representation of a C<TLPOBJ> object to C<stdout>,
or the filehandle if given:

  $tlpsrc->writeout;
  $tlpsrc->writeout(\*FILEHANDLE);

=item C<writeout_simple>

debugging function for comparison with C<tpm>/C<tlps>, will go away.

=item C<make_zip($type,$instroot[, $destdir[, $zipname]])>

creates a container file of the arch B<independent> files in the C<TLPOBJ>
in C<$destdir> (if not defined then C<< TLPOBJ->zipdir >> 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.

The file name of the created container file is C<$zipname.extension>,
where extension is either C<.zip> or C<.tar.lzma>, depending on the
setting of C<$type>. If no C<$zipname> is specified the package name
is used.

If the package contains C<"binfiles">, then container files for 
all archs containing B<only> the binfiles are created, and 
those container files name is C<$zipname.$arch.$extension>

All the arch independent zip files B<also> contain the respective
C<TLPOBJ> file in C<tlpkg/tlpobj/$name.tlpobj> so C<$zipname.$extension> does
contain this tlpobj file, while C<$zipname.$arch.$extension> does NOT.

The argument C<$instroot> specifies the root of the installation from
which the files should be taken.

=item C<recompute_sizes($tltree)>

recomputes the sizes based on the information present in C<$tltree>.

=item C<recompute_revision($tltree [, $revtlpsrc ])>

recomputes the revision based on the information present in C<$tltree>.
The optional argument C<$rectlpsrc> can be an additional revision number
which is taken into account. C<$tlpsrc->make_tlpobj> adds the revision
number of the C<tlpsrc> file here so that collections (which do not
contain files) also have revision number.

=item C<update_from_catalogue($texcatalogue)>

adds information from a C<TeXCatalogue> object 
(currently license, version, url, and updates docfiles with details and
languages tags if present in the Catalogue).

=item C<is_arch_dependent>

returns C<1> if there are C<binfiles>, otherwise C<0>.

=item C<total_size>

If no argument is given returns the sum of C<srcsize>, C<docsize>,
C<runsize>.

If arguments are given, they are assumed to be architecture names, and
it returns the above plus the sum of sizes of C<binsize> for those
architectures.

=item C<is_meta_package>

Returns true if the package is a meta package as defined in TLConfig
(Currently Collection and Scheme).

=item C<{add,remove}_{src,run,doc}files(@files)>

adds or removes files to the respective list of files.

=item C<{add,remove}_binfiles($arch, @files)>

adds or removes files from the list of C<binfiles> for the given architecture.

=item C<{add,remove}_files($type, $files)>

adds or removes files for the given type (only for C<run>, C<src>, C<doc>).

=item C<all_files>

returns a list of all files of all types.

=back

=head1 SEE ALSO

The modules L<TeXLive::TLConfig>, L<TeXLive::TLUtils>, L<TeXLive::TLPSRC>,
L<TeXLive::TLPDB>, L<TeXLive::TLTREE>, L<TeXLive::TeXCatalogue>.

=head1 AUTHORS AND COPYRIGHT

This script and its documentation were written for the TeX Live
distribution (L<http://tug.org/texlive>) and both are licensed under the
GNU General Public License Version 2 or later.

=cut

### Local Variables:
### perl-indent-level: 2
### tab-width: 2
### indent-tabs-mode: nil
### End:
# vim:set tabstop=2 expandtab: #