summaryrefslogtreecommitdiff
path: root/Master/tlpkg/TeXLive/TLPDB.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPDB.pm')
-rw-r--r--Master/tlpkg/TeXLive/TLPDB.pm346
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: #