diff options
author | Norbert Preining <preining@logic.at> | 2007-06-16 16:22:16 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2007-06-16 16:22:16 +0000 |
commit | d4eefe7213116b2b11dbfa09d39b54d6470203ca (patch) | |
tree | d0fa75c399323763c095e1ac6d77ae6766ab88e5 /Master/tlpkg/TeXLive/TLPSRC.pm | |
parent | ad7c8ab6419951c6e744c47c4be81bef897a18b3 (diff) |
move new-infra to Master/tlpkg
rename stuff
create list files
tlsrc for all packages (also schemes)
git-svn-id: svn://tug.org/texlive/trunk@4439 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPSRC.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPSRC.pm | 419 |
1 files changed, 419 insertions, 0 deletions
diff --git a/Master/tlpkg/TeXLive/TLPSRC.pm b/Master/tlpkg/TeXLive/TLPSRC.pm new file mode 100644 index 00000000000..9497a6f962e --- /dev/null +++ b/Master/tlpkg/TeXLive/TLPSRC.pm @@ -0,0 +1,419 @@ +# +# TeXLive::TLPSRC.pm +# module for using tlsrc files +# Copyright 2007 Norbert Preining +# +# This file is licensed under the GNU General Public Licence 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 tlsrc 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; + my $lastcmd = ""; + + 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 tlsrc file $_[0]!"); + } + if ($line =~ /^ /) { + if ( ($lastcmd eq "longdesc") || + ($lastcmd eq "runpatterns") || + ($lastcmd eq "binpatterns") || + ($lastcmd eq "docpatterns") || + ($lastcmd eq "srcpatterns") || + ($lastcmd eq "execute") || + ($lastcmd eq "depend") ) { + $line =~ s/^ /$lastcmd /; + } else { + die("Continuation of $lastcmd not allowed, please fix tlsrc!\n"); + } + } + if ($line =~ /^name\s*([-\w]+)$/) { + $name = "$1"; + $lastcmd = "name"; + $started && die("Cannot have two name directives!"); + $started = 1; + } else { + $started || die("First directive needs to be 'name'"); + if ($line =~ /^shortdesc\s*(.*)$/) { + $shortdesc = "$1"; + $lastcmd = "shortdesc"; + next; + } elsif ($line =~ /^category\s+(Package|TLCore|Documentation)$/) { + $category = "$1"; + $lastcmd = "category"; + next; + } elsif ($line =~ /^longdesc\s+(.*)$/) { + $longdesc .= "$1 "; + $lastcmd = "longdesc"; + next; + } elsif ($line =~ /^catalogue\s+(.*)$/) { + $catalogue = "$1"; + $lastcmd = "catalogue"; + next; + } elsif ($line =~ /^runpatterns\s+(.*)$/) { + push @runpatterns, "$1" if ("$1" ne ""); + $lastcmd = "runpatterns"; + next; + } elsif ($line =~ /^srcpatterns\s+(.*)$/) { + push @srcpatterns, "$1" if ("$1" ne ""); + $lastcmd = "srcpatterns"; + next; + } elsif ($line =~ /^docpatterns\s+(.*)$/) { + push @docpatterns, "$1" if ("$1" ne ""); + $lastcmd = "docpatterns"; + next; + } elsif ($line =~ /^binpatterns\s+(.*)$/) { + push @binpatterns, "$1" if ("$1" ne ""); + $lastcmd = "binpatterns"; + next; + } elsif ($line =~ /^execute\s+(.*)$/) { + push @executes, "$1" if ("$1" ne ""); + $lastcmd = "execute"; + next; + } elsif ($line =~ /^depend\s+(.*)$/) { + push @depends, "$1" if ("$1" ne ""); + $lastcmd = "depend"; + 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 ne "" ? "$catalogue" : "$name"); + $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"; + print $fd "catalogue $self->{'catalogue'}\n"; + defined($self->{'shortdesc'}) && print $fd "shortdesc $self->{'shortdesc'}\n"; + if (defined($self->{'longdesc'})) { + $_tmp = "longdesc $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'}})) { + print $fd "srcpatterns\n"; + foreach (sort @{$self->{'srcpatterns'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'runpatterns'}) && (@{$self->{'runpatterns'}})) { + print $fd "runpatterns\n"; + foreach (sort @{$self->{'runpatterns'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'docpatterns'}) && (@{$self->{'docpatterns'}})) { + print $fd "docpatterns\n"; + foreach (sort @{$self->{'docpatterns'}}) { + print $fd " $_\n"; + } + } + if (defined($self->{'binpatterns'}) && (@{$self->{'binpatterns'}})) { + print $fd "binpatterns\n"; + foreach (sort @{$self->{'binpatterns'}}) { + print $fd " $_\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 = +^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< +$_tmp + ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<~~ +$_tmp +. + +### Local Variables: +### perl-indent-level: 4 +### tab-width: 4 +### indent-tabs-mode: t +### End: +# vim:set tabstop=4: # |