summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/TeXLive/TeXCatalogue.pm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/texlive/tlnet/tlpkg/TeXLive/TeXCatalogue.pm
Initial commit
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/TeXLive/TeXCatalogue.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/TeXLive/TeXCatalogue.pm340
1 files changed, 340 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/TeXLive/TeXCatalogue.pm b/systems/texlive/tlnet/tlpkg/TeXLive/TeXCatalogue.pm
new file mode 100644
index 0000000000..4f6721dc17
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/TeXLive/TeXCatalogue.pm
@@ -0,0 +1,340 @@
+# $Id: TeXCatalogue.pm 48521 2018-08-31 03:41:21Z preining $
+# TeXLive::TeXCatalogue - module for accessing the TeX Catalogue
+# Copyright 2007-2018 Norbert Preining
+# This file is licensed under the GNU General Public License version 2
+# or any later version.
+#
+# Loads of code taken from the catalogue checking script of Robin Fairbairns.
+
+use XML::Parser;
+use XML::XPath;
+use XML::XPath::XMLParser;
+use Text::Unidecode;
+
+package TeXLive::TeXCatalogue::Entry;
+
+my $svnrev = '$Revision: 48521 $';
+my $_modulerevision;
+if ($svnrev =~ m/: ([0-9]+) /) {
+ $_modulerevision = $1;
+} else {
+ $_modulerevision = "unknown";
+}
+sub module_revision {
+ return $_modulerevision;
+}
+
+my $_parser = XML::Parser->new(
+ ErrorContext => 2,
+ ParseParamEnt => 1,
+ NoLWP => 1
+);
+
+sub new {
+ my $class = shift;
+ my %params = @_;
+ my $self = {
+ ioref => $params{'ioref'},
+ entry => defined($params{'entry'}) ? $params{'entry'} : {},
+ docs => defined($params{'docs'}) ? $params{'docs'} : {},
+ name => $params{'name'},
+ caption => $params{'caption'},
+ description => $params{'description'},
+ license => $params{'license'},
+ ctan => $params{'ctan'},
+ texlive => $params{'texlive'},
+ miktex => $params{'miktex'},
+ version => $params{'version'},
+ also => defined($params{'also'}) ? $params{'also'} : [],
+ topic => defined($params{'topic'}) ? $params{'topic'} : [],
+ alias => defined($params{'alias'}) ? $params{'alias'} : [],
+ contact => defined($params{'contact'}) ? $params{'contact'} : {},
+ };
+ bless $self, $class;
+ if (defined($self->{'ioref'})) {
+ $self->initialize();
+ }
+ return $self;
+}
+
+sub initialize {
+ my $self = shift;
+ # parse all the files
+ my $parser
+ = new XML::XPath->new(ioref => $self->{'ioref'}, parser => $_parser)
+ || die "Failed to parse given ioref";
+ $self->{'entry'}{'id'} = $parser->findvalue('/entry/@id')->value();
+ $self->{'entry'}{'date'} = $parser->findvalue('/entry/@datestamp')->value();
+ $self->{'entry'}{'modder'} = $parser->findvalue('/entry/@modifier')->value();
+ $self->{'name'} = $parser->findvalue("/entry/name")->value();
+ $self->{'caption'} = beautify($parser->findvalue("/entry/caption")->value());
+ $self->{'description'} = beautify($parser->findvalue("/entry/description")->value());
+ $self->{'license'} = $parser->findvalue('/entry/license/@type')->value();
+ $self->{'version'} = Text::Unidecode::unidecode(
+ $parser->findvalue('/entry/version/@number')->value());
+ $self->{'ctan'} = $parser->findvalue('/entry/ctan/@path')->value();
+ if ($parser->findvalue('/entry/texlive/@location') ne "") {
+ $self->{'texlive'} = $parser->findvalue('/entry/texlive/@location')->value();
+ }
+ if ($parser->findvalue('/entry/miktex/@location') ne "") {
+ $self->{'miktex'} = $parser->findvalue('/entry/miktex/@location')->value();
+ }
+ # parse all alias entries
+ my $alset = $parser->find('/entry/alias');
+ for my $node ($alset->get_nodelist) {
+ my $id = $parser->find('./@id', $node);
+ push @{$self->{'alias'}}, "$id";
+ }
+ # parse the documentation entries
+ my $docset = $parser->find('/entry/documentation');
+ foreach my $node ($docset->get_nodelist) {
+ my $docfileparse = $parser->find('./@href',$node);
+ # convert to string
+ my $docfile = "$docfileparse";
+ # see comments at end of beautify()
+ my $details
+ = Text::Unidecode::unidecode($parser->find('./@details',$node));
+ my $language = $parser->find('./@language',$node);
+ $self->{'docs'}{$docfile}{'available'} = 1;
+ if ($details) { $self->{'docs'}{$docfile}{'details'} = "$details"; }
+ if ($language) { $self->{'docs'}{$docfile}{'language'} = "$language"; }
+ }
+ # parse the also entries
+ foreach my $node ($parser->find('/entry/also')->get_nodelist) {
+ my $alsoid = $parser->find('./@refid',$node);
+ push @{$self->{'also'}}, "$alsoid";
+ }
+ # parse the contact entries
+ foreach my $node ($parser->find('/entry/contact')->get_nodelist) {
+ my $contacttype = $parser->find('./@type',$node);
+ my $contacthref = $parser->find('./@href',$node);
+ if ($contacttype && $contacthref) {
+ $self->{'contact'}{$contacttype} = $contacthref;
+ }
+ }
+ # parse the keyval/topic entries
+ foreach my $node ($parser->find('/entry/keyval')->get_nodelist) {
+ my $k = $parser->find('./@key',$node);
+ my $v = $parser->find('./@value',$node);
+ # for now we only support evaluating the 'topic' key
+ if ("$k" eq 'topic') {
+ push @{$self->{'topic'}}, "$v";
+ }
+ }
+}
+
+sub beautify {
+ my ($txt) = @_;
+ $txt =~ s/\n/ /g; # make one line
+ $txt =~ s/^\s+//g; # rm leading whitespace
+ $txt =~ s/\s+$//g; # rm trailing whitespace
+ $txt =~ s/\s\s+/ /g; # multiple spaces to one
+ # transliterate to ascii: it allows the final tlpdb to be pure ascii,
+ # avoiding problems since we don't control the user's terminal encoding
+ return Text::Unidecode::unidecode($txt);
+}
+
+sub name {
+ my $self = shift;
+ if (@_) { $self->{'name'} = shift }
+ return $self->{'name'};
+}
+sub license {
+ my $self = shift;
+ if (@_) { $self->{'license'} = shift }
+ return $self->{'license'};
+}
+sub version {
+ my $self = shift;
+ if (@_) { $self->{'version'} = shift }
+ return $self->{'version'};
+}
+sub caption {
+ my $self = shift;
+ if (@_) { $self->{'caption'} = shift }
+ return $self->{'caption'};
+}
+sub description {
+ my $self = shift;
+ if (@_) { $self->{'description'} = shift }
+ return $self->{'description'};
+}
+sub ctan {
+ my $self = shift;
+ if (@_) { $self->{'ctan'} = shift }
+ return $self->{'ctan'};
+}
+sub texlive {
+ my $self = shift;
+ if (@_) { $self->{'texlive'} = shift }
+ return $self->{'texlive'};
+}
+sub miktex {
+ my $self = shift;
+ if (@_) { $self->{'miktex'} = shift }
+ return $self->{'miktex'};
+}
+sub docs {
+ my $self = shift;
+ my %newdocs = @_;
+ if (@_) { $self->{'docs'} = \%newdocs }
+ return $self->{'docs'};
+}
+sub entry {
+ my $self = shift;
+ my %newentry = @_;
+ if (@_) { $self->{'entry'} = \%newentry }
+ return $self->{'entry'};
+}
+sub alias {
+ my $self = shift;
+ my @newalias = @_;
+ if (@_) { $self->{'alias'} = \@newalias }
+ return $self->{'alias'};
+}
+sub also {
+ my $self = shift;
+ my @newalso = @_;
+ if (@_) { $self->{'also'} = \@newalso }
+ return $self->{'also'};
+}
+sub topics {
+ my $self = shift;
+ my @newtopics = @_;
+ if (@_) { $self->{'topic'} = \@newtopics }
+ return $self->{'topic'};
+}
+sub contact {
+ my $self = shift;
+ my %newcontact = @_;
+ if (@_) { $self->{'contact'} = \%newcontact }
+ return $self->{'contact'};
+}
+
+
+################################################################
+#
+# TeXLive::TeXCatalogue
+#
+################################################################
+package TeXLive::TeXCatalogue;
+
+sub new {
+ my $class = shift;
+ my %params = @_;
+ my $self = {
+ location => $params{'location'},
+ entries => defined($params{'entries'}) ? $params{'entries'} : {},
+ };
+ bless $self, $class;
+ if (defined($self->{'location'})) {
+ $self->initialize();
+ $self->quest4texlive();
+ }
+ return $self;
+}
+
+sub initialize {
+ my $self = shift;
+ # chdir to the location of the DTD file, otherwise it cannot be found
+ # furthermore we have to open the xml file from a file handle otherwise
+ # the catalogue.dtd is searched in a/catalogue.dtd etc, see above
+ my $cwd = `pwd`;
+ chomp($cwd);
+ chdir($self->{'location'} . "/entries")
+ || die "chdir($self->{location}/entries failed: $!";
+ # parse all the files
+ foreach (glob("?/*.xml")) {
+ # for debugging, nice to skip everything but: next unless /pst-node/;
+ open(my $io,"<$_") or die "open($_) failed: $!";
+ our $tce;
+ # the XML parser die's on malformed xml entries, so we catch
+ # that and continue, simply skipping the entry
+ eval { $tce = TeXLive::TeXCatalogue::Entry->new( 'ioref' => $io ); };
+ if ($@) {
+ warn "TeXCatalogue.pm:$_: cannot parse, skipping: $@\n";
+ close($io);
+ next;
+ }
+ close($io);
+ $self->{'entries'}{lc($tce->{'entry'}{'id'})} = $tce;
+ }
+ chdir($cwd) || die ("Cannot change back to $cwd: $!");
+}
+
+# Copy every catalogue $entry under the name $entry->{'texlive'}
+# if it makes sense.
+#
+sub quest4texlive {
+ my $self = shift;
+
+ # The catalogue has a partial mapping from catalogue entries to
+ # texlive packages: $id --> $texcat->{$id}{'texlive'}
+ my $texcat = $self->{'entries'};
+
+ # Try to build the inverse mapping:
+ my (%inv, %count);
+ for my $id (keys %{$texcat}) {
+ my $tl = $texcat->{$id}{'texlive'};
+ if (defined($tl)) {
+ $tl =~ s/^bin-//;
+ $count{$tl}++;
+ $inv{$tl} = $id;
+ }
+ }
+ # Go through texlive names
+ for my $name (keys %inv) {
+ # If this name is free and there is only one corresponding catalogue
+ # entry then copy the entry under this name
+ if (!exists($texcat->{$name}) && $count{$name} == 1) {
+ $texcat->{$name} = $texcat->{$inv{$name}};
+ }
+ }
+}
+
+sub location {
+ my $self = shift;
+ if (@_) { $self->{'location'} = shift }
+ return $self->{'location'};
+}
+
+sub entries {
+ my $self = shift;
+ my %newentries = @_;
+ if (@_) { $self->{'entries'} = \%newentries }
+ return $self->{'entries'};
+}
+
+1;
+__END__
+
+
+=head1 NAME
+
+TeXLive::TeXCatalogue - Accessing the TeX Catalogue
+
+=head1 SYNOPSIS
+
+missing
+
+=head1 DESCRIPTION
+
+The L<TeXLive::TeXCatalogue> module provides access to the data stored
+in the TeX Catalogue.
+
+DOCUMENTATION MISSING, SORRY!!!
+
+=head1 AUTHORS AND COPYRIGHT
+
+This script and its documentation were written for the TeX Live
+distribution (L<http://tug.org/texlive>) and both are licensed under the
+GNU General Public License Version 2 or later.
+
+=cut
+
+### Local Variables:
+### perl-indent-level: 2
+### tab-width: 2
+### indent-tabs-mode: nil
+### End:
+# vim:set tabstop=2 expandtab: #