diff options
| -rw-r--r-- | Master/tlpkg/TeXLive/TeXCatalogue.pm | 122 |
1 files changed, 55 insertions, 67 deletions
diff --git a/Master/tlpkg/TeXLive/TeXCatalogue.pm b/Master/tlpkg/TeXLive/TeXCatalogue.pm index eb5682068d4..e034e9d0f5d 100644 --- a/Master/tlpkg/TeXLive/TeXCatalogue.pm +++ b/Master/tlpkg/TeXLive/TeXCatalogue.pm @@ -7,15 +7,23 @@ # # Loads of code taken from the catalogue checking script of Robin Fairbairns. -use XML::DOM; +use XML::Parser; +use XML::XPath; +use XML::XPath::XMLParser; package TeXLive::TeXCatalogue::Entry; +my $_parser = XML::Parser->new( + ErrorContext => 2, + ParseParamEnt => 1, + NoLWP => 1 +); + sub new { my $class = shift; my %params = @_; my $self = { - xmlfile => $params{'xmlfile'}, + ioref => $params{'ioref'}, entry => defined($params{'entry'}) ? $params{'entry'} : {}, docs => defined($params{'docs'}) ? $params{'docs'} : {}, name => $params{'name'}, @@ -23,10 +31,9 @@ sub new { ctan => $params{'ctan'}, texlive => $params{'texlive'}, version => $params{'version'}, - url => $params{'url'}, }; bless $self, $class; - if (defined($self->{'xmlfile'})) { + if (defined($self->{'ioref'})) { $self->initialize(); } return $self; @@ -34,72 +41,40 @@ sub new { sub initialize { my $self = shift; - my $parser = new XML::DOM::Parser; # parse all the files - my $cat = $parser->parsefile ($self->{'xmlfile'}) || - die "Failed to parse ", $self->{'xmlfile'}; - # there's almost always only one, but... - my $entryset = $cat -> getElementsByTagName ("entry"); - my $entry = $entryset->item(0); - # entry attributes - my $entryid = $entry->getAttributeNode("id"); - $self->{'entry'}{'id'} = $entryid->getValue; - my $entrydate = $entry->getAttributeNode("datestamp"); - if ($entrydate) { - $self->{'entry'}{'date'} = $entrydate->getValue; - } - my $entrymodder = $entry->getAttributeNode("modifier"); - if ($entrymodder) { - $self->{'entry'}{'modder'} = $entrymodder->getValue; - } - # parse the rest of the entries - # only the first name and caption is allowed - # description CANNOT be parsed like this since it contains more childs!! - # (<tt> <xref> etc elements - foreach my $k qw/name caption/ { - $self->{$k} = $cat->getElementsByTagName($k)->item(0)->getFirstChild->toString; - } - $self->{'license'} = $cat->getElementsByTagName("license")->item(0)->getAttributeNode("type")->getValue; - my $versnode = $cat->getElementsByTagName("version")->item(0); - if ($versnode) { - my $numnode = $versnode->getAttributeNode("number"); - if ($numnode) { - $self->{'version'} = $numnode->getValue; - } - } - my $urlnode = $cat->getElementsByTagName("home")->item(0); - if ($urlnode) { - $self->{'url'} = $urlnode->getAttributeNode("href")->getValue; - } - $ctannode = $cat->getElementsByTagName("ctan")->item(0); - if ($ctannode) { - $self->{'ctan'} = $ctannode->getAttributeNode("path")->getValue; - } - my $tlnode = $cat->getElementsByTagName("texlive")->item(0); - if ($tlnode) { - $self->{'texlive'} = $tlnode->getAttributeNode("location")->getValue; - } + my $parser = new XML::XPath->new(ioref => $self->{'ioref'}, parser => $_parser) || + die "Failed to parse the given ioref"; + $self->{'entry'}{'id'} = $parser->findvalue('/entry/@id'); + $self->{'entry'}{'date'} = $parser->findvalue('/entry/@datestamp'); + $self->{'entry'}{'modder'} = $parser->findvalue('/entry/@modifier'); + $self->{'name'} = $parser->findvalue("/entry/name"); + $self->{'caption'} = $parser->findvalue("/entry/caption"); + $self->{'description'} = beautify($parser->findvalue("/entry/description")); + $self->{'license'} = $parser->findvalue('/entry/license/@type'); + $self->{'version'} = $parser->findvalue('/entry/version/@number'); + $self->{'ctan'} = $parser->findvalue('/entry/ctan/@path'); + $self->{'texlive'} = $parser->findvalue('/entry/texlive/@location'); + $self->{'miktex'} = $parser->findvalue('/entry/miktex/@location'); # parse the documentation entries - my $doc = $cat->getElementsByTagName ("documentation"); - for (my $i=0; $i < $doc->getLength; $i++ ) { - my $node = $doc->item($i); - my $docfile = $node->getAttributeNode("href")->getValue; - my $detailsnode = $node->getAttributeNode("details"); - if ($detailsnode) { $details = $detailsnode->getValue; } - my $languagenode = $node->getAttributeNode("language"); - if ($languagenode) { $language = $languagenode->getValue; } + my $docset = $parser->find('/entry/documentation'); + foreach my $node ($docset->get_nodelist) { + my $docfile = $parser->find('./@href',$node); + my $details = $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; } } - $cat->dispose; } -sub xmlfile { - my $self = shift; - if (@_) { $self->{'xmlfile'} = shift } - return $self->{'xmlfile'}; +sub beautify{ + my ($txt) = @_; + $txt =~ s/\n/ /g; + $txt =~ s/^[[:space:]]*//g; + $txt =~ s/[[:space:]][[:space:]]*/ /g; + return($txt); } + sub name { my $self = shift; if (@_) { $self->{'name'} = shift } @@ -120,10 +95,10 @@ sub caption { if (@_) { $self->{'caption'} = shift } return $self->{'caption'}; } -sub url { +sub description { my $self = shift; - if (@_) { $self->{'url'} = shift } - return $self->{'url'}; + if (@_) { $self->{'description'} = shift } + return $self->{'description'}; } sub ctan { my $self = shift; @@ -135,6 +110,11 @@ sub texlive { 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 = @_; @@ -172,12 +152,20 @@ sub new { sub initialize { my $self = shift; - my $parser = new XML::DOM::Parser; + # 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 ("Cannot chdir to TeX Catalogue entries: $!"); # parse all the files - foreach (glob($self->{'location'} . "/entries/?/*.xml")) { - my $tce = TeXLive::TeXCatalogue::Entry->new( 'xmlfile' => "$_" ); + foreach (glob("?/*.xml")) { + open(my $io,"<$_") or die "Cannot read $_: $!"; + my $tce = TeXLive::TeXCatalogue::Entry->new( 'ioref' => $io ); + close($io); $self->{'entries'}{$tce->name} = $tce; } + chdir($cwd) || die ("Cannot change back to $cwd: $!"); } sub location { |