lib/Pod/Html.pm

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