package Pod::Simple::HTML;
use Pod::Simple::PullParser ();
our (
@ISA, %Tagmap, $Computerese, $LamePad, $Linearization_Limit, $VERSION,
$Perldoc_URL_Prefix, $Perldoc_URL_Postfix,
$Title_Prefix, $Title_Postfix, $HTML_EXTENSION, %ToIndex,
$Doctype_decl, $Content_decl,
);
@ISA = @('Pod::Simple::PullParser');
$VERSION = '3.03';
use UNIVERSAL ();
BEGIN {
if(defined &DEBUG) { } # no-op
elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG }
else { *DEBUG = sub () {0}; }
}
$Doctype_decl ||= ''; # No. Just No. Don't even ask me for it.
# qq{<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
# "http://www.w3.org/TR/html4/loose.dtd">\n};
$Content_decl ||=
q{<meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" >};
$HTML_EXTENSION = '.html' unless defined $HTML_EXTENSION;
$Computerese = "" unless defined $Computerese;
$LamePad = '' unless defined $LamePad;
$Linearization_Limit = 120 unless defined $Linearization_Limit;
# headings/items longer than that won't get an <a name="...">
$Perldoc_URL_Prefix = 'http://search.cpan.org/perldoc?'
unless defined $Perldoc_URL_Prefix;
$Perldoc_URL_Postfix = ''
unless defined $Perldoc_URL_Postfix;
$Title_Prefix = '' unless defined $Title_Prefix;
$Title_Postfix = '' unless defined $Title_Postfix;
%ToIndex = %( < @+: map { @: $_ => 1 }, qw(head1 head2 head3 head4 ) ); # item-text
# 'item-text' stuff in the index doesn't quite work, and may
# not be a good idea anyhow.
__PACKAGE__->_accessorize(
'perldoc_url_prefix',
# In turning L<Foo::Bar> into http://whatever/Foo%3a%3aBar, what
# to put before the "Foo%3a%3aBar".
# (for singleton mode only?)
'perldoc_url_postfix',
# what to put after "Foo%3a%3aBar" in the URL. Normally "".
'batch_mode', # whether we're in batch mode
'batch_mode_current_level',
# When in batch mode, how deep the current module is: 1 for "LWP",
# 2 for "LWP::Procotol", 3 for "LWP::Protocol::GHTTP", etc
'title_prefix', 'title_postfix',
# What to put before and after the title in the head.
# Should already be &-escaped
'html_header_before_title',
'html_header_after_title',
'html_footer',
'index', # whether to add an index at the top of each page
# (actually it's a table-of-contents, but we'll call it an index,
# out of apparently longstanding habit)
'html_css', # URL of CSS file to point to
'html_javascript', # URL of CSS file to point to
'force_title', # should already be &-escaped
'default_title', # should already be &-escaped
);
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
my @_to_accept;
%Tagmap = %(
'Verbatim' => "\n<pre$Computerese>",
'/Verbatim' => "</pre>\n",
'VerbatimFormatted' => "\n<pre$Computerese>",
'/VerbatimFormatted' => "</pre>\n",
'VerbatimB' => "<b>",
'/VerbatimB' => "</b>",
'VerbatimI' => "<i>",
'/VerbatimI' => "</i>",
'VerbatimBI' => "<b><i>",
'/VerbatimBI' => "</i></b>",
'Data' => "\n",
'/Data' => "\n",
'head1' => "\n<h1>", # And also stick in an <a name="...">
'head2' => "\n<h2>", # ''
'head3' => "\n<h3>", # ''
'head4' => "\n<h4>", # ''
'/head1' => "</a></h1>\n",
'/head2' => "</a></h2>\n",
'/head3' => "</a></h3>\n",
'/head4' => "</a></h4>\n",
'X' => "<!--\n\tINDEX: ",
'/X' => "\n-->", <
changes( <qw(
Para=p
B=b I=i
over-bullet=ul
over-number=ol
over-text=dl
over-block=blockquote
item-bullet=li
item-number=li
item-text=dt
)), <
changes2(
< map {; m/^([-a-z]+)/s && push @_to_accept, $1; $_ },
qw[
sample=samp
definition=dfn
kbd=keyboard
variable=var
citation=cite
abbreviation=abbr
acronym=acronym
subscript=sub
superscript=sup
big=big
small=small
underline=u
strikethrough=s
] # no point in providing a way to get <q>...</q>, I think
),
'/item-bullet' => "</li>$LamePad\n",
'/item-number' => "</li>$LamePad\n",
'/item-text' => "</a></dt>$LamePad\n",
'item-body' => "\n<dd>",
'/item-body' => "</dd>\n",
'B' => "<b>", '/B' => "</b>",
'I' => "<i>", '/I' => "</i>",
'F' => "<em$Computerese>", '/F' => "</em>",
'C' => "<code$Computerese>", '/C' => "</code>",
'L' => "<a href='YOU_SHOULD_NEVER_SEE_THIS'>", # ideally never used!
'/L' => "</a>",
);
sub changes {
return @+: map { m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s
?? @( $1, => "\n<$2>", "/$1", => "</$2>\n" ) !! die "Funky $_"
}, @_;
}
sub changes2 {
return @+: map {; m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s
?? @( $1, => "<$2>", "/$1", => "</$2>" ) !! die "Funky $_"
}, @_;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub go { exit Pod::Simple::HTML->parse_from_file(< @ARGV) }
# Just so we can run from the command line. No options.
# For that, use perldoc!
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub new {
my $new = shift->SUPER::new(< @_);
#$new->nix_X_codes(1);
$new->nbsp_for_S(1);
$new->accept_targets( 'html', 'HTML' );
$new->accept_codes('VerbatimFormatted');
$new->accept_codes(< @_to_accept);
DEBUG +> 2 and print $^STDOUT, "To accept: ", join(' ', @_to_accept), "\n";
$new->perldoc_url_prefix( $Perldoc_URL_Prefix );
$new->perldoc_url_postfix( $Perldoc_URL_Postfix );
$new->title_prefix( $Title_Prefix );
$new->title_postfix( $Title_Postfix );
$new->html_header_before_title(
qq[$Doctype_decl<html><head><title>]
);
$new->html_header_after_title( join "\n", @(
"</title>",
$Content_decl,
"</head>\n<body class='pod'>",
$new->version_tag_comment,
"<!-- start doc -->\n",)
);
$new->html_footer( qq[\n<!-- end doc -->\n\n</body></html>\n] );
$new->{+'Tagmap'} = \%(< %Tagmap);
return $new;
}
sub batch_mode_page_object_init($self, $batchconvobj, $module, $infile, $outfile, $depth) {
DEBUG and print $^STDOUT, "Initting $self\n for $module\n",
" in $infile\n out $outfile\n depth $depth\n";
$self->batch_mode(1);
$self->batch_mode_current_level($depth);
return $self;
}
sub run {
my $self = @_[0];
return $self->do_middle if $self->bare_output;
return
$self->do_beginning && $self->do_middle && $self->do_end;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub do_beginning {
my $self = @_[0];
my $title;
if(defined $self->force_title) {
$title = $self->force_title;
DEBUG and print $^STDOUT, "Forcing title to be $title\n";
} else {
# Actually try looking for the title in the document:
$title = $self->get_short_title();
unless($self->content_seen) {
DEBUG and print $^STDOUT, "No content seen in search for title.\n";
return;
}
$self->{+'Title'} = $title;
if(defined $title and $title =~ m/\S/) {
$title = $self->title_prefix . esc($title) . $self->title_postfix;
} else {
$title = $self->default_title;
$title = '' unless defined $title;
DEBUG and print $^STDOUT, "Title defaults to $title\n";
}
}
my $after = $self->html_header_after_title || '';
if($self->html_css) {
my $link =
$self->html_css =~ m/</
?? $self->html_css # It's a big blob of markup, let's drop it in
!! sprintf( # It's just a URL, so let's wrap it up
qq[<link rel="stylesheet" type="text/css" title="pod_stylesheet" href="\%s">\n], <
$self->html_css,
);
$after =~ s{(</head>)}{$link\n$1}i; # otherwise nevermind
}
$self->_add_top_anchor(\$after);
if($self->html_javascript) {
my $link =
$self->html_javascript =~ m/</
?? $self->html_javascript # It's a big blob of markup, let's drop it in
!! sprintf( # It's just a URL, so let's wrap it up
qq[<script type="text/javascript" src="\%s"></script>\n], <
$self->html_javascript,
);
$after =~ s{(</head>)}{$link\n$1}i; # otherwise nevermind
}
print $self->{?'output_fh'}
,$self->html_header_before_title || '',
$title, # already escaped
$after,
;
DEBUG and print $^STDOUT, "Returning from do_beginning...\n";
return 1;
}
sub _add_top_anchor($self, $text_r) {
unless($$text_r and $$text_r =~ m/name=['"]___top['"]/) { # a hack
$$text_r .= "<a name='___top' class='dummyTopAnchor' ></a>\n";
}
return;
}
sub version_tag_comment {
my $self = shift;
return sprintf
"<!--\n generated by \%s v\%s,\n using \%s v\%s,\n under Perl v\%s at \%s GMT.\n\n \%s\n\n-->\n",
(< map { esc($_) },
@( ref($self), $self->VERSION(), @ISA[0], @ISA[0]->VERSION(),
$^PERL_VERSION, scalar(gmtime),)
), $self->_modnote(),
;
}
sub _modnote {
my $class = ref(@_[0]) || @_[0];
return join "\n ", grep { m/\S/ }, split "\n",
qq{
If you want to change this HTML document, you probably shouldn't do that
by changing it directly. Instead, see about changing the calling options
to $class, and/or subclassing $class,
then reconverting this document from the Pod source.
When in doubt, email the author of $class for advice.
See 'perldoc $class' for more info.
};
}
sub do_end {
my $self = @_[0];
print $self->{?'output_fh'} ,$self->html_footer || '';
return 1;
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Normally this would just be a call to _do_middle_main_loop -- but we
# have to do some elaborate things to emit all the content and then
# summarize it and output it /before/ the content that it's a summary of.
sub do_middle {
my $self = @_[0];
return $self->_do_middle_main_loop unless $self->index;
if( $self->output_string ) {
# An efficiency hack
my $out = $self->output_string; #it's a reference to it
my $sneakytag = "\f\f\e\e\b\bIndex Here\e\e\b\b\f\f\n";
$$out .= $sneakytag;
$self->_do_middle_main_loop;
$sneakytag = quotemeta($sneakytag);
my $index = $self->index_as_html();
if( $$out =~ s/$sneakytag/$index/s ) {
# Expected case
DEBUG and print $^STDOUT, "Inserted ", length($index), " bytes of index HTML into $out.\n";
} else {
DEBUG and print $^STDOUT, "Odd, couldn't find where to insert the index in the output!\n";
# I don't think this should ever happen.
}
return 1;
}
unless( $self->output_fh ) {
require Carp;
Carp::confess("Parser object \$p doesn't seem to have any output object! I don't know how to deal with that.");
}
# If we get here, we're outputting to a FH. So we need to do some magic.
# Namely, divert all content to a string, which we output after the index.
my $fh = $self->output_fh;
my $content = '';
do {
# Our horrible bait and switch:
$self->output_string( \$content );
$self->_do_middle_main_loop;
$self->abandon_output_string();
$self->output_fh($fh);
};
print $fh, $self->index_as_html();
print $fh, $content;
return 1;
}
###########################################################################
sub index_as_html {
my $self = @_[0];
# This is meant to be called AFTER the input document has been parsed!
my $points = $self->{?'PSHTML_index_points'} || \@();
(nelems @$points) +> 1 or return qq[<div class='indexgroupEmpty'></div>\n];
# There's no point in having a 0-item or 1-item index, I dare say.
my@(@out) =@( @( qq{\n<div class='indexgroup'>} ));
my $level = 0;
my( $target_level, $previous_tagname, $tagname, $text, $anchorname, $indent);
foreach my $p ( @( < @$points, \@('head0', '(end)') ) ) {
@($tagname, $text) = @$p;
$anchorname = $self->section_escape($text);
if( $tagname =~ m{^head(\d+)$} ) {
$target_level = 0 + $1;
} else { # must be some kinda list item
if($previous_tagname =~ m{^head\d+$} ) {
$target_level = $level + 1;
} else {
$target_level = $level; # no change needed
}
}
# Get to target_level by opening or closing ULs
while($level +> $target_level)
{ --$level; push @out, (" " x $level) . "</ul>"; }
while($level +< $target_level)
{ ++$level; push @out, (" " x ($level-1))
. "<ul class='indexList indexList$level'>"; }
$previous_tagname = $tagname;
next unless $level;
$indent = ' ' x $level;
push @out, sprintf
"\%s<li class='indexItem indexItem\%s'><a href='#\%s'>\%s</a>",
$indent, $level, $anchorname, esc($text)
;
}
push @out, "</div>\n";
return join "\n", @out;
}
###########################################################################
sub _do_middle_main_loop {
my $self = @_[0];
my $fh = $self->{?'output_fh'};
my $tagmap = $self->{?'Tagmap'};
my($token, $type, $tagname, $linkto, $linktype);
my @stack;
my $dont_wrap = 0;
while($token = $self->get_token) {
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
if( ($type = $token->type) eq 'start' ) {
if(($tagname = $token->tagname) eq 'L') {
$linktype = $token->attr('type') || 'insane';
$linkto = $self->do_link($token);
if(defined $linkto and length $linkto) {
$linkto = esc($linkto);
# (Yes, SGML-escaping applies on top of %-escaping!
# But it's rarely noticeable in practice.)
print $fh, qq{<a href="$linkto" class="podlink$linktype"\n>};
} else {
print $fh, "<a>"; # Yes, an 'a' element with no attributes!
}
} elsif ($tagname eq 'item-text' or $tagname =~ m/^head\d$/s) {
print $fh, $tagmap->{?$tagname} || next;
my @to_unget;
while(1) {
push @to_unget, $self->get_token;
last if @to_unget[-1]->is_end
and @to_unget[-1]->tagname eq $tagname;
# TODO: support for X<...>'s found in here? (maybe hack into linearize_tokens)
}
my $name = $self->linearize_tokens(< @to_unget);
print $fh, "<a ";
print $fh, "class='u' href='#___top' title='click to go to top of document'\n"
if $tagname =~ m/^head\d$/s;
if(defined $name) {
my $esc = esc( $self->section_name_tidy( $name ) );
print $fh, qq[name="$esc"];
DEBUG and print $^STDOUT, "Linearized ", scalar(nelems @to_unget),
" tokens as \"$name\".\n";
push @{ $self->{+'PSHTML_index_points'} }, \@($tagname, $name)
if %ToIndex{?$tagname };
# Obviously, this discards all formatting codes (saving
# just their content), but ahwell.
} else { # ludicrously long, so nevermind
DEBUG and print $^STDOUT, "Linearized ", scalar(nelems @to_unget),
" tokens, but it was too long, so nevermind.\n";
}
print $fh, "\n>";
$self->unget_token(< @to_unget);
} elsif ($tagname eq 'Data') {
my $next = $self->get_token;
next unless defined $next;
unless( $next->type eq 'text' ) {
$self->unget_token($next);
next;
}
DEBUG and print $^STDOUT, " raw text ", < $next->text, "\n";
printf $fh, "\n" . $next->text . "\n";
next;
} else {
if( $tagname =~ m/^over-/s ) {
push @stack, '';
} elsif( $tagname =~ m/^item-/s and nelems @stack and @stack[-1] ) {
print $fh, @stack[-1];
@stack[-1] = '';
}
print $fh, $tagmap->{?$tagname} || next;
++$dont_wrap if $tagname eq 'Verbatim' or $tagname eq "VerbatimFormatted"
or $tagname eq 'X';
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
} elsif( $type eq 'end' ) {
if( ($tagname = $token->tagname) =~ m/^over-/s ) {
if( my $end = pop @stack ) {
print $fh, $end;
}
} elsif( $tagname =~ m/^item-/s and nelems @stack) {
@stack[-1] = $tagmap->{?"/$tagname"};
if( $tagname eq 'item-text' and defined(my $next = $self->get_token) ) {
$self->unget_token($next);
if( $next->type eq 'start' and $next->tagname !~ m/^item-/s ) {
print $fh, $tagmap->{?"/item-text"},$tagmap->{?"item-body"};
@stack[-1] = $tagmap->{?"/item-body"};
}
}
next;
}
print $fh, $tagmap->{?"/$tagname"} || next;
--$dont_wrap if $tagname eq 'Verbatim' or $tagname eq 'X';
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
} elsif( $type eq 'text' ) {
$type = esc($token->text); # reuse $type, why not
$type =~ s/([\?\!\"\'\.\,]) /$1\n/g unless $dont_wrap;
print $fh, $type;
}
}
return 1;
}
###########################################################################
#
sub do_link($self, $token) {
my $type = $token->attr('type');
if(!defined $type) {
$self->whine("Typeless L!?", < $token->attr('start_line'));
} elsif( $type eq 'pod') { return $self->do_pod_link($token);
} elsif( $type eq 'url') { return $self->do_url_link($token);
} elsif( $type eq 'man') { return $self->do_man_link($token);
} else {
$self->whine("L of unknown type $type!?", < $token->attr('start_line'));
}
return 'FNORG'; # should never get called
}
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
sub do_url_link { return @_[1]->attr('to') }
sub do_man_link { return undef }
# But subclasses are welcome to override this if they have man
# pages somewhere URL-accessible.
sub do_pod_link($self, $link) {
my $to = $link->attr('to');
my $section = $link->attr('section');
return undef unless( # should never happen
(defined $to and length $to) or
(defined $section and length $section)
);
$section = $self->section_escape($section)
if defined $section and length($section .= ''); # (stringify)
DEBUG and printf $^STDOUT, "Resolving \"\%s\" \"\%s\"...\n",
$to || "(nil)", $section || "(nil)";
do {
# An early hack:
my $complete_url = $self->resolve_pod_link_by_table($to, $section);
if( $complete_url ) {
DEBUG +> 1 and print $^STDOUT, "resolve_pod_link_by_table(T,S) gives ",
$complete_url, "\n (Returning that.)\n";
return $complete_url;
} else {
DEBUG +> 4 and print $^STDOUT, " resolve_pod_link_by_table(T,S)",
" didn't return anything interesting.\n";
}
};
if(defined $to and length $to) {
# Give this routine first hack again
my $there = $self->resolve_pod_link_by_table($to);
if(defined $there and length $there) {
DEBUG +> 1
and print $^STDOUT, "resolve_pod_link_by_table(T) gives $there\n";
} else {
$there =
$self->resolve_pod_page_link($to, $section);
# (I pass it the section value, but I don't see a
# particular reason it'd use it.)
DEBUG +> 1 and print $^STDOUT, "resolve_pod_page_link gives ", $to || "(nil)", "\n";
unless( defined $there and length $there ) {
DEBUG and print $^STDOUT, "Can't resolve $to\n";
return undef;
}
# resolve_pod_page_link returning undef is how it
# can signal that it gives up on making a link
}
$to = $there;
}
#DEBUG and print "So far [", $to||'nil', "] [", $section||'nil', "]\n";
my $out = (defined $to and length $to) ?? $to !! '';
$out .= "#" . $section if defined $section and length $section;
unless(length $out) { # sanity check
DEBUG and printf $^STDOUT, "Oddly, couldn't resolve \"\%s\" \"\%s\"...\n",
$to || "(nil)", $section || "(nil)";
return undef;
}
DEBUG and print $^STDOUT, "Resolved to $out\n";
return $out;
}
# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
sub section_escape($self, $section) {
return $self->section_url_escape(
$self->section_name_tidy($section)
);
}
sub section_name_tidy($self, $section) {
$section =~ s/ /_/g;
$section =~ s/\x[00]-\x[1F]\x[80]-\x[9F]//g; # drop crazy characters
$section = $self->unicode_escape_url($section);
$section = '_' unless length $section;
return $section;
}
sub section_url_escape { shift->general_url_escape(< @_) }
sub pagepath_url_escape { shift->general_url_escape(< @_) }
sub general_url_escape($self, $string) {
$string =~ s/([^\x[00]-\x[FF]])/$(
join '', map { sprintf('%%%02X',$_) }, @( unpack 'C*', $1)
)/g;
# express Unicode things as urlencode(utf(orig)).
# A pretty conservative escaping, behoovey even for query components
# of a URL (see RFC 2396)
$string =~ s/([^-_\.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/$(sprintf('%%%02X',ord($1)))/g;
# Yes, stipulate the list without a range, so that this can work right on
# all charsets that this module happens to run under.
# Altho, hmm, what about that ord? Presumably that won't work right
# under non-ASCII charsets. Something should be done
# about that, I guess?
return $string;
}
#--------------------------------------------------------------------------
#
# Oh look, a yawning portal to Hell! Let's play touch football right by it!
#
sub resolve_pod_page_link {
# resolve_pod_page_link must return a properly escaped URL
my $self = shift;
return $self->batch_mode()
?? $self->resolve_pod_page_link_batch_mode(< @_)
!! $self->resolve_pod_page_link_singleton_mode(< @_)
;
}
sub resolve_pod_page_link_singleton_mode($self, $it) {
return undef unless defined $it and length $it;
my $url = $self->pagepath_url_escape($it);
$url =~ s{::$}{}s; # probably never comes up anyway
$url =~ s{::}{/}g unless $self->perldoc_url_prefix =~ m/\?/s; # sane DWIM?
return undef unless length $url;
return $self->perldoc_url_prefix . $url . $self->perldoc_url_postfix;
}
sub resolve_pod_page_link_batch_mode($self, $to) {
DEBUG +> 1 and print $^STDOUT, " During batch mode, resolving $to ...\n";
my @path = grep { length($_) }, split m/::/s, $to, -1;
unless( nelems @path ) { # sanity
DEBUG and print $^STDOUT, "Very odd! Splitting $to gives (nil)!\n";
return undef;
}
$self->batch_mode_rectify_path(\@path);
my $out = join('/', map { < $self->pagepath_url_escape($_) }, @path)
. $HTML_EXTENSION;
DEBUG +> 1 and print $^STDOUT, " => $out\n";
return $out;
}
sub batch_mode_rectify_path($self, $pathbits) {
my $level = $self->batch_mode_current_level;
$level--; # how many levels up to go to get to the root
if($level +< 1) {
unshift @$pathbits, '.'; # just to be pretty
} else {
unshift @$pathbits, ('..') x $level;
}
return;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub resolve_pod_link_by_table {
# A crazy hack to allow specifying custom L<foo> => URL mappings
return unless @_[0]->{?'podhtml_LOT'}; # An optimizy shortcut
my@($self, $to, $section) = @_;
# TODO: add a method that actually populates podhtml_LOT from a file?
if(defined $section) {
$to = '' unless defined $to and length $to;
return $self->{'podhtml_LOT'}->{?"$to#$section"}; # quite possibly undef!
} else {
return $self->{'podhtml_LOT'}->{?$to}; # quite possibly undef!
}
return;
}
###########################################################################
sub linearize_tokens { # self, tokens
my $self = shift;
my $out = '';
my $t;
while($t = shift @_) {
if(!ref $t or !UNIVERSAL::can($t, 'is_text')) {
$out .= $t; # a string, or some insane thing
} elsif($t->is_text) {
$out .= $t->text;
} elsif($t->is_start and $t->tag eq 'X') {
# Ignore until the end of this X<...> sequence:
my $x_open = 1;
while($x_open) {
next if( ($t = shift @_)->is_text );
if( $t->is_start and $t->tag eq 'X') { ++$x_open }
elsif($t->is_end and $t->tag eq 'X') { --$x_open }
}
}
}
return undef if length $out +> $Linearization_Limit;
return $out;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub unicode_escape_url($self, $string) {
$string =~ s/([^\x[00]-\x[FF]])/$('('.ord($1).')')/g;
# Turn char 1234 into "(1234)"
return $string;
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub esc { # a function.
my $x = shift;
$x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/$('&#'.(ord($1)).';')/g;
return $x;
# Leave out "- so that "--" won't make it thru in X-generated comments
# with text in them.
# Yes, stipulate the list without a range, so that this can work right on
# all charsets that this module happens to run under.
# Altho, hmm, what about that ord? Presumably that won't work right
# under non-ASCII charsets. Something should be done about that.
}
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1;
__END__
=head1 NAME
Pod::Simple::HTML - convert Pod to HTML
=head1 SYNOPSIS
perl -MPod::Simple::HTML -e Pod::Simple::HTML::go thingy.pod
=head1 DESCRIPTION
This class is for making an HTML rendering of a Pod document.
This is a subclass of L<Pod::Simple::PullParser> and inherits all its
methods (and options).
Note that if you want to do a batch conversion of a lot of Pod
documents to HTML, you should see the module L<Pod::Simple::HTMLBatch>.
=head1 CALLING FROM THE COMMAND LINE
TODO
perl -MPod::Simple::HTML -e Pod::Simple::HTML::go Thing.pod Thing.html
=head1 CALLING FROM PERL
TODO make a new object, set any options, and use parse_from_file
=head1 METHODS
TODO
all (most?) accessorized methods
=head1 SUBCLASSING
TODO
can just set any of: html_css html_javascript title_prefix
'html_header_before_title',
'html_header_after_title',
'html_footer',
maybe override do_pod_link
maybe override do_beginning do_end
=head1 SEE ALSO
L<Pod::Simple>, L<Pod::Simple::HTMLBatch>
TODO: a corpus of sample Pod input and HTML output? Or common
idioms?
=head1 COPYRIGHT AND DISCLAIMERS
Copyright (c) 2002-2004 Sean M. Burke. All rights reserved.
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.
=head1 AUTHOR
Sean M. Burke C<sburke@cpan.org>
=cut