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

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

package TeXLive::TLPSRC;

use FileHandle;
use TeXLive::TLPOBJ;
use TeXLive::TLTREE;

my $_tmp;

sub new { 
  my $class = shift;
  my %params = @_;
  my $self = {
    name        => $params{'name'},
    category    => defined($params{'category'}) ? $params{'category'} : "Package",
    shortdesc   => $params{'shortdesc'},
    longdesc    => $params{'longdesc'},
    catalogue   => $params{'catalogue'},
    runpatterns => $params{'runpatterns'},
    srcpatterns => $params{'srcpatterns'},
    docpatterns => $params{'docpatterns'},
    binpatterns => $params{'binpatterns'},
    executes    => defined($params{'executes'}) ? $params{'executes'} : [],
    depends     => defined($params{'depends'}) ? $params{'depends'} : [],
  };
  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 tlpsrc file: $_[0]");
  my @lines = <TMP>;
  close(TMP);
  my $name = "";
  # default category = Package
  my $category = "Package";
  my $shortdesc = "";
  my $longdesc= "";
  my $catalogue = "";
  my (@executes, @depends);
  my (@runpatterns, @docpatterns, @binpatterns, @srcpatterns);
  my $started = 0;
  my $finished = 0;

  foreach my $line (@lines) {
    $line =~ /^\s*#/ && next;          # skip comment lines
    if ($line =~ /^\s*$/) {
      if (!$started) { next; }
      if ($finished) { next; }
      die("No empty line allowed in tlpsrc file $_[0]!");
    }
    if ($line =~ /^ /) {
      die("No continuation lines >>>$line<<< allowed in TLPSRC files!");
    }
    if ($line =~ /^name\s*([-\w]+)$/) {
      $name = "$1";
      $started && die("Cannot have two name directives!");
      $started = 1;
    } else {
      $started || die("First directive needs to be 'name'");
      if ($line =~ /^shortdesc\s*(.*)$/) {
        $shortdesc = "$1";
        next;
      } elsif ($line =~ /^category\s+(Collection|Scheme|Package|TLCore|Documentation)$/) {
        $category = "$1";
        next;
      } elsif ($line =~ /^longdesc\s+(.*)$/) {
        $longdesc .= "$1 ";
        next;
      } elsif ($line =~ /^catalogue\s+(.*)$/) {
        $catalogue = "$1";
        next;
      } elsif ($line =~ /^runpattern\s+(.*)$/) {
        push @runpatterns, "$1" if ("$1" ne "");
        next;
      } elsif ($line =~ /^srcpattern\s+(.*)$/) {
        push @srcpatterns, "$1" if ("$1" ne "");
        next;
      } elsif ($line =~ /^docpattern\s+(.*)$/) {
        push @docpatterns, "$1" if ("$1" ne "");
        next;
      } elsif ($line =~ /^binpattern\s+(.*)$/) {
        push @binpatterns, "$1" if ("$1" ne "");
        next;
      } elsif ($line =~ /^execute\s+(.*)$/) {
        push @executes, "$1" if ("$1" ne "");
        next;
      } elsif ($line =~ /^depend\s+(.*)$/) {
        push @depends, "$1" if ("$1" ne "");
        next;
      } else {
        #die("Unknown directive ...$line... in $_[0], please fix it!");
        print STDERR "Unknown directive ...$line... in $_[0], please fix it!\n";
      }
    }
  }
  $self->name("$name");
  $self->category("$category");
  $self->catalogue($catalogue) if ("$catalogue" ne "");
  $self->shortdesc("$shortdesc") if ($shortdesc ne "");
  $self->longdesc("$longdesc") if ($longdesc ne "");
  $self->srcpatterns(@srcpatterns) if ($#srcpatterns >= 0);
  $self->runpatterns(@runpatterns) if ($#runpatterns >= 0);
  $self->binpatterns(@binpatterns) if ($#binpatterns >= 0);
  $self->docpatterns(@docpatterns) if ($#docpatterns >= 0);
  $self->executes(@executes) if ($#executes >= 0);
  $self->depends(@depends) if ($#depends >= 0);
}

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->{'catalogue'}) && print $fd "catalogue $self->{'catalogue'}\n";
  defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\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->{'srcpatterns'}) && (@{$self->{'srcpatterns'}})) {
    foreach (sort @{$self->{'srcpatterns'}}) {
      print $fd "srcpattern $_\n";
    }
  }
  if (defined($self->{'runpatterns'}) && (@{$self->{'runpatterns'}})) {
    foreach (sort @{$self->{'runpatterns'}}) {
      print $fd "runpattern $_\n";
    }
  }
  if (defined($self->{'docpatterns'}) && (@{$self->{'docpatterns'}})) {
    foreach (sort @{$self->{'docpatterns'}}) {
      print $fd "docpattern $_\n";
    }
  }
  if (defined($self->{'binpatterns'}) && (@{$self->{'binpatterns'}})) {
    foreach (sort @{$self->{'binpatterns'}}) {
      print $fd "binpattern $_\n";
    }
  }
}

#
# the hard work, generate a TLP file
#

sub make_tlpobj {
  my ($self,$tltree) = @_;
  my $tlp = TeXLive::TLPOBJ->new;
  $tlp->name($self->name);
  $tlp->category($self->category);
  $tlp->shortdesc($self->{'shortdesc'}) if (defined($self->{'shortdesc'}));
  $tlp->longdesc($self->{'longdesc'}) if (defined($self->{'longdesc'}));
  $tlp->catalogue($self->{'catalogue'}) if (defined($self->{'catalogue'}));
  $tlp->executes(@{$self->{'executes'}}) if (defined($self->{'executes'}));
  $tlp->depends(@{$self->{'depends'}}) if (defined($self->{'depends'}));
  $tlp->revision(0);
  my $filemax;
  my $usedefault = 1;
  my @allpospats;
  my @allnegpats;
  foreach my $p (@{$self->{'runpatterns'}}) {
    if ($p =~ m/^\+!(.*)$/) {
      push @allnegpats, $1;
    } elsif ($p =~ m/^\+(.*)$/) {
      push @allpospats, $1;
    } elsif ($p =~ m/^!(.*)$/) {
      push @allnegpats, $1;
      $usedefault = 0;
    } else {
      push @allpospats, $p;
      $usedefault = 0;
    }
  }
  if ($usedefault) {
    if ($self->category eq "Package") {
      foreach my $md (qw/bibtex context dvips fonts makeindex metafont
                metapost mft omega scripts tex vtex/) {
        push @allpospats, "t texmf-dist $md $self->{'name'}";
      }
    }
  }
  foreach my $p (@allpospats) {
    $self->_do_normal_pattern($p,$tlp,$tltree,'run');
  }
  foreach my $p (@allnegpats) {
    $self->_do_normal_pattern($p,$tlp,$tltree,'run',1);
  }
  @allpospats = ();
  @allnegpats = ();
  $usedefault = 1;
  foreach my $p (@{$self->{'srcpatterns'}}) {
    if ($p =~ m/^\+!(.*)$/) {
      push @allnegpats, $1;
    } elsif ($p =~ m/^\+(.*)$/) {
      push @allpospats, $1;
    } elsif ($p =~ m/^!(.*)$/) {
      push @allnegpats, $1;
      $usedefault = 0;
    } else {
      push @allpospats, $p;
      $usedefault = 0;
    }
  }
  if ($usedefault) {
    # default patterns for srcfiles
    if ($self->category eq "Package") {
      push @allpospats, "t texmf-dist source $self->{'name'}";
    } elsif ($self->category eq "Documentation") {
      push @allpospats, "t texmf-doc source $self->{'name'}";
    }
  }
  foreach my $p (@allpospats) {
    $self->_do_normal_pattern($p,$tlp,$tltree,'src');
  }
  foreach my $p (@allnegpats) {
    $self->_do_normal_pattern($p,$tlp,$tltree,'src',1);
  }
  @allpospats = ();
  @allnegpats = ();
  $usedefault = 1;
  foreach my $p (@{$self->{'docpatterns'}}) {
    if ($p =~ m/^\+!(.*)$/) {
      push @allnegpats, $1;
    } elsif ($p =~ m/^\+(.*)$/) {
      push @allpospats, $1;
    } elsif ($p =~ m/^!(.*)$/) {
      push @allnegpats, $1;
      $usedefault = 0;
    } else {
      push @allpospats, $p;
      $usedefault = 0;
    }
  }
  if ($usedefault) {
    # default patterns for docfiles
    if ($self->category eq "Package") {
      push @allpospats, "t texmf-dist doc $self->{'name'}";
    } elsif ($self->category eq "Documentation") {
      push @allpospats, "t texmf-doc doc $self->{'name'}";
    }
  }
  foreach my $p (@allpospats) {
    $self->_do_normal_pattern($p,$tlp,$tltree,'doc');
  }
  foreach my $p (@allnegpats) {
    $self->_do_normal_pattern($p,$tlp,$tltree,'doc',1);
  }
  # no default patterns for binfiles
  @allpospats = ();
  @allnegpats = ();
  foreach my $p (@{$self->{'binpatterns'}}) {
    if ($p =~ m/^\+!(.*)$/) {
      push @allnegpats, $1;
    } elsif ($p =~ m/^\+(.*)$/) {
      push @allpospats, $1;
    } elsif ($p =~ m/^!(.*)$/) {
      push @allnegpats, $1;
    } else {
      push @allpospats, $p;
    }
  }
  foreach my $p (@allpospats) {
    my $matchref;
    $matchref = $tltree->get_matching_files('bin',$p);
    my %archmatches = %$matchref;
    my @archs = $tltree->architectures;
    foreach my $arch (@archs) {
      $tlp->add_binfiles($arch,@{$archmatches{$arch}});
    }
  }
  foreach my $p (@allnegpats) {
    my $matchref;
    $matchref = $tltree->get_matching_files('bin',$p);
    my %archmatches = %$matchref;
    my @archs = $tltree->architectures;
    foreach my $arch (@archs) {
      $tlp->remove_binfiles($arch,@{$archmatches{$arch}});
    }
  }
  $tlp->recompute_sizes($tltree);
  $tlp->recompute_revision($tltree);
  return $tlp;
}

sub _do_normal_pattern {
  my ($self,$p,$tlp,$tltree,$type,$negative) = @_;
  my $matchref = $tltree->get_matching_files($type,$p);
  my @matchfiles = @$matchref;
  if (defined($negative) && $negative == 1) {
    $tlp->remove_files($type,@matchfiles);
  } else {
    $tlp->add_files($type,@matchfiles);
  }
}

#
# 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 catalogue {
  my $self = shift;
  if (@_) { $self->{'catalogue'} = shift }
  return $self->{'catalogue'};
}
sub srcpatterns {
  my $self = shift;
  if (@_) { @{ $self->{'srcpatterns'} } = @_ }
  return @{ $self->{'srcpatterns'} };
}
sub docpatterns {
  my $self = shift;
  if (@_) { @{ $self->{'docpatterns'} } = @_ }
  return @{ $self->{'docpatterns'} };
}
sub binpatterns {
  my $self = shift;
  if (@_) { @{ $self->{'binpatterns'} } = @_ }
  return @{ $self->{'binpatterns'} };
}
sub depends {
  my $self = shift;
  if (@_) { @{ $self->{'depends'} } = @_ }
  return @{ $self->{'depends'} };
}
sub runpatterns {
  my $self = shift;
  if (@_) { @{ $self->{'runpatterns'} } = @_ }
  return @{ $self->{'runpatterns'} };
}
sub executes {
  my $self = shift;
  if (@_) { @{ $self->{'executes'} } = @_ }
  return @{ $self->{'executes'} };
}

1;

# FORMATS
format multilineformat =
longdesc ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~
$_tmp
.

__END__

=head1 NAME

TeXLive::TLPSRC - TeX Live Package Source access module

=head1 SYNOPSIS

	use TeXLive::TLPSRC;

	my $tlpsrc = TeXLive::TLPSRC->new( name => "foobar" );
	$tlpsrc->from_file("package.tlpsrc");
	$tlpsrc->writeout;
	$tlpsrc->writeout(\*FILEHANDLE);


=head1 DESCRIPTION

The L<TeXLive::TLPSRC> module provide access to TeX Live Package Source
files, which contains all the information which cannot be automatically
derived from the files in the TeX Live subversion repository.

=head1 FILE SPECIFICATION

A L<tlpsrc> file has to consist of non-empty lines (initial and final
empty lines are ignored) of the form

I<key value>

where I<key> can be C<name>, C<category>, C<shortdesc>, C<longdesc>,
C<catalogue>, C<runpattern>, C<srcpattern>, C<docpattern>, C<binpattern>,
C<execute>, or C<depend>.

The interpretation of the respective I<values> are:

=over

=item C<name>

identifies the package, C<value> must consist only of [-_a-zA-Z0-9]

=item C<category>

identifies the category into which this package belongs. Possible categories
are C<Collection>, C<Scheme>, C<TLCore>, C<Documentation>, C<Package>.
Note that there is no inherent checking whether a C<tlpsrc> file called
C<collection-something> actually belongs to the category C<Collection>.
Most packages will fall into the C<Package> category.

=item C<catalogue>

(currently not used in TeX Live) identifies the name under which this
package can be found in the TeX Catalogue.

=item C<shortdesc>

gives a one line description of the package. Susequent entries will overwrite
the former ones. In TeX Live only used for collections and schemes.

=item C<longdesc>

gives a long description of the package. Susequent entries are added up
to a long text. In TeX Live only used for collections and schemes.

=item C<depend>

gives the list of dependencies of the package in the form

I<Category>/I<Name>

All the depend lines contribute to the dependencies of the package.

=item C<execute>

gives a free form entry of install time jobs to be executed. Currently
the following possible values are understood by the installers:

=over 6

=item C<execute addMap I<font.map>>

enables the font map file I<font.map> in the F<updmap.cfg> file.

=item C<execute addMixedMap I<font.map>>

enables the font map file I<font.map>> for Mixed mode in the F<updmap.cfg> file.

=item C<execute BuildLanguageDat NN>

activates all the hyphenation patterns found in 
F<Master/texmf/tex/generic/config/language.NN.dat> in the generated
F<language.dat> file.

=item C<execute BuildFormat FMTCFG>

activates all the formats present in F<Master/texmf/fmtutil/format.FMTCFG.cnf>
in the generated F<fmtutil.cnf> file.

=back

=item C<(src|run|doc|bin)pattern I<pattern>>

adds a pattern (see below) to the respective list of patterns.

=back

=head1 PATTERNS

Patterns specify which files are to be included into a C<tlpobj> at
expansion time. Patterns are of the form

	[PREFIX]TYPE PAT

where

	PREFIX = + | +! | !
	TYPE = t | f | d | r

The meaning of the various pattern types is

=over

=item C<f path>

includes all files which match C<path> where B<only> the last component
of C<path> can contain the usual glob characters * and ? (but no others!).

=item C<d path>

includes all the files in and below the directory specified as C<path>.

=item C<t word1 ... wordN worldL>

includes all the files in and below all directories of the form

	word1/word2/.../wordN/.../any/dirs/.../wordL/

i.e., the first words but the last form the prefix of the path, then
there can be an arbitrary nesting of directories, followed by C<wordL>
as another directory.

=item C<r regexp>

includes all files matching the regexp C</^regexp$/>

=back

In the case that one of the pattern sections is empty or B<all> the provided
patterns have the prefix C<+> (e.g., C<+f ...>), then the following patterns
are B<automatically> added at expansion time (but never written to the
textual representation):

=over

=item runpattern

for runpatterns of category C<Package>

	t texmf-dist topdir $name

where C<topdir> is one of: bibtex context dvips fonts makeindex metafont
metapost mft omega scripts tex vtex.

For other categories B<no> patterns are automatically added to the 
list of runpatterns.

=item docpattern

for docpattern of category C<Package>

	t texmf-dist doc $name

for docpattern of category C<Documentation>

	t texmf-doc doc $name

=item srcpattern

for srcpattern of category C<Package>

	t texmf-dist source $name

for srcpattern of category C<Documentation>

	t texmf-doc source $name

=back

binpatterns are never automatically added.

If the C<PREFIX> contains the symbol ! the meaning of the pattern is
reversed, i.e., file matching this pattern are removed from the list
of included files.

=head2 arch expansion

In case the string C<${ARCH}> occurs in one C<binpattern> it is
automatically expanded to the respective architecture.

=head2 bat/exe/dll for win32

For C<binpatterns> of the form C<f bin/win32/foobar> (i.e., also for a
binpattern of the form C<f bin/${ARCH}/foobar>) files F<foobar.bat>,
F<foobar.dll>, and F<foobar.exe> are also matched.

The above two properties allows to capture the binaries for all architectures
in one binpattern

	binpattern f bin/${ARCH}/dvips

and would get F<bin/win32/dvips.exe> into the runfiles for arch=win32.

Note that the bat/exe expansion B<only> works for patterns of the C<f> type!

=head1 MEMBER ACCESS FUNCTIONS

For any of the above I<keys> a function

	$tlpsrc->key

is available, which returns the current value when called without an argument,
and sets the respective value when called with an argument.

Arguments and return values for C<name>, C<category>, C<shortdesc>,
C<longdesc>, C<catalogue> are single scalars. Arguments and return values
for C<depends>, C<executes>, and the various C<patterns> are lists.

=head1 OTHER FUNCTIONS

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

=over 

=item C<new>

(constructor) 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:

	$tlpsrc = TLPSRC->new ( name => "foobar", shortdesc => "The foobar package" );

=item C<from_file("filename")>

reads a C<tlpsrc> file.

	$tlpsrc = new TLPSRC;
	$tlpsrc->from_file("path/to/the/tlpsrc/file");

=item C<writeout>

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

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

=item C<make_tlpobj($tltree)>

creates a C<TLPOBJ> object from a C<TLPSRC> object and a C<TLTREE> object.
This function does the necessary work to expand the manual data and
enrich it which the actual content from <$tltree> to a C<TLPOBJ> object.

=back

=head1 SEE ALSO

The modules L<TeXLive::TLUtils>, L<TeXLive::TLPOBJ>, 
L<TeXLive::TLPDB>, L<TeXLive::TLTREE>.

=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: #