lib/Pod/Html.pm

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