diff options
Diffstat (limited to 'new-infra/TLSRC.pm')
| -rw-r--r-- | new-infra/TLSRC.pm | 155 |
1 files changed, 133 insertions, 22 deletions
diff --git a/new-infra/TLSRC.pm b/new-infra/TLSRC.pm index 8862e4cb3f4..2cc88a478da 100644 --- a/new-infra/TLSRC.pm +++ b/new-infra/TLSRC.pm @@ -8,6 +8,9 @@ package TLSRC; +use TLP; +use TLTREE; + sub new { my $class = shift; my %params = @_; @@ -54,10 +57,10 @@ sub from_file { } if ($line =~ /^ /) { if ( ($lastcmd eq "longdesc") || - ($lastcmd eq "runpattern") || - ($lastcmd eq "binpattern") || - ($lastcmd eq "docpattern") || - ($lastcmd eq "srcpattern") || + ($lastcmd eq "runpatterns") || + ($lastcmd eq "binpatterns") || + ($lastcmd eq "docpatterns") || + ($lastcmd eq "srcpatterns") || ($lastcmd eq "execute") || ($lastcmd eq "depend") ) { $line =~ s/^ /$lastcmd /; @@ -76,35 +79,35 @@ sub from_file { $shortdesc .= "$1 "; $lastcmd = "shortdesc"; next; - } elsif ($line =~ /^longdesc\s*(.*)$/) { + } elsif ($line =~ /^longdesc\s+(.*)$/) { $longdesc .= "$1 "; $lastcmd = "longdesc"; next; - } elsif ($line =~ /^catalogue\s*(.*)$/) { + } elsif ($line =~ /^catalogue\s+(.*)$/) { $catalogue .= "$1 "; $lastcmd = "catalogue"; next; - } elsif ($line =~ /^runpattern\s*(.*)$/) { + } elsif ($line =~ /^runpatterns\s+(.*)$/) { push @runpatterns, "$1"; $lastcmd = "runpattern"; next; - } elsif ($line =~ /^srcpattern\s*(.*)$/) { + } elsif ($line =~ /^srcpatterns\s+(.*)$/) { push @srcpatterns, "$1"; $lastcmd = "srcpattern"; next; - } elsif ($line =~ /^docpattern\s*(.*)$/) { + } elsif ($line =~ /^docpatterns\s+(.*)$/) { push @docpatterns, "$1"; $lastcmd = "docpattern"; next; - } elsif ($line =~ /^binpattern\s*(.*)$/) { + } elsif ($line =~ /^binpatterns\s+(.*)$/) { push @binpatterns, "$1"; $lastcmd = "binpattern"; next; - } elsif ($line =~ /^execute\s*(.*)$/) { + } elsif ($line =~ /^execute\s+(.*)$/) { push @executes, "$1"; $lastcmd = "execute"; next; - } elsif ($line =~ /^depend\s*(.*)$/) { + } elsif ($line =~ /^depend\s+(.*)$/) { push @depends, "$1"; $lastcmd = "depend"; next; @@ -142,28 +145,136 @@ sub writeout { print $fd "execute $_\n"; } } - if (defined($self->{'srcpatterns'})) { + if (defined($self->{'srcpatterns'}) && (@{$self->{'srcpatterns'}})) { + print $fd "srcpatterns\n"; foreach (@{$self->{'srcpatterns'}}) { - print $fd "srcpattern $_\n"; + print $fd " $_\n"; } } - if (defined($self->{'runpatterns'})) { + if (defined($self->{'runpatterns'}) && (@{$self->{'runpatterns'}})) { + print $fd "runpatterns\n"; foreach (@{$self->{'runpatterns'}}) { - print $fd "runpattern $_\n"; + print $fd " $_\n"; } } - if (defined($self->{'docpatterns'})) { + if (defined($self->{'docpatterns'}) && (@{$self->{'docpatterns'}})) { + print $fd "docpatterns\n"; foreach (@{$self->{'docpatterns'}}) { - print $fd "docpattern $_\n"; + print $fd " $_\n"; } } - if (defined($self->{'binpatterns'})) { + if (defined($self->{'binpatterns'}) && (@{$self->{'binpatterns'}})) { + print $fd "binpatterns\n"; foreach (@{$self->{'binpatterns'}}) { - print $fd "binpattern $_\n"; + print $fd " $_\n"; + } + } +} + +# +# the hard work, generate a TLP file +# + +sub make_tlp { + my ($self,$tltree) = @_; + # predefined patterns if all are missing + if (! ( (defined($self->{'runpatterns'})) || + (defined($self->{'srcpatterns'})) || + (defined($self->{'docpatterns'})) || + (defined($self->{'binpatterns'})) )) { + foreach my $md (qw/bibtex context dvips fonts makeindex metafont + metapost mft omega scripts tex vtex/) { + push @{$self->{'runpatterns'}}, "t texmf-dist $md $tlp"; + } + push @{$self->{'docpatterns'}}, "t texmf-dist doc $tlp"; + push @{$self->{'srcpatterns'}}, "t texmf-dist source $tlp"; + } + my $tlp = TLP->new; + $tlp->name($tlsrc->name); + $tlp->shortdesc($self->{'shortdesc'}) if (defined($self->{'shortdesc'})); + $tlp->longdesc($self->{'longdesc'}) if (defined($tls{$tlp}{'longdesc'})); + $tlp->catalogue($self->{'catalogue'}) if (defined($tls{$tlp}{'catalogue'})); + $tlp->executes($self->{'executes'}) if (defined($tls{$tlp}{'executes'})); + $tlp->depends($self->{'depends'}) if (defined($tls{$tlp}{'depends'})); + $tlp->revision(0); + my $filemax; + foreach my $p (@{$self->{'runpatterns'}}) { + my ($pattype,@patwords) = split ' ',$p; + if ($pattype eq "t") { + $self->_do_leaf_pattern($tlp,$tltree,'runfiles',@patwords); + } else { + $self->_do_regexp_pattern($tlp,$tltree,'runfiles',$p); + } + } + foreach my $p (@{$self->{'srcpatterns'}}) { + my ($pattype,@patwords) = split ' ',$p; + if ($pattype eq "t") { + $self->_do_leaf_pattern($tlp,$tltree,'srcfiles',@patwords); + } else { + $self->_do_regexp_pattern($tlp,$tltree,'srcfiles',$p); + } + } + foreach my $p (@{$self->{'docpatterns'}}) { + my ($pattype,@patwords) = split ' ',$p; + if ($pattype eq "t") { + $self->_do_leaf_pattern($tlp,$tltree,'docfiles',@patwords); + } else { + $self->_do_regexp_pattern($tlp,$tltree,'docfiles',$p); + } + } + foreach my $p (@{$self->{'binpatterns'}}) { + my ($pattype,@patwords) = split ' ',$p; + if ($pattype eq "t") { + $self->_do_leaf_pattern($tlp,$tltree,'binfiles',@patwords); + } else { + $self->_do_regexp_pattern($tlp,$tltree,'binfiles',$p); + } + } +} + +sub _do_leaf_pattern { + my ($self,$tlp,$tltree,$type,@patwords) = @_; + my @matchfiles = $tltree->get_files_matching_dir_pattern($type,$patwords); + my $filemax; + foreach my $f (@matchfiles) { + $filemax = $tltree->file_svn_lastrevision($f); + $tlp->revision($filemax > $tlp->revision ? : $filemax : $tlp->revision); + } +} + +sub _do_regexp_pattern { + my ($self,$tltree,$tlp,$filetype,$p) = @_; + my @matchfiles = $tltree->get_files_matching_regexp_pattern($type,$p); + my $filemax; + foreach my $f (@matchfiles) { + $filemax = $tltree->file_svn_lastrevision($f); + $tlp->revision($filemax > $tlp->revision ? : $filemax : $tlp->revision); + } +} + +sub pattern_hit { + my ($file, $pattern) = @_; + my (@dirs) = split /\//, $file; + $pattern =~ /^(d|f|t)\s+(.*)$/; + my $pattype = $1; + my $patdata = $2; + logit("pattype=...$pattype...patdata=...$patdata...\n"); + if ($pattype eq "d") { + pop @dirs ; + my $foo = join "/",@dirs; + logit("matching [d] >>>$patdata<<< against >>>$foo<<<\n"); + if ($foo =~ /^$patdata$/) { + return 1; + } + } elsif ($pattype eq "f") { + logit("matching [f] >>>$patdata<<< against >>>$file<<<\n"); + if ($file =~ /^$patdata$/) { + return 1; } + } else { + die("Unknown pattern specification: $pattern!"); } - # print final empty line - print $fd "\n"; + return 0; } # |