home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 May / Chip_2000-05_cd1.bin / zkuste / Perl / ActivePerl-5.6.0.613.msi / 䆊䌷䈹䈙䏵-䞅䞆䞀㡆䞃䄦䠥 / _98a6c9be6e4e3bf9d2284429e6dcb588 < prev    next >
Text File  |  2000-03-15  |  46KB  |  1,621 lines
  1. package Pod::WinHtml;
  2.  
  3. use Pod::Functions;
  4. use Getopt::Long;    # package for handling command-line parameters
  5. require Exporter;
  6. use vars qw($VERSION);
  7. $VERSION = 1.01;
  8. @ISA = Exporter;
  9. @EXPORT = qw(pod2html htmlify);
  10. use Cwd;
  11.  
  12. use Carp;
  13.  
  14. use locale;    # make \w work right in non-ASCII lands
  15.  
  16. use strict;
  17.  
  18. use Config;
  19.  
  20. =head1 NAME
  21.  
  22. Pod::WinHtml - module to convert pod files to HTML
  23.  
  24. Taken from Pod::Html to correct some things for Win32.
  25.  
  26. =head1 SYNOPSIS
  27.  
  28.     use Pod::WinHtml;
  29.     pod2html([options]);
  30.  
  31. =head1 DESCRIPTION
  32.  
  33. Converts files from pod format (see L<perlpod>) to HTML format.  It
  34. can automatically generate indexes and cross-references, and it keeps
  35. a cache of things it knows how to cross-reference.
  36.  
  37. =head1 ARGUMENTS
  38.  
  39. Pod::Html takes the following arguments:
  40.  
  41. =over 4
  42.  
  43. =item help
  44.  
  45.     --help
  46.  
  47. Displays the usage message.
  48.  
  49. =item htmlroot
  50.  
  51.     --htmlroot=name
  52.  
  53. Sets the base URL for the HTML files.  When cross-references are made,
  54. the HTML root is prepended to the URL.
  55.  
  56. =item infile
  57.  
  58.     --infile=name
  59.  
  60. Specify the pod file to convert.  Input is taken from STDIN if no
  61. infile is specified.
  62.  
  63. =item outfile
  64.  
  65.     --outfile=name
  66.  
  67. Specify the HTML file to create.  Output goes to STDOUT if no outfile
  68. is specified.
  69.  
  70. =item podroot
  71.  
  72.     --podroot=name
  73.  
  74. Specify the base directory for finding library pods.
  75.  
  76. =item podpath
  77.  
  78.     --podpath=name:...:name
  79.  
  80. Specify which subdirectories of the podroot contain pod files whose
  81. HTML converted forms can be linked-to in cross-references.
  82.  
  83. =item libpods
  84.  
  85.     --libpods=name:...:name
  86.  
  87. List of page names (eg, "perlfunc") which contain linkable C<=item>s.
  88.  
  89. =item netscape
  90.  
  91.     --netscape
  92.  
  93. Use Netscape HTML directives when applicable.
  94.  
  95. =item nonetscape
  96.  
  97.     --nonetscape
  98.  
  99. Do not use Netscape HTML directives (default).
  100.  
  101. =item index
  102.  
  103.     --index
  104.  
  105. Generate an index at the top of the HTML file (default behaviour).
  106.  
  107. =item noindex
  108.  
  109.     --noindex
  110.  
  111. Do not generate an index at the top of the HTML file.
  112.  
  113.  
  114. =item recurse
  115.  
  116.     --recurse
  117.  
  118. Recurse into subdirectories specified in podpath (default behaviour).
  119.  
  120. =item norecurse
  121.  
  122.     --norecurse
  123.  
  124. Do not recurse into subdirectories specified in podpath.
  125.  
  126. =item title
  127.  
  128.     --title=title
  129.  
  130. Specify the title of the resulting HTML file.
  131.  
  132. =item verbose
  133.  
  134.     --verbose
  135.  
  136. Display progress messages.
  137.  
  138. =item css
  139.  
  140.     --css=stylesheet
  141.  
  142. Style sheet to use for the page.
  143.  
  144. =back
  145.  
  146. =head1 EXAMPLE
  147.  
  148.     pod2html("pod2html",
  149.          "--podpath=lib:ext:pod:vms", 
  150.          "--podroot=/usr/src/perl",
  151.          "--htmlroot=/perl/nmanual",
  152.          "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
  153.          "--recurse",
  154.          "--infile=foo.pod",
  155.          "--outfile=/perl/nmanual/foo.html");
  156.  
  157. =head1 AUTHOR
  158.  
  159. Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
  160. Hacked for ActiveState Online Help by David Grove, E<lt>pete@activestate.comE<gt>.
  161.  
  162. =head1 BUGS
  163.  
  164. Has trouble with C<> etc in = commands.
  165.  
  166. =head1 SEE ALSO
  167.  
  168. L<perlpod>
  169.  
  170. =head1 COPYRIGHT
  171.  
  172. This program is distributed under the Artistic License.
  173.  
  174. =cut
  175.  
  176. my $dircache = "pod2html-dircache";
  177. my $itemcache = "pod2html-itemcache";
  178.  
  179. my @begin_stack = ();        # begin/end stack
  180.  
  181. my @libpods = ();            # files to search for links from C<> directives
  182. my $htmlroot = "/";            # http-server base directory from which all
  183.                 #   relative paths in $podpath stem.
  184. my $htmlfile = "";        # write to stdout by default
  185. my $podfile = "";        # read from stdin by default
  186. my @podpath = ();        # list of directories containing library pods.
  187. my $podroot = ".";        # filesystem base directory from which all
  188.                 #   relative paths in $podpath stem.
  189. my $css = '';
  190.  
  191. my $csslink = "<link rel=\"stylesheet\" href=\"file://$Config{prefix}/html/win32prk.css\" type=\"text/css\">";
  192.    $csslink =~ s{\\}{/}g;
  193.    $csslink =~ s{(/.):}{$1|};
  194. my $recurse = 1;        # recurse on subdirectories in $podpath.
  195. my $verbose = 0;        # not verbose by default
  196. my $doindex = 1;               # non-zero if we should generate an index
  197. my $listlevel = 0;        # current list depth
  198. my @listitem = ();        # stack of HTML commands to use when a =item is
  199.                 #   encountered.  the top of the stack is the
  200.                 #   current list.
  201. my @listdata = ();        # similar to @listitem, but for the text after
  202.                 #   an =item
  203. my @listend = ();        # similar to @listitem, but the text to use to
  204.                 #   end the list.
  205. my $ignore = 1;            # whether or not to format text.  we don't
  206.                 #   format text until we hit our first pod
  207.                 #   directive.
  208.  
  209. my %items_named = ();        # for the multiples of the same item in perlfunc
  210. my @items_seen = ();
  211. my $netscape = 0;        # whether or not to use netscape directives.
  212. my $title;            # title to give the pod(s)
  213. my $top = 1;            # true if we are at the top of the doc.  used
  214.                 #   to prevent the first <HR> directive.
  215. my $paragraph;            # which paragraph we're processing (used
  216.                 #   for error messages)
  217. my %pages = ();            # associative array used to find the location
  218.                 #   of pages referenced by L<> links.
  219. my %sections = ();        # sections within this page
  220. my %items = ();            # associative array used to find the location
  221.                 #   of =item directives referenced by C<> links
  222. my $Is83;                       # is dos with short filenames (8.3)
  223.  
  224. sub init_globals {
  225. $dircache = "pod2html.dir";
  226. $itemcache = "pod2html.itm";
  227.  
  228. @begin_stack = ();        # begin/end stack
  229.  
  230. @libpods = ();            # files to search for links from C<> directives
  231. $htmlroot = "/";            # http-server base directory from which all
  232.                 #   relative paths in $podpath stem.
  233. $htmlfile = "";        # write to stdout by default
  234. $podfile = "";        # read from stdin by default
  235. @podpath = ();        # list of directories containing library pods.
  236. $podroot = ".";        # filesystem base directory from which all
  237.                 #   relative paths in $podpath stem.
  238. $recurse = 1;        # recurse on subdirectories in $podpath.
  239. $verbose = 0;        # not verbose by default
  240. $doindex = 1;               # non-zero if we should generate an index
  241. $listlevel = 0;        # current list depth
  242. @listitem = ();        # stack of HTML commands to use when a =item is
  243.                 #   encountered.  the top of the stack is the
  244.                 #   current list.
  245. @listdata = ();        # similar to @listitem, but for the text after
  246.                 #   an =item
  247. @listend = ();        # similar to @listitem, but the text to use to
  248.                 #   end the list.
  249. $ignore = 1;            # whether or not to format text.  we don't
  250.                 #   format text until we hit our first pod
  251.                 #   directive.
  252.  
  253. @items_seen = ();
  254. %items_named = ();
  255. $netscape = 0;        # whether or not to use netscape directives.
  256. $title = '';            # title to give the pod(s)
  257. $top = 1;            # true if we are at the top of the doc.  used
  258.                 #   to prevent the first <HR> directive.
  259. $paragraph = '';            # which paragraph we're processing (used
  260.                 #   for error messages)
  261. %sections = ();        # sections within this page
  262.  
  263. # These are not reinitialised here but are kept as a cache.
  264. # See get_cache and related cache management code.
  265. #%pages = ();            # associative array used to find the location
  266.                 #   of pages referenced by L<> links.
  267. #%items = ();            # associative array used to find the location
  268.                 #   of =item directives referenced by C<> links
  269. $Is83=$^O eq 'dos';
  270. }
  271.  
  272. sub pod2html {
  273.     local(@ARGV) = @_;
  274.     local($/);
  275.     local $_;
  276.  
  277.     init_globals();
  278.  
  279.     $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
  280.  
  281.     # cache of %pages and %items from last time we ran pod2html
  282.  
  283.     #undef $opt_help if defined $opt_help;
  284.  
  285.     # parse the command-line parameters
  286.     parse_command_line();
  287.  
  288.     # Setup the stylsheet link if one was provided
  289.     $csslink = qq(<link rel="stylesheet" href="$css" type="text/css">) 
  290.     if $css;
  291.  
  292.     # set some variables to their default values if necessary
  293.     local *POD;
  294.     unless (@ARGV && $ARGV[0]) { 
  295.     $podfile  = "-" unless $podfile;    # stdin
  296.     open(POD, "<$podfile")
  297.         || die "$0: cannot open $podfile file for input: $!\n";
  298.     } else {
  299.     $podfile = $ARGV[0];  # XXX: might be more filenames
  300.     *POD = *ARGV;
  301.     } 
  302.     $htmlfile = "-" unless $htmlfile;    # stdout
  303.     $htmlroot = "" if $htmlroot eq "/";    # so we don't get a //
  304.  
  305.     # read the pod a paragraph at a time
  306.     warn "Scanning for sections in input file(s)\n" if $verbose;
  307.     $/ = "";
  308.     my @poddata  = <POD>;
  309.     close(POD);
  310.  
  311.     # scan the pod for =head[1-6] directives and build an index
  312.     my $index = scan_headings(\%sections, @poddata);
  313.  
  314.     unless($index) {
  315.     warn "No pod in $podfile\n" if $verbose;
  316.     return;
  317.     }
  318.  
  319.     # open the output file
  320.     open(HTML, ">$htmlfile")
  321.         || die "$0: cannot open $htmlfile file for output: $!\n";
  322.  
  323.     # put a title in the HTML file if one wasn't specified
  324.     if ($title eq '') {
  325.     TITLE_SEARCH: {
  326.         for (my $i = 0; $i < @poddata; $i++) { 
  327.         if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
  328.             for my $para ( @poddata[$i, $i+1] ) { 
  329.             last TITLE_SEARCH
  330.                 if ($title) = $para =~ /(\S+\s+-+.*\S)/s;
  331.             }
  332.         } 
  333.  
  334.         } 
  335.     }
  336.     }
  337.     if (!$title and $podfile =~ /\.pod$/) {
  338.     # probably a split pod so take first =head[12] as title
  339.     for (my $i = 0; $i < @poddata; $i++) { 
  340.         last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
  341.     } 
  342.     warn "adopted '$title' as title for $podfile\n"
  343.         if $verbose and $title;
  344.     } 
  345.     if ($title) {
  346.     $title =~ s/\s*\(.*\)//;
  347.     } else {
  348. #    warn "$0: no title for $podfile";
  349.     $podfile =~ /^(.*)(\.[^.\/]+)?$/;
  350.     $title = ($podfile eq "-" ? 'No Title' : $1);
  351.     warn "using $title" if $verbose;
  352.     }
  353.     print HTML <<END_OF_HEAD;
  354. <HTML>
  355. <HEAD>
  356. <TITLE>$title</TITLE>
  357. <LINK REV="made" HREF="mailto:$Config{perladmin}">
  358.         $csslink
  359. </HEAD>
  360.     <BODY BGCOLOR=\"FFFFFF\">
  361.     <!-- beginning of leaf header-->
  362.  
  363.     <TABLE border=0  cellpadding=0 cellspacing=0 width=100%>
  364.     <TR>
  365.         <TD valign=middle width=\"100%\"
  366.         bgcolor=\"#cc0066\"> <font face=\"sans-serif\" size=\"+1\"
  367.         color=\"#ff99cc\">   $title</font>
  368.         </TD>
  369.     </TR>
  370.     </TABLE>
  371.     <p> </p>
  372.     <!-- end of leaf content-->
  373. END_OF_HEAD
  374.  
  375.     # load/reload/validate/cache %pages and %items
  376.     get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse);
  377.  
  378.     # scan the pod for =item directives
  379.     scan_items("", \%items, @poddata);
  380.  
  381.     # put an index at the top of the file.  note, if $doindex is 0 we
  382.     # still generate an index, but surround it with an html comment.
  383.     # that way some other program can extract it if desired.
  384.     $index =~ s/--+/-/g;
  385.     print HTML "<!-- INDEX BEGIN -->\n";
  386.     print HTML "<!--\n" unless $doindex;
  387.     print HTML $index;
  388.     print HTML "-->\n" unless $doindex;
  389.     print HTML "<!-- INDEX END -->\n\n";
  390.     print HTML "<HR>\n" if $doindex;
  391.  
  392.     # now convert this file
  393.     warn "Converting input file\n" if $verbose;
  394.     foreach my $i (0..$#poddata) {
  395.     $_ = $poddata[$i];
  396.     $paragraph = $i+1;
  397.     if (/^(=.*)/s) {    # is it a pod directive?
  398.         $ignore = 0;
  399.         $_ = $1;
  400.         if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
  401.         process_begin($1, $2);
  402.         } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
  403.         process_end($1, $2);
  404.         } elsif (/^=cut/) {            # =cut
  405.         process_cut();
  406.         } elsif (/^=pod/) {            # =pod
  407.         process_pod();
  408.         } else {
  409.         next if @begin_stack && $begin_stack[-1] ne 'html';
  410.  
  411.         if (/^=(head[1-6])\s+(.*\S)/s) {    # =head[1-6] heading
  412.             process_head($1, $2);
  413.         } elsif (/^=item\s*(.*\S)/sm) {    # =item text
  414.             process_item($1);
  415.         } elsif (/^=over\s*(.*)/) {        # =over N
  416.             process_over();
  417.         } elsif (/^=back/) {        # =back
  418.             process_back();
  419.         } elsif (/^=for\s+(\S+)\s+(.*)/si) {# =for
  420.             process_for($1,$2);
  421.         } else {
  422.             /^=(\S*)\s*/;
  423.             warn "$0: $podfile: unknown pod directive '$1' in "
  424.                . "paragraph $paragraph.  ignoring.\n";
  425.         }
  426.         }
  427.         $top = 0;
  428.     }
  429.     else {
  430.         next if $ignore;
  431.         next if @begin_stack && $begin_stack[-1] ne 'html';
  432.         my $text = $_;
  433.         process_text(\$text, 1);
  434.         print HTML "<P>\n$text</P>\n";
  435.     }
  436.     }
  437.  
  438.     # finish off any pending directives
  439.     finish_list();
  440.     print HTML <<"END_OF_TAIL";
  441.         <!-- beginning of leaf footer-->
  442.         <p> </p>
  443.         <TABLE border=0  cellpadding=0 cellspacing=0 width=100%>
  444.         <TR>
  445.             <TD valign=middle
  446.                 bgcolor=\"#cc0066\"> <font face=\"sans-serif\" size=\"+1\"
  447.                 color=\"#ff99cc\">   $title</font>
  448.             </TD>
  449.         </TR>
  450.         </TABLE>
  451.         <!-- end of leaf footer-->
  452.         </BODY>
  453.         </HTML>
  454. END_OF_TAIL
  455.  
  456.     # close the html file
  457.     close(HTML);
  458.  
  459.     warn "Finished\n" if $verbose;
  460. }
  461.  
  462. ##############################################################################
  463.  
  464. my $usage;            # see below
  465. sub usage {
  466.     my $podfile = shift;
  467.     warn "$0: $podfile: @_\n" if @_;
  468.     die $usage;
  469. }
  470.  
  471. $usage =<<END_OF_USAGE;
  472. Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
  473.            --podpath=<name>:...:<name> --podroot=<name>
  474.            --libpods=<name>:...:<name> --recurse --verbose --index
  475.            --netscape --norecurse --noindex
  476.  
  477.   --flush      - flushes the item and directory caches.
  478.   --help       - prints this message.
  479.   --htmlroot   - http-server base directory from which all relative paths
  480.                  in podpath stem (default is /).
  481.   --index      - generate an index at the top of the resulting html
  482.                  (default).
  483.   --infile     - filename for the pod to convert (input taken from stdin
  484.                  by default).
  485.   --libpods    - colon-separated list of pages to search for =item pod
  486.                  directives in as targets of C<> and implicit links (empty
  487.                  by default).  note, these are not filenames, but rather
  488.                  page names like those that appear in L<> links.
  489.   --netscape   - will use netscape html directives when applicable.
  490.   --nonetscape - will not use netscape directives (default).
  491.   --outfile    - filename for the resulting html file (output sent to
  492.                  stdout by default).
  493.   --podpath    - colon-separated list of directories containing library
  494.                  pods.  empty by default.
  495.   --podroot    - filesystem base directory from which all relative paths
  496.                  in podpath stem (default is .).
  497.   --noindex    - don't generate an index at the top of the resulting html.
  498.   --norecurse  - don't recurse on those subdirectories listed in podpath.
  499.   --recurse    - recurse on those subdirectories listed in podpath
  500.                  (default behavior).
  501.   --title      - title that will appear in resulting html file.
  502.   --verbose    - self-explanatory
  503.  
  504. END_OF_USAGE
  505.  
  506. sub parse_command_line {
  507.     my ($opt_flush,$opt_help,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,$opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_norecurse,$opt_recurse,$opt_title,$opt_verbose,$opt_css,$opt_embedcss);
  508.     my $result = GetOptions(
  509.                 'flush'      => \$opt_flush,
  510.                 'help'       => \$opt_help,
  511.                 'htmlroot=s' => \$opt_htmlroot,
  512.                 'index!'     => \$opt_index,
  513.                 'infile=s'   => \$opt_infile,
  514.                 'libpods=s'  => \$opt_libpods,
  515.                 'netscape!'  => \$opt_netscape,
  516.                 'outfile=s'  => \$opt_outfile,
  517.                 'podpath=s'  => \$opt_podpath,
  518.                 'podroot=s'  => \$opt_podroot,
  519.                 'norecurse'  => \$opt_norecurse,
  520.                 'recurse!'   => \$opt_recurse,
  521.                 'title=s'    => \$opt_title,
  522.                 'verbose'    => \$opt_verbose,
  523.                 'css=s'         => \$opt_css
  524.                );
  525.     usage("-", "invalid parameters") if not $result;
  526.  
  527.     usage("-") if defined $opt_help;    # see if the user asked for help
  528.     $opt_help = "";            # just to make -w shut-up.
  529.  
  530.     $podfile  = $opt_infile if defined $opt_infile;
  531.     $htmlfile = $opt_outfile if defined $opt_outfile;
  532.  
  533.     @podpath  = split(":", $opt_podpath) if defined $opt_podpath;
  534.     @libpods  = split(":", $opt_libpods) if defined $opt_libpods;
  535.  
  536.     warn "Flushing item and directory caches\n"
  537.     if $opt_verbose && defined $opt_flush;
  538.     unlink($dircache, $itemcache) if defined $opt_flush;
  539.  
  540.     $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
  541.     $podroot  = $opt_podroot if defined $opt_podroot;
  542.  
  543.     $doindex  = $opt_index if defined $opt_index;
  544.     $recurse  = $opt_recurse if defined $opt_recurse;
  545.     $title    = $opt_title if defined $opt_title;
  546.     $verbose  = defined $opt_verbose ? 1 : 0;
  547.     $netscape = $opt_netscape if defined $opt_netscape;
  548.  
  549.     $css = $opt_css if defined $opt_css;
  550. }
  551.  
  552.  
  553. my $saved_cache_key;
  554.  
  555. sub get_cache {
  556.     my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
  557.     my @cache_key_args = @_;
  558.  
  559.     # A first-level cache:
  560.     # Don't bother reading the cache files if they still apply
  561.     # and haven't changed since we last read them.
  562.  
  563.     my $this_cache_key = cache_key(@cache_key_args);
  564.  
  565.     return if $saved_cache_key and $this_cache_key eq $saved_cache_key;
  566.  
  567.     # load the cache of %pages and %items if possible.  $tests will be
  568.     # non-zero if successful.
  569.     my $tests = 0;
  570.     if (-f $dircache && -f $itemcache) {
  571.     warn "scanning for item cache\n" if $verbose;
  572.     $tests = load_cache($dircache, $itemcache, $podpath, $podroot);
  573.     }
  574.  
  575.     # if we didn't succeed in loading the cache then we must (re)build
  576.     #  %pages and %items.
  577.     if (!$tests) {
  578.     warn "scanning directories in pod-path\n" if $verbose;
  579.     scan_podpath($podroot, $recurse, 0);
  580.     }
  581.     $saved_cache_key = cache_key(@cache_key_args);
  582. }
  583.  
  584. sub cache_key {
  585.     my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
  586.     return join('!', $dircache, $itemcache, $recurse,
  587.         @$podpath, $podroot, stat($dircache), stat($itemcache));
  588. }
  589.  
  590. #
  591. # load_cache - tries to find if the caches stored in $dircache and $itemcache
  592. #  are valid caches of %pages and %items.  if they are valid then it loads
  593. #  them and returns a non-zero value.
  594. #
  595.  
  596. sub load_cache {
  597.     my($dircache, $itemcache, $podpath, $podroot) = @_;
  598.     my($tests);
  599.     local $_;
  600.  
  601.     $tests = 0;
  602.  
  603.     open(CACHE, "<$itemcache") ||
  604.     die "$0: error opening $itemcache for reading: $!\n";
  605.     $/ = "\n";
  606.  
  607.     # is it the same podpath?
  608.     $_ = <CACHE>;
  609.     chomp($_);
  610.     $tests++ if (join(":", @$podpath) eq $_);
  611.  
  612.     # is it the same podroot?
  613.     $_ = <CACHE>;
  614.     chomp($_);
  615.     $tests++ if ($podroot eq $_);
  616.  
  617.     # load the cache if its good
  618.     if ($tests != 2) {
  619.     close(CACHE);
  620.     return 0;
  621.     }
  622.  
  623.     warn "loading item cache\n" if $verbose;
  624.     while (<CACHE>) {
  625.     /(.*?) (.*)$/;
  626.     $items{$1} = $2;
  627.     }
  628.     close(CACHE);
  629.  
  630.     warn "scanning for directory cache\n" if $verbose;
  631.     open(CACHE, "<$dircache") ||
  632.     die "$0: error opening $dircache for reading: $!\n";
  633.     $/ = "\n";
  634.     $tests = 0;
  635.  
  636.     # is it the same podpath?
  637.     $_ = <CACHE>;
  638.     chomp($_);
  639.     $tests++ if (join(":", @$podpath) eq $_);
  640.  
  641.     # is it the same podroot?
  642.     $_ = <CACHE>;
  643.     chomp($_);
  644.     $tests++ if ($podroot eq $_);
  645.  
  646.     # load the cache if its good
  647.     if ($tests != 2) {
  648.     close(CACHE);
  649.     return 0;
  650.     }
  651.  
  652.     warn "loading directory cache\n" if $verbose;
  653.     while (<CACHE>) {
  654.     /(.*?) (.*)$/;
  655.     $pages{$1} = $2;
  656.     }
  657.  
  658.     close(CACHE);
  659.  
  660.     return 1;
  661. }
  662.  
  663. #
  664. # scan_podpath - scans the directories specified in @podpath for directories,
  665. #  .pod files, and .pm files.  it also scans the pod files specified in
  666. #  @libpods for =item directives.
  667. #
  668. sub scan_podpath {
  669.     my($podroot, $recurse, $append) = @_;
  670.     my($pwd, $dir);
  671.     my($libpod, $dirname, $pod, @files, @poddata);
  672.  
  673.     unless($append) {
  674.     %items = ();
  675.     %pages = ();
  676.     }
  677.  
  678.     # scan each directory listed in @podpath
  679.     $pwd = getcwd();
  680.     chdir($podroot)
  681.     || die "$0: error changing to directory $podroot: $!\n";
  682.     foreach $dir (@podpath) {
  683.     scan_dir($dir, $recurse);
  684.     }
  685.  
  686.     # scan the pods listed in @libpods for =item directives
  687.     foreach $libpod (@libpods) {
  688.     # if the page isn't defined then we won't know where to find it
  689.     # on the system.
  690.     next unless defined $pages{$libpod} && $pages{$libpod};
  691.  
  692.     # if there is a directory then use the .pod and .pm files within it.
  693.     if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
  694.         #  find all the .pod and .pm files within the directory
  695.         $dirname = $1;
  696.         opendir(DIR, $dirname) ||
  697.         die "$0: error opening directory $dirname: $!\n";
  698.         @files = grep(/(\.pod|\.pm)$/ && ! -d $_, readdir(DIR));
  699.         closedir(DIR);
  700.  
  701.         # scan each .pod and .pm file for =item directives
  702.         foreach $pod (@files) {
  703.         open(POD, "<$dirname/$pod") ||
  704.             die "$0: error opening $dirname/$pod for input: $!\n";
  705.         @poddata = <POD>;
  706.         close(POD);
  707.  
  708.         scan_items("$dirname/$pod", @poddata);
  709.         }
  710.  
  711.         # use the names of files as =item directives too.
  712.         foreach $pod (@files) {
  713.         $pod =~ /^(.*)(\.pod|\.pm)$/;
  714.         $items{$1} = "$dirname/$1.html" if $1;
  715.         }
  716.     } elsif ($pages{$libpod} =~ /([^:]*\.pod):/ ||
  717.          $pages{$libpod} =~ /([^:]*\.pm):/) {
  718.         # scan the .pod or .pm file for =item directives
  719.         $pod = $1;
  720.         open(POD, "<$pod") ||
  721.         die "$0: error opening $pod for input: $!\n";
  722.         @poddata = <POD>;
  723.         close(POD);
  724.  
  725.         scan_items("$pod", @poddata);
  726.     } else {
  727.         warn "$0: shouldn't be here (line ".__LINE__."\n";
  728.     }
  729.     }
  730.     @poddata = ();    # clean-up a bit
  731.  
  732.     chdir($pwd)
  733.     || die "$0: error changing to directory $pwd: $!\n";
  734.  
  735.     # cache the item list for later use
  736.     warn "caching items for later use\n" if $verbose;
  737.     open(CACHE, ">$itemcache") ||
  738.     die "$0: error open $itemcache for writing: $!\n";
  739.  
  740.     print CACHE join(":", @podpath) . "\n$podroot\n";
  741.     foreach my $key (keys %items) {
  742.     print CACHE "$key $items{$key}\n";
  743.     }
  744.  
  745.     close(CACHE);
  746.  
  747.     # cache the directory list for later use
  748.     warn "caching directories for later use\n" if $verbose;
  749.     open(CACHE, ">$dircache") ||
  750.     die "$0: error open $dircache for writing: $!\n";
  751.  
  752.     print CACHE join(":", @podpath) . "\n$podroot\n";
  753.     foreach my $key (keys %pages) {
  754.     print CACHE "$key $pages{$key}\n";
  755.     }
  756.  
  757.     close(CACHE);
  758. }
  759.  
  760. #
  761. # scan_dir - scans the directory specified in $dir for subdirectories, .pod
  762. #  files, and .pm files.  notes those that it finds.  this information will
  763. #  be used later in order to figure out where the pages specified in L<>
  764. #  links are on the filesystem.
  765. #
  766. sub scan_dir {
  767.     my($dir, $recurse) = @_;
  768.     my($t, @subdirs, @pods, $pod, $dirname, @dirs);
  769.     local $_;
  770.  
  771.     @subdirs = ();
  772.     @pods = ();
  773.  
  774.     opendir(DIR, $dir) ||
  775.     die "$0: error opening directory $dir: $!\n";
  776.     while (defined($_ = readdir(DIR))) {
  777.     if (-d "$dir/$_" && $_ ne "." && $_ ne "..") {        # directory
  778.         $pages{$_}  = "" unless defined $pages{$_};
  779.         $pages{$_} .= "$dir/$_:";
  780.         push(@subdirs, $_);
  781.     } elsif (/\.pod$/) {                                # .pod
  782.         s/\.pod$//;
  783.         $pages{$_}  = "" unless defined $pages{$_};
  784.         $pages{$_} .= "$dir/$_.pod:";
  785.         push(@pods, "$dir/$_.pod");
  786.     } elsif (/\.pm$/) {                                 # .pm
  787.         s/\.pm$//;
  788.         $pages{$_}  = "" unless defined $pages{$_};
  789.         $pages{$_} .= "$dir/$_.pm:";
  790.         push(@pods, "$dir/$_.pm");
  791.     }
  792.     }
  793.     closedir(DIR);
  794.  
  795.     # recurse on the subdirectories if necessary
  796.     if ($recurse) {
  797.     foreach my $subdir (@subdirs) {
  798.         scan_dir("$dir/$subdir", $recurse);
  799.     }
  800.     }
  801. }
  802.  
  803. #
  804. # scan_headings - scan a pod file for head[1-6] tags, note the tags, and
  805. #  build an index.
  806. #
  807. sub scan_headings {
  808.     my($sections, @data) = @_;
  809.     my($tag, $which_head, $title, $listdepth, $index);
  810.  
  811.     # here we need    local $ignore = 0;
  812.     #  unfortunately, we can't have it, because $ignore is lexical
  813.     $ignore = 0;
  814.  
  815.     $listdepth = 0;
  816.     $index = "";
  817.  
  818.     # scan for =head directives, note their name, and build an index
  819.     #  pointing to each of them.
  820.     foreach my $line (@data) {
  821.     if ($line =~ /^=(head)([1-6])\s+(.*)/) {
  822.         ($tag,$which_head, $title) = ($1,$2,$3);
  823.         chomp($title);
  824.         $$sections{htmlify(0,$title)} = 1;
  825.  
  826.         while ($which_head != $listdepth) {
  827.         if ($which_head > $listdepth) {
  828.             $index .= "\n" . ("\t" x $listdepth) . "<UL>\n";
  829.             $listdepth++;
  830.         } elsif ($which_head < $listdepth) {
  831.             $listdepth--;
  832.             $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
  833.         }
  834.         }
  835.  
  836.         # DTG *** Added </LI> after the </A> to close the list item
  837.         $index .= "\n" . ("\t" x $listdepth) . "<LI>" .
  838.                   "<A HREF=\"#" . htmlify(0,$title) . "\">" .
  839.               html_escape(process_text(\$title, 0)) . "</A></LI>";
  840.     }
  841.     }
  842.  
  843.     # finish off the lists
  844.     while ($listdepth--) {
  845.     $index .= "\n" . ("\t" x $listdepth) . "</UL>\n";
  846.     }
  847.  
  848.     # get rid of bogus lists
  849.     $index =~ s,\t*<UL>\s*</UL>\n,,g;
  850.  
  851.     $ignore = 1;    # restore old value;
  852.  
  853.     return $index;
  854. }
  855.  
  856. #
  857. # scan_items - scans the pod specified by $pod for =item directives.  we
  858. #  will use this information later on in resolving C<> links.
  859. #
  860. sub scan_items {
  861.     my($pod, @poddata) = @_;
  862.     my($i, $item);
  863.     local $_;
  864.  
  865.     $pod =~ s/\.pod$//;
  866.     $pod .= ".html" if $pod;
  867.  
  868.     foreach $i (0..$#poddata) {
  869.     $_ = $poddata[$i];
  870.  
  871.     # remove any formatting instructions
  872.     s,[A-Z]<([^<>]*)>,$1,g;
  873.  
  874.     # figure out what kind of item it is and get the first word of
  875.     #  it's name.
  876.     if (/^=item\s+(\w*)\s*.*$/s) {
  877.         if ($1 eq "*") {        # bullet list
  878.         /\A=item\s+\*\s*(.*?)\s*\Z/s;
  879.         $item = $1;
  880.         } elsif ($1 =~ /^\d+/) {    # numbered list
  881.         /\A=item\s+\d+\.?(.*?)\s*\Z/s;
  882.         $item = $1;
  883.         } else {
  884. #        /\A=item\s+(.*?)\s*\Z/s;
  885.         /\A=item\s+(\w*)/s;
  886.         $item = $1;
  887.         }
  888.  
  889.         $items{$item} = "$pod" if $item;
  890.     }
  891.     }
  892. }
  893.  
  894. #
  895. # process_head - convert a pod head[1-6] tag and convert it to HTML format.
  896. #
  897. sub process_head {
  898.     my($tag, $heading) = @_;
  899.     my $firstword;
  900.  
  901.     # figure out the level of the =head
  902.     $tag =~ /head([1-6])/;
  903.     my $level = $1;
  904.  
  905.     # can't have a heading full of spaces and speechmarks and so on
  906.     $firstword = $heading; $firstword =~ s/\s*(\w+)\s.*/$1/;
  907.  
  908.     #print HTML "<P>\n" unless $listlevel;
  909.     print HTML "<HR>\n" unless $listlevel || $top;
  910.     print HTML "<H$level>"; # unless $listlevel;
  911.     #print HTML "<H$level>" unless $listlevel;
  912.     my $convert = $heading; process_text(\$convert, 0);
  913.     $convert = html_escape($convert);
  914.     print HTML '<A NAME="' . htmlify(0,$heading) . "\">$convert</A>";
  915.     print HTML "</H$level>"; # unless $listlevel;
  916.     print HTML "\n";
  917. }
  918.  
  919. #
  920. # process_item - convert a pod item tag and convert it to HTML format.
  921. #
  922. sub process_item {
  923.     my $text = $_[0];
  924.     my($i, $quote, $name);
  925.  
  926.     my $need_preamble = 0;
  927.     my $this_entry;
  928.  
  929.  
  930.     # lots of documents start a list without doing an =over.  this is
  931.     # bad!  but, the proper thing to do seems to be to just assume
  932.     # they did do an =over.  so warn them once and then continue.
  933.     warn "$0: $podfile: unexpected =item directive in paragraph $paragraph.  ignoring.\n"
  934.     unless $listlevel;
  935.     process_over() unless $listlevel;
  936.  
  937.     return unless $listlevel;
  938.  
  939.     # remove formatting instructions from the text
  940.     1 while $text =~ s/[A-Z]<([^<>]*)>/$1/g;
  941.     pre_escape(\$text);
  942.  
  943.     $need_preamble = $items_seen[$listlevel]++ == 0;
  944.  
  945.     # check if this is the first =item after an =over
  946.     $i = $listlevel - 1;
  947.     my $need_new = $listlevel >= @listitem;
  948.  
  949.     if ($text =~ /\A\*/) {        # bullet
  950.  
  951.     if ($need_preamble) {
  952.         push(@listend,  "</UL>");
  953.         print HTML "<UL>\n";
  954.     }
  955.  
  956.     print HTML '<LI>';
  957.     if ($text =~ /\A\*\s*(.+)\Z/s) {
  958.         print HTML '<STRONG>';
  959.         if ($items_named{$1}++) {
  960.         print HTML html_escape($1);
  961.         } else {
  962.         my $name = 'item_' . htmlify(1,$1);
  963.         print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
  964.         }
  965.         print HTML '</STRONG>';
  966.     }
  967.  
  968.     } elsif ($text =~ /\A[\d#]+/) {    # numbered list
  969.  
  970.     if ($need_preamble) {
  971.         push(@listend,  "</OL>");
  972.         print HTML "<OL>\n";
  973.     }
  974.  
  975.     print HTML '<LI>';
  976.     if ($text =~ /\A\d+\.?\s*(.+)\Z/s) {
  977.         print HTML '<STRONG>';
  978.         if ($items_named{$1}++) {
  979.         print HTML html_escape($1);
  980.         } else {
  981.         my $name = 'item_' . htmlify(0,$1);
  982.         print HTML qq(<A NAME="$name">), html_escape($1), '</A>';
  983.         }
  984.         print HTML '</STRONG>';
  985.     }
  986.  
  987.     } else {            # all others
  988.  
  989.     if ($need_preamble) {
  990.         push(@listend,  '</DL>');
  991.         print HTML "<DL>\n";
  992.     }
  993.  
  994.     print HTML '<DT>';
  995.     if ($text =~ /(\S+)/) {
  996.         print HTML '<STRONG>';
  997.         if ($items_named{$1}++) {
  998.         print HTML html_escape($text);
  999.         } else {
  1000.         my $name = 'item_' . htmlify(1,$text);
  1001.         print HTML qq(<A NAME="$name">), html_escape($text), '</A>';
  1002.         }
  1003.         print HTML '</STRONG>';
  1004.     }
  1005.        print HTML '<DD>';
  1006.     }
  1007.  
  1008.     print HTML "\n";
  1009. }
  1010.  
  1011. #
  1012. # process_over - process a pod over tag and start a corresponding HTML
  1013. # list.
  1014. #
  1015. sub process_over {
  1016.     # start a new list
  1017.     $listlevel++;
  1018. }
  1019.  
  1020. #
  1021. # process_back - process a pod back tag and convert it to HTML format.
  1022. #
  1023. sub process_back {
  1024.     warn "$0: $podfile: unexpected =back directive in paragraph $paragraph.  ignoring.\n"
  1025.     unless $listlevel;
  1026.     return unless $listlevel;
  1027.  
  1028.     # close off the list.  note, I check to see if $listend[$listlevel] is
  1029.     # defined because an =item directive may have never appeared and thus
  1030.     # $listend[$listlevel] may have never been initialized.
  1031.     $listlevel--;
  1032.     print HTML $listend[$listlevel] if defined $listend[$listlevel];
  1033.     print HTML "\n";
  1034.  
  1035.     # don't need the corresponding perl code anymore
  1036.     pop(@listitem);
  1037.     pop(@listdata);
  1038.     pop(@listend);
  1039.  
  1040.     pop(@items_seen);
  1041. }
  1042.  
  1043. #
  1044. # process_cut - process a pod cut tag, thus stop ignoring pod directives.
  1045. #
  1046. sub process_cut {
  1047.     $ignore = 1;
  1048. }
  1049.  
  1050. #
  1051. # process_pod - process a pod pod tag, thus ignore pod directives until we see a
  1052. # corresponding cut.
  1053. #
  1054. sub process_pod {
  1055.     # no need to set $ignore to 0 cause the main loop did it
  1056. }
  1057.  
  1058. #
  1059. # process_for - process a =for pod tag.  if it's for html, split
  1060. # it out verbatim, if illustration, center it, otherwise ignore it.
  1061. #
  1062. sub process_for {
  1063.     my($whom, $text) = @_;
  1064.     if ( $whom =~ /^(pod2)?html$/i) {
  1065.     print HTML $text;
  1066.     } elsif ($whom =~ /^illustration$/i) {
  1067.         1 while chomp $text;
  1068.     for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) {
  1069.       $text .= $ext, last if -r "$text$ext";
  1070.     }
  1071.         print HTML qq{<p align = "center"><img src = "$text" alt = "$text illustration"></p>};
  1072.     }
  1073. }
  1074.  
  1075. #
  1076. # process_begin - process a =begin pod tag.  this pushes
  1077. # whom we're beginning on the begin stack.  if there's a
  1078. # begin stack, we only print if it us.
  1079. #
  1080. sub process_begin {
  1081.     my($whom, $text) = @_;
  1082.     $whom = lc($whom);
  1083.     push (@begin_stack, $whom);
  1084.     if ( $whom =~ /^(pod2)?html$/) {
  1085.     print HTML $text if $text;
  1086.     }
  1087. }
  1088.  
  1089. #
  1090. # process_end - process a =end pod tag.  pop the
  1091. # begin stack.  die if we're mismatched.
  1092. #
  1093. sub process_end {
  1094.     my($whom, $text) = @_;
  1095.     $whom = lc($whom);
  1096.     if ($begin_stack[-1] ne $whom ) {
  1097.     die "$0: $podfile: Unmatched begin/end at chunk $paragraph\n"
  1098.     } 
  1099.     pop @begin_stack;
  1100. }
  1101.  
  1102. #
  1103. # process_text - handles plaintext that appears in the input pod file.
  1104. # there may be pod commands embedded within the text so those must be
  1105. # converted to html commands.
  1106. #
  1107. sub process_text {
  1108.     my($text, $escapeQuotes) = @_;
  1109.     my($result, $rest, $s1, $s2, $s3, $s4, $match, $bf);
  1110.     my($podcommand, $params, $tag, $quote);
  1111.  
  1112.     return if $ignore;
  1113.  
  1114.     $quote  = 0;                # status of double-quote conversion
  1115.     $result = "";
  1116.     $rest = $$text;
  1117.  
  1118.     if ($rest =~ /^\s+/) {    # preformatted text, no pod directives
  1119.     $rest =~ s/\n+\Z//;
  1120.     $rest =~ s#.*#
  1121.         my $line = $&;
  1122.         1 while $line =~ s/\t+/' ' x (length($&) * 8 - length($`) % 8)/e;
  1123.         $line;
  1124.     #eg;
  1125.  
  1126.     $rest   =~ s/&/&/g;
  1127.     $rest   =~ s/</</g;
  1128.     $rest   =~ s/>/>/g;
  1129.     $rest   =~ s/"/"/g;
  1130.  
  1131.     # try and create links for all occurrences of perl.* within
  1132.     # the preformatted text.
  1133.     $rest =~ s{
  1134.             (\s*)(perl\w+)
  1135.           }{
  1136.             if (defined $pages{$2}) {    # is a link
  1137.             qq($1<A HREF="$htmlroot/$pages{$2}">$2</A>);
  1138.             } elsif (defined $pages{dosify($2)}) {    # is a link
  1139.             qq($1<A HREF="$htmlroot/$pages{dosify($2)}">$2</A>);
  1140.             } else {
  1141.             "$1$2";
  1142.             }
  1143.           }xeg;
  1144.     $rest =~ s/(<A HREF=)([^>:]*:)?([^>:]*)\.pod:([^>:]*:)?/$1$3.html/g;
  1145.  
  1146.   my $urls = '(' . join ('|', qw{
  1147.                 http
  1148.                 telnet
  1149.         mailto
  1150.         news
  1151.                 gopher
  1152.                 file
  1153.                 wais
  1154.                 ftp
  1155.             } ) 
  1156.         . ')';
  1157.   
  1158.   my $ltrs = '\w';
  1159.   my $gunk = '/#~:.?+=&%@!\-';
  1160.   my $punc = '.:?\-';
  1161.   my $any  = "${ltrs}${gunk}${punc}";
  1162.  
  1163.   $rest =~ s{
  1164.         \b                          # start at word boundary
  1165.         (                           # begin $1  {
  1166.           $urls     :               # need resource and a colon
  1167.           [$any] +?                 # followed by on or more
  1168.                                     #  of any valid character, but
  1169.                                     #  be conservative and take only
  1170.                                     #  what you need to....
  1171.         )                           # end   $1  }
  1172.         (?=                         # look-ahead non-consumptive assertion
  1173.                 [$punc]*            # either 0 or more puntuation
  1174.                 [^$any]             #   followed by a non-url char
  1175.             |                       # or else
  1176.                 $                   #   then end of the string
  1177.         )
  1178.       }{<A HREF="$1">$1</A>}igox;
  1179.  
  1180.     $result =   "<PRE>"    # text should be as it is (verbatim)
  1181.           . "$rest\n"
  1182.           . "</PRE>\n";
  1183.     } else {            # formatted text
  1184.     # parse through the string, stopping each time we find a
  1185.     # pod-escape.  once the string has been throughly processed
  1186.     # we can output it.
  1187.     while (length $rest) {
  1188.         # check to see if there are any possible pod directives in
  1189.         # the remaining part of the text.
  1190.         if ($rest =~ m/[BCEIFLSZ]</) {
  1191.         warn "\$rest\t= $rest\n" unless
  1192.             $rest =~ /\A
  1193.                ([^<]*?)
  1194.                ([BCEIFLSZ]?)
  1195.                <
  1196.                (.*)\Z/xs;
  1197.  
  1198.         $s1 = $1;    # pure text
  1199.         $s2 = $2;    # the type of pod-escape that follows
  1200.         $s3 = '<';    # '<'
  1201.         $s4 = $3;    # the rest of the string
  1202.         } else {
  1203.         $s1 = $rest;
  1204.         $s2 = "";
  1205.         $s3 = "";
  1206.         $s4 = "";
  1207.         }
  1208.  
  1209.         if ($s3 eq '<' && $s2) {    # a pod-escape
  1210.         $result    .= ($escapeQuotes ? process_puretext($s1, \$quote) : $s1);
  1211.         $podcommand = "$s2<";
  1212.         $rest       = $s4;
  1213.  
  1214.         # find the matching '>'
  1215.         $match = 1;
  1216.         $bf = 0;
  1217.         while ($match && !$bf) {
  1218.             $bf = 1;
  1219.             if ($rest =~ /\A([^<>]*[BCEIFLSZ]<)(.*)\Z/s) {
  1220.             $bf = 0;
  1221.             $match++;
  1222.             $podcommand .= $1;
  1223.             $rest        = $2;
  1224.             } elsif ($rest =~ /\A([^>]*>)(.*)\Z/s) {
  1225.             $bf = 0;
  1226.             $match--;
  1227.             $podcommand .= $1;
  1228.             $rest        = $2;
  1229.             }
  1230.         }
  1231.  
  1232.         if ($match != 0) {
  1233.             warn <<WARN;
  1234. $0: $podfile: cannot find matching > for $s2 in paragraph $paragraph.
  1235. WARN
  1236.             $result .= substr $podcommand, 0, 2;
  1237.             $rest = substr($podcommand, 2) . $rest;
  1238.             next;
  1239.         }
  1240.  
  1241.         # pull out the parameters to the pod-escape
  1242.         $podcommand =~ /^([BCFEILSZ]?)<(.*)>$/s;
  1243.         $tag    = $1;
  1244.         $params = $2;
  1245.  
  1246.         # process the text within the pod-escape so that any escapes
  1247.         # which must occur do.
  1248.         process_text(\$params, 0) unless $tag eq 'L';
  1249.  
  1250.         $s1 = $params;
  1251.         if (!$tag || $tag eq " ") {    #  <> : no tag
  1252.             $s1 = "<$params>";
  1253.         } elsif ($tag eq "L") {        # L<> : link 
  1254.             $s1 = process_L($params);
  1255.         } elsif ($tag eq "I" ||        # I<> : italicize text
  1256.              $tag eq "B" ||        # B<> : bold text
  1257.              $tag eq "F") {        # F<> : file specification
  1258.             $s1 = process_BFI($tag, $params);
  1259.         } elsif ($tag eq "C") {        # C<> : literal code
  1260.             $s1 = process_C($params, 1);
  1261.         } elsif ($tag eq "E") {        # E<> : escape
  1262.             $s1 = process_E($params);
  1263.         } elsif ($tag eq "Z") {        # Z<> : zero-width character
  1264.             $s1 = process_Z($params);
  1265.         } elsif ($tag eq "S") {        # S<> : non-breaking space
  1266.             $s1 = process_S($params);
  1267.         } elsif ($tag eq "X") {        # S<> : non-breaking space
  1268.             $s1 = process_X($params);
  1269.         } else {
  1270.             warn "$0: $podfile: unhandled tag '$tag' in paragraph $paragraph\n";
  1271.         }
  1272.  
  1273.         $result .= "$s1";
  1274.         } else {
  1275.         # for pure text we must deal with implicit links and
  1276.         # double-quotes among other things.
  1277.         $result .= ($escapeQuotes ? process_puretext("$s1$s2$s3", \$quote) : "$s1$s2$s3");
  1278.         $rest    = $s4;
  1279.         }
  1280.     }
  1281.     }
  1282.     $$text = $result;
  1283. }
  1284.  
  1285. sub html_escape {
  1286.     my $rest = $_[0];
  1287.     $rest   =~ s/&/&/g;
  1288.     $rest   =~ s/</</g;
  1289.     $rest   =~ s/>/>/g;
  1290.     $rest   =~ s/"/"/g;
  1291.     return $rest;
  1292. } 
  1293.  
  1294. #
  1295. # process_puretext - process pure text (without pod-escapes) converting
  1296. #  double-quotes and handling implicit C<> links.
  1297. #
  1298. sub process_puretext {
  1299.     my($text, $quote) = @_;
  1300.     my(@words, $result, $rest, $lead, $trail);
  1301.  
  1302.     # convert double-quotes to single-quotes
  1303.     $text =~ s/\A([^"]*)"/$1''/s if $$quote;
  1304.     while ($text =~ s/\A([^"]*)["]([^"]*)["]/$1``$2''/sg) {}
  1305.  
  1306.     $$quote = ($text =~ m/"/ ? 1 : 0);
  1307.     $text =~ s/\A([^"]*)"/$1``/s if $$quote;
  1308.  
  1309.     # keep track of leading and trailing white-space
  1310.     $lead  = ($text =~ /\A(\s*)/s ? $1 : "");
  1311.     $trail = ($text =~ /(\s*)\Z/s ? $1 : "");
  1312.  
  1313.     # collapse all white space into a single space
  1314.     $text =~ s/\s+/ /g;
  1315.     @words = split(" ", $text);
  1316.  
  1317.     # process each word individually
  1318.     foreach my $word (@words) {
  1319.     # see if we can infer a link
  1320.     if ($word =~ /^\w+\(/) {
  1321.         # has parenthesis so should have been a C<> ref
  1322.         $word = process_C($word);
  1323. #        $word =~ /^[^()]*]\(/;
  1324. #        if (defined $items{$1} && $items{$1}) {
  1325. #        $word =   "\n<CODE><A HREF=\"$htmlroot/$items{$1}#item_"
  1326. #            . htmlify(0,$word)
  1327. #            . "\">$word</A></CODE>";
  1328. #        } elsif (defined $items{$word} && $items{$word}) {
  1329. #        $word =   "\n<CODE><A HREF=\"$htmlroot/$items{$word}#item_"
  1330. #            . htmlify(0,$word)
  1331. #            . "\">$word</A></CODE>";
  1332. #        } else {
  1333. #        $word =   "\n<CODE><A HREF=\"#item_"
  1334. #            . htmlify(0,$word)
  1335. #            . "\">$word</A></CODE>";
  1336. #        }
  1337.     } elsif ($word =~ /^[\$\@%&*]+\w+$/) {
  1338.         # perl variables, should be a C<> ref
  1339.         $word = process_C($word, 1);
  1340.     } elsif ($word =~ m,^\w+://\w,) {
  1341.         # looks like a URL
  1342.         $word = qq(<A HREF="$word">$word</A>);
  1343.     } elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) {
  1344.         # looks like an e-mail address
  1345.         my ($w1, $w2, $w3) = ("", $word, "");
  1346.         ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
  1347.         ($w1, $w2, $w3) = ("<", $1, ">$2") if $word =~ /^<(.*?)>(,?)/;
  1348.         $word = qq($w1<A HREF="mailto:$w2">$w2</A>$w3);
  1349.     } elsif ($word !~ /[a-z]/ && $word =~ /[A-Z]/) {  # all uppercase?
  1350.         $word = html_escape($word) if $word =~ /["&<>]/;
  1351.         $word = "\n<FONT SIZE=-1>$word</FONT>" if $netscape;
  1352.     } else { 
  1353.         $word = html_escape($word) if $word =~ /["&<>]/;
  1354.     }
  1355.     }
  1356.  
  1357.     # build a new string based upon our conversion
  1358.     $result = "";
  1359.     $rest   = join(" ", @words);
  1360.     while (length($rest) > 75) {
  1361.     if ( $rest =~ m/^(.{0,75})\s(.*?)$/o ||
  1362.          $rest =~ m/^(\S*)\s(.*?)$/o) {
  1363.  
  1364.         $result .= "$1\n";
  1365.         $rest    = $2;
  1366.     } else {
  1367.         $result .= "$rest\n";
  1368.         $rest    = "";
  1369.     }
  1370.     }
  1371.     $result .= $rest if $rest;
  1372.  
  1373.     # restore the leading and trailing white-space
  1374.     $result = "$lead$result$trail";
  1375.  
  1376.     return $result;
  1377. }
  1378.  
  1379. #
  1380. # pre_escape - convert & in text to $amp;
  1381. #
  1382. sub pre_escape {
  1383.     my($str) = @_;
  1384.  
  1385.     $$str =~ s,&,&,g;
  1386. }
  1387.  
  1388. #
  1389. # dosify - convert filenames to 8.3
  1390. #
  1391. sub dosify {
  1392.     my($str) = @_;
  1393.     if ($Is83) {
  1394.         $str = lc $str;
  1395.         $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
  1396.         $str =~ s/(\w+)/substr ($1,0,8)/ge;
  1397.     }
  1398.     return $str;
  1399. }
  1400.  
  1401. #
  1402. # process_L - convert a pod L<> directive to a corresponding HTML link.
  1403. #  most of the links made are inferred rather than known about directly
  1404. #  (i.e it's not known whether the =head\d section exists in the target file,
  1405. #   or whether a .pod file exists in the case of split files).  however, the
  1406. #  guessing usually works.
  1407. #
  1408. # Unlike the other directives, this should be called with an unprocessed
  1409. # string, else tags in the link won't be matched.
  1410. #
  1411. sub process_L {
  1412.     my($str) = @_;
  1413.     my($s1, $s2, $linktext, $page, $page83, $section, $link);    # work strings
  1414.  
  1415.     $str =~ s/\n/ /g;            # undo word-wrapped tags
  1416.     $s1 = $str;
  1417.     for ($s1) {
  1418.     # LREF: a la HREF L<show this text|man/section>
  1419.     $linktext = $1 if s:^([^|]+)\|::;
  1420.  
  1421.     # make sure sections start with a /
  1422.     s,^",/",g;
  1423.     s,^,/,g if (!m,/, && / /);
  1424.  
  1425.     # check if there's a section specified
  1426.     if (m,^(.*?)/"?(.*?)"?$,) {    # yes
  1427.         ($page, $section) = ($1, $2);
  1428.     } else {            # no
  1429.         ($page, $section) = ($str, "");
  1430.     }
  1431.  
  1432.     # check if we know that this is a section in this page
  1433.     if (!defined $pages{$page} && defined $sections{$page}) {
  1434.         $section = $page;
  1435.         $page = "";
  1436.     }
  1437.     }
  1438.  
  1439.     $page83=dosify($page);
  1440.     $page=$page83 if (defined $pages{$page83});
  1441.     if ($page eq "") {
  1442.     $link = "#" . htmlify(0,$section);
  1443.     $linktext = $section unless defined($linktext);
  1444.     } elsif ( $page =~ /::/ ) {
  1445.     $linktext  = ($section ? "$section" : "$page");
  1446.     $page =~ s,::,/,g;
  1447.     $link = "$htmlroot/$page.html";
  1448.     $link .= "#" . htmlify(0,$section) if ($section);
  1449.     } elsif (!defined $pages{$page}) {
  1450. #    warn "$0: $podfile: cannot resolve L<$str> in paragraph $paragraph: no such page '$page'\n";
  1451.     $link = "";
  1452.     $linktext = $page unless defined($linktext);
  1453.     } else {
  1454.     $linktext  = ($section ? "$section" : "the $page manpage") unless defined($linktext);
  1455.     $section = htmlify(0,$section) if $section ne "";
  1456.  
  1457.     # if there is a directory by the name of the page, then assume that an
  1458.     # appropriate section will exist in the subdirectory
  1459.     if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
  1460.         $link = "$htmlroot/$1/$section.html";
  1461.  
  1462.     # since there is no directory by the name of the page, the section will
  1463.     # have to exist within a .html of the same name.  thus, make sure there
  1464.     # is a .pod or .pm that might become that .html
  1465.     } else {
  1466.         $section = "#$section";
  1467.         # check if there is a .pod with the page name
  1468.         if ($pages{$page} =~ /([^:]*)\.pod:/) {
  1469.         $link = "$htmlroot/$1.html$section";
  1470.         } elsif ($pages{$page} =~ /([^:]*)\.pm:/) {
  1471.         $link = "$htmlroot/$1.html$section";
  1472.         } else {
  1473.         warn "$0: $podfile: cannot resolve L$str in paragraph $paragraph: ".
  1474.                  "no .pod or .pm found\n";
  1475.         $link = "";
  1476.         $linktext = $section unless defined($linktext);
  1477.         }
  1478.     }
  1479.     }
  1480.  
  1481.     process_text(\$linktext, 0);
  1482.     if ($link) {
  1483.     $s1 = "<A HREF=\"$link\">$linktext</A>";
  1484.     } else {
  1485.     $s1 = "<EM>$linktext</EM>";
  1486.     }
  1487.     return $s1;
  1488. }
  1489.  
  1490. #
  1491. # process_BFI - process any of the B<>, F<>, or I<> pod-escapes and
  1492. # convert them to corresponding HTML directives.
  1493. #
  1494. sub process_BFI {
  1495.     my($tag, $str) = @_;
  1496.     my($s1);            # work string
  1497.     my(%repltext) = (    'B' => 'STRONG',
  1498.             'F' => 'EM',
  1499.             'I' => 'EM');
  1500.  
  1501.     # extract the modified text and convert to HTML
  1502.     $s1 = "<$repltext{$tag}>$str</$repltext{$tag}>";
  1503.     return $s1;
  1504. }
  1505.  
  1506. #
  1507. # process_C - process the C<> pod-escape.
  1508. #
  1509. sub process_C {
  1510.     my($str, $doref) = @_;
  1511.     my($s1, $s2);
  1512.  
  1513.     $s1 = $str;
  1514.     $s1 =~ s/\([^()]*\)//g;    # delete parentheses
  1515.     $s2 = $s1;
  1516.     $s1 =~ s/\W//g;        # delete bogus characters
  1517.     $str = html_escape($str);
  1518.  
  1519.     # if there was a pod file that we found earlier with an appropriate
  1520.     # =item directive, then create a link to that page.
  1521.     if ($doref && defined $items{$s1}) {
  1522.     $s1 = ($items{$s1} ?
  1523.            "<A HREF=\"$htmlroot/$items{$s1}#item_" . htmlify(0,$s2) .  "\">$str</A>" :
  1524.            "<A HREF=\"#item_" . htmlify(0,$s2) .  "\">$str</A>");
  1525.     $s1 =~ s,(perl\w+/(\S+)\.html)#item_\2\b,$1,; 
  1526.     confess "s1 has space: $s1" if $s1 =~ /HREF="[^"]*\s[^"]*"/;
  1527.     } else {
  1528.     $s1 = "<CODE>$str</CODE>";
  1529.     # warn "$0: $podfile: cannot resolve C<$str> in paragraph $paragraph\n" if $verbose
  1530.     }
  1531.  
  1532.  
  1533.     return $s1;
  1534. }
  1535.  
  1536. #
  1537. # process_E - process the E<> pod directive which seems to escape a character.
  1538. #
  1539. sub process_E {
  1540.     my($str) = @_;
  1541.  
  1542.     for ($str) {
  1543.     s,([^/].*),\&$1\;,g;
  1544.     }
  1545.  
  1546.     return $str;
  1547. }
  1548.  
  1549. #
  1550. # process_Z - process the Z<> pod directive which really just amounts to
  1551. # ignoring it.  this allows someone to start a paragraph with an =
  1552. #
  1553. sub process_Z {
  1554.     my($str) = @_;
  1555.  
  1556.     # there is no equivalent in HTML for this so just ignore it.
  1557.     $str = "";
  1558.     return $str;
  1559. }
  1560.  
  1561. #
  1562. # process_S - process the S<> pod directive which means to convert all
  1563. # spaces in the string to non-breaking spaces (in HTML-eze).
  1564. #
  1565. sub process_S {
  1566.     my($str) = @_;
  1567.  
  1568.     # convert all spaces in the text to non-breaking spaces in HTML.
  1569.     $str =~ s/ / /g;
  1570.     return $str;
  1571. }
  1572.  
  1573. #
  1574. # process_X - this is supposed to make an index entry.  we'll just 
  1575. # ignore it.
  1576. #
  1577. sub process_X {
  1578.     return '';
  1579. }
  1580.  
  1581.  
  1582. #
  1583. # finish_list - finish off any pending HTML lists.  this should be called
  1584. # after the entire pod file has been read and converted.
  1585. #
  1586. sub finish_list {
  1587.     while ($listlevel > 0) {
  1588.     print HTML "</DL>\n";
  1589.     $listlevel--;
  1590.     }
  1591. }
  1592.  
  1593. #
  1594. # htmlify - converts a pod section specification to a suitable section
  1595. # specification for HTML.  if first arg is 1, only takes 1st word.
  1596. #
  1597. sub htmlify {
  1598.     my($compact, $heading) = @_;
  1599.  
  1600.     if ($compact) {
  1601.       $heading =~ /^(\w+)/;
  1602.       $heading = $1;
  1603.     } 
  1604.  
  1605.   # $heading = lc($heading);
  1606.   $heading =~ s/[^\w\s]/_/g;
  1607.   $heading =~ s/(\s+)/ /g;
  1608.   $heading =~ s/^\s*(.*?)\s*$/$1/s;
  1609.   $heading =~ s/ /_/g;
  1610.   $heading =~ s/\A(.{32}).*\Z/$1/s;
  1611.   $heading =~ s/\s+\Z//;
  1612.   $heading =~ s/_{2,}/_/g;
  1613.  
  1614.   return $heading;
  1615. }
  1616.  
  1617. BEGIN {
  1618. }
  1619.  
  1620. 1;
  1621.