# $Id$ # TeXLive::TLPDB.pm - module for using tlpdb files # Copyright 2007 Norbert Preining # # This file is licensed under the GNU General Public License version 2 # or any later version. package TeXLive::TLPDB; =pod =head1 NAME C -- A database of TeX Live Packages =head1 SYNOPSIS use TeXLive::TLPDB; TeXLive::TLPDB->new (); TeXLive::TLPDB->new (location => "/path/to/texlive.tlpdb"); $tlpdb->location("/path/to/texlive.tlpdb"); $tlpdb->from_file($filename); $tlpdb->writeout; $tlpdb->writeout(FILEHANDLE); $tlpdb->save; $tlpdb->add_objpkg($tlpobj); $tlpdb->get_package("packagename"); $tlpdb->list_packages; $tlpdb->package_revision("packagename"); TeXLive::TLPDB->listdir([$dir]); $tlpdb->generate_listfiles([$destdir]); =head1 DESCRIPTION =cut use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory); use TeXLive::TLUtils; use TeXLive::TLPOBJ; my $_listdir; =pod =over 6 =item C<< TeXLive::TLPDB->new >> =item C<< TeXLive::TLPDB->new(location => "$filename") >> C<< TeXLive::TLPDB->new >> creates a new C object. If the argument C is given it will be initialized from this location. C<$filename> is usually C. If C<$filename> begins with C or C, the program C is used to download the file. =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 =item C<< $tlpdb->add_tlpobj($tlpobj) >> The C adds an object of the type TLPOBJ to the TLPDB. =cut sub add_tlpobj { my ($self,$tlp) = @_; $self->{'tlps'}{$tlp->name} = $tlp; } =pod =item C<< $tlpdb->from_file($filename) >> The C function initializes the C in case the location was not given at generation time. If C<$filename> begins with C or C, the program C is used to download the file. =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]); if ($_[0]=~/^(http|ftp):\/\//) { open(TMP, "wget -nv --output-document=- $_[0]|") || die("Cannot open tlpdb file: $_[0]"); } else { open(TMP,"<$_[0]") || die("Cannot open tlpdb file: $_[0]"); } my $found = 0; do { my $tlp = TeXLive::TLPOBJ->new; &TeXLive::TLUtils::debug("creating tlp from $_[0]..."); $found = $tlp->from_fh(\*TMP,1); if ($found) { $self->add_tlpobj($tlp); } } until (!$found); } =pod =item C<< $tlpdb->writeout >> =item C<< $tlpdb->writeout(FILEHANDLE) >> The C function writes the database to C, or 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 = $_"); &TeXLive::TLUtils::debug("foo: " . $self->{'tlps'}{$_}->name); $self->{'tlps'}{$_}->writeout($fd); print $fd "\n"; } } =pod =item C<< $tlpdb->save >> The C functions saves the C 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 =item C<< $tlpdb->get_package("packagename") >> The C function returns a reference to a C 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 =item C<< $tlpdb->list_packages >> The C function returns the list of all included packages. =cut sub list_packages { my $self = shift; return (sort keys %{$self->{'tlps'}}); } =pod =item C<< $tlpdb->package_revision("packagename") >> The C function returns the revision number 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 =item C<< $tlpdb->generate_packagelist >> The C 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 =item C<< $tlpdb->generate_listfiles >> =item C<< $tlpdb->generate_listfiles($destdir) >> The C 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) { my $subtlp = $self->get_package($d); if (defined($subtlp)) { if ($subtlp->is_meta_package) { push @lot, $d; } else { push @lop, $d; } } else { warn "Strange: $tlp->name depends on $d, but this package does not exists!\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 ($tlp->category eq "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 tlpdb"; } $s += $subtlp->total_size; } # in case the collection itself ships files ... $s += $tlp->runsize + $tlp->srcsize + $tlp->docsize; print TMP "*Size: $s\n"; } elsif ($tlp->category eq "Scheme") { print TMP "*Title: ", $tlp->shortdesc, "\n"; my $s = 0; # schemes size includes ONLY those packages which are directly # included and direclty included files, not the size of the # included collections. But if a package is included in one of # the called for collections AND listed directly, we don't want # to count its size two times my (@inccol,@incpkg,@collpkg); # 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) { my $subtlp = $self->get_package($d); if (defined($subtlp)) { if (!($subtlp->is_meta_package)) { TeXLive::TLUtils::push_uniq(\@collpkg,$d); } } else { warn "Strange: $coll->name depends on $d, but this does not exists!\n"; } } } # finally go through all packages and add the ->total_size foreach my $p (@incpkg) { if (!TeXLive::TLUtils::member($p,@collpkg)) { $s += $self->get_package($p)->total_size; } } $s += $tlp->runsize + $tlp->srcsize + $tlp->docsize; 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 =item C<< $tlpdb->location("/path/to/texlive.tlpdb") >> The function C allows to read and set the location of the text file of the TeX Live database, by default named C. =cut sub location { my $self = shift; if (@_) { $self->{'location'} = shift } return $self->{'location'}; } =pod =item C<< $tlpdb->listdir >> The function C 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; } =back =pod =head1 SEE ALSO The modules L, L, L, L and the document L and the specification in the TeX Live repository trunk/Master/tlpkg/doc/. =head1 AUTHORS AND COPYRIGHT This script and its documentation were written for the TeX Live distribution (L) and both are licensed under the GNU General Public License Version 2 or later. =cut 1; ### Local Variables: ### perl-indent-level: 2 ### tab-width: 2 ### indent-tabs-mode: nil ### End: # vim:set tabstop=2 expandtab: #