diff options
Diffstat (limited to 'Master/tlpkg/TeXLive/TLPDB.pm')
-rw-r--r-- | Master/tlpkg/TeXLive/TLPDB.pm | 148 |
1 files changed, 146 insertions, 2 deletions
diff --git a/Master/tlpkg/TeXLive/TLPDB.pm b/Master/tlpkg/TeXLive/TLPDB.pm index e415ae6b5b8..e79d9df2fa3 100644 --- a/Master/tlpkg/TeXLive/TLPDB.pm +++ b/Master/tlpkg/TeXLive/TLPDB.pm @@ -21,6 +21,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages TeXLive::TLPDB->new (location => "/path/to/texlive.tlpdb"); $tlpdb->location("/path/to/texlive.tlpdb"); + $tlpdb->root("/path/to/root/of/texlive/installation"); $tlpdb->from_file($filename); $tlpdb->writeout; $tlpdb->writeout(FILEHANDLE); @@ -30,6 +31,9 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages $tlpdb->add_tlpobj($tlpobj); $tlpdb->get_package("packagename"); $tlpdb->list_packages; + $tlpdb->updmap_cfg_lines; + $tlpdb->fmtutil_cnf_lines; + $tlpdb->language_dat_lines; $tlpdb->package_revision("packagename"); TeXLive::TLPDB->listdir([$dir]); @@ -40,7 +44,7 @@ C<TeXLive::TLPDB> -- A database of TeX Live Packages =cut use TeXLive::TLConfig qw($CategoriesRegexp $DefaultCategory); -use TeXLive::TLUtils; +use TeXLive::TLUtils qw(basename); use TeXLive::TLPOBJ; my $_listdir; @@ -66,13 +70,26 @@ sub new { my %params = @_; my $self = { location => $params{'location'}, + root => $params{'root'}, tlps => $params{'tlps'} }; $_listdir = $params{'listdir'} if defined($params{'listdir'}); bless $self, $class; + if (defined($self->{'location'}) && defined($self->{'root'})) { + my $chk = basename(basename($self->{'root'})); + if ($self->{'root'} ne $chk) { + warn "root $self->{'root'} and location $self->{'location'} does not really fit, are you sure?!\n"; + } + } if (defined($self->{'location'})) { + if (not(defined($self->{'root'}))) { + $self->{'root'} = basename(basename($self->{'location'})); + } $self->from_file($self->{'location'}); } + if (defined($self->{'root'}) && not(defined($self->{'location'}))) { + $self->{'location'} = $self->{'root'} . "/" . $TeXLive::TLConfig::InfraLocation . "/texlive.tlpdb"; + } return $self; } @@ -460,6 +477,21 @@ sub _generate_listfile { =pod +=item C<< $tlpdb->root([ "/path/to/installation" ]) >> + +The function C<root> allows to read and set the root of the +installation. Note that root and location is somehow linked! + +=cut + +sub root { + my $self = shift; + if (@_) { $self->{'root'} = shift } + return $self->{'root'}; +} + +=pod + =item C<< $tlpdb->location("/path/to/texlive.tlpdb") >> The function C<location> allows to read and set the location of the @@ -482,14 +514,126 @@ specifiying where generated list files are created. =cut sub listdir { - my @self = shift; + my $self = shift; if (@_) { $_listdir = $_[0] } return $_listdir; } =back + +=item C<< $tlpdb->fmtutil_cnf_lines >> + +The function C<fmtutil_cnf_lines> returns the list of a fmtutil.cnf file +containing only those formats present in the installation. + +=cut +sub fmtutil_cnf_lines { + my $self = shift; + my %fmtcnffiles; + foreach my $p ($self->list_packages) { + my $obj = $self->get_package ($p); + die "No TeX Live package named $p, strange.\n" if ! $obj; + foreach my $e ($obj->executes) { + if ($e =~ m/BuildFormat (.*)$/) { + $fmtcnffiles{$1} = 1; + } + # others are ignored here + } + } + my @formatlines; + open(INFILE,"<$self->{'root'}/texmf/fmtutil/fmtutil-hdr.cnf") + or die("Cannot open $self->{'root'}/texmf/fmtutil/fmtutil-hdr.cnf\n"); + my @tmp = <INFILE>; + close (INFILE); + push @formatlines, @tmp; + foreach my $f (keys %fmtcnffiles) { + open(INFILE,"<$self->{'root'}/texmf/fmtutil/format.$f.cnf") + or die("Cannot open $self->{'root'}/texmf/fmtutil/format.$f.cnf"); + @tmp = <INFILE>; + close(INFILE); + push @formatlines, @tmp; + } + return(@formatlines); +} + +=item C<< $tlpdb->updmap_cfg_lines >> + +The function C<updmap_cfg_lines> returns the list of a updmap.cfg file +containing only those maps present in the installation. + +=cut +sub updmap_cfg_lines { + my $self = shift; + my %maps; + foreach my $p ($self->list_packages) { + my $obj = $self->get_package ($p); + die "No TeX Live package named $p, strange.\n" if ! $obj; + foreach my $e ($obj->executes) { + if ($e =~ m/addMap (.*)$/) { + $maps{$1} = 1; + } elsif ($e =~ m/addMixedMap (.*)$/) { + $maps{$1} = 2; + } + # others are ignored here + } + } + my @updmaplines; + open(UPDHDR,"<$self->{'root'}/texmf/web2c/updmap-hdr.cfg") + or die("Cannot find $self->{'root'}/texmf/web2c/updmap-hdr.cfg!\n"); + my @tmp = <UPDHDR>; + close(UPDHDR); + push @updmaplines, @tmp; + foreach (sort keys %maps) { + if ($maps{$_} == 2) { + push @updmaplines, "MixedMap $_\n"; + } else { + push @updmaplines, "Map $_\n"; + } + } + return(@updmaplines); +} + +=item C<< $tlpdb->language_dat_lines >> + +The function C<language_dat_lines> returns the list of a language.dat file +containing only those hyphenation patterns present in the installation. + +=cut +sub language_dat_lines { + my $self = shift; + my %langfiles; + foreach my $p ($self->list_packages) { + my $obj = $self->get_package ($p); + die "No TeX Live package named $p, strange.\n" if ! $obj; + foreach my $e ($obj->executes) { + if ($e =~ m/BuildLanguageDat (.*)$/) { + $langfiles{$1} = 1; + } + # others are ignored here + } + } + my @langlines; + open(LANHDR,"<$self->{'root'}/texmf/tex/generic/config/language.us") + or die("Cannot find $self{'root'}/texmf/tex/generic/config/language.us!\n"); + my @tmp = <LANHDR>; + close(LANHDR); + push @langlines, @tmp; + foreach my $f (keys %langfiles) { + open(INFILE,"<$self->{'root'}/texmf/tex/generic/config/language.$f.dat") + or die("Cannot open $self->{'root'}/texmf/tex/generic/config/language.$f.cnf"); + @tmp = <INFILE>; + close(INFILE); + push @langlines, @tmp; + } + return(@langlines); +} + + +=back + =pod + =head1 SEE ALSO The modules L<TeXLive::TLPSRC>, L<TeXLive::TLPOBJ>, |