# $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. # # TODO: # - patterns which do not catch at least one file should issue a warning package TeXLive::TLPSRC; use FileHandle; use TeXLive::TLConfig qw($CategoriesRegexp); use TeXLive::TLUtils qw(tllog); 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'} : $DefaultCategory, 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; die("Need exactly one filename for initialization!") if @_ != 1; my $srcfile = $_[0]; if (! -r "$srcfile") { # if the argument is not readable as is, try looking for it in the # hierarchy where we are. The %INC hash records where packages were # found, so we use that to locate ourselves. (my $trydir = $INC{"TeXLive/TLPSRC.pm"}) =~ s,/[^/]*$,,; chomp ($trydir = `cd $trydir/../tlpsrc && pwd`); # make absolute my $tryfile = "$trydir/$srcfile.tlpsrc"; #warn "$trydir\n$tryfile\n"; $srcfile = $tryfile if -r $tryfile; } open(TMP, "<$srcfile") || die("failed to open tlpsrc '$srcfile': $!"); my @lines = ; 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("$srcfile: empty line not allowed in tlpsrc"); } if ($line =~ /^ /) { die "$srcfile: continuation line not allowed in tlpsrc: $line\n"; } if ($line =~ /^name\s*([-\w]+(\.win32)?|00texlive\..*|0texlive\..*)$/) { $name = "$1"; $started && die("$srcfile: tlpsrc cannot have two name directives"); $started = 1; } else { $started || die("$srcfile: first tlpsrc directive must be 'name'"); if ($line =~ /^shortdesc\s*(.*)$/) { $shortdesc = "$1"; next; } elsif ($line =~ /^category\s+$CategoriesRegexp$/) { $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 { tllog($::LOG_NORMAL,"$srcfile: unknown tlpsrc directive, please fix: $line\n"); } } } $self->_srcfile($srcfile); $self->name($name); $self->category($category); $self->catalogue($catalogue) if $catalogue; $self->shortdesc($shortdesc) if $shortdesc; $self->longdesc($longdesc) if $longdesc; $self->srcpatterns(@srcpatterns) if @srcpatterns; $self->runpatterns(@runpatterns) if @runpatterns; $self->binpatterns(@binpatterns) if @binpatterns; $self->docpatterns(@docpatterns) if @docpatterns; $self->executes(@executes) if @executes; $self->depends(@depends) if @depends; } 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 the TLPOBJ data. # 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}}); } } # add the revision number of the .tlpsrc file to the compute list: $tlp->recompute_revision($tltree, $tltree->file_svn_lastrevision("tlpkg/tlpsrc/" . $self->name . ".tlpsrc")); $tlp->recompute_sizes($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 _srcfile { my $self = shift; if (@_) { $self->{'_srcfile'} = shift } return $self->{'_srcfile'}; } 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 C -- TeX Live Package Source access module =head1 SYNOPSIS use TeXLive::TLPSRC; my $tlpsrc = TeXLive::TLPSRC->new(name => "foobar"); $tlpsrc->from_file("/some/tlpsrc/package.tlpsrc"); $tlpsrc->from_file("package"); $tlpsrc->writeout; $tlpsrc->writeout(\*FILEHANDLE); =head1 DESCRIPTION The C 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 C file has to consist of non-empty lines (except that initial and final empty lines are ignored) of the form I where I can be C, C, C, C, C, C, C, C, C, C, or C. The interpretation of the respective I are: =over 6 =item C identifies the package, C must consist only of C<[-_a-zA-Z0-9]>. =item C identifies the category into which this package belongs. Possible categories are defined in C, but are currently C, C, C, C, C. Note that there is no inherent checking whether a C file called C actually belongs to the category C. Most packages will fall into the C category. =item C (currently not used in TeX Live) identifies the name under which this package can be found in the TeX Catalogue. =item C gives a one line description of the package. Subsequent entries will overwrite the former ones. In TeX Live only used for collections and schemes. =item C 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 gives the list of dependencies of the package in the form I/I All the depend lines contribute to the dependencies of the package. =item C 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 IC<.map> enables the font map file IC<.map> in the C file. =item C IC<.map> enables the font map file IC<.map> for Mixed mode in the C file. =item C activates all the hyphenation patterns found in C in the generated C file. =item C activates all the formats present in C in the generated C file. =back =item C<(src|run|doc|bin)pattern> I 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 at expansion time. Patterns are of the form [PREFIX]TYPE[/ARCH] PAT where PREFIX = + | +! | ! TYPE = t | f | d | r ARCH = Simple patterns without PREFIX and ARCH specification are explained first, see below for these extensions. =over =item CI includes all files which match C where B the last component of C can contain the usual glob characters C<*> and C (but no others!). =item CI includes all the files in and below the directory specified as C. =item CI 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 number of subdirectories, followed by C as the final directory. A real life example from C: runpattern t texmf-dist fonts omega matches C, where C<**> matches any number of intervening subdirectories, e.g.: texmf-dist/fonts/ofm/public/omega texmf-dist/fonts/tfm/public/omega texmf-dist/fonts/type1/public/omega =item C I includes all files matching the regexp C =back =head2 Special patterns =over 6 =item PREFIX If the C contains the symbol C the meaning of the pattern is reversed, i.e., file matching this pattern are removed from the list of included files. The prefix C<+> deals with the autogeneration of patterns. =item Auto generated patterns In the case that one of the pattern sections is empty or B the provided patterns have the prefix C<+> (e.g., C<+f ...>), then the following patterns are B added at expansion time (but never written to the textual representation): =over 6 =item C for runpatterns of category C t texmf-dist topdir $name where C is one of: C, C, C, C, C, C, C, C, C, C, C, C. For other categories B patterns are automatically added to the list of runpatterns. =item C for C of category C t texmf-dist doc $name for C of category C t texmf-doc doc $name =item C for C of category C t texmf-dist source $name for C of category C t texmf-doc source $name =back binpatterns are never automatically added. =item special treatment of binpatterns The binpatterns have to deal with all the different architectures. To ease the writing of patterns several extensions to the above pattern language are allowed: =over 6 =item arch expansion In case the string C<${>I} occurs in one C it is automatically expanded to the respective architecture. =item C for win32 For Cs of the form C (i.e., also for a binpattern of the form C) files C, C, C, and C 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 C into the runfiles for C. Note that the C/C expansion B works for patterns of the C type! =item ARCH specification of a pattern Sometimes some files should be included into the list of binfiles of a package only for one architecture. This can be done by specifying the architecture after the pattern specifier using a C: binpattern f/win32 tlpkg/bin/perl.exe will include the file C only in the binfiles for the architecture win32. =back =back =head1 MEMBER ACCESS FUNCTIONS For any of the above I 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, C, C, C, C are single scalars. Arguments and return values for C, C, and the various C are lists. In addition, the C<_srcfile> member refers to the filename for this C object, if set (normally by C). =head1 OTHER FUNCTIONS The following functions can be called for an C object: =over =item C The constructor C returns a new C object. The arguments to the C constructor can be in the usual hash representation for the different keys above: $tlpsrc=TLPSRC->new(name => "foobar", shortdesc => "The foobar package"); =item C reads a C file from disk. C can either be a full path (if it's readable, it's used), or just a package identifier such as C. In the latter case, the directory searched is the C sibling of the C package directory where C was found. $tlpsrc=new TeXLive::TLPSRC; $tlpsrc->from_file("/path/to/the/tlpsrc/somepkg.tlpsrc"); $tlpsrc->from_file("somepkg"); =item C writes the textual representation of a C object to stdout, or the filehandle if given: $tlpsrc->writeout; $tlpsrc->writeout(\*FILEHANDLE); =item C creates a C object from a C object and a C object. This function does the necessary work to expand the manual data and enrich it which the actual content from C<$tltree> to a C object. =back =head1 SEE ALSO The modules L, L, L, L, L. =head1 AUTHORS AND COPYRIGHT This script and its documentation were written for the TeX Live distribution (L) 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: #