diff options
Diffstat (limited to 'new-infra/TLSRC.pm')
-rw-r--r-- | new-infra/TLSRC.pm | 419 |
1 files changed, 0 insertions, 419 deletions
diff --git a/new-infra/TLSRC.pm b/new-infra/TLSRC.pm deleted file mode 100644 index 804ebc8ccad..00000000000 --- a/new-infra/TLSRC.pm +++ /dev/null @@ -1,419 +0,0 @@ -# -# TLSRC.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 TLSRC; - -use FileHandle; -use TLP; -use 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_tlp { - my ($self,$tltree) = @_; - my $tlp = TLP->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: # |