summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLPSRC.pm
diff options
context:
space:
mode:
authorNorbert Preining <preining@logic.at>2007-06-16 16:22:16 +0000
committerNorbert Preining <preining@logic.at>2007-06-16 16:22:16 +0000
commitd4eefe7213116b2b11dbfa09d39b54d6470203ca (patch)
treed0fa75c399323763c095e1ac6d77ae6766ab88e5 /Master/tlpkg/TeXLive/TLPSRC.pm
parentad7c8ab6419951c6e744c47c4be81bef897a18b3 (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.pm419
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: #