Category: HTML/Documentation utilities
Author/Contact Info Original by the venerable Tom Christensen. XHTML support and additional enhancements by Demerphq

Description: Use for generating XHTML compliant documentation. Basically equivelent to Pod::Html but it is object oriented and slightly better documented. (er, or was before I had to gut the code to post it...)

* THIS IS A WORK IN PROGRESS *

It has been relatively well tested for fatal issues, but there are a few quirks (bottom indexes are unsatisfactory) and the code is far from clean. Bear in mind this is a rework of a _very_ old script, which has had many hands over the ages, and has been written to support many old versions of perl. The new version is slowly removing support for old perls and cleaning up the code at the same time.

I will also upload the CSS sheet and the batchfile (sorry im on MS) version of the script pod2xhtml.

The condition of the code is due to it being compressed by perltidy. It appears that PM wont handle 75k uploads.. wonder why. Contact me if you want the original, but soon it should go to CPAN anyway...

package Pod::XHtml;
use strict;
use vars qw($VERSION);
$VERSION = 0.01;
use Carp;
use Config;
use Cwd;
use File::Spec::Unix;
use Getopt::Long;
use Pod::Functions;
use POSIX 'strftime';
use diagnostics;
use locale;
{my$singleton;
sub new{return$singleton if$singleton;
my$class=shift;
my$self=bless{},$class;
$self->init_globals(1);
$singleton=$self;
return$self;}sub class_obj{Carp::confess"$_[0]" unless ref($_[0])eq 'P
+od::XHtml'||$_[0]eq 'Pod::XHtml';
return$_[0]if ref$_[0];
return$_[0]->new();}}sub init_globals{my$self=shift->class_obj;
my$new=shift;
$self->{cache_ext}=$^O eq 'VMS'?".tmp":".x~~";
my$init={dircache=>"pod2xhtmd$self->{cache_ext}",itemcache=>"pod2xhtmi
+$self->{cache_ext}",begin_stack=>[],libpods=>[],htmlroot=>"/",htmldir
+=>"",htmlfile=>"",htmlfileurl=>"",podfile=>"",podpath=>[],podroot=>".
+",css=>'',recurse=>1,quiet=>0,verbose=>0,doindex=>1,backlink=>'',list
+level=>0,listend=>[],after_lpar=>0,ignore=>1,items_named=>{},items_se
+en=>[],stack=>[],netscape=>0,title=>undef,header=>0,top=>1,paragraph=
+>undef,ptQuote=>0,ldq=>'``',rdq=>"''",sections=>{},*items=>{},local_i
+tems=>{},printed_items=>{},Is83=>undef,usage=>undef,saved_cache_key=>
+undef,EmittedItem=>undef,HTML=>[],E2c=>{lt=>'<',gt=>'>',sol=>'/',verb
+ar=>'|',amp=>'&',},};
$self->{$_}=$init->{$_}foreach keys%$init;
if($new){$self->{pages}={};
$self->{items}={};
$self->{hc}=[];
$self->{c_index}={};}$self->{usage}= <<END_OF_USAGE;
Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
           --podpath=<name>:...:<name> --podroot=<name>
           --libpods=<name>:...:<name> --recurse --verbose --index
           --netscape --norecurse --noindex

  --backlink     - set text for "back to top" links (default: none).
  --css          - stylesheet URL
  --flush        - flushes the item and directory caches.
  --[no]header   - produce block header/footer (default is no headers)
+.
  --help         - prints this message.
  --htmldir      - directory for resulting HTML files.
  --htmlroot     - http-server base directory from which all relative 
+paths
                   in podpath stem (default is /).
  --[no]index    - generate an index at the top of the resulting html
                   (default behaviour).
  --infile       - filename for the pod to convert (input taken from s
+tdin
                   by default).
  --libpods      - colon-separated list of pages to search for =item p
+od
                   directives in as targets of C<> and implicit links 
+(empty
                   by default).  note, these are not filenames, but ra
+ther
                   page names like those that appear in L<> links.
  --[no]netscape - will use netscape html directives when applicable.
                   (default is not to use them).
  --outfile      - filename for the resulting html file (output sent t
+o
                   stdout by default).
  --podpath      - colon-separated list of directories containing libr
+ary
                   pods (empty by default).
  --podroot      - filesystem base directory from which all relative p
+aths
                   in podpath stem (default is .).
  --[no]quiet    - supress some benign warning messages (default is of
+f).
  --[no]recurse  - recurse on those subdirectories listed in podpath
                   (default behaviour).
  --title        - title that will appear in resulting html file.
  --[no]verbose  - self-explanatory (off by default).

END_OF_USAGE
return$self;}sub clean_data{my$self=shift->class_obj;
my$dataref=shift;
for my $i(0..$#$dataref){$dataref->[$i]=~s/\s+\Z//;
if($dataref->[$i]=~/^\s+$/m){my@chunks=split(/^\s+$/m,$dataref->[$i]);
splice(@$dataref,$i,1,@chunks);}}}sub find_title{my$self=shift->class_
+obj;
my$poddata=shift;
unless($self->{title}){TITLE_SEARCH:{for my $i(0..$#$poddata){if($podd
+ata->[$i]=~/^=head1\s*NAME\b/m){for my $para(@$poddata[$i,$i+1]){last
+ TITLE_SEARCH if($self->{title})=$para=~/(\S+\s+-+.*\S)/s;}}}}warn"us
+ing '$self->{title}' as title" if$self->{title}&&$self->{verbose};}if
+(!$self->{title}and$self->{podfile}=~/\.pod\z/){for my $i(0..$#$podda
+ta){last if($self->{title})=$poddata->[$i]=~/^=head[12]\s*(.*)/;}warn
+"adopted '$self->{title}' as title for $self->{podfile}\n" if$self->{
+verbose}and$self->{title};}if($self->{title}){$self->{title}=~s/\s*\(
+.*\)//;}else{warn ref($self).": no title for $self->{podfile}" unless
+$self->{quiet};
$self->{podfile}=~/^(.*)(\.[^.\/]+)?\z/s;
$self->{title}=($self->{podfile}eq"-"?'No Title':$1);
warn"using $self->{title}" if$self->{verbose};}}sub print_headers{my$s
+elf=shift->class_obj;
my$csslink=$self->{css}?qq(\n<link rel="stylesheet" href="$self->{css}
+" type="text/css">):'';
$csslink=~s,\\,/,g;
$csslink=~s,(/.):,$1|,;
my($creator)=$0=~/[\/\\]([^\/\\.]+)\..*$/;
my$create_time=strftime("%Y/%m/%d %H:%M:%S %Z",localtime);
my$block=$self->{header}? <<END_OF_BLOCK :'';
    <h1 class="title">&nbsp;$self->{title}</h1>
END_OF_BLOCK
push@{$self->{HTML}}, <<END_OF_HEAD;
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE html
          PUBLIC "-//W3C//DTD XHTML 1.0 TRANSITIONAL//EN"
          " HTTP://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
    <head>
        <title>$self->{title}</title>
        $csslink
        <link rev="made" href="mailto:$Config{perladmin}" />
        <meta name="generator_name" contents="$creator" />
        <meta name="generator_ver"  contents="$VERSION" />
        <meta name="date_generated" contents="$create_time" />
    </head>
    <body>
    $block
END_OF_HEAD
return$block;}sub print_index{my$self=shift->class_obj;
my$index=shift;
return unless$index;
$index=~s/--+/-/g;
push@{$self->{HTML}},"        <a class=\"idxstart\" id=\"__index__\"><
+/a>\n";
push@{$self->{HTML}},"        <!-- INDEX BEGIN -->\n";
push@{$self->{HTML}},"        <!--\n" unless$self->{doindex};
push@{$self->{HTML}},$index;
push@{$self->{HTML}},"        -->\n" unless$self->{doindex};
push@{$self->{HTML}},"        <!-- INDEX END -->\n\n";
push@{$self->{HTML}},"        <hr />\n" if$self->{doindex}and$index;}s
+ub open_filehandles_get_pod{my$self=shift->class_obj;
local*POD;
unless(@ARGV&&$ARGV[0]){$self->{podfile}="-" unless$self->{podfile};
open(POD,"<$self->{podfile}")||die ref($self)." cannot open $self->{po
+dfile} file for input: $!\n";}else{$self->{podfile}=$ARGV[0];
*POD=*ARGV;}$self->{htmlfile}="-" unless$self->{htmlfile};
$self->{htmlroot}="" if$self->{htmlroot}eq"/";
$self->{htmldir}=~s#/\z##;
if($self->{htmlroot}eq ''&&defined($self->{htmldir})&&$self->{htmldir}
+ne ''&&substr($self->{htmlfile},0,length($self->{htmldir}))eq$self->{
+htmldir}){$self->{htmlfileurl}="$self->{htmldir}/".substr($self->{htm
+lfile},length($self->{htmldir})+1);}warn"Scanning for sections in inp
+ut file(s)\n" if$self->{verbose};
$/="";
my@return=<POD>;
close(POD);
open(HTML,">$self->{htmlfile}")||die ref($self)." cannot open $self->{
+htmlfile} file for output: $!\n";
return@return;}sub text_to_table{my$self=shift->class_obj;
my$text=shift;
if($text=~/\t/){my@lines=split("\n",$text);
my@split;
my$width;
if(@lines>1){my$all=2;
foreach my $line(@lines){if($line=~/\S/&&$line!~/\t/){$all--;
last if$all==0;}my@row=split/\t/,$line;
$width=$#row unless$width&&$width>$#row;
push@split,\@row;}if($all>0){my$tablename=$split[0][0];
$tablename=~tr[- +."<>]
                              [__]d;
my$hasheader=0;
if($lines[1]!~/[^-\t\s]/&&(@{$split[1]}==@{$split[0]})){$split[1]=$spl
+it[0];
shift@split;
my$row='<tr class="expr_tabs_hdr">';
{no warnings;
$row.=qq'<th class="expr_tabs">$split[$row][$_]</th>' foreach 0..$widt
+h;}$row.="</tr>\n";
$split[0]=$row;
$hasheader=1;}else{$tablename="no_header";}foreach my $row(0..$#split)
+{next unless ref$split[$row];
my$txt='<tr class="expr_tabs">';
foreach(0..$width){no warnings;
if($hasheader){my$data=$split[$row][$_];
my$wl=$data=~s/^\s+//;
my$wr=$data=~s/\s+$//;
my$dir=($wl&&$wr)?"center":$wl?"right":"left";
$txt.=qq'<td class="expr_tabs" nowrap="nowrap" align="$dir">$data</td>
+';}else{$txt.=qq'<td class="expr_tabs" nowrap="nowrap">$split[$row][$
+_]</td>';}}$txt.="</tr>\n";
$split[$row]=$txt;}$text=qq'<table class="expr_tabs">\n'.join('',@spli
+t)."</table>\n";
$text=qq'\n<div class="$tablename">\n$text</div>\n';
;}}}return$text;}sub print_footer{my$self=shift->class_obj;
my$index=shift;
my$block=shift;
push@{$self->{HTML}},q'<p class="backlink"><a class="backlink" href="#
+__index__">$self->{backlink}</a></p>\n' if$self->{doindex}and$index a
+nd$self->{backlink};
push@{$self->{HTML}},"<!-- itm_index -->\n";
foreach my $itype(sort keys%{$self->{printed_items}}){push@{$self->{HT
+ML}},"<hr class=\"itm_index\" />\n";
my@out;
my$ltr="";
foreach my $iname(sort keys%{$self->{printed_items}->{$itype}}){if($it
+ype eq"Functions"){if($ltr ne substr($iname,0,1)){$ltr=substr($iname,
+0,1);
push@{$self->{HTML}},qq'&nbsp;&nbsp;<b class="itm_index">$ltr)</b>&nbs
+p;&nbsp;';}}if($itype eq"Sections"){push@out,qq'<td class="itm_index"
+>'.qq'<a class="itm_index" href="$self->{printed_items}->{$itype}{$in
+ame}">$iname</a>&nbsp;&nbsp;'.qq'</td>';}else{(my$nbsp=$iname)=~s/\s+
+/&nbsp;/g;
push@{$self->{HTML}},qq'<a class="itm_index" href="$self->{printed_ite
+ms}->{$itype}{$iname}">$nbsp</a>\n';}}if($itype eq"Sections"){push@{$
+self->{HTML}},qq'<table class="itm_index" rows="2">\n';
foreach(0..$#out){push@{$self->{HTML}},qq'<tr class="itm_index">\n' un
+less$_%3;
push@{$self->{HTML}},($out[$_]||"<td />");
push@{$self->{HTML}},qq'</tr>\n' if$_%3==2;}push@{$self->{HTML}},qq'</
+tr>\n' unless$#out%3==2;
push@{$self->{HTML}},qq'</table>\n' if($itype eq"Sections");}}push@{$s
+elf->{HTML}},"\n<hr />\n";
push@{$self->{HTML}}, <<END_OF_TAIL;
$block
</body>

</html>
END_OF_TAIL
}sub pod2html{my$self=shift->class_obj;
local(@ARGV)=@_;
local($/);
local$_;
$self->init_globals();
$self->{Is83}=0 if(defined(&Dos::UseLFN)&&Dos::UseLFN());
$self->parse_command_line();
my@poddata=$self->open_filehandles_get_pod();
$self->clean_data(\@poddata);
my$index=$self->scan_headings(\%{$self->{sections}},@poddata);
unless($index){warn"No headings in $self->{podfile}\n" if$self->{verbo
+se};}$self->find_title(\@poddata);
my$block=$self->print_headers();
$self->get_cache($self->{dircache},$self->{itemcache},\@{$self->{podpa
+th}},$self->{podroot},$self->{recurse});
$self->scan_items(\%{$self->{local_items}},"",@poddata);
$self->print_index($index);
my$after_item;
warn"Converting input file $self->{podfile}\n" if$self->{verbose};
my$last_head;
foreach my $i(0..$#poddata){$self->{ptQuote}=0;
$_=$poddata[$i];
$self->{paragraph}=$i+1;
if(/^(=.*)/s){$self->{ignore}=0;
$after_item=0;
$_=$1;
if(/^=begin\s+(\S+)\s*(.*)/si){$self->process_begin($1,$2);}elsif(/^=e
+nd\s+(\S+)\s*(.*)/si){$self->process_end($1,$2);}elsif(/^=cut/){$self
+->process_cut();}elsif(/^=pod/){$self->process_pod();}else{next if@{$
+self->{begin_stack}}&&$self->{begin_stack}->[-1]ne 'html';
if(/^=(head[1-6])\s+(.*\S)/s){$last_head=$1;
$self->process_head($1,$2,$self->{doindex}&&$index);}elsif(/^=item\s*(
+.*\S)?/sm){warn ref($self)." $self->{podfile}: =item without bullet, 
+number or text"." in paragraph $self->{paragraph}.\n" if!$self->{quie
+t}and(!defined($1)or$1 eq '');
$self->process_item($1);
$after_item=1;}elsif(/^=over\s*(.*)/){$self->process_over();}elsif(/^=
+back/){$self->process_back();}elsif(/^=for\s+(\S+)\s*(.*)/si){$self->
+process_for($1,$2);}else{/^=(\S*)\s*/;
warn ref($self)." $self->{podfile}: unknown pod directive '$1' in "."p
+aragraph $self->{paragraph}.  ignoring.\n" unless$self->{quiet};}}$se
+lf->{top}=0;}else{next if$self->{ignore};
next if@{$self->{begin_stack}}&&$self->{begin_stack}->[-1]ne 'html';
my$text=$_;
if($text=~/\A\s+/){$self->process_pre(\$text);
push@{$self->{HTML}},qq'<pre class="verbatim">$text</pre>';}else{$self
+->process_text(\$text);
$text=$self->text_to_table($text);
if($after_item||$text=~/^<table/){push@{$self->{HTML}},"$text\n";
$self->{after_lpar}=1;}else{push@{$self->{HTML}},"<p class=\"text_$las
+t_head\">$text</p>\n";}}$after_item=0;}}$self->finish_list();
$self->print_footer($index,$block);
my@out;
my@pre;
my$last;
while(@{$self->{HTML}}){my$html=shift@{$self->{HTML}};
chomp$html;
$html=~s/\A\n+//;
$html=~s/\n+\z//;
next unless$html;
if($html=~/\A<pre/&&$html=~/<\/pre>\Z/){push@pre,$html;}else{if(@pre){
+if(@pre>1){$pre[0]=~s/<\/pre>\Z//;
$pre[$#pre]=~s/\A<pre[^>]+>//;
for my $i(1..($#pre-1)){$pre[$i]=~s/\A<pre[^>]+>|\n?<\/pre>\Z//g;}push
+@out,join("\n",@pre);}else{push@out,@pre;}@pre=();}push@out,$html;}}p
+rint HTML join"\n",@out;
close(HTML);
warn"Finished\n" if$self->{verbose};}{no strict 'refs';
*pod2xhtml=\*pod2html;}sub usage{my$self=shift->class_obj;
$self->{podfile}=shift;
warn ref($self)." $self->{podfile}: @_\n" if@_;
confess$self->{usage};}sub parse_command_line{my$self=shift->class_obj
+;
my($opt_backlink,$opt_css,$opt_flush,$opt_header,$opt_help,$opt_htmldi
+r,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$op
+t_outfile,$opt_podpath,$opt_podroot,$opt_quiet,$opt_recurse,$opt_titl
+e,$opt_verbose);
unshift@ARGV,split ' ',$Config{pod2html}if$Config{pod2html};
my$result=GetOptions('backlink=s'=>\$opt_backlink,'css=s'=>\$opt_css,'
+flush'=>\$opt_flush,'header!'=>\$opt_header,'help'=>\$opt_help,'htmld
+ir=s'=>\$opt_htmldir,'htmlroot=s'=>\$opt_htmlroot,'index!'=>\$opt_ind
+ex,'infile=s'=>\$opt_infile,'libpods=s'=>\$opt_libpods,'netscape!'=>\
+$opt_netscape,'outfile=s'=>\$opt_outfile,'podpath=s'=>\$opt_podpath,'
+podroot=s'=>\$opt_podroot,'quiet!'=>\$opt_quiet,'recurse!'=>\$opt_rec
+urse,'title=s'=>\$opt_title,'verbose!'=>\$opt_verbose,);
$self->usage("-","invalid parameters")if not$result;
$self->usage("-")if defined$opt_help;
$opt_help="";
@{$self->{podpath}}=split(":",$opt_podpath)if defined$opt_podpath;
@{$self->{libpods}}=split(":",$opt_libpods)if defined$opt_libpods;
$self->{backlink}=$opt_backlink if defined$opt_backlink;
$self->{css}=$opt_css      if defined$opt_css;
$self->{header}=$opt_header   if defined$opt_header;
$self->{htmldir}=$opt_htmldir  if defined$opt_htmldir;
$self->{htmlroot}=$opt_htmlroot if defined$opt_htmlroot;
$self->{doindex}=$opt_index    if defined$opt_index;
$self->{podfile}=$opt_infile   if defined$opt_infile;
$self->{netscape}=$opt_netscape if defined$opt_netscape;
$self->{htmlfile}=$opt_outfile  if defined$opt_outfile;
$self->{podroot}=$opt_podroot  if defined$opt_podroot;
$self->{quiet}=$opt_quiet    if defined$opt_quiet;
$self->{recurse}=$opt_recurse  if defined$opt_recurse;
$self->{title}=$opt_title    if defined$opt_title;
$self->{verbose}=$opt_verbose  if defined$opt_verbose;
warn"Flushing item and directory caches\n" if$opt_verbose&&defined$opt
+_flush;
unlink($self->{dircache},$self->{itemcache})if defined$opt_flush;}sub 
+get_cache{my$self=shift->class_obj;
my$podpath;
($self->{dircache},$self->{itemcache},$podpath,$self->{podroot},$self-
+>{recurse})=@_;
my@cache_key_args=@_;
my$this_cache_key=$self->cache_key(@cache_key_args);
return if$self->{saved_cache_key}and$this_cache_key eq$self->{saved_ca
+che_key};
my$tests=0;
if(-f$self->{dircache}&&-f$self->{itemcache}){warn"scanning for item c
+ache\n" if$self->{verbose};
$tests=$self->load_cache($self->{dircache},$self->{itemcache},$podpath
+,$self->{podroot});}if(!$tests){warn"scanning directories in pod-path
+\n" if$self->{verbose};
$self->scan_podpath($self->{podroot},$self->{recurse},0);}$self->{save
+d_cache_key}=$self->cache_key(@cache_key_args);}sub cache_key{my$self
+=shift->class_obj;
my$podpath;
($self->{dircache},$self->{itemcache},$podpath,$self->{podroot},$self-
+>{recurse})=@_;
return join('!',$self->{dircache},$self->{itemcache},$self->{recurse},
+@$podpath,$self->{podroot},stat($self->{dircache}),stat($self->{itemc
+ache}));}sub load_cache{my$self=shift->class_obj;
my$podpath;
($self->{dircache},$self->{itemcache},$podpath,$self->{podroot})=@_;
my($tests);
local$_;
$tests=0;
open(CACHE,"<$self->{itemcache}")||die ref($self)." error opening $sel
+f->{itemcache} for reading: $!\n";
$/="\n";
$_=<CACHE>;
chomp($_);
$tests++ if(join(":",@$podpath)eq$_);
$_=<CACHE>;
chomp($_);
$tests++ if($self->{podroot}eq$_);
if($tests!=2){close(CACHE);
return 0;}warn"loading item cache\n" if$self->{verbose};
while(<CACHE>){/(.*?) (.*)$/;
$self->{items}->{$1}=$2;}close(CACHE);
warn"scanning for directory cache\n" if$self->{verbose};
open(CACHE,"<$self->{dircache}")||die ref($self)." error opening $self
+->{dircache} for reading: $!\n";
$/="\n";
$tests=0;
$_=<CACHE>;
chomp($_);
$tests++ if(join(":",@$podpath)eq$_);
$_=<CACHE>;
chomp($_);
$tests++ if($self->{podroot}eq$_);
if($tests!=2){close(CACHE);
return 0;}warn"loading directory cache\n" if$self->{verbose};
while(<CACHE>){/(.*?) (.*)$/;
$self->{pages}->{$1}=$2;}close(CACHE);
return 1;}sub scan_podpath{my$self=shift->class_obj;
my$append;
($self->{podroot},$self->{recurse},$append)=@_;
my($pwd,$dir);
my($libpod,$dirname,$pod,@files,@poddata);
unless($append){%{$self->{items}}=();
%{$self->{pages}}=();}$pwd=getcwd();
chdir($self->{podroot})||die ref($self)." error changing to directory 
+$self->{podroot}: $!\n";
foreach$dir(@{$self->{podpath}}){$self->scan_dir($dir,$self->{recurse}
+);}foreach$libpod(@{$self->{libpods}}){next unless defined$self->{pag
+es}->{$libpod}&&$self->{pages}->{$libpod};
if($self->{pages}->{$libpod}=~/([^:]*(?<!\.pod)(?<!\.pm)):/){$dirname=
+$1;
opendir(DIR,$dirname)||die ref($self)." error opening directory $dirna
+me: $!\n";
@files=grep(/(\.pod|\.pm)\z/&&!-d$_,readdir(DIR));
closedir(DIR);
foreach$pod(@files){open(POD,"<$dirname/$pod")||die ref($self)." error
+ opening $dirname/$pod for input: $!\n";
@poddata=<POD>;
close(POD);
$self->clean_data(\@poddata);
$self->scan_items(\%{$self->{items}},"$dirname/$pod",@poddata);}}elsif
+($self->{pages}->{$libpod}=~/([^:]*\.pod):/||$self->{pages}->{$libpod
+}=~/([^:]*\.pm):/){$pod=$1;
open(POD,"<$pod")||die ref($self)." error opening $pod for input: $!\n
+";
@poddata=<POD>;
close(POD);
$self->clean_data(\@poddata);
$self->scan_items(\%{$self->{items}},"$pod",@poddata);}else{warn ref($
+self)." shouldn't be here (line ".__LINE__."\n" unless$self->{quiet};
+}}@poddata=();
chdir($pwd)||die ref($self)." error changing to directory $pwd: $!\n";
warn"caching items for later use\n" if$self->{verbose};
open(CACHE,">$self->{itemcache}")||die ref($self)." error open $self->
+{itemcache} for writing: $!\n";
print CACHE join(":",@{$self->{podpath}})."\n$self->{podroot}\n";
foreach my $key(keys%{$self->{items}}){print CACHE"$key $self->{items}
+->{$key}\n";}close(CACHE);
warn"caching directories for later use\n" if$self->{verbose};
open(CACHE,">$self->{dircache}")||die ref($self)." error open $self->{
+dircache} for writing: $!\n";
print CACHE join(":",@{$self->{podpath}})."\n$self->{podroot}\n";
foreach my $key(keys%{$self->{pages}}){print CACHE"$key $self->{pages}
+->{$key}\n";}close(CACHE);}sub scan_dir{my$self=shift->class_obj;
my$dir;
($dir,$self->{recurse})=@_;
my($t,@subdirs,@pods,$pod,$dirname,@dirs);
local$_;
@subdirs=();
@pods=();
opendir(DIR,$dir)||die ref($self)." error opening directory $dir: $!\n
+";
while(defined($_=readdir(DIR))){if(-d"$dir/$_"&&$_ ne"."&&$_ ne".."){$
+self->{pages}->{$_}="" unless defined$self->{pages}->{$_};
$self->{pages}->{$_}.="$dir/$_:";
push(@subdirs,$_);}elsif(/\.pod\z/){s/\.pod\z//;
$self->{pages}->{$_}="" unless defined$self->{pages}->{$_};
$self->{pages}->{$_}.="$dir/$_.pod:";
push(@pods,"$dir/$_.pod");}elsif(/\.html\z/){s/\.html\z//;
$self->{pages}->{$_}="" unless defined$self->{pages}->{$_};
$self->{pages}->{$_}.="$dir/$_.pod:";}elsif(/\.pm\z/){s/\.pm\z//;
$self->{pages}->{$_}="" unless defined$self->{pages}->{$_};
$self->{pages}->{$_}.="$dir/$_.pm:";
push(@pods,"$dir/$_.pm");}}closedir(DIR);
if($self->{recurse}){foreach my $subdir(@subdirs){$self->scan_dir("$di
+r/$subdir",$self->{recurse});}}}sub scan_headings{my$self=shift->clas
+s_obj;
my($sections,@data)=@_;
my($tag,$which_head,$otitle,$listdepth,$index);
$self->{ignore}=0;
$listdepth=0;
$index="";
foreach my $line(@data){if($line=~/^=(head)([1-6])\s+(.*)/){($tag,$whi
+ch_head,$otitle)=($1,$2,$3);
my$title=$self->depod($otitle);
my$name=$self->htmlify($title);
$sections->{$name}=1;
$title=$self->process_text(\$otitle);
while($which_head!=$listdepth){if($which_head>$listdepth){$index.="\n"
+.("\t" x$listdepth).qq'<ul class="index">\n';
$listdepth++;}elsif($which_head<$listdepth){$listdepth--;
$index.="\n".("\t" x$listdepth)."</ul>\n";}}$index.="\n".("\t" x$listd
+epth).qq'<li class="index">'.qq'<a class="index" href="\#$name">'."$t
+itle</a></li>";}}while($listdepth--){$index.="\n".("\t" x$listdepth).
+"</ul>\n";}$index=~s!\t*<ul class="index">\s*</ul>!!g;
$self->{ignore}=1;
return$index;}sub scan_items{my$self=shift->class_obj;
my($itemref,$pod,@poddata)=@_;
my($i,$item);
local$_;
$pod=~s/\.pod\z//;
$pod.=".html" if$pod;
foreach$i(0..$#poddata){my$txt=$self->depod($poddata[$i]);
if($txt=~/\A=item\s+[*+-]\s*(.*)\Z/s){next unless$1;
$item=$1;}elsif($txt=~/\A=item\s+(?>\d+\.?)\s*(.*)\Z/s){$item=$1;}elsi
+f($txt=~/\A=item\s+(.*)\Z/s){$item=$1;}else{next;}my$fid=$self->fragm
+ent_id($item);
$itemref->{$fid}="$pod" if$fid;}}sub process_head{my$self=shift->class
+_obj;
my($tag,$heading,$hasindex)=@_;
$tag=~/head([1-6])/;
my$level=$1;
push@{$self->{HTML}},"\n<!-- Head=".($self->{listlevel}||0)." -->\n";
if($self->{listlevel}){warn ref($self)." $self->{podfile}: unterminate
+d list at =head in paragraph $self->{paragraph}.  ignoring.\n" unless
+$self->{quiet};
while($self->{listlevel}){$self->process_back();}}push@{$self->{HTML}}
+,qq'<p class="sec_break"/>\n';
if($level==1&&!$self->{top}){push@{$self->{HTML}},q'<a class="backlink
+" href="#__index__">$self->{backlink}</a>\n' if$hasindex and$self->{b
+acklink};
push@{$self->{HTML}},qq'<hr />\n';}my$name=$self->htmlify($self->depod
+($heading));
my$convert=$self->process_text(\$heading);
push@{$self->{HTML}},qq'<h$level class="pod"><a class="head" id="$name
+">$convert</a></h$level>\n';}sub emit_item_tag{my$self=shift->class_o
+bj;
my($otext,$text,$index)=@_;
my$item=$self->fragment_id($text);
$self->{EmittedItem}=$item;
if($self->{items_named}->{$item}++){push@{$self->{HTML}},$self->proces
+s_text(\$otext);}else{my$name='item_'.$item;
my$ptxt=$self->process_text(\$otext);
push@{$self->{HTML}},qq'<!-- ITEM -->\n<a class="item" id="$name">$ptx
+t</a>\n';
if($index){my$index=$self->_fragment_id($text,1);
my($str,$str_type)=@$index;
if($str_type ne"Sections"){($str)=$str=~m/\A\s*(\S+<.*>\S+|\S+)/;}$sel
+f->process_text(\$str);
$self->{printed_items}->{$str_type}{$str}="\#$name" unless$self->{prin
+ted_items}->{$str_type}{$str};
$self->{printed_items}->{$str_type}{$str}="\#$name" if$str eq$text;}}p
+ush@{$self->{HTML}},"<br />\n";
undef($self->{EmittedItem});}sub emit_li{my$self=shift->class_obj;
my$tag=lc(shift@_);
if($self->{items_seen}->[$self->{listlevel}]++ ==0){push(@{$self->{lis
+tend}},($tag eq 'dl'?'</dd>':'</li>')."</$tag>");
push@{$self->{HTML}},qq'<$tag class="item">\n';}else{push@{$self->{HTM
+L}},$tag eq 'dl'?'</dd>':'</li>';}push@{$self->{HTML}},$tag eq 'dl'?'
+<dt class="item">':'<li class="item">';}sub process_item{my$self=shif
+t->class_obj;
my($otext)=@_;
if($self->{listlevel}==0){warn ref($self)." $self->{podfile}: unexpect
+ed =item directive in paragraph $self->{paragraph}.  ignoring.\n" unl
+ess$self->{quiet};
$self->process_over();}if($self->{after_lpar}){push@{$self->{HTML}},"<
+p />\n";
$self->{after_lpar}=0;}my$text=$self->depod($otext);
if($text=~/\A\*/){$self->emit_li('ul');
if($text=~/\A\s*[+*-]\s+(.+)\Z/s){my$tag=$1;
$otext=~s/\A\s*[+*-]\s+//;
$self->emit_item_tag($otext,$tag,0);}}elsif($text=~/\A\s*\d+/){$self->
+emit_li('ol');
if($text=~/\A\s*(?>\d+\.?)\s*(.+)\Z/s){my$tag=$1;
$otext=~s/\A\s*\d+\.?\s*//;
$self->emit_item_tag($otext,$tag,0);}}else{$self->emit_li('dl');
if($text=~/\A\s*(.+)\s*\Z/s){$self->emit_item_tag($otext,$1,1);}push@{
+$self->{HTML}},'</dt><dd class="item">';}push@{$self->{HTML}},"\n";}s
+ub process_over{my$self=shift->class_obj;
push@{$self->{HTML}},"\n<!-- Over=".($self->{listlevel}||0)." -->\n";
$self->{listlevel}++;
push(@{$self->{items_seen}},0);
$self->{after_lpar}=0;}sub process_back{my$self=shift->class_obj;
if($self->{listlevel}==0){warn ref($self)." $self->{podfile}: unexpect
+ed =back directive in paragraph $self->{paragraph}.  ignoring.\n" unl
+ess$self->{quiet};
return;}push@{$self->{HTML}},"\n<!-- Back=$self->{listlevel}-->\n";
$self->{listlevel}--;
if(defined$self->{listend}->[$self->{listlevel}]){push@{$self->{HTML}}
+,qq'<p class="after_lpar"/>\n' if$self->{after_lpar};
push@{$self->{HTML}},$self->{listend}->[$self->{listlevel}];
push@{$self->{HTML}},"\n";
pop(@{$self->{listend}});}$self->{after_lpar}=0;
pop(@{$self->{items_seen}});}sub process_cut{my$self=shift->class_obj;
$self->{ignore}=1;}sub process_pod{my$self=shift->class_obj;}sub proce
+ss_for{my$self=shift->class_obj;
my($whom,$text)=@_;
if($whom=~/^(pod2)?xhtml$/i){push@{$self->{HTML}},$text;}elsif($whom=~
+/^illustration$/i){1 while chomp$text;
for my $ext(qw[.png .gif .jpeg .jpg .tga .pcl .bmp]){$text.=$ext,last 
+if-r"$text$ext";}push@{$self->{HTML}},qq{<p align = "center"><img src
+ = "$text" alt = "$text illustration"></p>};}}sub process_begin{my$se
+lf=shift->class_obj;
my($whom,$text)=@_;
$whom=lc($whom);
push(@{$self->{begin_stack}},$whom);
if($whom=~/^(pod2)?xhtml$/){push@{$self->{HTML}},$text if$text;}}sub p
+rocess_end{my$self=shift->class_obj;
my($whom,$text)=@_;
$whom=lc($whom);
if($self->{begin_stack}->[-1]ne$whom){die"Unmatched begin/end at chunk
+ $self->{paragraph}\n";}pop(@{$self->{begin_stack}});}sub process_pre
+{my$self=shift->class_obj;
my($text)=@_;
my($rest);
return if$self->{ignore};
$rest=$$text;
$rest=~s#.*#
        my $line = $&;
        1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)
+/e;
        $line;
    #eg;
$rest=~s/&/&amp;/g;
$rest=~s/</&lt;/g;
$rest=~s/>/&gt;/g;
$rest=~s/"/&quot;/g;
$rest=~s{
             (\s*)(perl\w+)
          }{
         if ( defined $self->{pages}->{$2} ){    # is a link
             qq($1<a class="perl" href="$self->{htmlroot}/$self->{page
+s}->{$2}">$2</a>);
         } elsif (defined $self->{pages}->{$self->dosify($2)}) {    # 
+is a link
             qq($1<a class="perl" href="$self->{htmlroot}/$self->{page
+s}->{dosify($2)}">$2</a>);
         } else {
             "$1$2";
         }
          }xeg;
$rest=~s{
         (<a\ class="[^"]*" href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]
+*:)?
               }{
                  my $url ;
                  if ( $self->{htmlfileurl} ne '' ){
             # Here, we take advantage of the knowledge 
             # that $self->{htmlfileurl} ne '' implies $self->{htmlroo
+t} eq ''.
             # Since $self->{htmlroot} eq '', we need to prepend $self
+->{htmldir}
             # on the fron of the link to get the absolute path
             # of the link's target. We check for a leading '/'
             # to avoid corrupting links that are #, file:, etc.
             my $old_url = $3 ;
             $old_url = "$self->{htmldir}$old_url" if $old_url =~ m{^\
+/};
              $url =$self->relativize_url( "$old_url.html", $self->{ht
+mlfileurl} );
              } else {
             $url = "$3.html" ;
          }
          "$1$url" ;
           }xeg;
my$urls='('.join('|',
qw{
    http
    telnet
    mailto
    news
    gopher
    file
    wais
    ftp
    }
).')';
my$ltrs='\w';
my$gunk='/#~:.?+=&%@!\-';
my$punc='.:?\-';
my$any="${ltrs}${gunk}${punc}";
$rest=~s{
        \b                          # start at word boundary
        (                           # begin $1  {
          $urls     :               # need resource and a colon
          (?!:)                     # Ignore File::, among others.
          [$any]+?                  # followed by one or more
                                    #  of any valid character, but
                                    #  be conservative and take only
                                    #  what you need to....
        )                           # end   $1  }
        (?=                         # look-ahead non-consumptive asser
+tion
                [$punc]*            # either 0 or more punctuation
                [^$any]             #   followed by a non-url char
            |                       # or else
                $                   #   the end of the string
        )
      }{<a class="embed" href="$1">$1</a>}igox;
$$text=$rest;}sub pure_text{my$self=shift->class_obj;
my$text=shift();
$self->process_puretext($text,\$self->{ptQuote},1);}sub inIS_text{my$s
+elf=shift->class_obj;
my$text=shift();
$self->process_puretext($text,\$self->{ptQuote},0);}sub process_purete
+xt{my$self=shift->class_obj;
my($text,$quote,$notinIS)=@_;
my(@words,$lead,$trail);
if($$quote&&$text=~s/"/$self->{rdq}/s){$$quote=0;}while($text=~s/"([^"
+]*)"/$self->{ldq}$1$self->{rdq}/sg){}$$quote=1 if$text=~s/"/$self->{l
+dq}/s;
$lead=($text=~s/\A(\s+)//s?$1:"");
$trail=($text=~s/(\s+)\Z//s?$1:"");
@words=split(/(?<=\s)(?=\S)|(?<=\S)(?=\s)/,$text);
foreach my $word(@words){next if$word=~/^\s*$/;
if($notinIS&&$word=~/^(\w+)\((.*)\)$/){my($func,$args)=($1,$2);
if($args=~/^\d+$/){my$url=$self->page_sect($word,'');
if(defined$url){$word=qq'<a class="inferred" href="$url">the $word man
+page</a>';
next;}}$word=$self->emit_C($func,'',"($args)");}elsif($word=~m,^\w+://
+\w,){$word=qq'<a class="embed" href="$word">$word</a>';}elsif($word=~
+/[\w.-]+\@[\w-]+\.\w/){my($w1,$w2,$w3)=("",$word,"");
($w1,$w2,$w3)=("(",$1,")$2")if$word=~/^\((.*?)\)(,?)/;
($w1,$w2,$w3)=("&lt;",$1,"&gt;$2")if$word=~/^<(.*?)>(,?)/;
$word=qq'$w1<a href="mailto:$w2">$w2</a>$w3';}else{$word=$self->html_e
+scape($word)if$word=~/["&<>]/;}}return$lead.join('',@words).$trail;}s
+ub pattern{my$self=shift->class_obj;
$_[0]?'[^\S\n]+'.('>' x($_[0]+1)):'>';}sub closing{my$self=shift->clas
+s_obj;
local($_)=shift;
(defined&&s/\s+$//)?length:0;}sub process_text{my$self=shift->class_ob
+j;
return if$self->{ignore};
my($tref)=@_;
my$res=$self->process_text1(0,$tref);
$$tref=$res;}sub process_text1{my$self=shift->class_obj;
my($lev,$rstr,$func,$closing)=@_;
my$res='';
unless(defined$func){$func='';
$lev++;}if($func eq 'B'){$res='<b>'.$self->process_text1($lev,$rstr).'
+</b>';}elsif($func eq 'C'){my$par=$self->go_ahead($rstr,'C',$closing)
+;
my$text=$self->depod($par);
$res=$self->emit_C($text,$lev>1||($par=~/[BI]</));}elsif($func eq 'E')
+{$$rstr=~s/^([^>]*)>//;
my$escape=$1;
$escape=~s/^(\d+|X[\dA-F]+)$/#$1/i;
$res="&$escape;";}elsif($func eq 'F'){$res='<i class="filename">'.$sel
+f->process_text1($lev,$rstr).'</i>';}elsif($func eq 'I'){$res='<i>'.$
+self->process_text1($lev,$rstr).'</i>';}elsif($func eq 'L'){my$par=$s
+elf->go_ahead($rstr,'L',$closing);
if($par=~m{^\w+://}s){return$self->make_URL_href($par);}if($par=~/^C<(
+.*)>$/){my$text=$self->depod($1);
return$self->emit_C($text,$lev>1||($par=~/[BI]</));}$par=~s/\n/ /g;
my$opar=$par;
my$linktext;
if($par=~s{^([^|]+)\|}{}){$linktext=$1;}$par=~s{^"}{/"};
my($page,$section,$ident);
if($par=~m{^([^/]+?)/(?!")(.*?)$}){($page,$ident)=($1,$2);}elsif($par=
+~m{^(.*?)/"?(.*?)"?$}){($page,$ident)=($1,$2);}elsif($par=~/\s/){($pa
+ge,$section)=('',$par);}else{($page,$section)=($par,'');}defined and 
+s/\(\s*\d+\s*\)//g foreach$page,$section,$ident;
my($url,$ltext,$fid);
RESOLVE:{if(defined$ident){($url,$fid)=$self->coderef($page,$ident);
if($url){if(!defined($linktext)){$linktext=$ident;
$linktext.=" in " if$ident&&$page;
$linktext.="the $page manpage" if$page;}last RESOLVE;}$section=$ident;
+}my$htmlsection=$self->htmlify($section);
$url=$self->page_sect($page,$htmlsection);
if($url){if(!defined($linktext)){$linktext=$section;
$linktext.=" in " if$section&&$page;
$linktext.="the $page manpage" if$page;}last RESOLVE;}if($section){$id
+ent=$section;}else{$ident=$page;
$page=undef();}($url,$fid)=$self->coderef($page,$ident);
if($url){if(!defined($linktext)){$linktext=$ident;
$linktext.=" in " if$ident&&$page;
$linktext.="the $page manpage" if$page;}last RESOLVE;}$linktext=$opar 
+unless defined$linktext;
warn ref($self).": $self->{podfile}: cannot resolve L<$opar> $page $se
+ction $ident in paragraph $self->{paragraph}." unless$self->{quiet};}
+$$rstr=$linktext.'>'.$$rstr;
if(defined($url)){$res=qq'<a class="link" href="$url">'.$self->process
+_text1($lev,$rstr).'</a>';}else{$res='<em class="link">'.$self->proce
+ss_text1($lev,$rstr).'</em>';}}elsif($func eq 'S'){$res=$self->proces
+s_text1($lev,$rstr);
$res=~s/ /&nbsp;/g;}elsif($func eq 'X'){$$rstr=~s/^[^>]*>//;}elsif($fu
+nc eq 'Z'){warn ref($self)." $self->{podfile}: invalid X<> in paragra
+ph $self->{paragraph}." unless$$rstr=~s/^>// or$self->{quiet};}else{m
+y$term=$self->pattern($closing);
while($$rstr=~s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s){my$pt=$
+1;
$pt.=$2 if!$3&&$lev==1;
$res.=$lev==1?$self->pure_text($pt):$self->inIS_text($pt);
return$res if!$3&&$lev>1;
if($3){$res.=$self->process_text1($lev,$rstr,$3,$self->closing($4));}}
+if($lev==1){$res.=$self->pure_text($$rstr);}else{warn ref($self)." $s
+elf->{podfile}: undelimited $func<> in paragraph $self->{paragraph}."
+ unless$self->{quiet};}}return$res;}sub go_ahead{my$self=shift->class
+_obj;
my($rstr,$func,$closing)=@_;
my$res='';
my@closing=($closing);
while($$rstr=~s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|@{[$self->pattern(
+$closing[0])]})//s){$res.=$1;
unless($3){shift@closing;
return$res unless@closing;}else{unshift@closing,$self->closing($4);}$r
+es.=$2;}warn ref($self)." $self->{podfile}: undelimited $func<> in pa
+ragraph $self->{paragraph}." unless$self->{quiet};
return$res;}sub emit_C{my$self=shift->class_obj;
my($text,$nocode,$args)=@_;
$args='' unless defined$args;
my$res;
my($url,$fid)=$self->coderef(undef(),$text);
my$linktext=$self->html_escape("$text$args");
if(defined($url)&&(!defined($self->{EmittedItem})||$self->{EmittedItem
+}ne$fid)){$res=qq'<a class="code" href="$url"><co'.qq'de class="link"
+>$linktext</co'.'de></a>';}elsif(0&&$nocode){$res=$linktext;}else{$re
+s="<co"."de>$linktext</co"."de>";}return$res;}sub html_escape{my$self
+=shift->class_obj;
my$rest=$_[0];
$rest=~s/&/&amp;/g;
$rest=~s/</&lt;/g;
$rest=~s/>/&gt;/g;
$rest=~s/"/&quot;/g;
return$rest;}sub dosify{my$self=shift->class_obj;
my($str)=@_;
return lc($str)if$^O eq 'VMS';
if($self->{Is83}){$str=lc$str;
$str=~s/(\.\w+)/substr ($1,0,4)/ge;
$str=~s/(\w+)/substr ($1,0,8)/ge;}return$str;}sub page_sect{my$self=sh
+ift->class_obj;
my($page,$section)=@_;
my($linktext,$page83,$link);
if(!defined$self->{pages}->{$page}&&defined$self->{sections}->{$page})
+{$section=$page;
$page="";}$page83=$self->dosify($page);
$page=$page83 if(defined$self->{pages}->{$page83});
if($page eq""){$link="#".$self->htmlify($section);}elsif($page=~/::/){
+$page=~s,::,/,g;
my$page_name=$page;
$page_name=~s,^.*/,,s;
if(defined($self->{pages}->{$page_name})&&$self->{pages}->{$page_name}
+=~/([^:]*$page)\.(?:pod|pm):/){$page=$1;}else{}$link="$self->{htmlroo
+t}/$page.html";
$link.="#".$self->htmlify($section)if($section);}elsif(!defined$self->
+{pages}->{$page}){$link="";}else{$section=$self->htmlify($section)if$
+section ne"";
if($section ne""&&$self->{pages}->{$page}=~/([^:]*(?<!\.pod)(?<!\.pm))
+:/){$link="$self->{htmlroot}/$1/$section.html";}else{$section="#$sect
+ion" if$section;
if($self->{pages}->{$page}=~/([^:]*)\.pod:/){$link="$self->{htmlroot}/
+$1.html$section";}elsif($self->{pages}->{$page}=~/([^:]*)\.pm:/){$lin
+k="$self->{htmlroot}/$1.html$section";}else{$link="";}}}if($link){my$
+url;
if($self->{htmlfileurl}ne ''){$link="$self->{htmldir}$link" if$link=~m
+{^/}s;
$url=$self->relativize_url($link,$self->{htmlfileurl});}else{$url=$lin
+k;}return$url;}else{return undef();}}sub relativize_url{my$self=shift
+->class_obj;
my($dest,$source)=@_;
my($dest_volume,$dest_directory,$dest_file)=File::Spec::Unix->splitpat
+h($dest);
$dest=File::Spec::Unix->catpath($dest_volume,$dest_directory,'');
my($source_volume,$source_directory,$source_file)=File::Spec::Unix->sp
+litpath($source);
$source=File::Spec::Unix->catpath($source_volume,$source_directory,'')
+;
my$rel_path='';
if($dest ne ''){$rel_path=File::Spec::Unix->abs2rel($dest,$source);}if
+($rel_path ne ''&&substr($rel_path,-1)ne '/'&&substr($dest_file,0,1)n
+e '#'){$rel_path.="/$dest_file";}else{$rel_path.="$dest_file";}return
+$rel_path;}sub coderef{my$self=shift->class_obj;
my($page,$item)=@_;
my($url);
my$fid=$self->fragment_id($item);
if(defined($page)){$page=~s{::}{/}g;
my$base=$self->{items}->{$fid}||"";
$base=~s{[^/]*/}{};
if($base ne"$page.html"){$page=undef();}}else{if(defined($fid)){if(exi
+sts$self->{local_items}->{$fid}){$page=$self->{local_items}->{$fid};}
+else{$page=$self->{items}->{$fid};}}}if(defined$page){if($page){if(ex
+ists$self->{pages}->{$page}and$self->{pages}->{$page}=~/([^:.]*)\.[^:
+]*:/){$page=$1.'.html';}my$link="$self->{htmlroot}/$page#item_$fid";
if($self->{htmlfileurl}ne ''){$link="$self->{htmldir}$link";
$url=$self->relativize_url($link,$self->{htmlfileurl});}else{$url=$lin
+k;}}else{$url="#item_".$fid;}confess"url has space: $url" if$url=~/"[
+^"]*\s[^"]*"/;}return($url,$fid);}sub relative_url{my$self=shift->cla
+ss_obj;
my$source_file=shift;
my$destination_file=shift;
my$source=URI::file->new_abs($source_file);
my$uo=URI::file->new($destination_file,$source)->abs;
return$uo->rel->as_string;}sub finish_list{my$self=shift->class_obj;
while($self->{listlevel}>0){push@{$self->{HTML}},"</dl>\n";
$self->{listlevel}--;}}sub htmlify{my$self=shift->class_obj;
my($heading)=@_;
$heading=~s/(\s+)/ /g;
$heading=~s/\s+\Z//;
$heading=~s/\A\s+//;
$heading=~s/[-"?]//g;
$heading=lc($heading);
return$heading;}sub depod{my$self=shift->class_obj;
my$string;
if(ref($_[0])){$string=${$_[0]};
${$_[0]}=$self->depod1(\$string);}else{$string=$_[0];
$self->depod1(\$string);}}sub depod1{my$self=shift->class_obj;
my($rstr,$func,$closing)=@_;
my$res='';
return$res unless defined$$rstr;
if(!defined($func)){while($$rstr=~s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?
+//){$res.=$1.$self->depod1($rstr,$2,$self->closing($3));}$res.=$$rstr
+;}elsif($func eq 'E'){$$rstr=~s/^([^>]*)>//;
$res.=$self->{E2c}->{$1}||"";}elsif($func eq 'X'){$$rstr=~s/^[^>]*>//;
+}elsif($func eq 'Z'){$$rstr=~s/^>//;}else{my$term=$self->pattern($clo
+sing);
while($$rstr=~s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//){$res.=$1
+;
last unless$3;
$res.=$self->depod1($rstr,$3,$self->closing($4));}}return$res;}sub fra
+gment_id{my$self=shift->class_obj;
my$text=$self->_fragment_id(shift);
return$text unless defined($text);
$text=~s/\s+/_/sg;
$text=~s{(\W)}{
        defined( $self->{hc}->[ord($1)] ) ? $self->{hc}->[ord($1)]
                 : ( $self->{hc}->[ord($1)] = sprintf( "%%%02X", ord($
+1) ) ) }gxe;
$text=substr($text,0,50);
$text;}sub _fragment_id{my$self=shift->class_obj;
my$text=shift@_;
$text=~s/\s+\Z//s;
$text=~s/\A\s+//s;
local$_=$text;
my$ret;
if($text){if(m{^
                (\s*-[rwxoRWXOezsfdlpSbctugkTBMAC]|[a-z\d]+)
                (\s+[:A-Z\d,\(\)/& ]+)?
               $
              }x
    ){$ret=[$1,"Functions"];}elsif(m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/&
+ ]+)?$}){$ret=[$1,"Functions"];}elsif(/(\w+)\s*\(/){$ret=[$1,"Functio
+ns"];}elsif(/->\s*(\w+)\s*\(?/){$ret=[$1,"Functions"];}elsif(/^\s*([\
+$\@\%\*]\S+)/){$ret=[$1,"Variables"];}elsif(m|^(\w+/).*/\w*$|){my$rop
+=$1."/";
$rop.="/" if$rop=~/^([sy]|tr)/;
$ret=[$rop,"Functions"];}elsif(m|^(\w+)\s*{.*}$|){$ret=[$1,"Functions"
+];}else{$ret=[$text,"Sections"];}return@_?$ret:$ret->[0];}else{return
+;}}sub make_URL_href{my$self=shift->class_obj;
my($url)=@_;
if($url!~s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i){
+$url=qq'<a class="url_href" href="$url">$url</a>';}return$url;}1;