# $Id$ # TeXLive::TLPSRC.pm - module for using tlpsrc files # Copyright 2007, 2008 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::TLConfig qw($CategoriesRegexp); use TeXLive::TLUtils; 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 next if $line =~ /^\s*$/; # skip blank lines # (blank lines are significant in tlpobj, but not tlpsrc) if ($line =~ /^ /) { die "$srcfile: continuation line not allowed in tlpsrc: $line\n"; } # names of source packages can either be # - normal names: ^[-\w]+$ # - win32 specific packages: ^[-\w]+\.win32$ # - normal texlive specific packages: ^texlive.*\..*$ # - configuration texlive specific packages: ^00texlive.*\..*$ if ($line =~ /^name\s*([-\w]+(\.win32)?|00texlive.*|texlive\..*)$/) { $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*(.*)\s*$/) { $shortdesc = "$1"; next; } elsif ($line =~ /^category\s+$CategoriesRegexp$/) { $category = "$1"; next; } elsif ($line =~ /^longdesc\s+(.*)\s*$/) { $longdesc .= "$1 "; next; } elsif ($line =~ /^catalogue\s+(.*)\s*$/) { $catalogue = "$1"; next; } elsif ($line =~ /^runpattern\s+(.*)\s*$/) { push @runpatterns, "$1" if ("$1" ne ""); next; } elsif ($line =~ /^srcpattern\s+(.*)\s*$/) { push @srcpatterns, "$1" if ("$1" ne ""); next; } elsif ($line =~ /^docpattern\s+(.*)\s*$/) { push @docpatterns, "$1" if ("$1" ne ""); next; } elsif ($line =~ /^binpattern\s+(.*)\s*$/) { push @binpatterns, "$1" if ("$1" ne ""); next; } elsif ($line =~ /^execute\s+(.*)\s*$/) { push @executes, "$1" if ("$1" ne ""); next; } elsif ($line =~ /^depend\s+(.*)\s*$/) { push @depends, "$1" if ("$1" ne ""); next; } else { tlwarn("$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; # # runpatterns # 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/) { # mark the default pattern with a leading * so that # we do not warn a missing hit on a default pattern 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); } # # srcpatterns # @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); } # # docpatterns # @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); } # # binpatterns # # 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) { my @archfiles = (); if (defined($archmatches{$arch})) { @archfiles = @{$archmatches{$arch}}; } if (!@archfiles) { # many patterns are special for w32, don't complain about those. # conversely, w32 fails to have many standard programs, don't # complain about those either. my $warnit = 1; if ($p =~ m,bin/([-a-z0-9]+)/,) { if ($1 ne "$arch") { # don't warn on specific platform patterns $warnit = 0; } } if ($p =~ m,/(\S+)\s+,) { # that is an arch specific pattern # don't warn if we the archs do not agree $warnit = 0 if ($1 ne "$arch"); } if ($p =~ m,\$\{ARCH\}, && $arch eq "win32") { # w32 fails to have many standard programs, don't complain # about those either $warnit = 0; } if ($self->{name} =~ m/\.win32/ && $arch ne "win32") { $warnit = 0; } tlwarn("$self->{name} ($arch): no hit on binpattern $p\n") if $warnit; } $tlp->add_binfiles($arch,@archfiles); } } foreach my $p (@allnegpats) { my $matchref; $matchref = $tltree->get_matching_files('bin',$p); my %archmatches = %$matchref; my @archs = $tltree->architectures; foreach my $arch (@archs) { my @archfiles = (); if (defined($archmatches{$arch})) { @archfiles = @{$archmatches{$arch}}; } if (!@archfiles) { tlwarn(" $self->{name} ($arch): no hit on negative binpattern $p\n"); } $tlp->remove_binfiles($arch,@archfiles); } } # 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 $is_default_pattern = 0; if ($p =~ m/^\*/) { $is_default_pattern = 1; $p =~ s/^\*//; } my $matchref = $tltree->get_matching_files($type,$p); my @matchfiles = @$matchref; if (!$is_default_pattern && !@matchfiles && ($p !~ m/^f ignore/)) { tlwarn("$self->{name}: no hit for pattern $p\n"); } 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]>, i.e., with what Perl considers a C<\w>. There are 3 exceptions to this rule: =over 12 =item B where B is a supported architecture-os combination. The use of this is two-fold: On the one hand packages are split into containers for the different architectures to make installations including only the necessary binaries possible. On the other hand one can add 'one-arch-only' packages, often used to deal with the peculiarities of the Windows family of systems. =item B<00texliveSOMETHING> these packages are used for internal operation and storage containers for settings. Besides being the only packages starting with B<00texlive> they will never be split into separate arch-packages, and containers are never generated for these packages. =item B (mind the dot in the package name) these packages are central TeX Live internal packages and are treated as usual packages in (more or less) all respects, but have that extra dot to be sure they are different from every package that can possibly appear on CTAN. =back =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<+> means to append to the list of automatically synthesized patterns, instead of replacing them. The C<+> and C prefixes can be combined. This is useful to exclude directories from the automatic pattern list. For example, C contains this line: docpattern +!d texmf-dist/doc/latex/tufte-latex/graphics so that this subdirectory of the C package that happens to be named `graphics' is not mistakenly included in the C package. =item Auto generated patterns If a given pattern section is empty or B the provided patterns have the prefix C<+> (e.g., C<+f ...>), then the following patterns, listed by type are I 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 Cs of the form C or C) also match the files C, C, C, C, and C. 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: #