# = HISTORY SECTION =====================================================================
# ---------------------------------------------------------------------------------------
# version | date | author | changes
# ---------------------------------------------------------------------------------------
# 0.04 |03.05.2006| JSTENZEL | added string2XMLObject();
# 0.03 |25.02.2006| JSTENZEL | empty XML tags now produced as <tag></tag>, as Opera
# | | | and Firefox failed to handle <tag />;
# 0.02 |01.01.2006| JSTENZEL | high bit characters are transformeds into entities now;
# 0.01 |18.08.2003| JSTENZEL | new.
# ---------------------------------------------------------------------------------------
# = POD SECTION =========================================================================
=head1 NAME
B<PerlPoint::Generator::XML> - generic XML generator
=head1 VERSION
This manual describes version B<0.04>.
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 METHODS
=cut
# check perl version
require 5.00503;
# = PACKAGE SECTION (internal helper package) ==========================================
# declare package
package PerlPoint::Generator::XML;
# declare package version
$VERSION=0.04;
$AUTHOR=$AUTHOR='J. Stenzel (perl@jochen-stenzel.de), 2003-2006';
# = PRAGMA SECTION =======================================================================
# set pragmata
use strict;
# inherit from base generator class
use base qw(PerlPoint::Generator);
# declare your fields (the _perlbug field is a workaround, obviously Perl 5.8.0 is buggy
# when it treats the first field entry as a PerlPoint::Backend object)
use fields qw(
_perlbug
flags
xml
xmlplain
xmlready
xmlmode
);
# = LIBRARY SECTION ======================================================================
# load modules
use Carp;
use XML::Generator;
use File::Basename;
use PerlPoint::Constants;
use PerlPoint::Tags::XML;
# = CODE SECTION =========================================================================
# precompile patterns
my $patternTagTrans=qr(^([-\w]+):([-\w]+)$);
# declare XML tags (TODO: should it become part of the object so that derived classes
# can access and adapt it?)
my %xmltags=(
# document root and other structures
__root => 'presentation',
__docdata => 'docdata',
__slides => 'slides',
__slide => 'slide',
# document data (meta data)
_title => 'title',
_author => 'author',
_description => 'description',
# paragraph entities
headline => 'headline',
text => 'text',
example => 'example',
ulist => 'ulist',
olist => 'olist',
dlist => 'dlist',
dlistitem => 'item',
dlistdefinition => 'definition',
upoint => 'upoint',
opoint => 'opoint',
dpointitem => 'item',
dpointtext => 'definition',
dstreamentry => 'dstreamentry',
dstreamframe => 'dstreamframe',
# helper entities
indexgroup => 'indexgroup',
indexphrase => 'indexphrase',
indexoccurence => 'link',
# complex tags
A => 'anchor',
IMAGE => 'img',
INDEX => 'index',
L => 'link',
PAGEREF => 'link',
REF => 'link',
SECTIONREF => 'link',
SEQ => 'sequence',
X => 'indexentry',
XREF => 'link',
# table tags
TABLE => 'table',
TABLE_ROW => 'tablerow',
TABLE_COL => 'tablecol',
TABLE_HL => 'tablehl',
# simple tags
B => 'strong',
C => 'code',
E => 'escaped',
I => 'em',
U => 'underlined',
);
=pod
=head2 new()
B<Parameters:>
=over 4
=item class
The class name.
=back
B<Returns:> the new object.
B<Example:>
=cut
sub new
{
# get parameter
my ($class, %params)=@_;
# check parameters
confess "[BUG] Missing class name.\n" unless $class;
confess "[BUG] Missing style type parameter.\n" unless exists $params{formatter};
confess "[BUG] This method should be called via its own package only.\n" unless $class eq __PACKAGE__;
# try to load the style type class
my $pluginClass=join('::', $class, $params{formatter});
eval "require $pluginClass" or die "[Fatal] Missing plugin $pluginClass, please install it ($@).\n";
die $@ if $@;
# build an object of the *plugin* class and check it
my __PACKAGE__ $plugin=$pluginClass->new(%params);
confess "[BUG] $pluginClass does not inherit from ", __PACKAGE__, ".\n" unless $plugin->isa(__PACKAGE__);
# prepare and add a pretty printing XML generator ...
$plugin->{cfg}{xml}{pretty}=2 unless exists $plugin->{cfg}{xml}{pretty};
$plugin->{xml}=new XML::Generator(
escape => 'always,high-bit',
pretty => $plugin->{cfg}{xml}{pretty},
empty => 'close',
conformance => 'strict',
);
# and a second one for examples ... usually without pretty printing to keep the structure
$plugin->{xmlplain}=new XML::Generator(
escape => 'always,high-bit',
pretty => $plugin->{cfg}{xml}{prettyPlain},
empty => 'close',
conformance => 'strict',
);
# and a third one for embedded XML which does not need to be escaped furtherly
$plugin->{xmlready}=new XML::Generator(
escape => 0,
pretty => $plugin->{cfg}{xml}{prettyPlain},
empty => 'close',
conformance => 'strict',
);
# by default, we use the pretty printing generator
$plugin->{xmlmode}='xml';
# supply new object
$plugin;
}
# provide option declarations
sub declareOptions
{
# get and check parameters
(my __PACKAGE__ $me)=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
# start with the base options
$me->readOptions($me->SUPER::declareOptions);
(
# new options
[
"tagtrans=s@", # a tag transformation/translation spec;
"writedtd", # writes the DTD to the file specified by -xmldtd;
"xmldtd=s", # DTD,
"xmldoctypeid=s", # DOCTYPE specifier: external id,
],
# there is no base option that we ignore
[],
);
}
# provide help portions
sub help
{
# get and check parameters
(my __PACKAGE__ $me)=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
# to get a flexible tool, help texts are supplied in portions
{
# supply the options part
OPTIONS => {
tagtrans => <<EOO,
This PerlPoint/XML converter uses an own DTD. (If you need a copy of the DTD, please try
C<-writedtd>). As usual, a DTD is only useful if an application can handle it, so you might
want to transform the generated XML to another DTD. This can be done using XSLT or the like,
but in simple cases all you need is just a tag translation, which is provided by this option.
C<-targtrans> takes a string argument of the form <original PP tag name>:<new tag name> to
replace the I<original PP tag name> by the I<new tag name>.
Example: -tagtrans headline:h1
As you can see, this is a simple name/name translation. Tag options cannot be taken into
account yet, as this would need more detailed transformation rules.
For a list of valid original tag names, please use C<-writedtd>.
The option can be used multiply.
Note: C<-tagtrans> adaptations will be taken into account by C<-writedtd>.
EOO
writedtd => <<EOO,
The XML produced by this converter belongs to a special DTD which is specified internally.
A copy of the current DTD is written to a file if this option is used. The name of the
DTD file should be specified by C<-xmldtd>.
Example: -writedtd -xmldtd ppdoc.dtd
Note: an output file already existing will be overwritten, take care.
EOO
xmldtd => <<EOO,
specifies the DTD to use. If used with C<-writedtd>, the argument specifies the DTD file
to I<write>.
Example: -xmldtd ppdoc.dtd
Note: currently, this option takes no effect without C<-writedtd>.
EOO
xmldoctypeid => <<EOO,
specifies the document type id.
Note: currently, this option is reserved for future use and has no impact.
EOO
},
# supply synopsis part
SYNOPSIS => <<EOS,
In your case, you want to produce XML.
EOS
};
}
# provide source filter declarations
sub sourceFilters
{
# get and check parameters
(my __PACKAGE__ $me)=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
# get the common parent class list, add a few items and provide the result
(
$me->SUPER::sourceFilters, # parent class list
"xml", # embedded XML;
);
}
# check usage
sub checkUsage
{
# get and check parameters
(my __PACKAGE__ $me)=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
# don't forget the base class
$me->SUPER::checkUsage;
# check DOCTYPE options
if (exists $me->{options}{writedtd} and not exists $me->{optionlist}[1]{writedtd})
{
confess "[BUG] Missing option -xmldtd.\n" unless exists $me->{options}{xmldtd} or exists $me->{optionlist}[1]{xmldtd};
}
# confess "[BUG] Missing option -xmldoctypeid.\n" unless exists $me->{options}{xmldoctypeid} or exists $me->{optionlist}[1]{xmldoctypeid}; # reserved for future use
# check tag translation options
if (exists $me->{options}{tagtrans})
{
# scopy
my ($error, $counter)=(0, 0);
# perform check
foreach my $option (@{$me->{options}{tagtrans}})
{
# check format
unless ($option=~/$patternTagTrans/)
{
$error=1;
warn qq([Error] Wrong format in option "-tagtrans $option": use "<PerlPoint tag>:<XML tag>".\n);
}
else
{
# check tag
warn (qq([Warn] Unknown PerlPoint tag "$1" in option "-tagtrans $option" ignored.)),
splice(@{$me->{options}{tagtrans}}, $counter, 1)
unless exists $xmltags{$1};
}
# update counter
$counter++;
}
# all right?
die "\n" if $error;
}
# being here means that the check succeeded
1;
}
sub bootstrap
{
# get and check parameters
(my __PACKAGE__ $me)=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
# don't forget the base class
$me->SUPER::bootstrap;
# take tag translations
my $error=0;
foreach my $option (@{$me->{options}{tagtrans}})
{
# check format, extract parts
unless ($option=~/$patternTagTrans/)
{die qq([Error] Wrong format in targ translation "$option": use "<PerlPoint tag>:<XML tag>".\n);}
else
{
# check tag
warn (qq([Warn] Unknown PerlPoint tag "$1" in tag translation "$option".\n)),
$error=1,
unless exists $xmltags{$1};
}
# store translation
$xmltags{$1}=$2;
}
#check success
die "\n" if $error;
# write DTD, if requested
if (exists $me->{options}{writedtd})
{
# open DTD
open(DTD, ">$me->{options}{xmldtd}") or die "[Fatal] Could not open DTD file $me->{options}{xmldtd} for writing: $!";
# get template
my $template=join('', <DATA>);
# transform it to the current tag names
$template=~s/=$_=/$xmltags{$_}/g for keys %xmltags;
# write DTD
print DTD $template;
# close DTD
close(DTD);
}
}
# formatters
sub preFormatter
{
# get and check parameters
((my __PACKAGE__ $me), my ($opcode, $mode, @more))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
# invoke base class method, if necessary
$me->SUPER::preFormatter() if $me->can('SUPER::preFormatter');
# embed tag?
if ($opcode==DIRECTIVE_TAG and $more[0] eq 'EMBED')
{
# get more parameters
my ($tag, $settings)=@more;
# embedded XML configuration
$me->{flags}{xml}=($mode==DIRECTIVE_START) ? 1 : 0 if $settings->{lang}=~/^xml$/i;
}
# a paragraph enforcing plain XML without formatting (newlines added for pretty printing)?
elsif (
$opcode==DIRECTIVE_TEXT
or $opcode==DIRECTIVE_BLOCK
or $opcode==DIRECTIVE_VERBATIM
)
{
# act mode dependend
$me->{xmlmode}=$mode==DIRECTIVE_START ? 'xmlplain' : 'xml';
}
}
sub formatSimple
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# the base operation is to concatenate the parts
my $result=join('', @{$item->{parts}});
# now we have to check for special operations to perform
unless ($me->{flags}{xml})
{
}
# supply result
$result;
}
sub formatHeadline
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{headline};
# build the headline
$me->{xml}->$xmltag(
{
level => $item->{cfg}{data}{level},
full => $item->{cfg}{data}{full},
abbr => $item->{cfg}{data}{abbr},
path => $page->path(type=>'fpath', mode=>'full', delimiter=>'|'),
template => 'dtm',
},
@{$item->{parts}},
);
}
sub formatComment
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# the base operation is to concatenate the parts
$me->{xml}->xmlcmnt(@{$item->{parts}});
}
sub formatText
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{text};
# build option hash
my %options;
$me->injectTagOptions(\%options, $xmltag, $page, $item) if $me->can('injectTagOptions');
# provide the parts, if necessary
(@{$item->{parts}} and grep((defined($_) and $_), @{$item->{parts}}) and "@{$item->{parts}}"=~/\S/) ? $me->{xml}->$xmltag(\%options, @{$item->{parts}}) : ();
}
sub formatBlock
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{example};
# build option hash
my %options;
$me->injectTagOptions(\%options, $xmltag, $page, $item) if $me->can('injectTagOptions');
# provide the parts, take care to begin the example in a *new* line
# (after the tag opener)
$me->{xmlplain}->$xmltag(\%options, "\n", @{$item->{parts}});
}
sub formatVerbatim
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{example};
# build option hash
my %options;
$me->injectTagOptions(\%options, $xmltag, $page, $item) if $me->can('injectTagOptions');
# provide the parts
$me->{xmlplain}->$xmltag(\%options, @{$item->{parts}});
}
# tag formatter
sub formatTag
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# declarations
my ($directive, $xmltag, $result)=('');
# handle the various tags
if ($item->{cfg}{data}{name} eq 'A')
{
# anchor: build result string
$xmltag=$xmltags{A};
confess "[BUG] No tag found" unless $xmltag;
$result=$me->{$me->{xmlmode}}->$xmltag(
{
name => $item->{cfg}{data}{options}{name},
},
@{$item->{parts}},
);
}
elsif ($item->{cfg}{data}{name} eq 'EMBED')
{
# embedded XML
if ($item->{cfg}{data}{options}{lang}=~/^XML$/i)
{
# just concatenate the parts (and supply them as XML::Generator object, not as string)
my $pseudotag="embedded-$item->{cfg}{data}{options}{lang}";
$result=$me->{xmlready}->$pseudotag(@{$item->{parts}});
}
}
elsif ($item->{cfg}{data}{name} eq 'FORMAT')
{
# formatting: all we have to do is to store informations
$result='';
# justification: store what we got
$item->{cfg}{data}{options}{align}=ucfirst(lc($item->{cfg}{data}{options}{align}));
$item->{cfg}{data}{options}{align}='Full' if $item->{cfg}{data}{options}{align} eq 'Justify';
$me->{flags}{align}=$item->{cfg}{data}{options}{align} if $item->{cfg}{data}{options}{align}=~/^(Left|Full|Center|Right)$/;
delete $me->{flags}{align} if $item->{cfg}{data}{options}{align} eq 'Default';
# handle transition settings
if (exists $item->{cfg}{data}{options}{transition})
{
# get setting
my $transition=$item->{cfg}{data}{options}{transition}!~/^reset$/i ? $item->{cfg}{data}{options}{transition} : undef;
# update transition settings for all the items that are listed,
# or in general if no certain item is mentioned
foreach my $target (qw(slides bullets images blocks verbatims))
{
$me->{cfg}{XML}{transition}{$target}=$transition
if not exists $item->{cfg}{data}{options}{items}
or $item->{cfg}{data}{options}{items}=~/(^|(\s*,\s*))$target((\s*,\s*)|$)/i;
}
}
}
elsif ($item->{cfg}{data}{name} eq 'IMAGE')
{
# get a local option copy
my %options=%{$item->{cfg}{data}{options}};
# image: parse image path
my ($base, $path)=fileparse($options{src});
# replace image source path by required reference path
$options{src}="$me->{options}{imageref}/$base";
# get tag name
$xmltag=$xmltags{$item->{cfg}{data}{name}};
# build and init option hash
%options=map {$_, map {/\s/ ? "\"$_\"" : $_} $options{$_}} grep(lc($_)!~/^(__loaderpath__)$/, keys %options);
$me->injectTagOptions(\%options, $xmltag, $page, $item) if $me->can('injectTagOptions');
# build result string
$result=$me->{$me->{xmlmode}}->$xmltag(\%options);
}
elsif ($item->{cfg}{data}{name} eq 'INDEX')
{
# scopies
my (%index);
# index: get data structure
my $anchors=$item->{cfg}{data}{options}{__anchors};
# traverse all groups and build their index
my ($xmlindextag, $xmlentrytag, $xmlgrouptag, $xmloccurencetag)=@xmltags{qw(INDEX indexphrase indexgroup indexoccurence)};
$result=$me->{$me->{xmlmode}}->$xmlindextag(
{
},
map
{
# this is a group
$me->{xml}->$xmlgrouptag(
{
# group name
group => $_,
},
# add all the index entries
map
{
# the list of entries
$me->{xml}->$xmlentrytag(
{
# the phrase
phrase => $_->[0],
},
# the list of occurences is passed by subelements (we need pairs, so attributes do not work ...)
map
{
$me->{xml}->$xmloccurencetag(
{
# attributes describe how to link the reference
type => 'internal',
target => $_->[0],
},
# the reference string
$_->[1],
),
} grep(ref($_), @{$_->[1]}) # TODO: check the structure! Why (doubled) scalars?
),
} @{$anchors->{$_}},
),
} sort keys %$anchors
);
}
elsif ($item->{cfg}{data}{name} eq 'INDEXRELATIONS')
{
# get headline data
my $data=[map {$_->[0]} @{$item->{cfg}{data}{options}{__data}}];
# configure list tag
my ($xmllisttag, $xmlpointtag, $xmlreftag)=($xmltags{$item->{cfg}{data}{options}{format} eq 'enumerated' ? 'olist' : 'ulist'}, $xmltags{$item->{cfg}{data}{options}{format} eq 'enumerated' ? 'opoint' : 'upoint'}, $xmltags{REF});
# write list structure
$result=$me->{$me->{xmlmode}}->span(
# start with an intro, if specified
exists $item->{cfg}{data}{options}{intro} ? $me->{$me->{xmlmode}}->span($item->{cfg}{data}{options}{intro}) : (),
# list of related topics
$me->{$me->{xmlmode}}->$xmllisttag(
map
{
# get page title
my $page=$me->page($_);
my $title=$page->path(type=>'spath', mode=>'title');
$title=join('', (map {"$_."} @{$page->path(type=>'npath', mode=>'array')}), " $title") if $item->{cfg}{data}{options}{format} eq 'numbers';
# build list entry, type dependent (as link or plain string)
$me->{$me->{xmlmode}}->$xmlpointtag($item->{cfg}{data}{options}{type} eq 'linked' ? $me->{$me->{xmlmode}}->$xmlreftag({type=>'internal', target=>join('|', @{$page->path(type=>'spath', mode=>'array')})}, $title) : $title);
} @$data,
)
);
}
elsif ($item->{cfg}{data}{name} eq 'L')
{
# link: build it
$xmltag=$xmltags{$item->{cfg}{data}{name}};
$result=$me->{$me->{xmlmode}}->$xmltag(
{
type => 'external',
target => $item->{cfg}{data}{options}{url},
},
@{$item->{parts}},
);
}
elsif ($item->{cfg}{data}{name} eq 'LOCALTOC')
{
# local toc: subchapters defined?
if (exists $item->{cfg}{data}{options}{__rawtoc__} and @{$item->{cfg}{data}{options}{__rawtoc__}})
{
# get type flag, store it more readable
my $plain=($item->{cfg}{data}{options}{type} eq 'plain');
# make a temporary headline path array copy
my @localHeadlinePath=@{$page->path(type=>'fpath', mode=>'array')};
# prepare a subroutine to build links, if necessary
my $link;
unless ($plain)
{
$link=sub
{
# take parameters
my ($level, $title)=@_;
# update headline path (so that it describes the complete
# path of the future chapter then)
$localHeadlinePath[$level-1]=$title;
# supply the path of the upcoming chapter
$xmltag=$xmltags{REF};
$result=$me->{$me->{xmlmode}}->$xmltag(
{
type => 'internal',
target => join('|',
map {defined($_) ? $_ : ''} @localHeadlinePath[0..$level-1],
),
},
$title,
);
}
}
# use a more readable toc variable
my $toc=$item->{cfg}{data}{options}{__rawtoc__};
# make it a list of the requested format
if ($item->{cfg}{data}{options}{format} eq 'bullets')
{
my ($xmllisttag, $xmlpointtag)=@xmltags{qw(ulist upoint)};
$result=$me->{$me->{xmlmode}}->$xmllisttag(map {$me->{$me->{xmlmode}}->$xmlpointtag($plain ? $_->[1] : $link->(@$_))} @$toc);
}
elsif ($item->{cfg}{data}{options}{format} eq 'enumerated')
{
my ($xmllisttag, $xmlpointtag)=@xmltags{qw(olist opoint)};
$result=$me->{$me->{xmlmode}}->$xmllisttag(map {$me->{$me->{xmlmode}}->$xmlpointtag($plain ? $_->[1] : $link->(@$_))} @$toc);
}
elsif ($item->{cfg}{data}{options}{format} eq 'numbers')
{
# make a temporary headline number array copy
my @localHeadlineNumbers=@{$page->path(type=>'npath', mode=>'array')};
# handle all provided subchapters
my ($xmllisttag, $xmlpointtag)=@xmltags{qw(ulist upoint)};
$result=$me->{$me->{xmlmode}}->$xmllisttag(
map
{
# get level and title
my ($level, $title)=@$_;
# update headline numbering
$localHeadlineNumbers[$level-1]++;
# add point
$me->{$me->{xmlmode}}->$xmlpointtag(
join('.', @localHeadlineNumbers[0..$level-1]), '. ',
$plain ? $title : $link->(@$_),
)
} @$toc
);
}
else
{die "[BUG] Unhandled case $item->{cfg}{data}{options}{format}."}
}
else
{
# oops - there are no subchapters
$result='';
}
}
elsif ($item->{cfg}{data}{name} eq 'REF')
{
# scopies
my ($label, @results);
# catch target
my $target=$item->{cfg}{data}{options}{name};
# get the upcoming chapters data
my @chapters=$me->getChapterByPath($target);
# Anything found? Otherwise search for an anchor of the target name and get its page data
unless ($chapters[0][0])
{
# get value and page
my $data=$me->getAnchorData($target);
# anything found?
if (defined $data)
{
# get chapter data
@chapters=$me->getChapterByPagenr($data->[1]);
# set up local link
$label=$target;
}
}
# build text to display: is there a body?
if ($item->{cfg}{data}{options}{__body__})
{
# yes: the tag body is our text
@results=@{$item->{parts}};
}
else
{
# no body: what we display depends on option "valueformat"
if ($item->{cfg}{data}{options}{valueformat} eq 'pure')
{
# display the value of the requested object
@results=$item->{cfg}{data}{options}{__value__};
}
elsif ($item->{cfg}{data}{options}{valueformat} eq 'pagetitle')
{
# display the objects page title, to be found in target data
@results=$chapters[0][2];
}
elsif ($item->{cfg}{data}{options}{valueformat} eq 'pagenr')
{
# display the objects page number (for more generic or configurable numbers,
# this could be done by a function)
@results=join('.', @{$chapters[0][7]}, '');
}
else
{die "[BUG] Unhandled case $item->{cfg}{data}{options}{valueformat}."}
}
# transform results into a scalar
$result=join('', @results);
# if we do not build a link, we are already done now, otherwise, we have to
# add link syntax
if ($item->{cfg}{data}{options}{type} eq 'linked')
{
# get the tag name
$xmltag=$xmltags{$item->{cfg}{data}{name}};
# build target chapter file name, using the absolute page number
my $link=$me->_buildFilename($chapters[0][0]);
# add lokal link, if necessary
$link=join('#', $link, $label) if $label;
# now build the link
$result=$me->{$me->{xmlmode}}->$xmltag(
{
type => 'internal',
target => $link,
},
$result,
);
}
}
elsif ($item->{cfg}{data}{name} eq 'SEQ')
{
# sequence: just pass the coordinates
$xmltag=$xmltags{$item->{cfg}{data}{name}};
$result=$me->{$me->{xmlmode}}->$xmltag(
{
type => $item->{cfg}{data}{options}{type},
exists $item->{cfg}{data}{options}{name} ? (name => $item->{cfg}{data}{options}{name}) : (),
},
$item->{cfg}{data}{options}{__nr__},
);
}
elsif ($item->{cfg}{data}{name} eq 'TABLE')
{
# build the table
$xmltag=$xmltags{$item->{cfg}{data}{name}};
$result=$me->{$me->{xmlmode}}->$xmltag(
{
maxcols => $item->{cfg}{data}{options}{__maxColumns__},
},
@{$item->{parts}}
);
}
elsif ($item->{cfg}{data}{name} eq 'TABLE_ROW')
{
# build the row
$xmltag=$xmltags{$item->{cfg}{data}{name}};
$result=$me->{$me->{xmlmode}}->$xmltag(
{
},
@{$item->{parts}}
);
}
elsif ($item->{cfg}{data}{name} eq 'TABLE_COL')
{
# build the cell
$xmltag=$xmltags{$item->{cfg}{data}{name}};
$result=$me->{$me->{xmlmode}}->$xmltag(
{
},
@{$item->{parts}}
);
}
elsif ($item->{cfg}{data}{name} eq 'TABLE_HL')
{
# build the cell
$xmltag=$xmltags{$item->{cfg}{data}{name}};
$result=$me->{$me->{xmlmode}}->$xmltag(
{
},
@{$item->{parts}}
);
}
elsif ($item->{cfg}{data}{name} eq 'X')
{
# index entry: transform it
$xmltag=$xmltags{$item->{cfg}{data}{name}};
$result=$me->{$me->{xmlmode}}->$xmltag(
{
name => $item->{cfg}{data}{options}{__anchor},
},
(exists $item->{cfg}{data}{options}{mode} and lc($item->{cfg}{data}{options}{mode}) eq 'index_only') ? () : @{$item->{parts}},
);
}
elsif (exists $xmltags{$item->{cfg}{data}{name}})
{
# a "simple" tag
$xmltag=$xmltags{$item->{cfg}{data}{name}};
$result=$me->{$me->{xmlmode}}->$xmltag(@{$item->{parts}});
}
else
{
# unknown tag, ignore it (but take care to supply an XML::Generator object, not a string)
my $pseudotag="UnknownTag-$item->{cfg}{data}{name}";
$result=$me->{$me->{xmlmode}}->$pseudotag(@{$item->{parts}});
}
# supply result
# warn $result;
$result;
}
# upoint formatter
sub formatUpoint
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{upoint};
# build option hash
my %options;
$me->injectTagOptions(\%options, $xmltag, $page, $item) if $me->can('injectTagOptions');
# provide the parts
$me->{xml}->$xmltag(\%options, @{$item->{parts}});
}
# dpoint item formatter
sub formatDpointItem
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{dpointitem};
# provide the parts
$me->{xml}->$xmltag(@{$item->{parts}});
}
# dpoint text formatter
sub formatDpointText
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{dpointtext};
# provide the parts
$me->{xml}->$xmltag(@{$item->{parts}});
}
# dpoint formatter
sub formatDpoint
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# provide the parts *without envelope as its parts are already structured*
(@{$item->{parts}});
}
# upoint formatter
sub formatOpoint
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{opoint};
# build and init option hash
my %options;
$me->injectTagOptions(\%options, $xmltag, $page, $item) if $me->can('injectTagOptions');
# provide the parts
$me->{xml}->$xmltag(\%options, @{$item->{parts}});
}
sub formatUlist
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{ulist};
# provide the parts
$me->{xml}->$xmltag(@{$item->{parts}});
}
sub formatOlist
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{olist};
my %options=(exists $item->{cfg}{options} and exists $item->{cfg}{options}{start} and $item->{cfg}{options}{start}) ? (start => $item->{cfg}{options}{start}) : ();
# provide the parts
$me->{xml}->$xmltag(\%options, @{$item->{parts}});
}
sub formatDlist
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless defined $item;
# get the tag name
my $xmltag=$xmltags{dlist};
# provide the parts
$me->{xml}->$xmltag(@{$item->{parts}});
}
# docstream entry formatter
sub formatDStreamEntrypoint
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless $item;
# get the tag name
my $xmltag=$xmltags{dstreamentry};
# provide the parts
$me->{xml}->$xmltag(
{
name => $item->{cfg}{data}{name},
},
@{$item->{parts}}
);
}
# docstream frame formatter
sub formatDStreamFrame
{
# get and check parameters
((my __PACKAGE__ $me), my ($page, $item))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing page data parameter.\n" unless $page;
confess "[BUG] Missing item parameter.\n" unless $item;
# get the tag name
my $xmltag=$xmltags{dstreamframe};
# provide the parts
$me->{xml}->$xmltag(@{$item->{parts}});
}
sub elementName
{
# get and check parameters
((my __PACKAGE__ $me), my ($name, $check))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing XML element name parameter.\n" unless $name;
confess qq([BUG] Invalid XML element name parameter "$name".\n) unless exists $xmltags{$name} or $check=1;
# if this is a trial, return an undefined value in case the element is unknown
return undef unless exists $xmltags{$name};
# provide the name of the XML element
$xmltags{$name};
}
# convert a plain string into an XML::Generator object
# (the strings should contain valid XML)
sub string2XMLObject
{
# get and check parameters
((my __PACKAGE__ $me), my (@strings))=@_;
confess "[BUG] Missing object parameter.\n" unless $me;
confess "[BUG] Object parameter is no ", __PACKAGE__, " object.\n" unless ref $me and $me->isa(__PACKAGE__);
confess "[BUG] Missing strings parameter.\n" unless @strings;
# tranformation is done by a trick
my $dummytag="DUMMYTAG$$";
my $xmlobject=$me->{xmlready}->$dummytag(join('', @strings));
@$xmlobject=map {/^<\/?$dummytag>$/ ? () : $_} @$xmlobject;
$xmlobject;
}
# flag successful loading
1;
# = POD TRAILER SECTION =================================================================
=pod
=head1 NOTES
=head1 SEE ALSO
=over 4
=back
=head1 SUPPORT
A PerlPoint mailing list is set up to discuss usage, ideas,
bugs, suggestions and translator development. To subscribe,
please send an empty message to perlpoint-subscribe@perl.org.
If you prefer, you can contact me via perl@jochen-stenzel.de
as well.
=head1 AUTHOR
Copyright (c) Jochen Stenzel (perl@jochen-stenzel.de), 2003-2004.
All rights reserved.
This module is free software, you can redistribute it and/or modify it
under the terms of the Artistic License distributed with Perl version
5.003 or (at your option) any later version. Please refer to the
Artistic License that came with your Perl distribution for more
details.
The Artistic License should have been included in your distribution of
Perl. It resides in the file named "Artistic" at the top-level of the
Perl source tree (where Perl was downloaded/unpacked - ask your
system administrator if you dont know where this is). Alternatively,
the current version of the Artistic License distributed with Perl can
be viewed on-line on the World-Wide Web (WWW) from the following URL:
http://www.perl.com/perl/misc/Artistic.html
=head1 DISCLAIMER
This software is distributed in the hope that it will be useful, but
is provided "AS IS" WITHOUT WARRANTY OF ANY KIND, either expressed or
implied, INCLUDING, without limitation, the implied warranties of
MERCHANTABILITY and FITNESS FOR A PARTICULAR PURPOSE.
The ENTIRE RISK as to the quality and performance of the software
IS WITH YOU (the holder of the software). Should the software prove
defective, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
CORRECTION.
IN NO EVENT WILL ANY COPYRIGHT HOLDER OR ANY OTHER PARTY WHO MAY CREATE,
MODIFY, OR DISTRIBUTE THE SOFTWARE BE LIABLE OR RESPONSIBLE TO YOU OR TO
ANY OTHER ENTITY FOR ANY KIND OF DAMAGES (no matter how awful - not even
if they arise from known or unknown flaws in the software).
Please refer to the Artistic License that came with your Perl
distribution for more details.
=cut
# the DATA section contains the DTD
__DATA__
<?xml version="1.0" encoding="UTF-8"?>
<!ELEMENT =__root= (=__docdata=, =__slides=)>
<!ELEMENT =__docdata= (=_author=, =_title=)>
<!ELEMENT =_author= (#PCDATA)>
<!ELEMENT =_title= (#PCDATA)>
<!ELEMENT =__slides= (=__slide=+)>
<!ELEMENT =__slide= (=headline= | =text= | =example= | =TABLE= | =ulist= | =olist= | =dlist= | %standalonetag;)+>
<!ENTITY % standalonetag "=IMAGE= | =INDEX=">
<!ELEMENT =IMAGE= EMPTY>
<!ATTLIST =IMAGE=
src CDATA #REQUIRED
>
<!ELEMENT =INDEX= (=indexgroup=+)>
<!ELEMENT =indexgroup= (=indexphrase=+)>
<!ATTLIST =indexgroup=
group CDATA #REQUIRED
>
<!ELEMENT =indexphrase= (=indexoccurence=+)>
<!ATTLIST =indexphrase=
phrase CDATA #REQUIRED
>
<!ENTITY % tag "=A= | =B= | =C= | =I= | =L= | =SEQ= | =X=">
<!ELEMENT =L= (#PCDATA | %tag;)*>
<!ATTLIST =L=
target CDATA #REQUIRED
type CDATA #REQUIRED
>
<!ELEMENT =B= (#PCDATA | %tag;)*>
<!ELEMENT =C= (#PCDATA | %tag;)*>
<!ELEMENT =I= (#PCDATA | %tag;)*>
<!ELEMENT =X= (#PCDATA)>
<!ATTLIST =X=
name CDATA #REQUIRED
>
<!ELEMENT =headline= (#PCDATA)>
<!ATTLIST =headline=
abbr CDATA #REQUIRED
level CDATA #REQUIRED
template CDATA #REQUIRED
path CDATA #REQUIRED
full CDATA #REQUIRED
>
<!ELEMENT =text= (#PCDATA | %tag;)*>
<!ENTITY % list "=ulist= | =olist= | =dlist=">
<!ELEMENT =ulist= (=upoint=+)>
<!ELEMENT =upoint= (#PCDATA | %tag;)*>
<!ELEMENT =olist= (=opoint=+)>
<!ELEMENT =opoint= (#PCDATA | %tag;)*>
<!ELEMENT =dlist= (=dlistitem= | =dlistdefinition=)*>
<!ELEMENT =dlistitem= (#PCDATA | %tag;)*>
<!ELEMENT =dlistdefinition= (#PCDATA | %tag;)*>
<!ELEMENT =example= (#PCDATA | %tag;)*>
<!ELEMENT =TABLE= (=TABLE_ROW=+)>
<!ATTLIST =TABLE=
maxcols CDATA #REQUIRED
>
<!ELEMENT =TABLE_ROW= (=TABLE_HL=+ | =TABLE_HL=+)>
<!ELEMENT =TABLE_COL= (#PCDATA | %tag;)*>
<!ELEMENT =TABLE_HL= (#PCDATA)>