diff options
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPDB.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 346 |
1 files changed, 346 insertions, 0 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm new file mode 100644 index 00000000000..1f5b79612cb --- /dev/null +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -0,0 +1,346 @@ +# +# TeXLive::TLPDB.pm +# module for using tldb files +# Copyright 2007 Norbert Preining +# +# This file is licensed under the GNU General Public Licence version 2 +# or any later version + +package TeXLive::TLPDB; + +=pod +=head1 NAME + +TeXLive::TLPDB - a database of TeX Live Packages + +=head1 SYNOPSIS + + use TeXLive::TLPDB; + + TeXLive::TLPDB->listdir([$dir]); + TeXLive::TLPDB->new ( [ location => "path/to/tldb/file" ] ); + + $tlpdb->location([$location]); + $tlpdb->from_file($filename); + $tlpdb->writeout([FILEHANDLE]); + $tlpdb->save; + $tlpdb->generate_listfiles([$destdir]); + $tlpdb->add_objpkg($tlpobj); + $tlpdb->get_package("packagename"); + $tlpdb->package_revision("packagename"); + +=head1 DESCRIPTION + +=cut + +use TeXLive::TLUtils; +use TeXLive::TLPOBJ; + +my $_listdir; + +=pod + +C<TeXLive::TLPDB->new> creates a new C<TLPDB> object. If the argument +location is given it will be initialized from this locations. + +=cut + +sub new { + my $class = shift; + my %params = @_; + my $self = { + location => $params{'location'}, + tlps => $params{'tlps'} + }; + $_listdir = $params{'listdir'} if defined($params{'listdir'}); + bless $self, $class; + if (defined($self->{'location'})) { + $self->from_file($self->{'location'}); + } + return $self; +} + +=pod + +The C<add_tlpobj> adds an object of the type TLPOBJ to the TLPDB. + +=cut +sub add_tlpobj { + my ($self,$tlp) = @_; + $self->{'tlps'}{$tlp->name} = $tlp; +} + +=pod + +The C<from_file> function initializes the C<TLPDB> in case the location +was not given at generation time. + +=cut +sub from_file { + my $self = shift; + if (@_ != 1) { + die("Need a filename for initialization!"); + } + if (defined($self->{'location'})) { + if ($self->location ne $_[0]) { + printf STDERR "Initialisation from different location as originally given.\nHope you are sure!\n"; + } + } + $self->location($_[0]); + open(TMP,"<$_[0]") || die("Cannot open tldb file: $_[0]"); + my $found = 0; + do { + my $tlp = TeXLive::TLPOBJ->new; + &TeXLive::TLUtils::debug("creating tlp ...\n"); + $found = $tlp->from_fh(\*TMP,1); + if ($found) { + $self->add_tlpobj($tlp); + } + } until (!$found); +} + +=pod + +The C<writeout> function writes the whole TLPDB to STDOUT, or to the file +handle given as argument. + +=cut +sub writeout { + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); + foreach (sort keys %{$self->{'tlps'}}) { + &TeXLive::TLUtils::debug("tlpname = $_\n"); + &TeXLive::TLUtils::debug("foo: " . $self->{'tlps'}{$_}->name . "\n"); + $self->{'tlps'}{$_}->writeout($fd); + print $fd "\n"; + } +} + +=pod + +The C<save> functions saves the TLPDB to the file which has been set +as location. If the location is undefined, die. + +=cut +sub save { + my $self = shift; + open(FOO,">$self->{'location'}") || die("Cannot open $self->{'location'} for writing: $!"); + $self->writeout(\*FOO); + close(FOO); +} + +=pod + +The C<get_package> function returns a reference to an TLPOBJ object in case +its name the the argument name coincide. + +=cut +sub get_package { + my ($self,$pkg) = @_; + if (defined($self->{'tlps'}{$pkg})) { + return($self->{'tlps'}{$pkg}); + } else { + return(undef); + } +} + +=pod + +The C<package_revision> functions returns the the revision of the +package named in the first argument. + +=cut +sub package_revision { + my ($self,$pkg) = @_; + if (defined($self->{'tlps'}{$pkg})) { + return($self->{'tlps'}{$pkg}->revision); + } else { + return(undef); + } +} + +=pod + +The C<generate_packagelist> lists all available TL Packages together +with their revisions. + +=cut +sub generate_packagelist { + my $self = shift; + my $fd = (@_ ? $_[0] : STDOUT); + foreach (sort keys %{$self->{'tlps'}}) { + print $fd $self->{'tlps'}{$_}->name, " ", $self->{'tlps'}{$_}->revision, "\n"; + } +} + +=pod + +The C<generate_listfiles> generates the list files for the old +installers. This function will probably go away. + +=cut +sub generate_listfiles { + my ($self,$destdir) = @_; + if (not(defined($destdir))) { + $destdir = TeXLive::TLPDB->listdir; + } + foreach (sort keys %{$self->{'tlps'}}) { + $tlp = $self->{'tlps'}{$_}; + $self->_generate_listfile($tlp, $destdir, "all"); + if ($tlp->is_arch_dependent) { + foreach my $a (keys %{$tlp->binfiles}) { + $self->_generate_listfile($tlp, $destdir, $a); + } + } + } +} + +sub _generate_listfile { + my ($self,$tlp,$destdir,$arch) = @_; + my @files = (); + my $listname; + if ($arch ne "all") { + my %foo = %{$tlp->binfiles}; + push @files, @{$foo{$arch}}; + $listname = $tlp->name . ".$arch"; + } else { + $listname = $tlp->name; + push @files, $tlp->runfiles; + push @files, $tlp->docfiles; + push @files, $tlp->srcfiles; + } + @files = TeXLive::TLUtils::sort_uniq(@files); + &mkpath("$destdir") if (! -d "$destdir"); + my (@lop, @lot); + foreach my $d ($tlp->depends) { + if ($d =~ m/^(Package|Documentation)\/(.*)$/) { + push @lop, $2; + } elsif ($d =~ m/^TLCore\/(.*)$/) { + push @lot, $1; + } else { + warn "strange depends line: $d\n"; + } + } + open(TMP, ">$destdir/$listname") or die "Cannot open $destdir/$listname!"; + # title and size information for collections and schemes in the + # first two lines, marked with * + if ($listname =~ m/^collection-/) { + print TMP "*Title: ", $tlp->shortdesc, "\n"; + # collections references Packages, we have to collect the sizes of + # all the Package-tlps included + # What is unclear for me is HOW the size is computed for bin-* + # packages. The collection-basicbin contains quite a lot of + # bin-files, but the sizes for the different archs differ. + # I guess we have to take the maximum? + my $s = 0; + foreach my $p (@lop) { + my $subtlp = $self->get_package($p); + if (!defined($subtlp)) { + warn "Strange: $listname references $p, but it is not in tldb"; + } + $s += $subtlp->total_size; + } + # in case the collection itself ships files ... + $s += $tlp->runsize + $tlp->srcsize + $tlp->docsize; + print TMP "*Size: $s\n"; + } elsif ($listname =~ m/^scheme-/) { + print TMP "*Title: ", $tlp->shortdesc, "\n"; + my $s = 0; + # needs a bitof trickyness, because contained collections + # do not have intersections of packages, but there could be + # additional tlps included which would be doubly included + my (@inccol,@incpkg); + # first we add all the packages tlps that are directly included + @incpkg = @lop; + # now we select all collections, and for all collections we + # again select all packages of type Documentation and Package + foreach my $c (@lot) { + my $coll = $self->get_package($c); + foreach my $d ($coll->depends) { + if ($d =~ m/^(Package|Documentation)\/(.*)$/) { + TeXLive::TLUtils::push_uniq(\@incpkg,$2); + } + } + } + # finally go through all packages and add the ->total_size + foreach my $p (@incpkg) { + $s += $self->get_package($p)->total_size + } + print TMP "*Size: $s\n"; + } + # dependencies and inclusion of packages + foreach my $t (@lot) { + # strange, schemes mark included collections via -, while collections + # themself mark deps on other collections with +. collection are + # never referenced in Packages + if ($listname =~ m/^scheme/) { + print TMP "-"; + } else { + print TMP "+"; + } + print TMP "$t\n"; + } + foreach my $t (@lop) { print TMP "+$t\n"; } + # included files + foreach my $f (@files) { print TMP "$f\n"; } + # also print the listfile itself + print TMP "$destdir/$listname\n"; + # execute statements + foreach my $e ($tlp->executes) { + print TMP "!$e\n"; + } + # finish + close(TMP); +} + +=pod + +The function C<location> allows to read and set the location of the +text file of the TeX Live Database. + +=cut +sub location { + my $self = shift; + if (@_) { $self->{'location'} = shift } + return $self->{'location'}; +} + +=pod + +The function C<listdir> allows to read and set the packages variable +specifiying where generated list files are created. + +=cut +sub listdir { + my @self = shift; + if (@_) { $_listdir = $_[0] } + return $_listdir; +} + + +=pod + +=head1 AUTHORS AND COPYRIGHT + +This module and its documentation was written by +Norbert Preining <F<preining@logic.at>> for the TeX Live distribution and both +are licensed under the GNU General Public License Version 2 or later. + +=head1 SEE ALSO + +The modules L<TeXLive::TLPSRC>, L<TeXLive::TLPOBJ>, +L<TeXLive::TLTREE>, L<TeXLive::TLUtils> and the +document L<Perl-API.txt> and the specification in the TeX Live +repository trunk/Master/tlpkg/doc/. + +=cut + + +1; + +### Local Variables: +### perl-indent-level: 4 +### tab-width: 4 +### indent-tabs-mode: t +### End: +# vim:set tabstop=4: # |