[perl-xml-cvs] CVS: perl-xml-faq db2sdb.pl,NONE,1.1

SourceForge Headquarters 1320 Columbia Street Suite 310 San Diego, CA 92101 +1 (858) 422-6466

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   => \&section_elem,
  qandaentry => \&section_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

=cut