<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">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 $Man_URL_Prefix $Man_URL_Postfix
  $Title_Prefix $Title_Postfix $HTML_EXTENSION %ToIndex
  $Doctype_decl  $Content_decl
);
@ISA = ('Pod::Simple::PullParser');
$VERSION = '3.43';
BEGIN {
  if(defined &amp;DEBUG) { } # no-op
  elsif( defined &amp;Pod::Simple::DEBUG ) { *DEBUG = \&amp;Pod::Simple::DEBUG }
  else { *DEBUG = sub () {0}; }
}

$Doctype_decl ||= '';  # No.  Just No.  Don't even ask me for it.
 # qq{&lt;!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
 #    "http://www.w3.org/TR/html4/loose.dtd"&gt;\n};

$Content_decl ||=
 q{&lt;meta http-equiv="Content-Type" content="text/html; charset=ISO-8859-1" &gt;};

$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 &lt;a name="..."&gt;
$Perldoc_URL_Prefix  = 'https://metacpan.org/pod/'
 unless defined $Perldoc_URL_Prefix;
$Perldoc_URL_Postfix = ''
 unless defined $Perldoc_URL_Postfix;


$Man_URL_Prefix  = 'http://man.he.net/man';
$Man_URL_Postfix = '';

$Title_Prefix  = '' unless defined $Title_Prefix;
$Title_Postfix = '' unless defined $Title_Postfix;
%ToIndex = map {; $_ =&gt; 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__-&gt;_accessorize(
 'perldoc_url_prefix',
   # In turning L&lt;Foo::Bar&gt; 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 "".

 'man_url_prefix',
   # In turning L&lt;crontab(5)&gt; into http://whatever/man/1/crontab, what
   #  to put before the "1/crontab".
 'man_url_postfix',
   #  what to put after the "1/crontab" 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 &amp;-escaped

 'html_h_level',
  
 'html_header_before_title',
 'html_header_after_title',
 'html_footer',
 'top_anchor',

 '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 Javascript file to point to

 'force_title',   # should already be &amp;-escaped
 'default_title', # should already be &amp;-escaped
);

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
my @_to_accept;

%Tagmap = (
  'Verbatim'  =&gt; "\n&lt;pre$Computerese&gt;",
  '/Verbatim' =&gt; "&lt;/pre&gt;\n",
  'VerbatimFormatted'  =&gt; "\n&lt;pre$Computerese&gt;",
  '/VerbatimFormatted' =&gt; "&lt;/pre&gt;\n",
  'VerbatimB'  =&gt; "&lt;b&gt;",
  '/VerbatimB' =&gt; "&lt;/b&gt;",
  'VerbatimI'  =&gt; "&lt;i&gt;",
  '/VerbatimI' =&gt; "&lt;/i&gt;",
  'VerbatimBI'  =&gt; "&lt;b&gt;&lt;i&gt;",
  '/VerbatimBI' =&gt; "&lt;/i&gt;&lt;/b&gt;",


  'Data'  =&gt; "\n",
  '/Data' =&gt; "\n",
  
  'head1' =&gt; "\n&lt;h1&gt;",  # And also stick in an &lt;a name="..."&gt;
  'head2' =&gt; "\n&lt;h2&gt;",  #  ''
  'head3' =&gt; "\n&lt;h3&gt;",  #  ''
  'head4' =&gt; "\n&lt;h4&gt;",  #  ''
  'head5' =&gt; "\n&lt;h5&gt;",  #  ''
  'head6' =&gt; "\n&lt;h6&gt;",  #  ''
  '/head1' =&gt; "&lt;/a&gt;&lt;/h1&gt;\n",
  '/head2' =&gt; "&lt;/a&gt;&lt;/h2&gt;\n",
  '/head3' =&gt; "&lt;/a&gt;&lt;/h3&gt;\n",
  '/head4' =&gt; "&lt;/a&gt;&lt;/h4&gt;\n",
  '/head5' =&gt; "&lt;/a&gt;&lt;/h5&gt;\n",
  '/head6' =&gt; "&lt;/a&gt;&lt;/h6&gt;\n",

  'X'  =&gt; "&lt;!--\n\tINDEX: ",
  '/X' =&gt; "\n--&gt;",

  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 &amp;&amp; push @_to_accept, $1; $_ }
    qw[
      sample=samp
      definition=dfn
      keyboard=kbd
      variable=var
      citation=cite
      abbreviation=abbr
      acronym=acronym
      subscript=sub
      superscript=sup
      big=big
      small=small
      underline=u
      strikethrough=s
      preformat=pre
      teletype=tt
    ]  # no point in providing a way to get &lt;q&gt;...&lt;/q&gt;, I think
  ),
  
  '/item-bullet' =&gt; "&lt;/li&gt;$LamePad\n",
  '/item-number' =&gt; "&lt;/li&gt;$LamePad\n",
  '/item-text'   =&gt; "&lt;/a&gt;&lt;/dt&gt;$LamePad\n",
  'item-body'    =&gt; "\n&lt;dd&gt;",
  '/item-body'   =&gt; "&lt;/dd&gt;\n",


  'B'      =&gt;  "&lt;b&gt;",                  '/B'     =&gt;  "&lt;/b&gt;",
  'I'      =&gt;  "&lt;i&gt;",                  '/I'     =&gt;  "&lt;/i&gt;",
  'F'      =&gt;  "&lt;em$Computerese&gt;",     '/F'     =&gt;  "&lt;/em&gt;",
  'C'      =&gt;  "&lt;code$Computerese&gt;",   '/C'     =&gt;  "&lt;/code&gt;",
  'L'  =&gt;  "&lt;a href='YOU_SHOULD_NEVER_SEE_THIS'&gt;", # ideally never used!
  '/L' =&gt;  "&lt;/a&gt;",
);

sub changes {
  return map {; m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s
     ? ( $1, =&gt; "\n&lt;$2&gt;", "/$1", =&gt; "&lt;/$2&gt;\n" ) : die "Funky $_"
  } @_;
}
sub changes2 {
  return map {; m/^([-_:0-9a-zA-Z]+)=([-_:0-9a-zA-Z]+)$/s
     ? ( $1, =&gt; "&lt;$2&gt;", "/$1", =&gt; "&lt;/$2&gt;" ) : die "Funky $_"
  } @_;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sub go { Pod::Simple::HTML-&gt;parse_from_file(@ARGV); exit 0 }
 # Just so we can run from the command line.  No options.
 #  For that, use perldoc!
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub new {
  my $new = shift-&gt;SUPER::new(@_);
  #$new-&gt;nix_X_codes(1);
  $new-&gt;nbsp_for_S(1);
  $new-&gt;accept_targets( 'html', 'HTML' );
  $new-&gt;accept_codes('VerbatimFormatted');
  $new-&gt;accept_codes(@_to_accept);
  DEBUG &gt; 2 and print STDERR "To accept: ", join(' ',@_to_accept), "\n";

  $new-&gt;perldoc_url_prefix(  $Perldoc_URL_Prefix  );
  $new-&gt;perldoc_url_postfix( $Perldoc_URL_Postfix );
  $new-&gt;man_url_prefix(  $Man_URL_Prefix  );
  $new-&gt;man_url_postfix( $Man_URL_Postfix );
  $new-&gt;title_prefix(  $Title_Prefix  );
  $new-&gt;title_postfix( $Title_Postfix );

  $new-&gt;html_header_before_title(
   qq[$Doctype_decl&lt;html&gt;&lt;head&gt;&lt;title&gt;]
  );
  $new-&gt;html_header_after_title( join "\n" =&gt;
    "&lt;/title&gt;",
    $Content_decl,
    "&lt;/head&gt;\n&lt;body class='pod'&gt;",
    $new-&gt;version_tag_comment,
    "&lt;!-- start doc --&gt;\n",
  );
  $new-&gt;html_footer( qq[\n&lt;!-- end doc --&gt;\n\n&lt;/body&gt;&lt;/html&gt;\n] );
  $new-&gt;top_anchor( "&lt;a name='___top' class='dummyTopAnchor' &gt;&lt;/a&gt;\n" );

  $new-&gt;{'Tagmap'} = {%Tagmap};

  return $new;
}

sub __adjust_html_h_levels {
  my ($self) = @_;
  my $Tagmap = $self-&gt;{'Tagmap'};

  my $add = $self-&gt;html_h_level;
  return unless defined $add;
  return if ($self-&gt;{'Adjusted_html_h_levels'}||0) == $add;

  $add -= 1;
  for (1 .. 6) {
    $Tagmap-&gt;{"head$_"}  =~ s/$_/$_ + $add/e;
    $Tagmap-&gt;{"/head$_"} =~ s/$_/$_ + $add/e;
  }
}

sub batch_mode_page_object_init {
  my($self, $batchconvobj, $module, $infile, $outfile, $depth) = @_;
  DEBUG and print STDERR "Initting $self\n  for $module\n",
    "  in $infile\n  out $outfile\n  depth $depth\n";
  $self-&gt;batch_mode(1);
  $self-&gt;batch_mode_current_level($depth);
  return $self;
}

sub run {
  my $self = $_[0];
  return $self-&gt;do_middle if $self-&gt;bare_output;
  return
   $self-&gt;do_beginning &amp;&amp; $self-&gt;do_middle &amp;&amp; $self-&gt;do_end;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub do_beginning {
  my $self = $_[0];

  my $title;
  
  if(defined $self-&gt;force_title) {
    $title = $self-&gt;force_title;
    DEBUG and print STDERR "Forcing title to be $title\n";
  } else {
    # Actually try looking for the title in the document:
    $title = $self-&gt;get_short_title();
    unless($self-&gt;content_seen) {
      DEBUG and print STDERR "No content seen in search for title.\n";
      return;
    }
    $self-&gt;{'Title'} = $title;

    if(defined $title and $title =~ m/\S/) {
      $title = $self-&gt;title_prefix . esc($title) . $self-&gt;title_postfix;
    } else {
      $title = $self-&gt;default_title;    
      $title = '' unless defined $title;
      DEBUG and print STDERR "Title defaults to $title\n";
    }
  }

  
  my $after = $self-&gt;html_header_after_title  || '';
  if($self-&gt;html_css) {
    my $link =
    $self-&gt;html_css =~ m/&lt;/
     ? $self-&gt;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[&lt;link rel="stylesheet" type="text/css" title="pod_stylesheet" href="%s"&gt;\n],
      $self-&gt;html_css,
    );
    $after =~ s{(&lt;/head&gt;)}{$link\n$1}i;  # otherwise nevermind
  }
  $self-&gt;_add_top_anchor(\$after);

  if($self-&gt;html_javascript) {
    my $link =
    $self-&gt;html_javascript =~ m/&lt;/
     ? $self-&gt;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[&lt;script type="text/javascript" src="%s"&gt;&lt;/script&gt;\n],
      $self-&gt;html_javascript,
    );
    $after =~ s{(&lt;/head&gt;)}{$link\n$1}i;  # otherwise nevermind
  }

  print {$self-&gt;{'output_fh'}}
    $self-&gt;html_header_before_title || '',
    $title, # already escaped
    $after,
  ;

  DEBUG and print STDERR "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 .= $self-&gt;top_anchor || '';
  }
  return;
}

sub version_tag_comment {
  my $self = shift;
  return sprintf
   "&lt;!--\n  generated by %s v%s,\n  using %s v%s,\n  under Perl v%s at %s GMT.\n\n %s\n\n--&gt;\n",
   esc(
    ref($self), $self-&gt;VERSION(), $ISA[0], $ISA[0]-&gt;VERSION(),
    $], scalar(gmtime($ENV{SOURCE_DATE_EPOCH} || time)),
   ), $self-&gt;_modnote(),
  ;
}

sub _modnote {
  my $class = ref($_[0]) || $_[0];
  return join "\n   " =&gt; 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-&gt;{'output_fh'}}  $self-&gt;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-&gt;_do_middle_main_loop unless $self-&gt;index;

  if( $self-&gt;output_string ) {
    # An efficiency hack
    my $out = $self-&gt;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-&gt;_do_middle_main_loop;
    $sneakytag = quotemeta($sneakytag);
    my $index = $self-&gt;index_as_html();
    if( $$out =~ s/$sneakytag/$index/s ) {
      # Expected case
      DEBUG and print STDERR "Inserted ", length($index), " bytes of index HTML into $out.\n";
    } else {
      DEBUG and print STDERR "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-&gt;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-&gt;output_fh;
  my $content = '';
  {
    # Our horrible bait and switch:
    $self-&gt;output_string( \$content );
    $self-&gt;_do_middle_main_loop;
    $self-&gt;abandon_output_string();
    $self-&gt;output_fh($fh);
  }
  print $fh $self-&gt;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-&gt;{'PSHTML_index_points'} || [];
  
  @$points &gt; 1 or return qq[&lt;div class='indexgroupEmpty'&gt;&lt;/div&gt;\n];
   # There's no point in having a 0-item or 1-item index, I dare say.
  
  my(@out) = qq{\n&lt;div class='indexgroup'&gt;};
  my $level = 0;

  my( $target_level, $previous_tagname, $tagname, $text, $anchorname, $indent);
  foreach my $p (@$points, ['head0', '(end)']) {
    ($tagname, $text) = @$p;
    $anchorname = $self-&gt;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 &gt; $target_level)
     { --$level; push @out, ("  " x $level) . "&lt;/ul&gt;"; }
    while($level &lt; $target_level)
     { ++$level; push @out, ("  " x ($level-1))
       . "&lt;ul   class='indexList indexList$level'&gt;"; }

    $previous_tagname = $tagname;
    next unless $level;
    
    $indent = '  '  x $level;
    push @out, sprintf
      "%s&lt;li class='indexItem indexItem%s'&gt;&lt;a href='#%s'&gt;%s&lt;/a&gt;",
      $indent, $level, esc($anchorname), esc($text)
    ;
  }
  push @out, "&lt;/div&gt;\n";
  return join "\n", @out;
}

###########################################################################

sub _do_middle_main_loop {
  my $self = $_[0];
  my $fh = $self-&gt;{'output_fh'};
  my $tagmap = $self-&gt;{'Tagmap'};

  $self-&gt;__adjust_html_h_levels;
  
  my($token, $type, $tagname, $linkto, $linktype);
  my @stack;
  my $dont_wrap = 0;

  while($token = $self-&gt;get_token) {

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    if( ($type = $token-&gt;type) eq 'start' ) {
      if(($tagname = $token-&gt;tagname) eq 'L') {
        $linktype = $token-&gt;attr('type') || 'insane';
        
        $linkto = $self-&gt;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{&lt;a href="$linkto" class="podlink$linktype"\n&gt;};
        } else {
          print $fh "&lt;a&gt;"; # Yes, an 'a' element with no attributes!
        }

      } elsif ($tagname eq 'item-text' or $tagname =~ m/^head\d$/s) {
        print $fh $tagmap-&gt;{$tagname} || next;

        my @to_unget;
        while(1) {
          push @to_unget, $self-&gt;get_token;
          last if $to_unget[-1]-&gt;is_end
              and $to_unget[-1]-&gt;tagname eq $tagname;
          
          # TODO: support for X&lt;...&gt;'s found in here?  (maybe hack into linearize_tokens)
        }

        my $name = $self-&gt;linearize_tokens(@to_unget);
        $name = $self-&gt;do_section($name, $token) if defined $name;

        print $fh "&lt;a ";
        if ($tagname =~ m/^head\d$/s) {
            print $fh "class='u'", $self-&gt;index
                ? " href='#___top' title='click to go to top of document'\n"
                : "\n";
        }
        
        if(defined $name) {
          my $esc = esc(  $self-&gt;section_name_tidy( $name ) );
          print $fh qq[name="$esc"];
          DEBUG and print STDERR "Linearized ", scalar(@to_unget),
           " tokens as \"$name\".\n";
          push @{ $self-&gt;{'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 STDERR "Linearized ", scalar(@to_unget),
           " tokens, but it was too long, so nevermind.\n";
        }
        print $fh "\n&gt;";
        $self-&gt;unget_token(@to_unget);

      } elsif ($tagname eq 'Data') {
        my $next = $self-&gt;get_token;
        next unless defined $next;
        unless( $next-&gt;type eq 'text' ) {
          $self-&gt;unget_token($next);
          next;
        }
        DEBUG and print STDERR "    raw text ", $next-&gt;text, "\n";
        # The parser sometimes preserves newlines and sometimes doesn't!
        (my $text = $next-&gt;text) =~ s/\n\z//;
        print $fh $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-&gt;{$tagname} || next;
        ++$dont_wrap if $tagname eq 'Verbatim' or $tagname eq "VerbatimFormatted"
          or $tagname eq 'X';
      }

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    } elsif( $type eq 'end' ) {
      if( ($tagname = $token-&gt;tagname) =~ m/^over-/s ) {
        if( my $end = pop @stack ) {
          print $fh $end;
        }
      } elsif( $tagname =~ m/^item-/s and @stack) {
        $stack[-1] = $tagmap-&gt;{"/$tagname"};
        if( $tagname eq 'item-text' and defined(my $next = $self-&gt;get_token) ) {
          $self-&gt;unget_token($next);
          if( $next-&gt;type eq 'start' ) {
            print $fh $tagmap-&gt;{"/item-text"},$tagmap-&gt;{"item-body"};
            $stack[-1] = $tagmap-&gt;{"/item-body"};
          }
        }
        next;
      }
      print $fh $tagmap-&gt;{"/$tagname"} || next;
      --$dont_wrap if $tagname eq 'Verbatim' or $tagname eq 'X';

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    } elsif( $type eq 'text' ) {
      esc($type = $token-&gt;text);  # reuse $type, why not
      $type =~ s/([\?\!\"\'\.\,]) /$1\n/g unless $dont_wrap;
      print $fh $type;
    }

  }
  return 1;
}

###########################################################################
#

sub do_section {
  my($self, $name, $token) = @_;
  return $name;
}

sub do_link {
  my($self, $token) = @_;
  my $type = $token-&gt;attr('type');
  if(!defined $type) {
    $self-&gt;whine("Typeless L!?", $token-&gt;attr('start_line'));
  } elsif( $type eq 'pod') { return $self-&gt;do_pod_link($token);
  } elsif( $type eq 'url') { return $self-&gt;do_url_link($token);
  } elsif( $type eq 'man') { return $self-&gt;do_man_link($token);
  } else {
    $self-&gt;whine("L of unknown type $type!?", $token-&gt;attr('start_line'));
  }
  return 'FNORG'; # should never get called
}

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

sub do_url_link { return $_[1]-&gt;attr('to') }

sub do_man_link {
  my ($self, $link) = @_;
  my $to = $link-&gt;attr('to');
  my $frag = $link-&gt;attr('section');

  return undef unless defined $to and length $to; # should never happen

  $frag = $self-&gt;section_escape($frag)
   if defined $frag and length($frag .= ''); # (stringify)

  DEBUG and print STDERR "Resolving \"$to/$frag\"\n\n";

  return $self-&gt;resolve_man_page_link($to, $frag);
}


sub do_pod_link {
  # And now things get really messy...
  my($self, $link) = @_;
  my $to = $link-&gt;attr('to');
  my $section = $link-&gt;attr('section');
  return undef unless(  # should never happen
    (defined $to and length $to) or
    (defined $section and length $section)
  );

  $section = $self-&gt;section_escape($section)
   if defined $section and length($section .= ''); # (stringify)

  DEBUG and printf STDERR "Resolving \"%s\" \"%s\"...\n",
   $to || "(nil)",  $section || "(nil)";
   
  {
    # An early hack:
    my $complete_url = $self-&gt;resolve_pod_link_by_table($to, $section);
    if( $complete_url ) {
      DEBUG &gt; 1 and print STDERR "resolve_pod_link_by_table(T,S) gives ",
        $complete_url, "\n  (Returning that.)\n";
      return $complete_url;
    } else {
      DEBUG &gt; 4 and print STDERR " 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-&gt;resolve_pod_link_by_table($to);
    if(defined $there and length $there) {
      DEBUG &gt; 1
       and print STDERR "resolve_pod_link_by_table(T) gives $there\n";
    } else {
      $there = 
        $self-&gt;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 &gt; 1 and print STDERR "resolve_pod_page_link gives ", $there || "(nil)", "\n";
      unless( defined $there and length $there ) {
        DEBUG and print STDERR "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 STDERR "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 STDERR "Oddly, couldn't resolve \"%s\" \"%s\"...\n",
     $to || "(nil)",  $section || "(nil)";
    return undef;
  }

  DEBUG and print STDERR "Resolved to $out\n";
  return $out;  
}


# . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .

sub section_escape {
  my($self, $section) = @_;
  return $self-&gt;section_url_escape(
    $self-&gt;section_name_tidy($section)
  );
}

sub section_name_tidy {
  my($self, $section) = @_;
  $section =~ s/^\s+//;
  $section =~ s/\s+$//;
  $section =~ tr/ /_/;
  if ($] ge 5.006) {
    $section =~ s/[[:cntrl:][:^ascii:]]//g; # drop crazy characters
  } elsif ('A' eq chr(65)) { # But not on early EBCDIC
    $section =~ tr/\x00-\x1F\x80-\x9F//d;
  }
  $section = $self-&gt;unicode_escape_url($section);
  $section = '_' unless length $section;
  return $section;
}

sub section_url_escape  { shift-&gt;general_url_escape(@_) }
sub pagepath_url_escape { shift-&gt;general_url_escape(@_) }
sub manpage_url_escape  { shift-&gt;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)
  
  if ($] ge 5.007_003) {
    $string =~ s/([^-_\.!~*()abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/sprintf('%%%02X',utf8::native_to_unicode(ord($1)))/eg;
  } else { # Is broken for non-ASCII platforms on early perls
    $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.
  
  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-&gt;batch_mode()
   ? $self-&gt;resolve_pod_page_link_batch_mode(@_)
   : $self-&gt;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-&gt;pagepath_url_escape($it);
  
  $url =~ s{::$}{}s; # probably never comes up anyway
  $url =~ s{::}{/}g unless $self-&gt;perldoc_url_prefix =~ m/\?/s; # sane DWIM?
  
  return undef unless length $url;
  return $self-&gt;perldoc_url_prefix . $url . $self-&gt;perldoc_url_postfix;
}

sub resolve_pod_page_link_batch_mode {
  my($self, $to) = @_;
  DEBUG &gt; 1 and print STDERR " During batch mode, resolving $to ...\n";
  my @path = grep length($_), split m/::/s, $to, -1;
  unless( @path ) { # sanity
    DEBUG and print STDERR "Very odd!  Splitting $to gives (nil)!\n";
    return undef;
  }
  $self-&gt;batch_mode_rectify_path(\@path);
  my $out = join('/', map $self-&gt;pagepath_url_escape($_), @path)
    . $HTML_EXTENSION;
  DEBUG &gt; 1 and print STDERR " =&gt; $out\n";
  return $out;
}

sub batch_mode_rectify_path {
  my($self, $pathbits) = @_;
  my $level = $self-&gt;batch_mode_current_level;
  $level--; # how many levels up to go to get to the root
  if($level &lt; 1) {
    unshift @$pathbits, '.'; # just to be pretty
  } else {
    unshift @$pathbits, ('..') x $level;
  }
  return;
}

sub resolve_man_page_link {
  my ($self, $to, $frag) = @_;
  my ($page, $section) = $to =~ /^([^(]+)(?:[(](\d+)[)])?$/;

  return undef unless defined $page and length $page;
  $section ||= 1;

  return $self-&gt;man_url_prefix . "$section/"
      . $self-&gt;manpage_url_escape($page)
      . $self-&gt;man_url_postfix;
}

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

sub resolve_pod_link_by_table {
  # A crazy hack to allow specifying custom L&lt;foo&gt; =&gt; URL mappings

  return unless $_[0]-&gt;{'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-&gt;{'podhtml_LOT'}{"$to#$section"}; # quite possibly undef!
  } else {
    return $self-&gt;{'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-&gt;is_text) {
      $out .= $t-&gt;text;
    } elsif($t-&gt;is_start and $t-&gt;tag eq 'X') {
      # Ignore until the end of this X&lt;...&gt; sequence:
      my $x_open = 1;
      while($x_open) {
        next if( ($t = shift @_)-&gt;is_text );
        if(   $t-&gt;is_start and $t-&gt;tag eq 'X') { ++$x_open }
        elsif($t-&gt;is_end   and $t-&gt;tag eq 'X') { --$x_open }
      }
    }
  }
  return undef if length $out &gt; $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;
      if ($] ge 5.007_003) {
        $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&amp;#'.(utf8::native_to_unicode(ord($1))).';'/eg;
      } else { # Is broken for non-ASCII platforms on early perls
        $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&amp;#'.(ord($1)).';'/eg;
      }
      return $x;
    }
  }
  foreach my $x (@_) {
    # Escape things very cautiously:
    if (defined $x) {
      if ($] ge 5.007_003) {
        $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&amp;#'.(utf8::native_to_unicode(ord($1))).';'/eg
      } else { # Is broken for non-ASCII platforms on early perls
        $x =~ s/([^-\n\t !\#\$\%\(\)\*\+,\.\~\/\:\;=\?\@\[\\\]\^_\`\{\|\}abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789])/'&amp;#'.(ord($1)).';'/eg
      }
    }
    # 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.
  }
  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&lt;Pod::Simple::PullParser&gt; 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&lt;Pod::Simple::HTMLBatch&gt;.



=head1 CALLING FROM THE COMMAND LINE

TODO

  perl -MPod::Simple::HTML -e Pod::Simple::HTML::go Thing.pod Thing.html



=head1 CALLING FROM PERL

=head2 Minimal code

  use Pod::Simple::HTML;
  my $p = Pod::Simple::HTML-&gt;new;
  $p-&gt;output_string(\my $html);
  $p-&gt;parse_file('path/to/Module/Name.pm');
  open my $out, '&gt;', 'out.html' or die "Cannot open 'out.html': $!\n";
  print $out $html;

=head2 More detailed example

  use Pod::Simple::HTML;

Set the content type:

  $Pod::Simple::HTML::Content_decl =  q{&lt;meta http-equiv="Content-Type" content="text/html; charset=UTF-8" &gt;};

  my $p = Pod::Simple::HTML-&gt;new;

Include a single javascript source:

  $p-&gt;html_javascript('http://abc.com/a.js');

Or insert multiple javascript source in the header 
(or for that matter include anything, thought this is not recommended)

  $p-&gt;html_javascript('
      &lt;script type="text/javascript" src="http://abc.com/b.js"&gt;&lt;/script&gt;
      &lt;script type="text/javascript" src="http://abc.com/c.js"&gt;&lt;/script&gt;');

Include a single css source in the header:

  $p-&gt;html_css('/style.css');

or insert multiple css sources:

  $p-&gt;html_css('
      &lt;link rel="stylesheet" type="text/css" title="pod_stylesheet" href="http://remote.server.com/jquery.css"&gt;
      &lt;link rel="stylesheet" type="text/css" title="pod_stylesheet" href="/style.css"&gt;');

Tell the parser where should the output go. In this case it will be placed in the $html variable:

  my $html;
  $p-&gt;output_string(\$html);

Parse and process a file with pod in it:

  $p-&gt;parse_file('path/to/Module/Name.pm');

=head1 METHODS

TODO
all (most?) accessorized methods

The following variables need to be set B&lt;before&gt; the call to the -&gt;new constructor.

Set the string that is included before the opening &lt;html&gt; tag:

  $Pod::Simple::HTML::Doctype_decl = qq{&lt;!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" 
	 "http://www.w3.org/TR/html4/loose.dtd"&gt;\n};

Set the content-type in the HTML head: (defaults to ISO-8859-1)

  $Pod::Simple::HTML::Content_decl =  q{&lt;meta http-equiv="Content-Type" content="text/html; charset=UTF-8" &gt;};

Set the value that will be embedded in the opening tags of F, C tags and verbatim text.
F maps to &lt;em&gt;, C maps to &lt;code&gt;, Verbatim text maps to &lt;pre&gt; (Computerese defaults to "")

  $Pod::Simple::HTML::Computerese =  ' class="some_class_name';

=head2 html_css

=head2 html_javascript

=head2 title_prefix

=head2 title_postfix

=head2 html_header_before_title

This includes everything before the &lt;title&gt; opening tag including the Document type
and including the opening &lt;title&gt; tag. The following call will set it to be a simple HTML
file:

  $p-&gt;html_header_before_title('&lt;html&gt;&lt;head&gt;&lt;title&gt;');

=head2 top_anchor

By default Pod::Simple::HTML adds a dummy anchor at the top of the HTML.
You can change it by calling

  $p-&gt;top_anchor('&lt;a name="zz" &gt;');

=head2 html_h_level

Normally =head1 will become &lt;h1&gt;, =head2 will become &lt;h2&gt; etc.
Using the html_h_level method will change these levels setting the h level
of =head1 tags:

  $p-&gt;html_h_level(3);

Will make sure that =head1 will become &lt;h3&gt; and =head2 will become &lt;h4&gt; etc...


=head2 index

Set it to some true value if you want to have an index (in reality a table of contents)
to be added at the top of the generated HTML.

  $p-&gt;index(1);

=head2 html_header_after_title

Includes the closing tag of &lt;/title&gt; and through the rest of the head
till the opening of the body

  $p-&gt;html_header_after_title('&lt;/title&gt;...&lt;/head&gt;&lt;body id="my_id"&gt;');

=head2 html_footer

The very end of the document:

  $p-&gt;html_footer( qq[\n&lt;!-- end doc --&gt;\n\n&lt;/body&gt;&lt;/html&gt;\n] );

=head1 SUBCLASSING

Can use any of the methods described above but for further customization
one needs to override some of the methods:

  package My::Pod;
  use strict;
  use warnings;

  use base 'Pod::Simple::HTML';

  # needs to return a URL string such
  # http://some.other.com/page.html
  # #anchor_in_the_same_file
  # /internal/ref.html
  sub do_pod_link {
    # My::Pod object and Pod::Simple::PullParserStartToken object
    my ($self, $link) = @_;

    say $link-&gt;tagname;          # will be L for links
    say $link-&gt;attr('to');       # 
    say $link-&gt;attr('type');     # will be 'pod' always
    say $link-&gt;attr('section');

    # Links local to our web site
    if ($link-&gt;tagname eq 'L' and $link-&gt;attr('type') eq 'pod') {
      my $to = $link-&gt;attr('to');
      if ($to =~ /^Padre::/) {
          $to =~ s{::}{/}g;
          return "/docs/Padre/$to.html";
      }
    }

    # all other links are generated by the parent class
    my $ret = $self-&gt;SUPER::do_pod_link($link);
    return $ret;
  }

  1;

Meanwhile in script.pl:

  use My::Pod;

  my $p = My::Pod-&gt;new;

  my $html;
  $p-&gt;output_string(\$html);
  $p-&gt;parse_file('path/to/Module/Name.pm');
  open my $out, '&gt;', 'out.html' or die;
  print $out $html;

TODO

maybe override do_beginning do_end

=head1 SEE ALSO

L&lt;Pod::Simple&gt;, L&lt;Pod::Simple::HTMLBatch&gt;

TODO: a corpus of sample Pod input and HTML output?  Or common
idioms?

=head1 SUPPORT

Questions or discussion about POD and Pod::Simple should be sent to the
pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.

This module is managed in an open GitHub repository,
L&lt;https://github.com/perl-pod/pod-simple/&gt;. Feel free to fork and contribute, or
to clone L&lt;git://github.com/perl-pod/pod-simple.git&gt; and send patches!

Patches against Pod::Simple are welcome. Please send bug reports to
&lt;bug-pod-simple@rt.cpan.org&gt;.

=head1 COPYRIGHT AND DISCLAIMERS

Copyright (c) 2002-2004 Sean M. Burke.

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 ACKNOWLEDGEMENTS

Thanks to L&lt;Hurricane Electric|http://he.net/&gt; for permission to use its
L&lt;Linux man pages online|http://man.he.net/&gt; site for man page links.

Thanks to L&lt;search.cpan.org|http://search.cpan.org/&gt; for permission to use the
site for Perl module links.

=head1 AUTHOR

Pod::Simple was created by Sean M. Burke &lt;sburke@cpan.org&gt;.
But don't bother him, he's retired.

Pod::Simple is maintained by:

=over

=item * Allison Randal C&lt;allison@perl.org&gt;

=item * Hans Dieter Pearcey C&lt;hdp@cpan.org&gt;

=item * David E. Wheeler C&lt;dwheeler@cpan.org&gt;

=back

=cut
</pre></body></html>