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