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