diff options
Diffstat (limited to 'chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm')
| -rw-r--r-- | chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm | 889 |
1 files changed, 889 insertions, 0 deletions
diff --git a/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm new file mode 100644 index 00000000000..c0a505d533e --- /dev/null +++ b/chromium/third_party/cygwin/lib/perl5/vendor_perl/5.10/Pod/Simple/HTML.pm @@ -0,0 +1,889 @@ + +require 5; +package Pod::Simple::HTML; +use strict; +use Pod::Simple::PullParser (); +use vars qw( + @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 "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 { + my($self, $batchconvobj, $module, $infile, $outfile, $depth) = @_; + DEBUG and print "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 "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 "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 "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 "Returning from do_beginning...\n"; + return 1; +} + +sub _add_top_anchor { + my($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", + esc( + ref($self), $self->VERSION(), $ISA[0], $ISA[0]->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 "Inserted ", length($index), " bytes of index HTML into $out.\n"; + } else { + DEBUG and print "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 = ''; + { + # 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'} || []; + + @$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) { + 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 "Linearized ", scalar(@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 "Linearized ", scalar(@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 " 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 @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 @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' ) { + esc($type = $token->text); # reuse $type, why not + $type =~ s/([\?\!\"\'\.\,]) /$1\n/g unless $dont_wrap; + print $fh $type; + } + + } + return 1; +} + +########################################################################### +# + +sub do_link { + my($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 { + # And now things get really messy... + my($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 "Resolving \"%s\" \"%s\"...\n", + $to || "(nil)", $section || "(nil)"; + + { + # An early hack: + my $complete_url = $self->resolve_pod_link_by_table($to, $section); + if( $complete_url ) { + DEBUG > 1 and print "resolve_pod_link_by_table(T,S) gives ", + $complete_url, "\n (Returning that.)\n"; + return $complete_url; + } else { + DEBUG > 4 and print " 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 "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 "resolve_pod_page_link gives ", $to || "(nil)", "\n"; + unless( defined $there and length $there ) { + DEBUG and print "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 "Oddly, couldn't resolve \"%s\" \"%s\"...\n", + $to || "(nil)", $section || "(nil)"; + return undef; + } + + DEBUG and print "Resolved to $out\n"; + return $out; +} + + +# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . + +sub section_escape { + my($self, $section) = @_; + return $self->section_url_escape( + $self->section_name_tidy($section) + ); +} + +sub section_name_tidy { + my($self, $section) = @_; + $section =~ tr/ /_/; + $section =~ tr/\x00-\x1F\x80-\x9F//d if 'A' eq chr(65); # 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 { + my($self, $string) = @_; + + $string =~ s/([^\x00-\xFF])/join '', map sprintf('%%%02X',$_), unpack 'C*', $1/eg; + # 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))/eg; + # 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 { + my($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 { + my($self, $to) = @_; + DEBUG > 1 and print " During batch mode, resolving $to ...\n"; + my @path = grep length($_), split m/::/s, $to, -1; + unless( @path ) { # sanity + DEBUG and print "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 " => $out\n"; + return $out; +} + +sub batch_mode_rectify_path { + my($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 { + my($self, $string) = @_; + $string =~ s/([^\x00-\xFF])/'('.ord($1).')'/eg; + # Turn char 1234 into "(1234)" + return $string; +} + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +sub esc { # a function. + if(defined wantarray) { + if(wantarray) { + @_ = splice @_; # break aliasing + } else { + my $x = shift; + $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg; + return $x; + } + } + foreach my $x (@_) { + # Escape things very cautiously: + $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&#'.(ord($1)).';'/eg + if defined $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. + } + return @_; +} + +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +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 + |