# # 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'}, 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 = ; close(TMP); my $name = ""; 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 files!"); } 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 =~ /^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 $tlsrc, please fix it!"); } } } $self->name("$name"); $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 "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) = @_; # 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 $self->{'name'}"; } push @{$self->{'docpatterns'}}, "t texmf-dist doc $self->{'name'}"; push @{$self->{'srcpatterns'}}, "t texmf-dist source $self->{'name'}"; } my $tlp = TLP->new; $tlp->name($self->name); $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; foreach my $p (@{$self->{'runpatterns'}}) { $self->_do_normal_pattern($p,$tlp,$tltree,'run'); } foreach my $p (@{$self->{'srcpatterns'}}) { $self->_do_normal_pattern($p,$tlp,$tltree,'src'); } foreach my $p (@{$self->{'docpatterns'}}) { $self->_do_normal_pattern($p,$tlp,$tltree,'doc'); } foreach my $p (@{$self->{'binpatterns'}}) { my $matchref; $matchref = $tltree->get_matching_files('bin',$p); my %archmatches = %$matchref; my @archs = $tltree->architectures; my $filemax; my @matchfiles; foreach my $arch (@archs) { @matchfiles = @{$archmatches{$arch}}; foreach my $f (@matchfiles) { $filemax = $tltree->file_svn_lastrevision($f); $tlp->revision(($filemax > $tlp->revision) ? $filemax : $tlp->revision); } $tlp->add_binfiles($arch,@matchfiles); } } $tlp->recompute_sizes($tltree); return $tlp; } sub _do_normal_pattern { my ($self,$p,$tlp,$tltree,$type) = @_; my $matchref = $tltree->get_matching_files($type,$p); my @matchfiles = @$matchref; my $filemax; foreach my $f (@matchfiles) { $filemax = $tltree->file_svn_lastrevision($f); $tlp->revision(($filemax > $tlp->revision) ? $filemax : $tlp->revision); } $tlp->add_files($type,@matchfiles); } # # member access functions # sub name { my $self = shift; if (@_) { $self->{'name'} = shift } return $self->{'name'}; } 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: #