From: Grant M. <gr...@us...> - 2002-04-28 22:02:35
|
Update of /cvsroot/perl-xml/perl-xml-faq In directory usw-pr-cvs1:/tmp/cvs-serv19897 Added Files: db2sdb.pl Log Message: - script for converting FAQ document from DocBook to Simplified DocBook (to work in with existing stylesheets) --- NEW FILE: db2sdb.pl --- #!/usr/local/bin/perl -w ############################################################################## # # Title: db2sbd.pl # # Author: Grant McLean <gr...@cp...> # # Description: # # Script for converting a DocBook XML document to a Simplified DocBook XML # document. The primary target for conversion is the Perl-XML FAQ. # Requires XML::SAX, XML::SAX::Machines and XML::SAX::Writer. # use strict; ############################################################################## # Filter class that does the translation # package DocBook2SDocBook; use XML::SAX::Base; our @ISA = qw(XML::SAX::Base); my %simple_elems = map { $_, undef } qw( abbrev abstract acronym affiliation appendix article articleinfo attribution audiodata audioobject author authorblurb authorgroup authorinitials bibliodiv bibliography bibliomisc bibliomixed bibliomset blockquote caption citetitle colspec command computeroutput copyright corpauthor date edition editor email emphasis entry epigraph example figure filename firstname footnote holder honorific imagedata imageobject informaltable inlinemediaobject issuenum itemizedlist jobtitle keyword keywordset legalnotice lineage lineannotation link listitem literal literallayout mediaobject note objectinfo option orderedlist orgname othercredit othername para phrase programlisting pubdate publishername quote releaseinfo replaceable revdescription revhistory revision revnumber revremark row section sectioninfo sidebar subject subjectset subjectterm subtitle surname systemitem table tbody term textobject tgroup thead title titleabbrev trademark ulink userinput variablelist varlistentry videodata videoobject volumenum xref year ); my %elem_mapping = ( address => undef, qandaset => undef, guimenu => undef, answer => undef, classname => 'filename', function => 'filename', formalpara => 'example', menuchoice => 'command', qandadiv => \§ion_elem, qandaentry => \§ion_elem, question => sub { my($self, $context, $elem) = @_; $self->{in_question} = ($context eq 'start' ? 1 : 0); # skip element }, para => sub { my($self, $context, $elem) = @_; if($self->{in_question}) { $elem->{Name} = 'title'; } if($context eq 'start') { return $self->SUPER::start_element($elem); } return $self->SUPER::end_element($elem); }, # formalpara => sub { # my($self, $context, $elem) = @_; # $self->{in_formal_para} = ($context eq 'start' ? 1 : 0); # # skip element # }, guisubmenu => sub { my($self, $context, $elem) = @_; if($context eq 'start') { return $self->SUPER::characters({ Data => '->' }); } # skip element }, ); sub section_elem { my($self, $context, $elem) = @_; $elem->{Name} = 'section'; delete($elem->{Attributes}->{'{}defaultlabel'}); if($context eq 'start') { return $self->SUPER::start_element($elem); } else { return $self->SUPER::end_element($elem); } } sub add_mappings { my $map = shift; while(my($from, $to) = each(%$map)) { $to = undef if($to eq '' or $to eq '1'); $elem_mapping{$from} = $to; } } ############################################################################## # SAX handler methods # sub start_document { my $self = shift; $self->{sectnum} = [ 0 ]; $self->SUPER::start_document(@_); } sub start_dtd { my $self = shift; my $data = shift; $data->{PublicId} = $main::opt{p} || '-//OASIS//DTD Simplified DocBook XML V4.1.2.5//EN'; $data->{SystemId} = $main::opt{s} || 'file:///usr/share/xml/docbook/simple/4.1.2.5/sdocbook.dtd'; $self->SUPER::start_dtd($data); } sub comment { my($self, $comment) = @_; $self->SUPER::comment($comment) if($main::opt{c}); }; sub start_element { my $self = shift; my $elem = shift; if(exists($elem_mapping{$elem->{Name}})) { $elem = { %$elem }; my $mapping = $elem_mapping{$elem->{Name}}; return unless(defined($mapping)); if(ref($mapping)) { return $mapping->($self, start => $elem); } else { $elem->{Name} = $mapping; } return $self->SUPER::start_element($elem); } if(exists($simple_elems{$elem->{Name}})) { return $self->SUPER::start_element($elem); } die "\nNo mapping for element: $elem->{Name}"; } sub end_element { my $self = shift; my $elem = shift; if(exists($elem_mapping{$elem->{Name}})) { $elem = { %$elem }; my $mapping = $elem_mapping{$elem->{Name}}; return unless(defined($mapping)); if(ref($mapping)) { return $mapping->($self, end => $elem); } else { $elem->{Name} = $mapping; } return $self->SUPER::end_element($elem); } if(exists($simple_elems{$elem->{Name}})) { return $self->SUPER::end_element($elem); } die "\nNo mapping for element: $elem->{Name}"; } ############################################################################## # Wrapper script to instantiate filter pipeline # package main; use Getopt::Long; use Pod::Usage; use XML::SAX::Machines qw( :all ); # handle command line options our %opt = ( m => {} ); GetOptions(\%opt, 'm=s', 'c', 'p=s', 's=s', 'h') || pod2usage(1); DocBook2SDocBook::add_mappings($opt{m}); pod2usage({-verbose => 2, -exitval => 0}) if($opt{h}); my $src_file = shift || 'perl-xml-faq.xml'; # filter the document my $filter = DocBook2SDocBook->new(); Pipeline($filter => \*STDOUT)->parse_uri($src_file); print "\n"; exit; __END__ =head1 NAME db2sbd.pl - converts from DocBook XML to Simplified DocBook =head1 SYNOPSIS db2sbd.pl <options> <filename> Options: -m x=y map <x> to <y>, 'x' will be skipped if 'y' not supplied -c keep comments (default action is to strip them out) -p override default PublicId -s override default SystemId (point to your local DTD copy) -h help - display the full documentation =head1 DESCRIPTION This script is a bit of a quick hack for converting a DocBookX (XML) document (specifically a E<lt>qandasetE<gt>) to Simplified DocBook. The original motivation being to integrate the Perl-XML FAQ document into a site built using Simplified DocBook with some pre-existing XSLT stylesheets. The code might be useful as a base for implementing similar translations. The DB to SDB element mappings are defined in a hash. A simple mapping from one element name to another looks like this: 'qandadiv' => 'section', An element which should simply be skipped, can be mapped to 'nothing' like this: 'qandaset' => undef, A more complex mapping can be achieved using a code reference: 'para' => sub { some clever code with conditionals etc }, The code will be called for both start_element() and end_element() events and will be passed three parameters: my($self, $context, $elem) = @; The 'context' is a string containing 'start' or 'end'. =head1 SEE ALSO This script uses the following modules: XML::SAX(::Base) XML::SAX::Machines XML::SAX::Writer =head1 AUTHOR Grant McLean <gr...@cp...> =head1 COPYRIGHT Copyright (c) 2002 Grant McLean. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut |