# -*-perl-*-
# $Id: html.wrt 6435 2010-10-01 21:41:54Z mnodine $
# Copyright (C) 2002-2005 Freescale Semiconductor, Inc.
# Distributed under terms of the Perl license, which is the disjunction of
# the GNU General Public License (GPL) and the Artistic License.
# Writer for html files
=pod
=begin reST
=begin Description
This writer creates HTML output.
It uses the following output defines:
-W attribution=<dash|parentheses|parens|none>
Specifies how the attribution of a block quote
is to be formatted (default is 'dash').
-W body-attr=<text> Specifies attributes to be passed to the <body>
tag (default is '').
-W body-only[=<0|1>] Only the contents of the HTML body tag are output.
Default is 0 unless specified with no value.
-W cloak-email-addresses[=<0|1>]
Enables cloaking of email addresses to keep
spambots from harvesting email addresses.
Default is 0.
-W colspecs[=<0|1>] Output colgroup width sections in tables based upon
the relative widths of the table columns in the
source. Default is 1.
-W embed-stylesheet[=<0|1>]
Embed the primary stylesheet verbatim in the
HTML output if possible. Stylesheets with
http: URLs are not embeddable. If prest is
installed with no default URL specified, the
default stylesheet is always embedded. Default
is 0.
-W enum-list-prefixes[=<0|1>]
Specify whether to keep information on prefixes
and suffixes of enumerated lists in the output;
can be used to specify styles based upon the prefix
and suffix attributes. Default is 0.
-W field-colon[=<0|1>]
Specify whether a field-name should be followed
by a colon. Such a colon can be supplied by a
style sheet, but this option is retained for
backward compatibility. Default is 1.
-W field-limit=<num> Specify the maximum width (in characters) for
field names in field lists. Longer fields will
span an entire row of the table used to render
the field list. Default is 14 characters.
-W footnote-backlinks=<0|1>
Enable backlinks from footnotes and citations
to their references if 1 (default is 1).
-W footnote-references=<superscript|brackets>
Format for footnote references. Default is
"superscript".
-W html-prolog=<0|1>
Generate file prolog for XHTML if 0 or
HTML if 1 (default is 0).
-W image-exts=<ext-list>
A comma-separated list of "ext1=ext2" pairs where
any URI with extension ext1 has it mapped to ext2.
This option allows using a single document
source with multiple writers by using whatever
figure extension is appropriate for a given writer.
(Deprecated: use "-D image-exts=" instead.)
-W link-target=<expr> An expression that determines what the target
frame will be in link references. The
link URL is available in ``$_`` so that the
target frame can depend upon the URL
(default is "").
-W option-limit=<num> Specify the maximum width (in characters) for
options in option lists. Longer options will
span an entire row of the table used to render
the option list. Default is 14 characters.
-W stylesheet[=<0|URL|file>]
Specify a URL or file for the primary stylesheet
in the HTML header, or 0 or 'none' to omit the
primary stylesheet. A file or "file:" URL
should be either a full path or a path relative
to where the HTML file will be served. The
stylesheet will be a link unless
-W embed-stylesheet is specified and the
stylesheet is embeddable. Defaults to
"${Text::Restructured::PrestConfig::DEFAULTCSS}"
-W stylesheet2=file
Specify a file to be embedded in the HTML
header as a secondary stylesheet.
-W target-tag=<a|span>
The HTML tag to use for target definitions (default
is "a").
=end Description
=end reST
=cut
sub BEGIN = {
# My -W flags
use vars qw($attribution $body_attr $body_only
$cloak_email_addresses $colspecs $embed_stylesheet
$enum_list_prefixes $field_colon $field_limit
$footnote_backlinks $footnote_references $html_prolog
$image_exts $link_target $option_limit $stylesheet
$stylesheet2 $target_tag);
# Static globals
use vars qw($DOM);
*DOM = \'Text::Restructured::DOM'; #';
# Run-time globals
use vars qw($HAS_CONTENTS $TARGET_FRAME $FOOTER $HEADER @HEAD @HEAD_INFO
%IMAGE_EXTS $IMAGE_EXT_RE %USED_DEFAULT $DOCTYPE $DOCDOM);
# Defaults for -W flags
$attribution = 'dash' unless defined $attribution;
$body_attr = '' unless defined $body_attr;
$cloak_email_addresses = '' unless defined $cloak_email_addresses;
$colspecs = 1 unless defined $colspecs;
# Note: $stylesheet will be 'none' only if DEFAULTCSS is
$stylesheet = '' unless defined $stylesheet;
$stylesheet = $stylesheet =~ /^(0|none)$/i ? 0 :
$stylesheet ? $stylesheet :
$Text::Restructured::PrestConfig::DEFAULTCSS;
my $embeddable = $stylesheet && $stylesheet !~ /^http:/;
$embed_stylesheet = $stylesheet =~ /^none$/ ||
$embed_stylesheet && $embeddable;
$field_colon = 1 unless defined $field_colon;
$field_limit = 14 unless defined $field_limit;
$footnote_backlinks = 1 unless defined $footnote_backlinks;
$footnote_references = 'superscript'
unless defined $footnote_references;
$html_prolog = 0 unless defined $html_prolog;
$link_target = "''" unless defined $link_target;
$option_limit = 14 unless defined $option_limit;
$target_tag = "a" unless defined $target_tag;
$image_exts = '' unless defined $image_exts;
%IMAGE_EXTS = split /[,=]/, $image_exts;
$IMAGE_EXT_RE = join '|', map("\Q$_", keys %IMAGE_EXTS);
$DOCTYPE = $html_prolog ? << "EOPROLOG1" : << "EOPROLOG2" ;
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.0 Transitional//EN">
EOPROLOG1
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
EOPROLOG2
;
}
# Creates a default HTML string
sub Default {
my ($dom, $str) = @_;
my $attr = GetAttr($dom);
my $tag = $dom->tag;
if (($dom->{attr}{'xml:space'} || '') eq 'preserve') {
$str = qq(<pre class="$tag">$str</pre>\n\n);
}
my $newstr = "<$tag$attr>$str</$tag>";
# Annotate the DOM with our content string
$dom->{_html}{str} = $str;
return $newstr;
}
# Creates a string from a reference to an attribute hash. Attribute
# values may be either scalars or array references.
# Arguments: hash reference
# Returns: string
sub MakeAttrList {
my ($attr) = @_;
return '' unless defined $attr && %$attr;
# Quote "
grep ref($attr->{$_}) eq 'ARRAY' ?
grep(s/\"/"/g, @{$attr->{$_}}) :
defined $attr->{$_} && $attr->{$_} =~ s/\"/"/g, keys %$attr;
# Force ids to be unique
my $id = $attr->{id};
if ($id && $DOCDOM->{_html}{ids}{$id}++) {
my $ids_hr = $DOCDOM->{_html}{ids};
my $sfx;
for ($sfx = '0001'; $ids_hr->{"$id-$sfx"}; $sfx++) {
}
my $new_id = "$id-$sfx";
$attr->{id} = $new_id;
$ids_hr->{$new_id} = 1;
}
return ' ' . join(' ', map($_ . (! defined $attr->{$_} ? '' :
ref($attr->{$_}) eq 'ARRAY' ?
qq(="@{$attr->{$_}}") :
qq(="$attr->{$_}")),
sort keys %$attr));
}
# Returns the attribute string for a DOM based upon its attr and _html,attr
# elements.
# Arguments: DOM object
# Returns: string
sub GetAttr {
my ($dom) = @_;
# The only thing taken from attr is {classes}, which is translated to
# 'class' under {_html}.
$dom->{_html}{attr}{class} = $dom->{attr}{classes}
if $dom->{attr}{classes} && @{$dom->{attr}{classes}};
my $attr_list = $dom->{_html}{attr} ?
MakeAttrList(\%{$dom->{_html}{attr}}) : '';
delete $dom->{_html}{attr}{class};
return $attr_list;
}
# Returns all the "paragraphs" from the DOM's contents (everything except
# comments, targets, substitution_definitions
# Arguments: DOM object
# Returns: list of DOM objects
sub Paras {
my ($dom) = @_;
grep($_->tag !~ /^(comment|target|substitution_definition)$/,
$dom->contents);
}
# Encodes HTML-specific characters
# Arguments: string
# Returns: substituted string
sub EncodeHTML {
my ($s) = @_;
$s =~ s/&/&/g;
$s =~ s/</</g;
$s =~ s/>/>/g;
# uncoverable statement count:2 note:Must be Devel::Cover bug
# uncoverable statement count:3 note:Must be Devel::Cover bug
# uncoverable statement count:4 note:Must be Devel::Cover bug
$s =~ s/[\xa0\xc2]/ /g;
# $s =~ s/\"/"/g; ######## FIX
$s =~ s/\@/&\#64;/g; ######## FIX
return $s;
}
# Removes markup that interferes with title display
# Arguments: string
# Returns: sanitized string
sub SanitizeTitle {
my ($s) = @_;
chomp $s;
$s =~ s!</?\w.*?>!!g;
return $s;
}
# This phase fixes all the attribute values to have characters that are
# safe for HTML files
phase FIXATTR {
sub .* = { # FIXATTR
my ($dom, $str) = @_;
my $attr;
foreach $attr (keys %{$dom->{attr}}) {
# uncoverable branch false count:2 note:guards against bug
if (ref($dom->{attr}{$attr}) eq 'ARRAY') {
@{$dom->{attr}{$attr}} =
map(EncodeHTML($_), @{$dom->{attr}{$attr}});
}
elsif (defined $dom->{attr}{$attr}) {
$dom->{attr}{$attr} =
EncodeHTML($dom->{attr}{$attr});
}
}
$DOCDOM = $dom if $dom->tag eq 'document';
return;
}
}
# This phase preprocesses the file.
phase PREPROCESS {
sub \#PCDATA = { # PREPROCESS
my ($dom) = @_;
my $parent = $dom->parent;
return $parent->tag eq 'raw' ? $dom->{text} :
EncodeHTML($dom->{text});
}
sub document = { # PREPROCESS
my ($dom) = @_;
my $nesting = 0;
# Compute the nesting levels for titles
$dom->Recurse
(sub {
my ($dom, $when) = @_;
if ($dom->tag eq 'section') {
$nesting += $when eq 'pre' ? 1 : -1;
}
elsif ($dom->tag eq 'title') {
$dom->{_html}{nesting} = $nesting;
}
return 0;
}, 'both');
my $target_frame = "sub { (\$_)=\@_; $link_target}";
$TARGET_FRAME = eval($target_frame);
die "Cannot parse link target $link_target: $@" if $@;
return;
}
sub docinfo = { # PREPROCESS
my ($dom, $str) = @_;
# Flatten Authors if it exists
$dom->Reshape(sub {
my ($dom) = @_;
return $dom->contents if ($dom->tag eq 'authors');
return $dom;
});
return;
}
sub author|date|organization|copyright = { # PREPROCESS
my ($dom, $str) = @_;
chomp $str;
my $headstr = $str;
$headstr =~ s/\n/ /g;
# Remove any HTML tags within it
$headstr =~ s/<[^>]*>//g;
push (@HEAD_INFO, [$dom->tag, $headstr]);
return $str;
}
sub meta = { # PREPROCESS
my ($dom) = @_;
my $attr = MakeAttrList($dom->{attr});
push (@HEAD_INFO, "<meta$attr />\n");
return;
}
sub reference = { # PREPROCESS
my ($dom, $str) = @_;
chomp $str;
#### FIX
use vars qw($FIRST_REFERENCE);
push (@{$dom->{attr}{classes}}, 'first', 'last')
if ! $FIRST_REFERENCE++;
return;
}
sub authors = { # PREPROCESS
return;
}
sub literal = { # PREPROCESS
my ($dom, $str) = @_;
PreprocessLiteral($dom);
return;
sub PreprocessLiteral {
my ($dom) = @_;
my $child;
foreach $child ($dom->contents) {
if ($child->tag eq '#PCDATA') {
my $str = $child->{val};
$str =~ s|(\s+)|</span>$1<span class="pre">|g;
$str =~ s/( +) /(" " x length($1)) . " "/ge;
$child->{val} = qq(<span class="pre">$str</span>);
}
elsif ($child->tag eq 'literal') {
$child->{_html}{txt} = $child->{lit};
}
else {
PreprocessLiteral($child);
}
}
}
}
sub (?:doctest|literal)_block = { # PREPROCESS
my ($dom, $str) = @_;
# Go through the children recursively
my $s = TraverseLiteral($dom);
# Get rid of my children
$dom->replace;
return $s;
sub TraverseLiteral {
my ($dom) = @_;
my $str;
my $child;
foreach $child ($dom->contents) {
$str .= EncodeHTML($child->{text});
}
return $str;
}
}
sub list_item = { # PREPROCESS
my ($dom, $str) = @_;
# Compute whether we're simple or not
my @children = Paras($dom);
pop @children if @children && $children[0]->tag eq 'paragraph' &&
$children[-1]->tag =~ /_list$/ && $children[-1]{_html}{simple};
$dom->{_html}{simple} = (@children < 2);
return Default($dom, $str);
}
sub definition|field_body|description|entry = { # PREPROCESS
my ($dom, $str) = @_;
my @paras = Paras($dom);
if (@paras > 1) {
push @{$paras[0]{attr}{classes}}, 'first';
push @{$paras[-1]{attr}{classes}}, 'last';
}
return Default($dom, $str);
}
sub (?:bullet|enumerated)_list = { # PREPROCESS
my ($dom, $str) = @_;
my $parent = $dom->parent;
# I'm simple if all my list_item children are simple.
$dom->{_html}{simple} = 1;
my $li;
foreach $li ($dom->contents) {
if (! $li->{_html}{simple}) {
$dom->{_html}{simple} = 0;
last;
}
}
# IF I'm not simple, neither are my list_item children
if (! $dom->{_html}{simple}) {
foreach $li ($dom->contents) {
$li->{_html}{simple} = 0;
push @{$li->first->{attr}{classes}},'first';
}
}
return Default($dom, $str);
}
sub attention|caution|danger|error|hint|important|note|tip|warning = { # PREPROCESS
my ($dom, $str) = @_;
# Need to turn our title into a paragraph
use vars qw(%ADM_TITLES);
BEGIN {
%ADM_TITLES = ('Danger'=>'!DANGER!', 'Caution'=>'Caution!',
'Attention'=>'Attention!');
}
my $tag = ucfirst $dom->tag;
my $label = $ADM_TITLES{$tag} || $tag;
my $para = $DOM->new('paragraph',
classes=>[qw(first admonition-title)]);
$para->append($DOM->newPCDATA($label));
$dom->prepend($para);
push @{$dom->last->{attr}{classes}}, 'last';
return;
}
sub admonition = { # PREPROCESS
my ($dom, $str) = @_;
push @{$dom->{attr}{classes}}, 'admonition';
my @paras = Paras($dom);
# Need to turn our title into a paragraph and myself into a div
my $para = $DOM->new('paragraph',
classes=>[qw(first admonition-title)]);
$para->append($dom->first->contents);
$dom->splice(0, 1, $para);
push @{$paras[-1]{attr}{classes}}, 'last';
$dom->tag('div');
}
sub footnote|citation = { # PREPROCESS
my ($dom, $str) = @_;
# Get the label out of our first child's child
# uncoverable branch false note:First child is always label
if ($dom->first->tag eq 'label') {
my $label = $dom->first->{_html}{str};
chomp $label;
$dom->{_html}{label} = $label;
# Delete the label that is our first child
$dom->splice(0, 1);
}
# Label the first/last paragraph if needed
my @paragraphs = Paras($dom);
push @{$paragraphs[0]{attr}{classes}}, 'first'
if @paragraphs > 1;
push @{$paragraphs[-1]{attr}{classes}}, 'last'
if @paragraphs > 1;
}
sub footnote_reference = { # PREPROCESS
my ($dom, $str) = @_;
# Need to trim a preceding space if using superscript
if ($footnote_references eq 'superscript') {
my $parent = $dom->parent;
my $index = $parent->index($dom);
$parent->child($index-1)->{val} =~ s/ +$//
if $index > 0 &&
$parent->child($index-1)->tag eq '#PCDATA';
}
}
sub definition_list_item = { # PREPROCESS
my ($dom, $str) = @_;
# Need to restructure the classifiers under the term
my @classifiers = grep($_->tag eq 'classifier', $dom->contents);
if (@classifiers) {
$dom->splice(1, 0+@classifiers);
$dom->first->append(@classifiers);
}
return;
}
sub table = { # PREPROCESS
my ($dom, $str) = @_;
# Turn a title into a caption
$dom->first->tag('caption')
if $dom->first->tag eq 'title';
}
sub colspec = { # PREPROCESS
my ($dom, $str) = @_;
# Add the "stub" class to all the entries of my column if I'm stub
if ($dom->{attr}{stub}) {
my $parent = $dom->parent;
my $indx = $parent->index($dom);
foreach my $cont ($parent->contents) {
next if $cont->tag eq 'colspec';
foreach my $row ($cont->contents) {
push @{$row->child($indx)->{attr}{classes}}, 'stub';
}
}
}
return;
}
sub thead = { # PREPROCESS
my ($dom, $str) = @_;
# Add the "head" class to each entry of each row
foreach my $row ($dom->contents) {
foreach my $entry ($row->contents) {
unshift @{$entry->{attr}{classes}}, 'head';
}
}
return;
}
sub image = { # PREPROCESS
my ($dom, $str, $writer) = @_;
# Insert a <div> object in the DOM above me if my parent takes
# body elements.
my $ancest = $writer->Ancestors;
my $parent = $ancest->[-1];
# my $parent = $dom->parent;
return unless $parent->takes_body_elts;
my $indx = $parent->index($dom);
my @classes = ('image');
push @classes, @{$dom->{attr}{classes}} if $dom->{attr}{classes};
my $div = $DOM->new('div', classes=>\@classes);
$div->append($parent->child($indx));
$parent->splice($indx, 1, $div);
}
sub generated = { # PREPROCESS
my ($dom, $str) = @_;
return $str;
}
sub sidebar = { # PREPROCESS
my ($dom, $str) = @_;
my @paras = Paras($dom);
# Turn any title or subtitle into paragraphs
foreach my $child ($dom->contents) {
if ($child->tag eq 'title') {
$child->tag('paragraph');
push @{$child->{attr}{classes}}, qw(first sidebar-title);
}
elsif ($child->tag eq 'subtitle') {
$child->tag('paragraph');
push @{$child->{attr}{classes}}, 'sidebar-subtitle';
}
else {
last;
}
}
push @{$paras[-1]{attr}{classes}}, 'last';
# Turn myself into a div
$dom->tag('div');
push @{$dom->{attr}{classes}}, 'sidebar';
return;
}
sub rubric = { # PREPROCESS
my ($dom, $str) = @_;
# Turn myself into a paragraph
$dom->tag('paragraph');
$dom->{attr}{classes} = [ 'rubric' ];
return;
}
sub compound = { # PREPROCESS
my ($dom, $str) = @_;
my @paras = Paras($dom);
# uncoverable branch false count:2 note:Compound must have content
if (@paras > 1) {
foreach (my $i=0; $i < @paras; $i++) {
my $c = $i == 0 ? 'compound-first' :
$i == $#paras ? 'compound-last' : 'compound-middle';
unshift @{$paras[$i]{attr}{classes}}, $c;
}
}
elsif (@paras) {
unshift @{$paras[0]{attr}{classes}},
'compound-first', 'compound-last';
}
# Turn myself into a div
$dom->tag('div');
push @{$dom->{attr}{classes}}, 'compound';
return;
}
sub mathml = { # PREPROCESS
my ($dom, $str) = @_;
return $str unless $dom->{attr}{mathml};
$DOCTYPE = << "EOS";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1 plus MathML 2.0//EN"
"http://www.w3.org/TR/MathML2/dtd/xhtml-math11-f.dtd" [
<!ENTITY mathml "http://www.w3.org/1998/Math/MathML">
]>
EOS
;
use HTML::Entities;
my $text = $dom->{attr}{mathml}->text;
# Fix up the HTML entities to be nicer
$text =~ s/(&\#x([\da-fA-F]+);)/
# uncoverable branch true note:There should always be an entity
$HTML::Entities::char2entity{chr(hex($2))} || $1/ge;
if (my $label = $dom->{attr}{label}) {
return qq(<table class="mathml" rules="none"><col width="100%"/><col width="0*"/><tr><td>$text</td><td align="right">($label)</td></tr></table>\n)
}
return $text;
}
sub .* = { # PREPROCESS
my ($dom, $str) = @_;
$USED_DEFAULT{$dom->tag} = 1;
return Default($dom, $str);
}
}
# This phase produces the final output
phase PROCESS {
sub paragraph = { # PROCESS
my ($dom, $str) = @_;
my $parent = $dom->parent;
my $p_tag = $parent->tag;
my $index = $parent->index($dom);
my @paras = Paras($parent);
chomp $str;
return "$str"
if (! $dom->{attr}{classes} &&
(($p_tag eq 'list_item' && $parent->{_html}{simple}) ||
(@paras == 1 && $p_tag !~ /list_item|block_quote|topic/)));
$dom->{_html}{attr}{id} = shift @{$dom->{attr}{ids}}
if $dom->{attr}{ids};
my @ids = @{$dom->{attr}{ids}} if $dom->{attr}{ids};
my $spans = join '', map(qq(<$target_tag id="$_"></$target_tag>),
@ids);
my $attr = GetAttr($dom);
return "$spans<p$attr>$str</p>\n";
}
sub \#PCDATA = { # PROCESS
my ($dom, $str) = @_;
return defined $dom->{val} ? $dom->{val} :
EncodeHTML($dom->{text});
}
sub (?:doctest|literal)_block = { # PROCESS
my ($dom, $str) = @_;
my @class = $dom->{attr}{classes} ? @{$dom->{attr}{classes}} : ();
my $class = $dom->tag;
$class =~ s/_/-/;
push(@class, $class);
my $attr = qq( class=") . join(' ',@class) . qq(");
return qq(<pre$attr>$dom->{val}</pre>\n);
}
sub attention|caution|danger|error|hint|important|note|tip|warning = { # PROCESS
my ($dom, $str) = @_;
my $tag = $dom->tag;
return qq(<div class="$tag">\n$str</div>\n);
}
# These just need to return their string
sub definition_list_item = { # PROCESS
my ($dom, $str) = @_;
return $str;
}
sub title = { # PROCESS
my ($dom, $str) = @_;
my $parent = $dom->parent;
my $p_tag = $parent->tag || '';
my $tag;
my $tag_attr = '';
my %a_attr;
# Figure out how deeply I'm nested
my $nesting = $dom->{_html}{nesting};
if ($p_tag =~ /^(topic|sidebar)$/) {
$a_attr{name} = $parent->{attr}{ids}[0]
if $parent->{attr}{classes} &&
$parent->{attr}{classes}[0] eq 'contents';
$tag = "p";
$dom->tag('paragraph');
$tag_attr = qq( class="$p_tag-title first");
}
elsif ($parent->{attr}{classes}[0] || '' eq 'system-messages') {
$tag = "h$nesting";
}
else {
$a_attr{class} = "toc-backref" if $HAS_CONTENTS;
$a_attr{href} = "#$dom->{attr}{refid}"
if defined $dom->{attr}{refid};
$a_attr{name} = $parent->{attr}{ids}[0];
$tag = "h$nesting";
}
my $a_attr = MakeAttrList(\%a_attr);
chomp $str;
$str = "<a$a_attr>$str</a>" unless $tag eq 'p' && $a_attr eq '';
return qq(<$tag$tag_attr>$str</$tag>\n);
}
sub (?:bullet|enumerated|definition)_list = { # PROCESS
my ($dom, $str) = @_;
# Figure out if I'm the least nested list
use vars qw(%LIST_TAGS);
BEGIN { %LIST_TAGS = ('bullet_list'=>'ul', 'enumerated_list'=>'ol',
'definition_list'=>'dl'); }
my $tag = $LIST_TAGS{$dom->tag};
my $attr = $dom->{attr};
$dom->{attr}{classes} ||= [];
my $class = $dom->{attr}{classes};
push @$class, $attr->{enumtype} if $tag eq 'ol';
push @$class, 'docutils' if $tag eq 'dl';
push @$class, 'simple' if $dom->{_html}{simple};
$dom->{_html}{attr}{start} = $attr->{start} if defined $attr->{start};
if ($enum_list_prefixes) {
$dom->{_html}{attr}{prefix} = $attr->{prefix}
if $attr->{prefix};
# uncoverable branch false note:Suffix required for enum list
$dom->{_html}{attr}{suffix} = $attr->{suffix}
if $attr->{suffix};
}
my $attrlist = GetAttr($dom);
return (qq(<$tag$attrlist>\n$str</$tag>\n));
}
sub list_item = { # PROCESS
my ($dom, $str) = @_;
my $attr = $dom->{attr};
my $attrlist = GetAttr($dom);
return qq(<li$attrlist>$str</li>\n);
}
sub section = { # PROCESS
my ($dom, $str) = @_;
my $attr = $dom->{attr};
my $hattr = $dom->{_html}{attr} = {};
$hattr->{id} = $attr->{ids}[0] if $attr->{ids};
push @{$attr->{classes}}, 'section';
my @ids = @{$attr->{ids}} if $attr->{ids};
shift @ids;
my $spans = join '', map(qq(<$target_tag id="$_"></$target_tag>),
@ids);
my $attrlist = GetAttr($dom);
return qq($spans<div$attrlist>\n$str</div>\n);
}
# All of these items need to chomp a preceding #PCDATA
sub emphasis|strong|subscript|superscript = { # PROCESS
my ($dom, $str) = @_;
use vars qw(%TAG_TRANSLATE);
BEGIN {
%TAG_TRANSLATE = qw(emphasis em subscript sub superscript sup);
}
$dom->tag(defined $TAG_TRANSLATE{$dom->tag} ?
$TAG_TRANSLATE{$dom->tag} : $dom->tag);
chomp $str;
return Default($dom, $str);
}
sub target = { # PROCESS
my ($dom, $str) = @_;
chomp $str;
my $id = $dom->{attr}{ids} ? $dom->{attr}{ids}[0] : '';
my $class = $str ne '' ? qq( class="target") : '';
return (! defined $dom->{attr}{refuri} &&
! defined $dom->{attr}{refid} &&
defined $dom->{attr}{ids}) || $str ne '' ?
qq(<$target_tag$class id="$id">$str</$target_tag>) :
"";
}
sub problematic = { # PROCESS
my ($dom, $str) = @_;
my $attr = $dom->{attr};
return qq(<a href="#$attr->{refid}" name="$attr->{ids}[0]"><span class="problematic" id="$attr->{ids}[0]">$str</span></a>);
}
sub footnote_reference = { # PROCESS
my ($dom, $str) = @_;
my $parent = $dom->parent;
my %attr;
$attr{class} = "footnote-reference";
# uncoverable branch false note:Assert refid filled in
my $ref = $attr{href} = "#$dom->{attr}{refid}" if $dom->{attr}{refid};
$attr{name} = $attr{id} = $dom->{attr}{ids}[0];
my $target = &$TARGET_FRAME($ref);
$attr{target} = $target if $target ne '';
my $attr = MakeAttrList(\%attr);
chomp $str;
my $index = $parent->index($dom);
my $ref_str = $footnote_references eq 'superscript' ?
"<sup>$str</sup>" : "[$str]";
return qq(<a$attr>$ref_str</a>);
}
sub literal = { # PROCESS
my ($dom, $str) = @_;
my %attr;
$attr{class} = [qw(docutils literal)];
push @{$attr{class}}, @{$dom->{attr}{classes}}
if $dom->{attr}{classes};
my $attr = MakeAttrList(\%attr);
return defined $dom->{_html}{txt} ? $dom->{_html}{txt} :
qq(<tt$attr>$str</tt>);
}
sub term = { # PROCESS
my ($dom, $str) = @_;
chomp $str;
return qq(<dt>$str</dt>\n);
}
sub classifier = { # PROCESS
my ($dom, $str) = @_;
chomp $str;
return qq( <span class="classifier-delimiter">:</span> <span class="classifier">$str</span>);
}
sub definition = { # PROCESS
my ($dom, $str) = @_;
return qq(<dd>$str</dd>\n);
}
sub reference = { # PROCESS
my ($dom, $str) = @_;
chomp $str;
my $ref = defined $dom->{attr}{refuri} ?
$dom->{attr}{refuri} : defined $dom->{attr}{refid} ?
"#$dom->{attr}{refid}" : undef;
my @class = $dom->{attr}{classes} ?
@{$dom->{attr}{classes}} : ();
push(@class, $dom->tag);
my $class = join(' ',@class);
my %attr = ('class'=>"$class");
if ($cloak_email_addresses && $ref =~ /^mailto:/) {
# Put back any &whatever; codes
$ref =~ s/&\#(\d+);/chr($1)/ge;
$str =~ s/&\#(\d+);/chr($1)/ge;
$ref =~ /^mailto:(.*)/;
$ref = 'mailto:' . join('', map(sprintf('%%%02X', ord($_)),
split(//, $1)));
$str =~ s!([@\.])!<span>\&\#${\ord($1)};</span>!g;
}
$attr{href} = $ref if defined $ref;
$attr{id} = $dom->{attr}{ids}[0] if $dom->{attr}{ids};
$attr{name} = $dom->{attr}{ids}[0] if $dom->{attr}{ids};
my $target = defined $ref ? &$TARGET_FRAME($ref) : '';
$attr{target} = $target if $target ne '';
my $attr = MakeAttrList(\%attr);
my $s = "<a$attr>$str</a>";
$dom->{_html}{str} = $str;
return $s;
}
sub footnote|citation = { # PROCESS
my ($dom, $str) = @_;
my (@list1, @list2);
my @class = $dom->{attr}{classes} ?
@{$dom->{attr}{classes}} : ();
push @class, 'docutils';
push @class, $dom->tag;
my $class = qq(class=") . join(' ',@class) . qq(");
push(@list1, qq(<table $class frame="void" id="$dom->{attr}{ids}[0]" rules="none">\n));
unshift(@list2, qq(</table>\n));
push(@list1, qq(<colgroup><col class="label" /><col /></colgroup>\n));
push(@list1, qq(<tbody valign="top">\n));
unshift(@list2, qq(</tbody>\n));
# uncoverable branch false note:html/label is always defined
my $label = defined $dom->{_html}{label} ? $dom->{_html}{label} :
$dom->{attr}{name};
my $backlinks;
my @backrefs = @{$dom->{attr}{backrefs}} if $dom->{attr}{backrefs};
if ($footnote_backlinks && @backrefs) {
if (@backrefs > 1) {
$backlinks = '<em>(' . join(', ',map(qq(<a class="fn-backref" href="#$backrefs[$_-1]">$_</a>), 1 .. @backrefs)) . ')</em> ';
push(@list1, qq(<tr><td class="label"><a name="$dom->{attr}{ids}[0]">[$label]</a></td><td>$backlinks$str</td></tr>\n));
}
else {
push(@list1, qq(<tr><td class="label"><a class="fn-backref" href="#$dom->{attr}{backrefs}[0]" name="$dom->{attr}{ids}[0]">[$label]</a></td><td>$str</td></tr>\n));
}
}
else {
push(@list1, qq(<tr><td class="label"><a name="$dom->{attr}{ids}[0]">[$label]</a></td><td>$str</td></tr>\n));
}
return join '', @list1, @list2;
}
sub block_quote = { # PROCESS
my ($dom, $str) = @_;
my $attr = GetAttr($dom);
return qq(<blockquote$attr>\n$str</blockquote>\n);
}
sub attribution = { # PROCESS
my ($dom, $str) = @_;
return '' if $attribution eq 'none';
chomp $str;
my $att = $attribution eq 'dash' ? "—$str" : "($str)";
return qq(<p class="attribution">$att</p>\n);
}
sub comment = { # PROCESS
my ($dom, $str) = @_;
# uncoverable branch false note:All children are #PCDATA
my $text = join('',map($_->tag eq '#PCDATA' ? $_->{text} : "",
$dom->contents));
chomp $text;
$text =~ s/--/- -/g;
return qq(<!-- $text -->\n);
}
sub topic = { # PROCESS
my ($dom, $str) = @_;
my $hattr = $dom->{_html}{attr} = {};
my $class = $dom->{attr}{classes} ? $dom->{attr}{classes}[0] : '';
if ($class eq 'contents') {
$HAS_CONTENTS = 1;
$hattr->{id} = $dom->{attr}{ids}[0];
}
my %attr;
push @{$dom->{attr}{classes}}, 'topic';
my $attrlist = GetAttr($dom);
return qq(<div$attrlist>\n$str</div>\n);
}
sub field_list = { # PROCESS
my ($dom, $str) = @_;
my (@list1, @list2);
push @{$dom->{attr}{classes}}, qw(docutils field-list);
$dom->{_html}{attr} = { qw(frame void rules none) };
my $attrlist = GetAttr($dom);
push(@list1,
qq(<table$attrlist>\n),
qq(<col class="field-name" />\n),
qq(<col class="field-body" />\n),
qq(<tbody valign="top">\n)
);
unshift(@list2, qq(</table>\n));
unshift(@list2, qq(</tbody>\n));
return join '', @list1, $str, @list2;
}
sub field_(?:name|argument|body) = { # PROCESS
my ($dom, $str) = @_;
chomp $str;
return $str;
}
sub field = { # PROCESS
my ($dom, $str) = @_;
my %fields = map(($_->tag, $_->{val}), $dom->contents);
my @str;
my $fieldname = $fields{field_name};
# Back-convert HTML codes to figure out how long fieldargs is
(my $fieldchars = $fieldname) =~ s/&.*;/ /g;
my $colspan = length($fieldchars) > $field_limit ?
qq( colspan="2") : '';
my $tr = $colspan ? "</tr>\n" : '';
my $cr = $fields{field_body} =~ m|</p>$| ? "\n" : '';
my $colon = $field_colon ? ':' : '';
push(@str,
qq(<tr class="field"><th class="field-name"$colspan>$fieldname$colon</th>$tr));
push(@str, $colspan ?
qq(<tr><td> </td><td class="field-body">$fields{field_body}$cr</td>\n)
: qq(<td class="field-body">$fields{field_body}$cr</td>\n)
);
push(@str, qq(</tr>\n));
return join '',@str;
}
sub transition = { # PROCESS
return qq(<hr class="docutils" />\n);
}
sub option_list = { # PROCESS
my ($dom, $str) = @_;
return << "EOS" ;
<table class="docutils option-list" frame="void" rules="none">
<col class="option" />
<col class="description" />
<tbody valign="top">
$str</tbody>
</table>
EOS
}
sub option_list_item = { # PROCESS
my ($dom, $str) = @_;
return qq(<tr>$str</tr>\n);
}
sub option_group = { # PROCESS
my ($dom, $str) = @_;
my $parent = $dom->parent;
my $val = join(', ', map($_->{val}, $dom->contents));
# Figure out what the raw text is
my $raw = $val;
$raw =~ s/<[^>]*>//g;
my $cspan = '';
if (length($raw) > $option_limit) {
$cspan = qq( colspan="2");
$parent->{_html}{colspan} = 2;
}
return qq(<td class="option-group"$cspan>\n<kbd>$val</kbd></td>\n);
}
sub option_string = { # PROCESS
my ($dom, $str) = @_;
return qq($str);
}
sub option = { # PROCESS
my ($dom, $str) = @_;
return qq(<span class="option">$str</span>);
}
sub option_argument = { # PROCESS
my ($dom, $str) = @_;
return qq($dom->{attr}{delimiter}<var>$str</var>);
}
sub description = { # PROCESS
my ($dom, $str) = @_;
my $parent = $dom->parent;
my $append = ($parent->{_html}{colspan} || 0) == 2 ?
qq(</tr>\n<tr><td> </td>) : '';
return qq($append<td>$str</td>);
}
sub table = { # PROCESS
my ($dom, $str) = @_;
my $tattr = $dom->{table_attr} || '';
%{$dom->{_html}{attr}} = ($tattr =~ /(\w+)(?:=(\S+))?/g,
$tattr =~ /(\w+)="(.*?)"/g);
$dom->{_html}{attr}{align} = $dom->{attr}{align}
if $dom->{attr}{align};
if ($dom->{_html}{attr}{class}) {
push @{$dom->{attr}{classes}}, $dom->{_html}{attr}{class};
delete $dom->{_html}{attr}{class};
}
my $attr = GetAttr($dom);
return qq(<table$attr>\n$str</table>\n);
}
sub tgroup = { # PROCESS
my ($dom, $str) = @_;
my $cols = $dom->{attr}{cols};
my $rest = join('', map($dom->child($_)->{val},
$cols .. ($dom->num_contents-1)));
return $rest unless $colspecs;
my @colwidths = map($dom->child($_)->{attr}{colwidth},
0 .. $cols-1);
my $total = 0;
grep($total += $_, @colwidths);
my $colspecs = join('',map(sprintf(qq(<col width="%s%%" />\n),
int(100*$_/$total)),
@colwidths));
my $colgroup = "<colgroup>\n$colspecs</colgroup>\n";
return qq($colgroup$rest);
}
sub thead = { # PROCESS
my ($dom, $str) = @_;
$str =~ s|(</?t)d|${1}h|g;
return qq(<thead valign="bottom">\n$str</thead>\n);
}
sub tbody = { # PROCESS
my ($dom, $str) = @_;
return qq(<tbody valign="top">\n$str</tbody>\n);
}
sub row = { # PROCESS
my ($dom, $str) = @_;
my $attr = defined $dom->{row_attr} && $dom->{row_attr} ne '' ?
" $dom->{row_attr}" : '';
my $dom_attr = GetAttr($dom);
$attr .= $dom_attr if $dom_attr ne '';
return qq(<tr$attr>$str</tr>\n);
}
sub entry = { # PROCESS
my ($dom, $str) = @_;
my $attr = $dom->{attr};
my $eattr = $dom->{entry_attr} || '';
# uncoverable branch false not:There are no pass-thru attributes
%{$dom->{_html}{attr}} =
(map($_ eq 'morerows' ? ('rowspan'=>$attr->{$_}+1) :
$_ eq 'morecols' ? ('colspan'=>$attr->{$_}+1) :
$_ eq 'classes' ||
$_ eq 'align' && $attr->{$_} eq 'left'? () :
($_=>$attr->{$_}), keys %$attr),
$eattr =~ /(\w+)(?:=(\S+))?/g,
$eattr =~ /(\w+)="(.*?)"/g);
my $attrlist = GetAttr($dom);
$str = ' ' if $str eq '';
my $tag = $attr->{classes} && grep($_ eq 'stub', @{$attr->{classes}}) ?
"th" : "td";
return qq(<$tag$attrlist>$str</$tag>\n);
}
sub citation_reference = { # PROCESS
my ($dom, $str) = @_;
my $hattr = $dom->{_html}{attr} = {};
push @{$dom->{attr}{classes}}, 'citation-reference';
my $ref = $hattr->{href} = "#$dom->{attr}{refid}";
$hattr->{name} = $hattr->{id} = $dom->{attr}{ids}[0];
my $target = &$TARGET_FRAME($ref);
$hattr->{target} = $target if $target ne '';
my $attr = GetAttr($dom);
return qq(<a$attr>[$str]</a>);
}
sub image = { # PROCESS
my ($dom, $str) = @_;
my $attr = $dom->{attr};
my $uri = $attr->{uri};
if ($IMAGE_EXT_RE) {
$uri =~ s/($IMAGE_EXT_RE)$/$IMAGE_EXTS{$1}/o;
}
my $alt = defined $attr->{alt} ? $attr->{alt} : $uri;
my $hattr = $dom->{_html}{attr} = {};
@$hattr{qw(alt src)} = ($alt, $uri);
my @attr_out = qw(height width align usemap);
foreach (@attr_out) {
$hattr->{$_} = $attr->{$_} if defined $attr->{$_};
}
# $hattr->{refid} = $dom->{attr}{ids} if $dom->{attr}{ids};
my $attrlist = GetAttr($dom);
my $img = qq(<img$attrlist />);
return $img;
}
sub figure = { # PROCESS
my ($dom, $str) = @_;
# Copy the non-classes attributes to {_html}{attr}
%{$dom->{_html}{attr}} = map($_ ne 'classes' ? ($_, $dom->{attr}{$_}) :
(), keys %{$dom->{attr}});
push @{$dom->{attr}{classes}}, 'figure';
my $attr = GetAttr($dom);
return qq(<div$attr>\n$str</div>\n);
}
sub caption = { # PROCESS
my ($dom, $str) = @_;
chomp $str;
my $parent = $dom->parent;
return $parent->tag eq 'table' ? qq(<caption>$str</caption>\n) :
qq(<p class="caption">$str</p>\n);
}
sub legend = { # PROCESS
my ($dom, $str) = @_;
return qq(<div class="legend">\n$str</div>\n);
}
sub line_block = { # PROCESS
my ($dom, $str) = @_;
$dom->{attr}{classes} = [ 'line-block' ] unless $dom->{attr}{classes};
my $attr = GetAttr($dom);
return qq(<div$attr>\n$str</div>\n);
}
sub line = { # PROCESS
my ($dom, $str) = @_;
chomp $str;
$str = "<br />" if $str eq '';
return qq(<div class="line">$str</div>\n);;
}
sub parsed_literal = { # PROCESS
my ($dom, $str) = @_;
my $attr = $dom->{attr};
$attr->{classes} ||= [];
push @{$attr->{classes}}, 'parsed-literal';
my $attrlist = GetAttr($dom);
return qq(<pre$attrlist>$str</pre>\n);
}
sub system_message = { # PROCESS
my ($dom, $str) = @_;
my $parent = $dom->parent;
my $attr = $dom->{attr};
my $backlink = $attr->{backrefs} ?
'; <em>backrefs ' .
join(' ',map(qq(<a href="#$_">$_</a>), @{$attr->{backrefs}})) .
'</em>' : '';
my $name = $attr->{ids} ? qq( name="$attr->{ids}[0]") : '';
my $line = $attr->{line} ? qq(, line $attr->{line}) : '';
my $id = $attr->{ids} ? qq( id="$attr->{ids}[0]") : '';
return << "EOS"
<div class="system-message"$id>
<p class="system-message-title">System Message: <a$name>$attr->{type}/$attr->{level}</a> (<tt class="docutils">$attr->{source}</tt>$line)$backlink</p>
$str</div>
EOS
if ($parent->{attr}{classes} && @{$parent->{attr}{classes}} &&
$parent->{attr}{classes}[0] eq 'system-messages');
return;
}
sub raw = { # PROCESS
my ($dom) = @_;
return unless $dom->{attr}{format} =~ /\bhtml\b/;
my $s = $dom->first->{text};
chomp $s;
if ($dom->{attr}{head}) {
push @HEAD, "$s\n";
return;
}
return $s unless $dom->{attr}{classes};
my $parent = $dom->parent;
my $tag = $parent->tag =~ /section|document/ ? 'div' : 'span';
my $attr = GetAttr($dom);
return qq(<$tag$attr>$s</$tag>);
}
sub subtitle|label|decoration|colspec|substitution_(?:definition|reference) = { # PROCESS
return;
}
sub document = { # PROCESS
my ($dom, $str, $writer) = @_;
my $doc = [[], []];
# Handle the prolog
my $enc = $writer->{opt}{e} || 'utf-8';
$enc =~ s/(utf)(\d+)/$1-$2/;
push @{$doc->[0]}, qq(<?xml version="1.0" encoding="$enc" ?>\n)
unless $html_prolog;
push @{$doc->[0]}, $DOCTYPE;
push (@{$doc->[0]}, qq(<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">\n));
unshift (@{$doc->[1]}, qq(</html>\n));
# Handle the header
my $head = [["<head>\n"], ["</head>\n"]];
push (@{$doc->[0]}, $head);
push (@{$head->[0]},
qq(<meta http-equiv="Content-Type" content="text/html; charset=$enc" />\n));
push (@{$head->[0]},
qq(<meta name="generator" content="$dom->{TOOL_ID}" />\n))
unless defined $writer->{opt}{D}{generator} &&
$writer->{opt}{D}{generator} eq 0;
my $title = $dom->num_contents &&
$dom->first->tag eq 'title' ?
$dom->first->{_html}{str} : $dom->{attr}{title} || '';
$title = SanitizeTitle($title);
my $subtitle = $dom->num_contents > 1 &&
$dom->child(1)->tag eq 'subtitle' ?
$dom->child(1)->{_html}{str} : '';
$subtitle = SanitizeTitle($subtitle);
push (@{$head->[0]}, "<title>$title</title>\n") if $title ne '';
push (@{$head->[0]},
map(ref($_) ? qq(<meta name="$_->[0]" content="$_->[1]" />\n) :
$_, @HEAD_INFO));
my @embeds;
if ($stylesheet =~ /^none$/i) {
# Find the default stylesheet
my $default = "Text/Restructured/default.css";
my ($dir) = grep -f "$_/$default", @INC;
push @embeds, "$dir/$default";
$stylesheet = 0;
}
elsif ($stylesheet !~ /^http:/ && $embed_stylesheet) {
push @embeds, $stylesheet =~ m!^file:(?://)?(.*)! ? $1 :
$stylesheet;
$stylesheet = 0;
}
if ($stylesheet) {
push @{$head->[0]}, qq(<link rel="stylesheet" href="$stylesheet" type="text/css" />\n);
}
push @embeds, $stylesheet2 if $stylesheet2;
foreach my $embed (@embeds) {
open SS, $embed or die "Cannot open stylesheet $embed";
my $ss_text = join '', <SS>;
push(@{$head->[0]},
sprintf(qq(<style type="text/css">\n%s</style>\n),
$ss_text));
}
push @{$head->[0]}, @HEAD if @HEAD;
# Handle the body.
my $battr = $body_attr ? " $body_attr" : '';
my $body = $body_only ? [] : [["<body$battr>\n"], ["</body>\n"]];
unshift @{$body->[1]}, $FOOTER if defined $FOOTER;
push @{$doc->[0]}, $body;
push @{$body->[0]}, $HEADER if defined $HEADER;
push @{$body->[0]}, map(qq(<span id="$_"></span>),
@{$dom->{attr}{ids}}
[1 .. $#{$dom->{attr}{ids}}])
if $dom->{attr}{ids} && @{$dom->{attr}{ids}} > 1;
push (@{$body->[0]},
qq(<div class="document") .
($dom->{attr}{ids} ? qq( id="$dom->{attr}{ids}[0]") : "")
. qq(>\n));
unshift (@{$body->[1]}, qq(</div>\n));
push (@{$body->[0]}, qq(<h1 class="title">$title</h1>\n))
if $title ne '' && ! $writer->{opt}{D}{keep_title_section};
my $id = $dom->num_contents > 1 &&
$dom->child(1)->{attr}{ids} ?
qq( id="${\$dom->child(1)->{attr}{ids}[0]}") : '';
if ($subtitle ne '') {
my $stdom = $dom->child(1);
push @{$body->[0]}, map(qq(<span id="$_"></span>),
@{$stdom->{attr}{ids}}
[1 .. $#{$stdom->{attr}{ids}}])
if @{$stdom->{attr}{ids}} > 1;
push (@{$body->[0]}, qq(<h2 class="subtitle"$id>$subtitle</h2>\n))
}
# Next go through all the contents
my $content;
foreach $content ($dom->contents) {
next if $content->tag =~ /title$/;
push (@{$body->[0]}, $content->{val});
}
my @list = $body_only ? Flatten($body) : Flatten($doc);
return join '',@list;
# This subroutine takes an array of items which may
# contain array references and flattens them into the
# a new array.
sub Flatten {
my @answer;
foreach (@_) {
next unless defined $_;
if (ref($_) eq 'ARRAY') {
push(@answer, Flatten(@$_));
}
else {
push(@answer, $_);
}
}
return @answer;
}
}
sub docinfo = { # PROCESS
my ($dom, $str) = @_;
$str =~ s/field-name/docinfo-name/g;
return << "EOS" ;
<table class="docinfo" frame="void" rules="none">
<col class="docinfo-name" />
<col class="docinfo-content" />
<tbody valign="top">
$str</tbody>
</table>
EOS
}
sub address = { # PROCESS
my ($dom, $str) = @_;
return << "EOS" ;
<tr><th class="docinfo-name">Address:</th>
<td><pre class="address">
$str</pre>
</td></tr>
EOS
}
sub author|contact|organization|date|status|revision|version|copyright = { # PROCESS
my ($dom, $str) = @_;
my $label = $dom->tag;
substr($label,0,1) =~ tr/[a-z]/[A-Z]/;
chomp $str;
return qq(<tr><th class="docinfo-name">$label:</th>\n<td>$str</td></tr>\n);
}
sub header = { # PROCESS
my ($dom, $str) = @_;
$HEADER =
qq(<div class="header">\n$str\n<hr class="header"/>\n</div>\n);
return;
}
sub footer = { # PROCESS
my ($dom, $str) = @_;
$FOOTER =
qq(<div class="footer">\n<hr class="footer" />\n$str\n</div>\n);
return;
}
sub div = { # PROCESS
my ($dom, $str) = @_;
my $nl = $dom->num_contents > 1 ? "\n" : '';
return qq(<div class="@{$dom->{attr}{classes}}">$nl$str</div>\n);
}
sub title_reference = { # PROCESS
my ($dom, $str) = @_;
return qq(<cite>$str</cite>);
}
sub inline = { # PROCESS
my ($dom, $str) = @_;
my $tag = 'span';
my $attr = GetAttr($dom);
return qq(<$tag$attr>$str</$tag>);
}
sub .* = { # PROCESS
my ($dom, $str) = @_;
if ($USED_DEFAULT{$dom->tag}) {
print STDERR
"Warning: Used default handler for type ${\$dom->tag}\n";
$USED_DEFAULT{$dom->tag} = 0;
}
return $dom->{val};
}
}