summaryrefslogtreecommitdiff
path: root/new-infra/TLSRC.pm
diff options
context:
space:
mode:
Diffstat (limited to 'new-infra/TLSRC.pm')
-rw-r--r--new-infra/TLSRC.pm419
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: #