lib/Pod/Html.pm

   1 package Pod::Html;
   2 use strict;
   3 require Exporter;
   4
   5 use vars qw($VERSION @ISA @EXPORT);
   6 $VERSION = 1.04;
   7 @ISA = qw(Exporter);
   8 @EXPORT = qw(pod2html htmlify);
   9
  10 use Carp;
  11 use Config;
  12 use Cwd;
  13 use File::Spec;
  14 use File::Spec::Unix;
  15 use Getopt::Long;
  16
  17 use locale;     # make \w work right in non-ASCII lands
  18
  19 =head1 NAME
  20
  21 Pod::Html - module to convert pod files to HTML
  22
  23 =head1 SYNOPSIS
  24
  25     use Pod::Html;
  26     pod2html([options]);
  27
  28 =head1 DESCRIPTION
  29
  30 Converts files from pod format (see L<perlpod>) to HTML format.  It
  31 can automatically generate indexes and cross-references, and it keeps
  32 a cache of things it knows how to cross-reference.
  33
  34 =head1 ARGUMENTS
  35
  36 Pod::Html takes the following arguments:
  37
  38 =over 4
  39
  40 =item backlink
  41
  42     --backlink="Back to Top"
  43
  44 Adds "Back to Top" links in front of every C<head1> heading (except for
  45 the first).  By default, no backlinks are generated.
  46
  47 =item cachedir
  48
  49     --cachedir=name
  50
  51 Creates the item and directory caches in the given directory.
  52
  53 =item css
  54
  55     --css=stylesheet
  56
  57 Specify the URL of a cascading style sheet.  Also disables all HTML/CSS
  58 C<style> attributes that are output by default (to avoid conflicts).
  59
  60 =item flush
  61
  62     --flush
  63
  64 Flushes the item and directory caches.
  65
  66 =item header
  67
  68     --header
  69     --noheader
  70
  71 Creates header and footer blocks containing the text of the C<NAME>
  72 section.  By default, no headers are generated.
  73
  74 =item help
  75
  76     --help
  77
  78 Displays the usage message.
  79
  80 =item htmldir
  81
  82     --htmldir=name
  83
  84 Sets the directory in which the resulting HTML file is placed.  This
  85 is used to generate relative links to other files. Not passing this
  86 causes all links to be absolute, since this is the value that tells
  87 Pod::Html the root of the documentation tree.
  88
  89 =item htmlroot
  90
  91     --htmlroot=name
  92
  93 Sets the base URL for the HTML files.  When cross-references are made,
  94 the HTML root is prepended to the URL.
  95
  96 =item index
  97
  98     --index
  99     --noindex
 100
 101 Generate an index at the top of the HTML file.  This is the default
 102 behaviour.
 103
 104 =item infile
 105
 106     --infile=name
 107
 108 Specify the pod file to convert.  Input is taken from STDIN if no
 109 infile is specified.
 110
 111 =item libpods
 112
 113     --libpods=name:...:name
 114
 115 List of page names (eg, "perlfunc") which contain linkable C<=item>s.
 116
 117 =item netscape
 118
 119     --netscape
 120     --nonetscape
 121
 122 B<Deprecated>, has no effect. For backwards compatibility only.
 123
 124 =item outfile
 125
 126     --outfile=name
 127
 128 Specify the HTML file to create.  Output goes to STDOUT if no outfile
 129 is specified.
 130
 131 =item podpath
 132
 133     --podpath=name:...:name
 134
 135 Specify which subdirectories of the podroot contain pod files whose
 136 HTML converted forms can be linked to in cross references.
 137
 138 =item podroot
 139
 140     --podroot=name
 141
 142 Specify the base directory for finding library pods.
 143
 144 =item quiet
 145
 146     --quiet
 147     --noquiet
 148
 149 Don't display I<mostly harmless> warning messages.  These messages
 150 will be displayed by default.  But this is not the same as C<verbose>
 151 mode.
 152
 153 =item recurse
 154
 155     --recurse
 156     --norecurse
 157
 158 Recurse into subdirectories specified in podpath (default behaviour).
 159
 160 =item title
 161
 162     --title=title
 163
 164 Specify the title of the resulting HTML file.
 165
 166 =item verbose
 167
 168     --verbose
 169     --noverbose
 170
 171 Display progress messages.  By default, they won't be displayed.
 172
 173 =back
 174
 175 =head1 EXAMPLE
 176
 177     pod2html("pod2html",
 178              "--podpath=lib:ext:pod:vms",
 179              "--podroot=/usr/src/perl",
 180              "--htmlroot=/perl/nmanual",
 181              "--libpods=perlfunc:perlguts:perlvar:perlrun:perlop",
 182              "--recurse",
 183              "--infile=foo.pod",
 184              "--outfile=/perl/nmanual/foo.html");
 185
 186 =head1 ENVIRONMENT
 187
 188 Uses C<$Config{pod2html}> to setup default options.
 189
 190 =head1 AUTHOR
 191
 192 Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
 193
 194 =head1 SEE ALSO
 195
 196 L<perlpod>
 197
 198 =head1 COPYRIGHT
 199
 200 This program is distributed under the Artistic License.
 201
 202 =cut
 203
 204 my $cachedir = ".";             # The directory to which item and directory
 205                                 # caches will be written.
 206 my $cache_ext = $^O eq 'VMS' ? ".tmp" : ".x~~";
 207 my $dircache = "pod2htmd$cache_ext";
 208 my $itemcache = "pod2htmi$cache_ext";
 209
 210 my @begin_stack = ();           # begin/end stack
 211
 212 my @libpods = ();               # files to search for links from C<> directives
 213 my $htmlroot = "/";             # http-server base directory from which all
 214                                 #   relative paths in $podpath stem.
 215 my $htmldir = "";               # The directory to which the html pages
 216                                 # will (eventually) be written.
 217 my $htmlfile = "";              # write to stdout by default
 218 my $htmlfileurl = "" ;          # The url that other files would use to
 219                                 # refer to this file.  This is only used
 220                                 # to make relative urls that point to
 221                                 # other files.
 222 my $podfile = "";               # read from stdin by default
 223 my @podpath = ();               # list of directories containing library pods.
 224 my $podroot = File::Spec->curdir;               # filesystem base directory from which all
 225                                 #   relative paths in $podpath stem.
 226 my $css = '';                   # Cascading style sheet
 227 my $recurse = 1;                # recurse on subdirectories in $podpath.
 228 my $quiet = 0;                  # not quiet by default
 229 my $verbose = 0;                # not verbose by default
 230 my $doindex = 1;                # non-zero if we should generate an index
 231 my $backlink = '';              # text for "back to top" links
 232 my $listlevel = 0;              # current list depth
 233 my @listend = ();               # the text to use to end the list.
 234 my $after_lpar = 0;             # set to true after a par in an =item
 235 my $ignore = 1;                 # whether or not to format text.  we don't
 236                                 #   format text until we hit our first pod
 237                                 #   directive.
 238
 239 my %items_named = ();           # for the multiples of the same item in perlfunc
 240 my @items_seen = ();
 241 my $title;                      # title to give the pod(s)
 242 my $header = 0;                 # produce block header/footer
 243 my $top = 1;                    # true if we are at the top of the doc.  used
 244                                 #   to prevent the first <hr /> directive.
 245 my $paragraph;                  # which paragraph we're processing (used
 246                                 #   for error messages)
 247 my $ptQuote = 0;                # status of double-quote conversion
 248 my %pages = ();                 # associative array used to find the location
 249                                 #   of pages referenced by L<> links.
 250 my %sections = ();              # sections within this page
 251 my %items = ();                 # associative array used to find the location
 252                                 #   of =item directives referenced by C<> links
 253 my %local_items = ();           # local items - avoid destruction of %items
 254 my $Is83;                       # is dos with short filenames (8.3)
 255
 256 sub init_globals {
 257 $dircache = "pod2htmd$cache_ext";
 258 $itemcache = "pod2htmi$cache_ext";
 259
 260 @begin_stack = ();              # begin/end stack
 261
 262 @libpods = ();          # files to search for links from C<> directives
 263 $htmlroot = "/";                # http-server base directory from which all
 264                                 #   relative paths in $podpath stem.
 265 $htmldir = "";          # The directory to which the html pages
 266                                 # will (eventually) be written.
 267 $htmlfile = "";         # write to stdout by default
 268 $podfile = "";          # read from stdin by default
 269 @podpath = ();          # list of directories containing library pods.
 270 $podroot = File::Spec->curdir;          # filesystem base directory from which all
 271                                 #   relative paths in $podpath stem.
 272 $css = '';                   # Cascading style sheet
 273 $recurse = 1;           # recurse on subdirectories in $podpath.
 274 $quiet = 0;             # not quiet by default
 275 $verbose = 0;           # not verbose by default
 276 $doindex = 1;                   # non-zero if we should generate an index
 277 $backlink = '';         # text for "back to top" links
 278 $listlevel = 0;         # current list depth
 279 @listend = ();          # the text to use to end the list.
 280 $after_lpar = 0;        # set to true after a par in an =item
 281 $ignore = 1;                    # whether or not to format text.  we don't
 282                                 #   format text until we hit our first pod
 283                                 #   directive.
 284
 285 @items_seen = ();
 286 %items_named = ();
 287 $header = 0;                    # produce block header/footer
 288 $title = '';                    # title to give the pod(s)
 289 $top = 1;                       # true if we are at the top of the doc.  used
 290                                 #   to prevent the first <hr /> directive.
 291 $paragraph = '';                        # which paragraph we're processing (used
 292                                 #   for error messages)
 293 %sections = ();         # sections within this page
 294
 295 # These are not reinitialised here but are kept as a cache.
 296 # See get_cache and related cache management code.
 297 #%pages = ();                   # associative array used to find the location
 298                                 #   of pages referenced by L<> links.
 299 #%items = ();                   # associative array used to find the location
 300                                 #   of =item directives referenced by C<> links
 301 %local_items = ();
 302 $Is83=$^O eq 'dos';
 303 }
 304
 305 #
 306 # clean_data: global clean-up of pod data
 307 #
 308 sub clean_data($){
 309     my( $dataref ) = @_;
 310     for my $i ( 0..$#{$dataref} ) {
 311         ${$dataref}[$i] =~ s/\s+\Z//;
 312
 313         # have a look for all-space lines
 314       if( ${$dataref}[$i] =~ /^\s+$/m and $dataref->[$i] !~ /^\s/ ){
 315             my @chunks = split( /^\s+$/m, ${$dataref}[$i] );
 316             splice( @$dataref, $i, 1, @chunks );
 317         }
 318     }
 319 }
 320
 321
 322 sub pod2html {
 323     local(@ARGV) = @_;
 324     local($/);
 325     local $_;
 326
 327     init_globals();
 328
 329     $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
 330
 331     # cache of %pages and %items from last time we ran pod2html
 332
 333     #undef $opt_help if defined $opt_help;
 334
 335     # parse the command-line parameters
 336     parse_command_line();
 337
 338     # escape the backlink argument (same goes for title but is done later...)
 339     $backlink = html_escape($backlink) if defined $backlink;
 340
 341     # set some variables to their default values if necessary
 342     local *POD;
 343     unless (@ARGV && $ARGV[0]) {
 344         $podfile  = "-" unless $podfile;        # stdin
 345         open(POD, "<$podfile")
 346                 || die "$0: cannot open $podfile file for input: $!\n";
 347     } else {
 348         $podfile = $ARGV[0];  # XXX: might be more filenames
 349         *POD = *ARGV;
 350     }
 351     $htmlfile = "-" unless $htmlfile;   # stdout
 352     $htmlroot = "" if $htmlroot eq "/"; # so we don't get a //
 353     $htmldir =~ s#/\z## ;               # so we don't get a //
 354     if (  $htmlroot eq ''
 355        && defined( $htmldir )
 356        && $htmldir ne ''
 357        && substr( $htmlfile, 0, length( $htmldir ) ) eq $htmldir
 358        )
 359     {
 360         # Set the 'base' url for this file, so that we can use it
 361         # as the location from which to calculate relative links
 362         # to other files. If this is '', then absolute links will
 363         # be used throughout.
 364         $htmlfileurl= "$htmldir/" . substr( $htmlfile, length( $htmldir ) + 1);
 365     }
 366
 367     # read the pod a paragraph at a time
 368     warn "Scanning for sections in input file(s)\n" if $verbose;
 369     $/ = "";
 370     my @poddata  = <POD>;
 371     close(POD);
 372
 373     # be eol agnostic
 374     for (@poddata) {
 375         if (/\x0D/) {
 376             if (/\x0D\x0A/) {
 377                 @poddata = map { s/\x0D\x0A/\n/g;
 378                                  /\n\n/ ?
 379                                      map { "$_\n\n" } split /\n\n/ :
 380                                      $_ } @poddata;
 381             } else {
 382                 @poddata = map { s/\x0D/\n/g;
 383                                  /\n\n/ ?
 384                                      map { "$_\n\n" } split /\n\n/ :
 385                                      $_ } @poddata;
 386             }
 387             last;
 388         }
 389     }
 390
 391     clean_data( \@poddata );
 392
 393     # scan the pod for =head[1-6] directives and build an index
 394     my $index = scan_headings(\%sections, @poddata);
 395
 396     unless($index) {
 397         warn "No headings in $podfile\n" if $verbose;
 398     }
 399
 400     # open the output file
 401     open(HTML, ">$htmlfile")
 402             || die "$0: cannot open $htmlfile file for output: $!\n";
 403
 404     # put a title in the HTML file if one wasn't specified
 405     if ($title eq '') {
 406         TITLE_SEARCH: {
 407             for (my $i = 0; $i < @poddata; $i++) {
 408                 if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
 409                     for my $para ( @poddata[$i, $i+1] ) {
 410                         last TITLE_SEARCH
 411                             if ($title) = $para =~ /(\S+\s+-+.*\S)/s;
 412                     }
 413                 }
 414
 415             }
 416         }
 417     }
 418     if (!$title and $podfile =~ /\.pod\z/) {
 419         # probably a split pod so take first =head[12] as title
 420         for (my $i = 0; $i < @poddata; $i++) {
 421             last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
 422         }
 423         warn "adopted '$title' as title for $podfile\n"
 424             if $verbose and $title;
 425     }
 426     if ($title) {
 427         $title =~ s/\s*\(.*\)//;
 428     } else {
 429         warn "$0: no title for $podfile.\n" unless $quiet;
 430         $podfile =~ /^(.*)(\.[^.\/]+)?\z/s;
 431         $title = ($podfile eq "-" ? 'No Title' : $1);
 432         warn "using $title" if $verbose;
 433     }
 434     $title = html_escape($title);
 435
 436     my $csslink = '';
 437     my $bodystyle = ' style="background-color: white"';
 438     my $tdstyle = ' style="background-color: #cccccc"';
 439
 440     if ($css) {
 441       $csslink = qq(\n<link rel="stylesheet" href="$css" type="text/css" />);
 442       $csslink =~ s,\\,/,g;
 443       $csslink =~ s,(/.):,$1|,;
 444       $bodystyle = '';
 445       $tdstyle = '';
 446     }
 447
 448       my $block = $header ? <<END_OF_BLOCK : '';
 449 <table border="0" width="100%" cellspacing="0" cellpadding="3">
 450 <tr><td class="block"$tdstyle valign="middle">
 451 <big><strong><span class="block">&nbsp;$title</span></strong></big>
 452 </td></tr>
 453 </table>
 454 END_OF_BLOCK
 455
 456     print HTML <<END_OF_HEAD;
 457 <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 458 <html xmlns="http://www.w3.org/1999/xhtml">
 459 <head>
 460 <title>$title</title>$csslink
 461 <link rev="made" href="mailto:$Config{perladmin}" />
 462 </head>
 463
 464 <body$bodystyle>
 465 $block
 466 END_OF_HEAD
 467
 468     # load/reload/validate/cache %pages and %items
 469     get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse);
 470
 471     # scan the pod for =item directives
 472     scan_items( \%local_items, "", @poddata);
 473
 474     # put an index at the top of the file.  note, if $doindex is 0 we
 475     # still generate an index, but surround it with an html comment.
 476     # that way some other program can extract it if desired.
 477     $index =~ s/--+/-/g;
 478     print HTML "<p><a name=\"__index__\"></a></p>\n";
 479     print HTML "<!-- INDEX BEGIN -->\n";
 480     print HTML "<!--\n" unless $doindex;
 481     print HTML $index;
 482     print HTML "-->\n" unless $doindex;
 483     print HTML "<!-- INDEX END -->\n\n";
 484     print HTML "<hr />\n" if $doindex and $index;
 485
 486     # now convert this file
 487     my $after_item;             # set to true after an =item
 488     my $need_dd = 0;
 489     warn "Converting input file $podfile\n" if $verbose;
 490     foreach my $i (0..$#poddata){
 491         $ptQuote = 0; # status of quote conversion
 492
 493         $_ = $poddata[$i];
 494         $paragraph = $i+1;
 495         if (/^(=.*)/s) {        # is it a pod directive?
 496             $ignore = 0;
 497             $after_item = 0;
 498             $need_dd = 0;
 499             $_ = $1;
 500             if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
 501                 process_begin($1, $2);
 502             } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
 503                 process_end($1, $2);
 504             } elsif (/^=cut/) {                 # =cut
 505                 process_cut();
 506             } elsif (/^=pod/) {                 # =pod
 507                 process_pod();
 508             } else {
 509                 next if @begin_stack && $begin_stack[-1] ne 'html';
 510
 511                 if (/^=(head[1-6])\s+(.*\S)/s) {        # =head[1-6] heading
 512                     process_head( $1, $2, $doindex && $index );
 513                 } elsif (/^=item\s*(.*\S)?/sm) {        # =item text
 514                     $need_dd = process_item( $1 );
 515                     $after_item = 1;
 516                 } elsif (/^=over\s*(.*)/) {             # =over N
 517                     process_over();
 518                 } elsif (/^=back/) {            # =back
 519                     process_back();
 520                 } elsif (/^=for\s+(\S+)\s*(.*)/si) {# =for
 521                     process_for($1,$2);
 522                 } else {
 523                     /^=(\S*)\s*/;
 524                     warn "$0: $podfile: unknown pod directive '$1' in "
 525                        . "paragraph $paragraph.  ignoring.\n";
 526                 }
 527             }
 528             $top = 0;
 529         }
 530         else {
 531             next if $ignore;
 532             next if @begin_stack && $begin_stack[-1] ne 'html';
 533             print HTML and next if @begin_stack && $begin_stack[-1] eq 'html';
 534             print HTML "<dd>\n" if $need_dd;
 535             my $text = $_;
 536             if( $text =~ /\A\s+/ ){
 537                 process_pre( \$text );
 538                 print HTML "<pre>\n$text</pre>\n";
 539
 540             } else {
 541                 process_text( \$text );
 542
 543                 # experimental: check for a paragraph where all lines
 544                 # have some ...\t...\t...\n pattern
 545                 if( $text =~ /\t/ ){
 546                     my @lines = split( "\n", $text );
 547                     if( @lines > 1 ){
 548                         my $all = 2;
 549                         foreach my $line ( @lines ){
 550                             if( $line =~ /\S/ && $line !~ /\t/ ){
 551                                 $all--;
 552                                 last if $all == 0;
 553                             }
 554                         }
 555                         if( $all > 0 ){
 556                             $text =~ s/\t+/<td>/g;
 557                             $text =~ s/^/<tr><td>/gm;
 558                             $text = '<table cellspacing="0" cellpadding="0">' .
 559                                     $text . '</table>';
 560                         }
 561                     }
 562                 }
 563                 ## end of experimental
 564
 565                 if( $after_item ){
 566                     print HTML "$text\n";
 567                     $after_lpar = 1;
 568                 } else {
 569                     print HTML "<p>$text</p>\n";
 570                 }
 571             }
 572             print HTML "</dd>\n" if $need_dd;
 573             $after_item = 0;
 574         }
 575     }
 576
 577     # finish off any pending directives
 578     finish_list();
 579
 580     # link to page index
 581     print HTML "<p><a href=\"#__index__\"><small>$backlink</small></a></p>\n"
 582         if $doindex and $index and $backlink;
 583
 584     print HTML <<END_OF_TAIL;
 585 $block
 586 </body>
 587
 588 </html>
 589 END_OF_TAIL
 590
 591     # close the html file
 592     close(HTML);
 593
 594     warn "Finished\n" if $verbose;
 595 }
 596
 597 ##############################################################################
 598
 599 my $usage;                      # see below
 600 sub usage {
 601     my $podfile = shift;
 602     warn "$0: $podfile: @_\n" if @_;
 603     die $usage;
 604 }
 605
 606 $usage =<<END_OF_USAGE;
 607 Usage:  $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
 608            --podpath=<name>:...:<name> --podroot=<name>
 609            --libpods=<name>:...:<name> --recurse --verbose --index
 610            --netscape --norecurse --noindex --cachedir=<name>
 611
 612   --backlink     - set text for "back to top" links (default: none).
 613   --cachedir     - directory for the item and directory cache files.
 614   --css          - stylesheet URL
 615   --flush        - flushes the item and directory caches.
 616   --[no]header   - produce block header/footer (default is no headers).
 617   --help         - prints this message.
 618   --htmldir      - directory for resulting HTML files.
 619   --htmlroot     - http-server base directory from which all relative paths
 620                    in podpath stem (default is /).
 621   --[no]index    - generate an index at the top of the resulting html
 622                    (default behaviour).
 623   --infile       - filename for the pod to convert (input taken from stdin
 624                    by default).
 625   --libpods      - colon-separated list of pages to search for =item pod
 626                    directives in as targets of C<> and implicit links (empty
 627                    by default).  note, these are not filenames, but rather
 628                    page names like those that appear in L<> links.
 629   --outfile      - filename for the resulting html file (output sent to
 630                    stdout by default).
 631   --podpath      - colon-separated list of directories containing library
 632                    pods (empty by default).
 633   --podroot      - filesystem base directory from which all relative paths
 634                    in podpath stem (default is .).
 635   --[no]quiet    - supress some benign warning messages (default is off).
 636   --[no]recurse  - recurse on those subdirectories listed in podpath
 637                    (default behaviour).
 638   --title        - title that will appear in resulting html file.
 639   --[no]verbose  - self-explanatory (off by default).
 640   --[no]netscape - deprecated, has no effect. for backwards compatibility only.
 641
 642 END_OF_USAGE
 643
 644 sub parse_command_line {
 645     my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,$opt_help,
 646         $opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,
 647         $opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet,
 648         $opt_recurse,$opt_title,$opt_verbose);
 649
 650     unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
 651     my $result = GetOptions(
 652                             'backlink=s' => \$opt_backlink,
 653                             'cachedir=s' => \$opt_cachedir,
 654                             'css=s'      => \$opt_css,
 655                             'flush'      => \$opt_flush,
 656                             'header!'    => \$opt_header,
 657                             'help'       => \$opt_help,
 658                             'htmldir=s'  => \$opt_htmldir,
 659                             'htmlroot=s' => \$opt_htmlroot,
 660                             'index!'     => \$opt_index,
 661                             'infile=s'   => \$opt_infile,
 662                             'libpods=s'  => \$opt_libpods,
 663                             'netscape!'  => \$opt_netscape,
 664                             'outfile=s'  => \$opt_outfile,
 665                             'podpath=s'  => \$opt_podpath,
 666                             'podroot=s'  => \$opt_podroot,
 667                             'quiet!'     => \$opt_quiet,
 668                             'recurse!'   => \$opt_recurse,
 669                             'title=s'    => \$opt_title,
 670                             'verbose!'   => \$opt_verbose,
 671                            );
 672     usage("-", "invalid parameters") if not $result;
 673
 674     usage("-") if defined $opt_help;    # see if the user asked for help
 675     $opt_help = "";                     # just to make -w shut-up.
 676
 677     @podpath  = split(":", $opt_podpath) if defined $opt_podpath;
 678     @libpods  = split(":", $opt_libpods) if defined $opt_libpods;
 679
 680     $backlink = $opt_backlink if defined $opt_backlink;
 681     $cachedir = $opt_cachedir if defined $opt_cachedir;
 682     $css      = $opt_css      if defined $opt_css;
 683     $header   = $opt_header   if defined $opt_header;
 684     $htmldir  = $opt_htmldir  if defined $opt_htmldir;
 685     $htmlroot = $opt_htmlroot if defined $opt_htmlroot;
 686     $doindex  = $opt_index    if defined $opt_index;
 687     $podfile  = $opt_infile   if defined $opt_infile;
 688     $htmlfile = $opt_outfile  if defined $opt_outfile;
 689     $podroot  = $opt_podroot  if defined $opt_podroot;
 690     $quiet    = $opt_quiet    if defined $opt_quiet;
 691     $recurse  = $opt_recurse  if defined $opt_recurse;
 692     $title    = $opt_title    if defined $opt_title;
 693     $verbose  = $opt_verbose  if defined $opt_verbose;
 694
 695     warn "Flushing item and directory caches\n"
 696         if $opt_verbose && defined $opt_flush;
 697     $dircache = "$cachedir/pod2htmd$cache_ext";
 698     $itemcache = "$cachedir/pod2htmi$cache_ext";
 699     unlink($dircache, $itemcache) if defined $opt_flush;
 700 }
 701
 702
 703 my $saved_cache_key;
 704
 705 sub get_cache {
 706     my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
 707     my @cache_key_args = @_;
 708
 709     # A first-level cache:
 710     # Don't bother reading the cache files if they still apply
 711     # and haven't changed since we last read them.
 712
 713     my $this_cache_key = cache_key(@cache_key_args);
 714
 715     return if $saved_cache_key and $this_cache_key eq $saved_cache_key;
 716
 717     # load the cache of %pages and %items if possible.  $tests will be
 718     # non-zero if successful.
 719     my $tests = 0;
 720     if (-f $dircache && -f $itemcache) {
 721         warn "scanning for item cache\n" if $verbose;
 722         $tests = load_cache($dircache, $itemcache, $podpath, $podroot);
 723     }
 724
 725     # if we didn't succeed in loading the cache then we must (re)build
 726     #  %pages and %items.
 727     if (!$tests) {
 728         warn "scanning directories in pod-path\n" if $verbose;
 729         scan_podpath($podroot, $recurse, 0);
 730     }
 731     $saved_cache_key = cache_key(@cache_key_args);
 732 }
 733
 734 sub cache_key {
 735     my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
 736     return join('!', $dircache, $itemcache, $recurse,
 737         @$podpath, $podroot, stat($dircache), stat($itemcache));
 738 }
 739
 740 #
 741 # load_cache - tries to find if the caches stored in $dircache and $itemcache
 742 #  are valid caches of %pages and %items.  if they are valid then it loads
 743 #  them and returns a non-zero value.
 744 #
 745 sub load_cache {
 746     my($dircache, $itemcache, $podpath, $podroot) = @_;
 747     my($tests);
 748     local $_;
 749
 750     $tests = 0;
 751
 752     open(CACHE, "<$itemcache") ||
 753         die "$0: error opening $itemcache for reading: $!\n";
 754     $/ = "\n";
 755
 756     # is it the same podpath?
 757     $_ = <CACHE>;
 758     chomp($_);
 759     $tests++ if (join(":", @$podpath) eq $_);
 760
 761     # is it the same podroot?
 762     $_ = <CACHE>;
 763     chomp($_);
 764     $tests++ if ($podroot eq $_);
 765
 766     # load the cache if its good
 767     if ($tests != 2) {
 768         close(CACHE);
 769         return 0;
 770     }
 771
 772     warn "loading item cache\n" if $verbose;
 773     while (<CACHE>) {
 774         /(.*?) (.*)$/;
 775         $items{$1} = $2;
 776     }
 777     close(CACHE);
 778
 779     warn "scanning for directory cache\n" if $verbose;
 780     open(CACHE, "<$dircache") ||
 781         die "$0: error opening $dircache for reading: $!\n";
 782     $/ = "\n";
 783     $tests = 0;
 784
 785     # is it the same podpath?
 786     $_ = <CACHE>;
 787     chomp($_);
 788     $tests++ if (join(":", @$podpath) eq $_);
 789
 790     # is it the same podroot?
 791     $_ = <CACHE>;
 792     chomp($_);
 793     $tests++ if ($podroot eq $_);
 794
 795     # load the cache if its good
 796     if ($tests != 2) {
 797         close(CACHE);
 798         return 0;
 799     }
 800
 801     warn "loading directory cache\n" if $verbose;
 802     while (<CACHE>) {
 803         /(.*?) (.*)$/;
 804         $pages{$1} = $2;
 805     }
 806
 807     close(CACHE);
 808
 809     return 1;
 810 }
 811
 812 #
 813 # scan_podpath - scans the directories specified in @podpath for directories,
 814 #  .pod files, and .pm files.  it also scans the pod files specified in
 815 #  @libpods for =item directives.
 816 #
 817 sub scan_podpath {
 818     my($podroot, $recurse, $append) = @_;
 819     my($pwd, $dir);
 820     my($libpod, $dirname, $pod, @files, @poddata);
 821
 822     unless($append) {
 823         %items = ();
 824         %pages = ();
 825     }
 826
 827     # scan each directory listed in @podpath
 828     $pwd = getcwd();
 829     chdir($podroot)
 830         || die "$0: error changing to directory $podroot: $!\n";
 831     foreach $dir (@podpath) {
 832         scan_dir($dir, $recurse);
 833     }
 834
 835     # scan the pods listed in @libpods for =item directives
 836     foreach $libpod (@libpods) {
 837         # if the page isn't defined then we won't know where to find it
 838         # on the system.
 839         next unless defined $pages{$libpod} && $pages{$libpod};
 840
 841         # if there is a directory then use the .pod and .pm files within it.
 842         # NOTE: Only finds the first so-named directory in the tree.
 843 #       if ($pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
 844         if ($pages{$libpod} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
 845             #  find all the .pod and .pm files within the directory
 846             $dirname = $1;
 847             opendir(DIR, $dirname) ||
 848                 die "$0: error opening directory $dirname: $!\n";
 849             @files = grep(/(\.pod|\.pm)\z/ && ! -d $_, readdir(DIR));
 850             closedir(DIR);
 851
 852             # scan each .pod and .pm file for =item directives
 853             foreach $pod (@files) {
 854                 open(POD, "<$dirname/$pod") ||
 855                     die "$0: error opening $dirname/$pod for input: $!\n";
 856                 @poddata = <POD>;
 857                 close(POD);
 858                 clean_data( \@poddata );
 859
 860                 scan_items( \%items, "$dirname/$pod", @poddata);
 861             }
 862
 863             # use the names of files as =item directives too.
 864 ### Don't think this should be done this way - confuses issues.(WL)
 865 ###         foreach $pod (@files) {
 866 ###             $pod =~ /^(.*)(\.pod|\.pm)$/;
 867 ###             $items{$1} = "$dirname/$1.html" if $1;
 868 ###         }
 869         } elsif ($pages{$libpod} =~ /([^:]*\.pod):/ ||
 870                  $pages{$libpod} =~ /([^:]*\.pm):/) {
 871             # scan the .pod or .pm file for =item directives
 872             $pod = $1;
 873             open(POD, "<$pod") ||
 874                 die "$0: error opening $pod for input: $!\n";
 875             @poddata = <POD>;
 876             close(POD);
 877             clean_data( \@poddata );
 878
 879             scan_items( \%items, "$pod", @poddata);
 880         } else {
 881             warn "$0: shouldn't be here (line ".__LINE__."\n";
 882         }
 883     }
 884     @poddata = ();      # clean-up a bit
 885
 886     chdir($pwd)
 887         || die "$0: error changing to directory $pwd: $!\n";
 888
 889     # cache the item list for later use
 890     warn "caching items for later use\n" if $verbose;
 891     open(CACHE, ">$itemcache") ||
 892         die "$0: error open $itemcache for writing: $!\n";
 893
 894     print CACHE join(":", @podpath) . "\n$podroot\n";
 895     foreach my $key (keys %items) {
 896         print CACHE "$key $items{$key}\n";
 897     }
 898
 899     close(CACHE);
 900
 901     # cache the directory list for later use
 902     warn "caching directories for later use\n" if $verbose;
 903     open(CACHE, ">$dircache") ||
 904         die "$0: error open $dircache for writing: $!\n";
 905
 906     print CACHE join(":", @podpath) . "\n$podroot\n";
 907     foreach my $key (keys %pages) {
 908         print CACHE "$key $pages{$key}\n";
 909     }
 910
 911     close(CACHE);
 912 }
 913
 914 #
 915 # scan_dir - scans the directory specified in $dir for subdirectories, .pod
 916 #  files, and .pm files.  notes those that it finds.  this information will
 917 #  be used later in order to figure out where the pages specified in L<>
 918 #  links are on the filesystem.
 919 #
 920 sub scan_dir {
 921     my($dir, $recurse) = @_;
 922     my($t, @subdirs, @pods, $pod, $dirname, @dirs);
 923     local $_;
 924
 925     @subdirs = ();
 926     @pods = ();
 927
 928     opendir(DIR, $dir) ||
 929         die "$0: error opening directory $dir: $!\n";
 930     while (defined($_ = readdir(DIR))) {
 931         if (-d "$dir/$_" && $_ ne "." && $_ ne "..") {      # directory
 932             $pages{$_}  = "" unless defined $pages{$_};
 933             $pages{$_} .= "$dir/$_:";
 934             push(@subdirs, $_);
 935         } elsif (/\.pod\z/) {                               # .pod
 936             s/\.pod\z//;
 937             $pages{$_}  = "" unless defined $pages{$_};
 938             $pages{$_} .= "$dir/$_.pod:";
 939             push(@pods, "$dir/$_.pod");
 940         } elsif (/\.html\z/) {                              # .html
 941             s/\.html\z//;
 942             $pages{$_}  = "" unless defined $pages{$_};
 943             $pages{$_} .= "$dir/$_.pod:";
 944         } elsif (/\.pm\z/) {                                # .pm
 945             s/\.pm\z//;
 946             $pages{$_}  = "" unless defined $pages{$_};
 947             $pages{$_} .= "$dir/$_.pm:";
 948             push(@pods, "$dir/$_.pm");
 949         }
 950     }
 951     closedir(DIR);
 952
 953     # recurse on the subdirectories if necessary
 954     if ($recurse) {
 955         foreach my $subdir (@subdirs) {
 956             scan_dir("$dir/$subdir", $recurse);
 957         }
 958     }
 959 }
 960
 961 #
 962 # scan_headings - scan a pod file for head[1-6] tags, note the tags, and
 963 #  build an index.
 964 #
 965 sub scan_headings {
 966     my($sections, @data) = @_;
 967     my($tag, $which_head, $otitle, $listdepth, $index);
 968
 969     # here we need      local $ignore = 0;
 970     #  unfortunately, we can't have it, because $ignore is lexical
 971     $ignore = 0;
 972
 973     $listdepth = 0;
 974     $index = "";
 975
 976     # scan for =head directives, note their name, and build an index
 977     #  pointing to each of them.
 978     foreach my $line (@data) {
 979       if ($line =~ /^=(head)([1-6])\s+(.*)/) {
 980         ($tag, $which_head, $otitle) = ($1,$2,$3);
 981
 982         my $title = depod( $otitle );
 983         my $name = htmlify( $title );
 984         $$sections{$name} = 1;
 985         $name =~ s/\s/_/g; # htmlify keeps spaces but we don't want them here..
 986         $title = process_text( \$otitle );
 987
 988             while ($which_head != $listdepth) {
 989                 if ($which_head > $listdepth) {
 990                     $index .= "\n" . ("\t" x $listdepth) . "<ul>\n";
 991                     $listdepth++;
 992                 } elsif ($which_head < $listdepth) {
 993                     $listdepth--;
 994                     $index .= "\n" . ("\t" x $listdepth) . "</ul>\n";
 995                 }
 996             }
 997
 998             $index .= "\n" . ("\t" x $listdepth) . "<li>" .
 999                       "<a href=\"#" . $name . "\">" .
1000                       $title . "</a></li>";
1001         }
1002     }
1003
1004     # finish off the lists
1005     while ($listdepth--) {
1006         $index .= "\n" . ("\t" x $listdepth) . "</ul>\n";
1007     }
1008
1009     # get rid of bogus lists
1010     $index =~ s,\t*<ul>\s*</ul>\n,,g;
1011
1012     $ignore = 1;        # restore old value;
1013
1014     return $index;
1015 }
1016
1017 #
1018 # scan_items - scans the pod specified by $pod for =item directives.  we
1019 #  will use this information later on in resolving C<> links.
1020 #
1021 sub scan_items {
1022     my( $itemref, $pod, @poddata ) = @_;
1023     my($i, $item);
1024     local $_;
1025
1026     $pod =~ s/\.pod\z//;
1027     $pod .= ".html" if $pod;
1028
1029     foreach $i (0..$#poddata) {
1030         my $txt = depod( $poddata[$i] );
1031
1032         # figure out what kind of item it is.
1033         # Build string for referencing this item.
1034         if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bullet
1035             next unless $1;
1036             $item = $1;
1037         } elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list
1038             $item = $1;
1039         } elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # plain item
1040             $item = $1;
1041         } else {
1042             next;
1043         }
1044         my $fid = fragment_id( $item );
1045         $$itemref{$fid} = "$pod" if $fid;
1046     }
1047 }
1048
1049 #
1050 # process_head - convert a pod head[1-6] tag and convert it to HTML format.
1051 #
1052 sub process_head {
1053     my($tag, $heading, $hasindex) = @_;
1054
1055     # figure out the level of the =head
1056     $tag =~ /head([1-6])/;
1057     my $level = $1;
1058
1059     if( $listlevel ){
1060         warn "$0: $podfile: unterminated list at =head in paragraph $paragraph.  ignoring.\n";
1061         while( $listlevel ){
1062             process_back();
1063         }
1064     }
1065
1066     print HTML "<p>\n";
1067     if( $level == 1 && ! $top ){
1068       print HTML "<a href=\"#__index__\"><small>$backlink</small></a>\n"
1069         if $hasindex and $backlink;
1070       print HTML "</p>\n<hr />\n"
1071     } else {
1072       print HTML "</p>\n";
1073     }
1074
1075     my $name = anchorify( depod( $heading ) );
1076     my $convert = process_text( \$heading );
1077     print HTML "<h$level><a name=\"$name\">$convert</a></h$level>\n";
1078 }
1079
1080
1081 #
1082 # emit_item_tag - print an =item's text
1083 # Note: The global $EmittedItem is used for inhibiting self-references.
1084 #
1085 my $EmittedItem;
1086
1087 sub emit_item_tag($$$){
1088     my( $otext, $text, $compact ) = @_;
1089     my $item = fragment_id( $text );
1090
1091     $EmittedItem = $item;
1092     ### print STDERR "emit_item_tag=$item ($text)\n";
1093
1094     print HTML '<strong>';
1095     if ($items_named{$item}++) {
1096         print HTML process_text( \$otext );
1097     } else {
1098         my $name = 'item_' . $item;
1099         $name = anchorify($name);
1100         print HTML qq{<a name="$name">}, process_text( \$otext ), '</a>';
1101     }
1102     print HTML "</strong><br />\n";
1103     undef( $EmittedItem );
1104 }
1105
1106 sub emit_li {
1107     my( $tag ) = @_;
1108     if( $items_seen[$listlevel]++ == 0 ){
1109         push( @listend, "</$tag>" );
1110         print HTML "<$tag>\n";
1111     }
1112     my $emitted = $tag eq 'dl' ? 'dt' : 'li';
1113     print HTML "<$emitted>";
1114     return $emitted;
1115 }
1116
1117 #
1118 # process_item - convert a pod item tag and convert it to HTML format.
1119 #
1120 sub process_item {
1121     my( $otext ) = @_;
1122     my $need_dd = 0; # set to 1 if we need a <dd></dd> after an item
1123
1124     # lots of documents start a list without doing an =over.  this is
1125     # bad!  but, the proper thing to do seems to be to just assume
1126     # they did do an =over.  so warn them once and then continue.
1127     if( $listlevel == 0 ){
1128         warn "$0: $podfile: unexpected =item directive in paragraph $paragraph.  ignoring.\n";
1129         process_over();
1130     }
1131
1132     # formatting: insert a paragraph if preceding item has >1 paragraph
1133     if( $after_lpar ){
1134         print HTML "<p></p>\n";
1135         $after_lpar = 0;
1136     }
1137
1138     # remove formatting instructions from the text
1139     my $text = depod( $otext );
1140
1141     my $emitted; # the tag actually emitted, used for closing
1142
1143     # all the list variants:
1144     if( $text =~ /\A\*/ ){ # bullet
1145         $emitted = emit_li( 'ul' );
1146         if ($text =~ /\A\*\s+(.+)\Z/s ) { # with additional text
1147             my $tag = $1;
1148             $otext =~ s/\A\*\s+//;
1149             emit_item_tag( $otext, $tag, 1 );
1150         }
1151
1152     } elsif( $text =~ /\A\d+/ ){ # numbered list
1153         $emitted = emit_li( 'ol' );
1154         if ($text =~ /\A(?>\d+\.?)\s*(.+)\Z/s ) { # with additional text
1155             my $tag = $1;
1156             $otext =~ s/\A\d+\.?\s*//;
1157             emit_item_tag( $otext, $tag, 1 );
1158         }
1159
1160     } else {                    # definition list
1161         $emitted = emit_li( 'dl' );
1162         if ($text =~ /\A(.+)\Z/s ){ # should have text
1163             emit_item_tag( $otext, $text, 1 );
1164         }
1165         $need_dd = 1;
1166     }
1167     print HTML "</$emitted>" if $emitted;
1168     print HTML "\n";
1169     return $need_dd;
1170 }
1171
1172 #
1173 # process_over - process a pod over tag and start a corresponding HTML list.
1174 #
1175 sub process_over {
1176     # start a new list
1177     $listlevel++;
1178     push( @items_seen, 0 );
1179     $after_lpar = 0;
1180 }
1181
1182 #
1183 # process_back - process a pod back tag and convert it to HTML format.
1184 #
1185 sub process_back {
1186     if( $listlevel == 0 ){
1187         warn "$0: $podfile: unexpected =back directive in paragraph $paragraph.  ignoring.\n";
1188         return;
1189     }
1190
1191     # close off the list.  note, I check to see if $listend[$listlevel] is
1192     # defined because an =item directive may have never appeared and thus
1193     # $listend[$listlevel] may have never been initialized.
1194     $listlevel--;
1195     if( defined $listend[$listlevel] ){
1196         print HTML '<p></p>' if $after_lpar;
1197         print HTML $listend[$listlevel];
1198         print HTML "\n";
1199         pop( @listend );
1200     }
1201     $after_lpar = 0;
1202
1203     # clean up item count
1204     pop( @items_seen );
1205 }
1206
1207 #
1208 # process_cut - process a pod cut tag, thus start ignoring pod directives.
1209 #
1210 sub process_cut {
1211     $ignore = 1;
1212 }
1213
1214 #
1215 # process_pod - process a pod tag, thus stop ignoring pod directives
1216 # until we see a corresponding cut.
1217 #
1218 sub process_pod {
1219     # no need to set $ignore to 0 cause the main loop did it
1220 }
1221
1222 #
1223 # process_for - process a =for pod tag.  if it's for html, spit
1224 # it out verbatim, if illustration, center it, otherwise ignore it.
1225 #
1226 sub process_for {
1227     my($whom, $text) = @_;
1228     if ( $whom =~ /^(pod2)?html$/i) {
1229         print HTML $text;
1230     } elsif ($whom =~ /^illustration$/i) {
1231         1 while chomp $text;
1232         for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) {
1233           $text .= $ext, last if -r "$text$ext";
1234         }
1235         print HTML qq{<p align="center"><img src="$text" alt="$text illustration" /></p>};
1236     }
1237 }
1238
1239 #
1240 # process_begin - process a =begin pod tag.  this pushes
1241 # whom we're beginning on the begin stack.  if there's a
1242 # begin stack, we only print if it us.
1243 #
1244 sub process_begin {
1245     my($whom, $text) = @_;
1246     $whom = lc($whom);
1247     push (@begin_stack, $whom);
1248     if ( $whom =~ /^(pod2)?html$/) {
1249         print HTML $text if $text;
1250     }
1251 }
1252
1253 #
1254 # process_end - process a =end pod tag.  pop the
1255 # begin stack.  die if we're mismatched.
1256 #
1257 sub process_end {
1258     my($whom, $text) = @_;
1259     $whom = lc($whom);
1260     if ($begin_stack[-1] ne $whom ) {
1261         die "Unmatched begin/end at chunk $paragraph\n"
1262     }
1263     pop( @begin_stack );
1264 }
1265
1266 #
1267 # process_pre - indented paragraph, made into <pre></pre>
1268 #
1269 sub process_pre {
1270     my( $text ) = @_;
1271     my( $rest );
1272     return if $ignore;
1273
1274     $rest = $$text;
1275
1276     # insert spaces in place of tabs
1277     $rest =~ s#(.+)#
1278             my $line = $1;
1279             1 while $line =~ s/(\t+)/' ' x ((length($1) * 8) - $-[0] % 8)/e;
1280             $line;
1281         #eg;
1282
1283     # convert some special chars to HTML escapes
1284     $rest = html_escape($rest);
1285
1286     # try and create links for all occurrences of perl.* within
1287     # the preformatted text.
1288     $rest =~ s{
1289                  (\s*)(perl\w+)
1290               }{
1291                  if ( defined $pages{$2} ){     # is a link
1292                      qq($1<a href="$htmlroot/$pages{$2}">$2</a>);
1293                  } elsif (defined $pages{dosify($2)}) { # is a link
1294                      qq($1<a href="$htmlroot/$pages{dosify($2)}">$2</a>);
1295                  } else {
1296                      "$1$2";
1297                  }
1298               }xeg;
1299      $rest =~ s{
1300                  (<a\ href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]*:)?
1301                }{
1302                   my $url ;
1303                   if ( $htmlfileurl ne '' ){
1304                      # Here, we take advantage of the knowledge
1305                      # that $htmlfileurl ne '' implies $htmlroot eq ''.
1306                      # Since $htmlroot eq '', we need to prepend $htmldir
1307                      # on the fron of the link to get the absolute path
1308                      # of the link's target. We check for a leading '/'
1309                      # to avoid corrupting links that are #, file:, etc.
1310                      my $old_url = $3 ;
1311                      $old_url = "$htmldir$old_url" if $old_url =~ m{^\/};
1312                      $url = relativize_url( "$old_url.html", $htmlfileurl );
1313                   } else {
1314                      $url = "$3.html" ;
1315                   }
1316                   "$1$url" ;
1317                }xeg;
1318
1319     # Look for embedded URLs and make them into links.  We don't
1320     # relativize them since they are best left as the author intended.
1321
1322     my $urls = '(' . join ('|', qw{
1323                 http
1324                 telnet
1325                 mailto
1326                 news
1327                 gopher
1328                 file
1329                 wais
1330                 ftp
1331             } )
1332         . ')';
1333
1334     my $ltrs = '\w';
1335     my $gunk = '/#~:.?+=&%@!\-';
1336     my $punc = '.:!?\-;';
1337     my $any  = "${ltrs}${gunk}${punc}";
1338
1339     $rest =~ s{
1340         \b                          # start at word boundary
1341         (                           # begin $1  {
1342           $urls     :               # need resource and a colon
1343           (?!:)                     # Ignore File::, among others.
1344           [$any] +?                 # followed by one or more of any valid
1345                                     #   character, but be conservative and
1346                                     #   take only what you need to....
1347         )                           # end   $1  }
1348         (?=                         # look-ahead non-consumptive assertion
1349                 [$punc]*            # either 0 or more punctuation
1350                 (?:                 #   followed
1351                     [^$any]         #   by a non-url char
1352                     |               #   or
1353                     $               #   end of the string
1354                 )                   #
1355             |                       # or else
1356                 $                   #   then end of the string
1357         )
1358       }{<a href="$1">$1</a>}igox;
1359
1360     # text should be as it is (verbatim)
1361     $$text = $rest;
1362 }
1363
1364
1365 #
1366 # pure text processing
1367 #
1368 # pure_text/inIS_text: differ with respect to automatic C<> recognition.
1369 # we don't want this to happen within IS
1370 #
1371 sub pure_text($){
1372     my $text = shift();
1373     process_puretext( $text, \$ptQuote, 1 );
1374 }
1375
1376 sub inIS_text($){
1377     my $text = shift();
1378     process_puretext( $text, \$ptQuote, 0 );
1379 }
1380
1381 #
1382 # process_puretext - process pure text (without pod-escapes) converting
1383 #  double-quotes and handling implicit C<> links.
1384 #
1385 sub process_puretext {
1386     my($text, $quote, $notinIS) = @_;
1387
1388     ## Guessing at func() or [$@%&]*var references in plain text is destined
1389     ## to produce some strange looking ref's. uncomment to disable:
1390     ## $notinIS = 0;
1391
1392     my(@words, $lead, $trail);
1393
1394     # convert double-quotes to single-quotes
1395     if( $$quote && $text =~ s/"/''/s ){
1396         $$quote = 0;
1397     }
1398     while ($text =~ s/"([^"]*)"/``$1''/sg) {};
1399     $$quote = 1 if $text =~ s/"/``/s;
1400
1401     # keep track of leading and trailing white-space
1402     $lead  = ($text =~ s/\A(\s+)//s ? $1 : "");
1403     $trail = ($text =~ s/(\s+)\Z//s ? $1 : "");
1404
1405     # split at space/non-space boundaries
1406     @words = split( /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $text );
1407
1408     # process each word individually
1409     foreach my $word (@words) {
1410         # skip space runs
1411         next if $word =~ /^\s*$/;
1412         # see if we can infer a link
1413         if( $notinIS && $word =~ /^(\w+)\((.*)\)$/ ) {
1414             # has parenthesis so should have been a C<> ref
1415             ## try for a pagename (perlXXX(1))?
1416             my( $func, $args ) = ( $1, $2 );
1417             if( $args =~ /^\d+$/ ){
1418                 my $url = page_sect( $word, '' );
1419                 if( defined $url ){
1420                     $word = "<a href=\"$url\">the $word manpage</a>";
1421                     next;
1422                 }
1423             }
1424             ## try function name for a link, append tt'ed argument list
1425             $word = emit_C( $func, '', "($args)");
1426
1427 #### disabled. either all (including $\W, $\w+{.*} etc.) or nothing.
1428 ##      } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) {
1429 ##          # perl variables, should be a C<> ref
1430 ##          $word = emit_C( $word );
1431
1432         } elsif ($word =~ m,^\w+://\w,) {
1433             # looks like a URL
1434             # Don't relativize it: leave it as the author intended
1435             $word = qq(<a href="$word">$word</a>);
1436         } elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) {
1437             # looks like an e-mail address
1438             my ($w1, $w2, $w3) = ("", $word, "");
1439             ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
1440             ($w1, $w2, $w3) = ("&lt;", $1, "&gt;$2") if $word =~ /^<(.*?)>(,?)/;
1441             $word = qq($w1<a href="mailto:$w2">$w2</a>$w3);
1442         } else {
1443             $word = html_escape($word) if $word =~ /["&<>]/;
1444         }
1445     }
1446
1447     # put everything back together
1448     return $lead . join( '', @words ) . $trail;
1449 }
1450
1451
1452 #
1453 # process_text - handles plaintext that appears in the input pod file.
1454 # there may be pod commands embedded within the text so those must be
1455 # converted to html commands.
1456 #
1457
1458 sub process_text1($$;$$);
1459 sub pattern ($) { $_[0] ? '[^\S\n]+'.('>' x ($_[0] + 1)) : '>' }
1460 sub closing ($) { local($_) = shift; (defined && s/\s+$//) ? length : 0 }
1461
1462 sub process_text {
1463     return if $ignore;
1464     my( $tref ) = @_;
1465     my $res = process_text1( 0, $tref );
1466     $$tref = $res;
1467 }
1468
1469 sub process_text1($$;$$){
1470     my( $lev, $rstr, $func, $closing ) = @_;
1471     my $res = '';
1472
1473     unless (defined $func) {
1474         $func = '';
1475         $lev++;
1476     }
1477
1478     if( $func eq 'B' ){
1479         # B<text> - boldface
1480         $res = '<strong>' . process_text1( $lev, $rstr ) . '</strong>';
1481
1482     } elsif( $func eq 'C' ){
1483         # C<code> - can be a ref or <code></code>
1484         # need to extract text
1485         my $par = go_ahead( $rstr, 'C', $closing );
1486
1487         ## clean-up of the link target
1488         my $text = depod( $par );
1489
1490         ### my $x = $par =~ /[BI]</ ? 'yes' : 'no' ;
1491         ### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n";
1492
1493         $res = emit_C( $text, $lev > 1 || ($par =~ /[BI]</) );
1494
1495     } elsif( $func eq 'E' ){
1496         # E<x> - convert to character
1497         $$rstr =~ s/^([^>]*)>//;
1498         my $escape = $1;
1499         $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i;
1500         $res = "&$escape;";
1501
1502     } elsif( $func eq 'F' ){
1503         # F<filename> - italizice
1504         $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
1505
1506     } elsif( $func eq 'I' ){
1507         # I<text> - italizice
1508         $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
1509
1510     } elsif( $func eq 'L' ){
1511         # L<link> - link
1512         ## L<text|cross-ref> => produce text, use cross-ref for linking
1513         ## L<cross-ref> => make text from cross-ref
1514         ## need to extract text
1515         my $par = go_ahead( $rstr, 'L', $closing );
1516
1517         # some L<>'s that shouldn't be:
1518         # a) full-blown URL's are emitted as-is
1519         if( $par =~ m{^\w+://}s ){
1520             return make_URL_href( $par );
1521         }
1522         # b) C<...> is stripped and treated as C<>
1523         if( $par =~ /^C<(.*)>$/ ){
1524             my $text = depod( $1 );
1525             return emit_C( $text, $lev > 1 || ($par =~ /[BI]</) );
1526         }
1527
1528         # analyze the contents
1529         $par =~ s/\n/ /g;   # undo word-wrapped tags
1530         my $opar = $par;
1531         my $linktext;
1532         if( $par =~ s{^([^|]+)\|}{} ){
1533             $linktext = $1;
1534         }
1535
1536         # make sure sections start with a /
1537         $par =~ s{^"}{/"};
1538
1539         my( $page, $section, $ident );
1540
1541         # check for link patterns
1542         if( $par =~ m{^([^/]+?)/(?!")(.*?)$} ){     # name/ident
1543             # we've got a name/ident (no quotes)
1544             ( $page, $ident ) = ( $1, $2 );
1545             ### print STDERR "--> L<$par> to page $page, ident $ident\n";
1546
1547         } elsif( $par =~ m{^(.*?)/"?(.*?)"?$} ){ # [name]/"section"
1548             # even though this should be a "section", we go for ident first
1549             ( $page, $ident ) = ( $1, $2 );
1550             ### print STDERR "--> L<$par> to page $page, section $section\n";
1551
1552         } elsif( $par =~ /\s/ ){  # this must be a section with missing quotes
1553             ( $page, $section ) = ( '', $par );
1554             ### print STDERR "--> L<$par> to void page, section $section\n";
1555
1556         } else {
1557             ( $page, $section ) = ( $par, '' );
1558             ### print STDERR "--> L<$par> to page $par, void section\n";
1559         }
1560
1561         # now, either $section or $ident is defined. the convoluted logic
1562         # below tries to resolve L<> according to what the user specified.
1563         # failing this, we try to find the next best thing...
1564         my( $url, $ltext, $fid );
1565
1566         RESOLVE: {
1567             if( defined $ident ){
1568                 ## try to resolve $ident as an item
1569                 ( $url, $fid ) = coderef( $page, $ident );
1570                 if( $url ){
1571                     if( ! defined( $linktext ) ){
1572                         $linktext = $ident;
1573                         $linktext .= " in " if $ident && $page;
1574                         $linktext .= "the $page manpage" if $page;
1575                     }
1576                     ###  print STDERR "got coderef url=$url\n";
1577                     last RESOLVE;
1578                 }
1579                 ## no luck: go for a section (auto-quoting!)
1580                 $section = $ident;
1581             }
1582             ## now go for a section
1583             my $htmlsection = htmlify( $section );
1584             $url = page_sect( $page, $htmlsection );
1585             if( $url ){
1586                 if( ! defined( $linktext ) ){
1587                     $linktext = $section;
1588                     $linktext .= " in " if $section && $page;
1589                     $linktext .= "the $page manpage" if $page;
1590                 }
1591                 ### print STDERR "got page/section url=$url\n";
1592                 last RESOLVE;
1593             }
1594             ## no luck: go for an ident
1595             if( $section ){
1596                 $ident = $section;
1597             } else {
1598                 $ident = $page;
1599                 $page  = undef();
1600             }
1601             ( $url, $fid ) = coderef( $page, $ident );
1602             if( $url ){
1603                 if( ! defined( $linktext ) ){
1604                     $linktext = $ident;
1605                     $linktext .= " in " if $ident && $page;
1606                     $linktext .= "the $page manpage" if $page;
1607                 }
1608                 ### print STDERR "got section=>coderef url=$url\n";
1609                 last RESOLVE;
1610             }
1611
1612             # warning; show some text.
1613             $linktext = $opar unless defined $linktext;
1614             warn "$0: $podfile: cannot resolve L<$opar> in paragraph $paragraph.\n";
1615         }
1616
1617         # now we have a URL or just plain code
1618         $$rstr = $linktext . '>' . $$rstr;
1619         if( defined( $url ) ){
1620             $res = "<a href=\"$url\">" . process_text1( $lev, $rstr ) . '</a>';
1621         } else {
1622             $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
1623         }
1624
1625     } elsif( $func eq 'S' ){
1626         # S<text> - non-breaking spaces
1627         $res = process_text1( $lev, $rstr );
1628         $res =~ s/ /&nbsp;/g;
1629
1630     } elsif( $func eq 'X' ){
1631         # X<> - ignore
1632         $$rstr =~ s/^[^>]*>//;
1633
1634     } elsif( $func eq 'Z' ){
1635         # Z<> - empty
1636         warn "$0: $podfile: invalid X<> in paragraph $paragraph.\n"
1637             unless $$rstr =~ s/^>//;
1638
1639     } else {
1640         my $term = pattern $closing;
1641         while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){
1642             # all others: either recurse into new function or
1643             # terminate at closing angle bracket(s)
1644             my $pt = $1;
1645             $pt .= $2 if !$3 &&  $lev == 1;
1646             $res .= $lev == 1 ? pure_text( $pt ) : inIS_text( $pt );
1647             return $res if !$3 && $lev > 1;
1648             if( $3 ){
1649                 $res .= process_text1( $lev, $rstr, $3, closing $4 );
1650             }
1651         }
1652         if( $lev == 1 ){
1653             $res .= pure_text( $$rstr );
1654         } else {
1655             warn "$0: $podfile: undelimited $func<> in paragraph $paragraph.\n";
1656         }
1657     }
1658     return $res;
1659 }
1660
1661 #
1662 # go_ahead: extract text of an IS (can be nested)
1663 #
1664 sub go_ahead($$$){
1665     my( $rstr, $func, $closing ) = @_;
1666     my $res = '';
1667     my @closing = ($closing);
1668     while( $$rstr =~
1669       s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|@{[pattern $closing[0]]})//s ){
1670         $res .= $1;
1671         unless( $3 ){
1672             shift @closing;
1673             return $res unless @closing;
1674         } else {
1675             unshift @closing, closing $4;
1676         }
1677         $res .= $2;
1678     }
1679     warn "$0: $podfile: undelimited $func<> in paragraph $paragraph.\n";
1680     return $res;
1681 }
1682
1683 #
1684 # emit_C - output result of C<text>
1685 #    $text is the depod-ed text
1686 #
1687 sub emit_C($;$$){
1688     my( $text, $nocode, $args ) = @_;
1689     $args = '' unless defined $args;
1690     my $res;
1691     my( $url, $fid ) = coderef( undef(), $text );
1692
1693     # need HTML-safe text
1694     my $linktext = html_escape( "$text$args" );
1695
1696     if( defined( $url ) &&
1697         (!defined( $EmittedItem ) || $EmittedItem ne $fid ) ){
1698         $res = "<a href=\"$url\"><code>$linktext</code></a>";
1699     } elsif( 0 && $nocode ){
1700         $res = $linktext;
1701     } else {
1702         $res = "<code>$linktext</code>";
1703     }
1704     return $res;
1705 }
1706
1707 #
1708 # html_escape: make text safe for HTML
1709 #
1710 sub html_escape {
1711     my $rest = $_[0];
1712     $rest   =~ s/&/&amp;/g;
1713     $rest   =~ s/</&lt;/g;
1714     $rest   =~ s/>/&gt;/g;
1715     $rest   =~ s/"/&quot;/g;
1716     # &apos; is only in XHTML, not HTML4.  Be conservative
1717     #$rest   =~ s/'/&apos;/g;
1718     return $rest;
1719 }
1720
1721
1722 #
1723 # dosify - convert filenames to 8.3
1724 #
1725 sub dosify {
1726     my($str) = @_;
1727     return lc($str) if $^O eq 'VMS';     # VMS just needs casing
1728     if ($Is83) {
1729         $str = lc $str;
1730         $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
1731         $str =~ s/(\w+)/substr ($1,0,8)/ge;
1732     }
1733     return $str;
1734 }
1735
1736 #
1737 # page_sect - make a URL from the text of a L<>
1738 #
1739 sub page_sect($$) {
1740     my( $page, $section ) = @_;
1741     my( $linktext, $page83, $link);     # work strings
1742
1743     # check if we know that this is a section in this page
1744     if (!defined $pages{$page} && defined $sections{$page}) {
1745         $section = $page;
1746         $page = "";
1747         ### print STDERR "reset page='', section=$section\n";
1748     }
1749
1750     $page83=dosify($page);
1751     $page=$page83 if (defined $pages{$page83});
1752     if ($page eq "") {
1753         $link = "#" . anchorify( $section );
1754     } elsif ( $page =~ /::/ ) {
1755         $page =~ s,::,/,g;
1756         # Search page cache for an entry keyed under the html page name,
1757         # then look to see what directory that page might be in.  NOTE:
1758         # this will only find one page. A better solution might be to produce
1759         # an intermediate page that is an index to all such pages.
1760         my $page_name = $page ;
1761         $page_name =~ s,^.*/,,s ;
1762         if ( defined( $pages{ $page_name } ) &&
1763              $pages{ $page_name } =~ /([^:]*$page)\.(?:pod|pm):/
1764            ) {
1765             $page = $1 ;
1766         }
1767         else {
1768             # NOTE: This branch assumes that all A::B pages are located in
1769             # $htmlroot/A/B.html . This is often incorrect, since they are
1770             # often in $htmlroot/lib/A/B.html or such like. Perhaps we could
1771             # analyze the contents of %pages and figure out where any
1772             # cousins of A::B are, then assume that.  So, if A::B isn't found,
1773             # but A::C is found in lib/A/C.pm, then A::B is assumed to be in
1774             # lib/A/B.pm. This is also limited, but it's an improvement.
1775             # Maybe a hints file so that the links point to the correct places
1776             # nonetheless?
1777
1778         }
1779         $link = "$htmlroot/$page.html";
1780         $link .= "#" . anchorify( $section ) if ($section);
1781     } elsif (!defined $pages{$page}) {
1782         $link = "";
1783     } else {
1784         $section = anchorify( $section ) if $section ne "";
1785         ### print STDERR "...section=$section\n";
1786
1787         # if there is a directory by the name of the page, then assume that an
1788         # appropriate section will exist in the subdirectory
1789 #       if ($section ne "" && $pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
1790         if ($section ne "" && $pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
1791             $link = "$htmlroot/$1/$section.html";
1792             ### print STDERR "...link=$link\n";
1793
1794         # since there is no directory by the name of the page, the section will
1795         # have to exist within a .html of the same name.  thus, make sure there
1796         # is a .pod or .pm that might become that .html
1797         } else {
1798             $section = "#$section" if $section;
1799             ### print STDERR "...section=$section\n";
1800
1801             # check if there is a .pod with the page name
1802             if ($pages{$page} =~ /([^:]*)\.pod:/) {
1803                 $link = "$htmlroot/$1.html$section";
1804             } elsif ($pages{$page} =~ /([^:]*)\.pm:/) {
1805                 $link = "$htmlroot/$1.html$section";
1806             } else {
1807                 $link = "";
1808             }
1809         }
1810     }
1811
1812     if ($link) {
1813         # Here, we take advantage of the knowledge that $htmlfileurl ne ''
1814         # implies $htmlroot eq ''. This means that the link in question
1815         # needs a prefix of $htmldir if it begins with '/'. The test for
1816         # the initial '/' is done to avoid '#'-only links, and to allow
1817         # for other kinds of links, like file:, ftp:, etc.
1818         my $url ;
1819         if (  $htmlfileurl ne '' ) {
1820             $link = "$htmldir$link" if $link =~ m{^/}s;
1821             $url = relativize_url( $link, $htmlfileurl );
1822 # print( "  b: [$link,$htmlfileurl,$url]\n" );
1823         }
1824         else {
1825             $url = $link ;
1826         }
1827         return $url;
1828
1829     } else {
1830         return undef();
1831     }
1832 }
1833
1834 #
1835 # relativize_url - convert an absolute URL to one relative to a base URL.
1836 # Assumes both end in a filename.
1837 #
1838 sub relativize_url {
1839     my ($dest,$source) = @_ ;
1840
1841     my ($dest_volume,$dest_directory,$dest_file) =
1842         File::Spec::Unix->splitpath( $dest ) ;
1843     $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ) ;
1844
1845     my ($source_volume,$source_directory,$source_file) =
1846         File::Spec::Unix->splitpath( $source ) ;
1847     $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ) ;
1848
1849     my $rel_path = '' ;
1850     if ( $dest ne '' ) {
1851        $rel_path = File::Spec::Unix->abs2rel( $dest, $source ) ;
1852     }
1853
1854     if ( $rel_path ne ''                &&
1855          substr( $rel_path, -1 ) ne '/' &&
1856          substr( $dest_file, 0, 1 ) ne '#'
1857         ) {
1858         $rel_path .= "/$dest_file" ;
1859     }
1860     else {
1861         $rel_path .= "$dest_file" ;
1862     }
1863
1864     return $rel_path ;
1865 }
1866
1867
1868 #
1869 # coderef - make URL from the text of a C<>
1870 #
1871 sub coderef($$){
1872     my( $page, $item ) = @_;
1873     my( $url );
1874
1875     my $fid = fragment_id( $item );
1876     if( defined( $page ) ){
1877         # we have been given a $page...
1878         $page =~ s{::}{/}g;
1879
1880         # Do we take it? Item could be a section!
1881         my $base = $items{$fid} || "";
1882         $base =~ s{[^/]*/}{};
1883         if( $base ne "$page.html" ){
1884             ###   print STDERR "coderef( $page, $item ): items{$fid} = $items{$fid} = $base => discard page!\n";
1885             $page = undef();
1886         }
1887
1888     } else {
1889         # no page - local items precede cached items
1890         if( defined( $fid ) ){
1891             if(  exists $local_items{$fid} ){
1892                 $page = $local_items{$fid};
1893             } else {
1894                 $page = $items{$fid};
1895             }
1896         }
1897     }
1898
1899     # if there was a pod file that we found earlier with an appropriate
1900     # =item directive, then create a link to that page.
1901     if( defined $page ){
1902         if( $page ){
1903             if( exists $pages{$page} and $pages{$page} =~ /([^:.]*)\.[^:]*:/){
1904                 $page = $1 . '.html';
1905             }
1906             my $link = "$htmlroot/$page#item_$fid";
1907
1908             # Here, we take advantage of the knowledge that $htmlfileurl
1909             # ne '' implies $htmlroot eq ''.
1910             if (  $htmlfileurl ne '' ) {
1911                 $link = "$htmldir$link" ;
1912                 $url = relativize_url( $link, $htmlfileurl ) ;
1913             } else {
1914                 $url = $link ;
1915             }
1916         } else {
1917             $url = "#item_" . $fid;
1918         }
1919
1920         confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/;
1921     }
1922     return( $url, $fid );
1923 }
1924
1925
1926
1927 #
1928 # Adapted from Nick Ing-Simmons' PodToHtml package.
1929 sub relative_url {
1930     my $source_file = shift ;
1931     my $destination_file = shift;
1932
1933     my $source = URI::file->new_abs($source_file);
1934     my $uo = URI::file->new($destination_file,$source)->abs;
1935     return $uo->rel->as_string;
1936 }
1937
1938
1939 #
1940 # finish_list - finish off any pending HTML lists.  this should be called
1941 # after the entire pod file has been read and converted.
1942 #
1943 sub finish_list {
1944     while ($listlevel > 0) {
1945         print HTML "</dl>\n";
1946         $listlevel--;
1947     }
1948 }
1949
1950 #
1951 # htmlify - converts a pod section specification to a suitable section
1952 # specification for HTML. Note that we keep spaces and special characters
1953 # except ", ? (Netscape problem) and the hyphen (writer's problem...).
1954 #
1955 sub htmlify {
1956     my( $heading) = @_;
1957     $heading =~ s/(\s+)/ /g;
1958     $heading =~ s/\s+\Z//;
1959     $heading =~ s/\A\s+//;
1960     # The hyphen is a disgrace to the English language.
1961     $heading =~ s/[-"?]//g;
1962     $heading = lc( $heading );
1963     return $heading;
1964 }
1965
1966 #
1967 # similar to htmlify, but turns spaces into underscores
1968 #
1969 sub anchorify {
1970     my ($anchor) = @_;
1971     $anchor = htmlify($anchor);
1972     $anchor =~ s/\s/_/g; # fixup spaces left by htmlify
1973     return $anchor;
1974 }
1975
1976 #
1977 # depod - convert text by eliminating all interior sequences
1978 # Note: can be called with copy or modify semantics
1979 #
1980 my %E2c;
1981 $E2c{lt}     = '<';
1982 $E2c{gt}     = '>';
1983 $E2c{sol}    = '/';
1984 $E2c{verbar} = '|';
1985 $E2c{amp}    = '&'; # in Tk's pods
1986
1987 sub depod1($;$$);
1988
1989 sub depod($){
1990     my $string;
1991     if( ref( $_[0] ) ){
1992         $string =  ${$_[0]};
1993         ${$_[0]} = depod1( \$string );
1994     } else {
1995         $string =  $_[0];
1996         depod1( \$string );
1997     }
1998 }
1999
2000 sub depod1($;$$){
2001   my( $rstr, $func, $closing ) = @_;
2002   my $res = '';
2003   return $res unless defined $$rstr;
2004   if( ! defined( $func ) ){
2005       # skip to next begin of an interior sequence
2006       while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?// ){
2007          # recurse into its text
2008           $res .= $1 . depod1( $rstr, $2, closing $3);
2009       }
2010       $res .= $$rstr;
2011   } elsif( $func eq 'E' ){
2012       # E<x> - convert to character
2013       $$rstr =~ s/^([^>]*)>//;
2014       $res .= $E2c{$1} || "";
2015   } elsif( $func eq 'X' ){
2016       # X<> - ignore
2017       $$rstr =~ s/^[^>]*>//;
2018   } elsif( $func eq 'Z' ){
2019       # Z<> - empty
2020       $$rstr =~ s/^>//;
2021   } else {
2022       # all others: either recurse into new function or
2023       # terminate at closing angle bracket
2024       my $term = pattern $closing;
2025       while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)// ){
2026           $res .= $1;
2027           last unless $3;
2028           $res .= depod1( $rstr, $3, closing $4 );
2029       }
2030       ## If we're here and $2 ne '>': undelimited interior sequence.
2031       ## Ignored, as this is called without proper indication of where we are.
2032       ## Rely on process_text to produce diagnostics.
2033   }
2034   return $res;
2035 }
2036
2037 #
2038 # fragment_id - construct a fragment identifier from:
2039 #   a) =item text
2040 #   b) contents of C<...>
2041 #
2042 my @hc;
2043 sub fragment_id {
2044     my $text = shift();
2045     $text =~ s/\s+\Z//s;
2046     if( $text ){
2047         # a method or function?
2048         return $1 if $text =~ /(\w+)\s*\(/;
2049         return $1 if $text =~ /->\s*(\w+)\s*\(?/;
2050
2051         # a variable name?
2052         return $1 if $text =~ /^([$@%*]\S+)/;
2053
2054         # some pattern matching operator?
2055         return $1 if $text =~ m|^(\w+/).*/\w*$|;
2056
2057         # fancy stuff... like "do { }"
2058         return $1 if $text =~ m|^(\w+)\s*{.*}$|;
2059
2060         # honour the perlfunc manpage: func [PAR[,[ ]PAR]...]
2061         # and some funnies with ... Module ...
2062         return $1 if $text =~ m{^([a-z\d]+)(\s+[A-Z\d,/& ]+)?$};
2063         return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$};
2064
2065         # text? normalize!
2066         $text =~ s/\s+/_/sg;
2067         $text =~ s{(\W)}{
2068          defined( $hc[ord($1)] ) ? $hc[ord($1)]
2069                  : ( $hc[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
2070         $text = substr( $text, 0, 50 );
2071     } else {
2072         return undef();
2073     }
2074 }
2075
2076 #
2077 # make_URL_href - generate HTML href from URL
2078 # Special treatment for CGI queries.
2079 #
2080 sub make_URL_href($){
2081     my( $url ) = @_;
2082     if( $url !~
2083         s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i ){
2084         $url = "<a href=\"$url\">$url</a>";
2085     }
2086     return $url;
2087 }
2088
2089 1;