This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Pod::Html - correctly link to =item's on the same page
[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
PP
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
PP
20=head1 NAME
21
7b8d334a 22Pod::Html - module to convert pod files to HTML
54310121
PP
23
24=head1 SYNOPSIS
25
7b8d334a 26 use Pod::Html;
54310121
PP
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
PP
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
PP
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
PP
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
PP
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
PP
171 --norecurse
172
0e4548d5 173Recurse into subdirectories specified in podpath (default behaviour).
54310121
PP
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
PP
188=back
189
190=head1 EXAMPLE
191
192 pod2html("pod2html",
59ecbafa 193 "--podpath=lib:ext:pod:vms",
54310121
PP
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
PP
205=head1 AUTHOR
206
207Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
208
54310121
PP
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
PP
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
PP
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
PP
330sub pod2html {
331 local(@ARGV) = @_;
332 local($/);
333 local $_;
334
335 init_globals();
336
39e571d4
ML
337 $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
338
69348ecf 339 # cache of %Pages and %Items from last time we ran pod2html
54310121
PP
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
PP
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
PP
374
375 # read the pod a paragraph at a time
69348ecf 376 warn "Scanning for sections in input file(s)\n" if $Verbose;
54310121
PP
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
PP
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;
59ecbafa
VS
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">
8d481ee5 467<head>
69348ecf 468<title>$Title</title>$csslink
59ecbafa
VS
469<link rev="made" href="mailto:$Config{perladmin}" />
470</head>
471
472<body$bodystyle>
34db337b 473$block
54310121
PP
474END_OF_HEAD
475
69348ecf
MS
476 # load/reload/validate/cache %Pages and %Items
477 get_cache($Dircache, $Itemcache, \@Podpath, $Podroot, $Recurse);
54310121
PP
478
479 # scan the pod for =item directives
69348ecf 480 scan_items( \%Local_Items, "", @poddata);
54310121 481
69348ecf 482 # put an index at the top of the file. note, if $Doindex is 0 we
54310121
PP
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;
59ecbafa 486 print HTML "<p><a name=\"__index__\"></a></p>\n";
54310121 487 print HTML "<!-- INDEX BEGIN -->\n";
69348ecf 488 print HTML "<!--\n" unless $Doindex;
54310121 489 print HTML $index;
69348ecf 490 print HTML "-->\n" unless $Doindex;
54310121 491 print HTML "<!-- INDEX END -->\n\n";
69348ecf 492 print HTML "<hr />\n" if $Doindex and $index;
54310121
PP
493
494 # now convert this file
2a28b791 495 my $after_item; # set to true after an =item
59ecbafa 496 my $need_dd = 0;
69348ecf 497 warn "Converting input file $Podfile\n" if $Verbose;
2a28b791 498 foreach my $i (0..$#poddata){
69348ecf 499 $PTQuote = 0; # status of quote conversion
2a28b791 500
54310121 501 $_ = $poddata[$i];
69348ecf 502 $Paragraph = $i+1;
54310121 503 if (/^(=.*)/s) { # is it a pod directive?
69348ecf 504 $Ignore = 0;
2a28b791 505 $after_item = 0;
59ecbafa 506 $need_dd = 0;
54310121
PP
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 {
69348ecf 517 next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
54310121 518
7b8d334a 519 if (/^=(head[1-6])\s+(.*\S)/s) { # =head[1-6] heading
69348ecf 520 process_head( $1, $2, $Doindex && $index );
2a28b791 521 } elsif (/^=item\s*(.*\S)?/sm) { # =item text
59ecbafa 522 $need_dd = process_item( $1 );
2a28b791 523 $after_item = 1;
54310121
PP
524 } elsif (/^=over\s*(.*)/) { # =over N
525 process_over();
526 } elsif (/^=back/) { # =back
527 process_back();
a45bd81d 528 } elsif (/^=for\s+(\S+)\s*(.*)/si) {# =for
54310121
PP
529 process_for($1,$2);
530 } else {
531 /^=(\S*)\s*/;
69348ecf 532 warn "$0: $Podfile: unknown pod directive '$1' in "
ac094485 533 . "paragraph $Paragraph. ignoring.\n" unless $Quiet;
54310121
PP
534 }
535 }
69348ecf 536 $Top = 0;
54310121
PP
537 }
538 else {
69348ecf
MS
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';
59ecbafa 542 print HTML "<dd>\n" if $need_dd;
54310121 543 my $text = $_;
2a28b791
GS
544 if( $text =~ /\A\s+/ ){
545 process_pre( \$text );
59ecbafa 546 print HTML "<pre>\n$text</pre>\n";
2a28b791
GS
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 ){
59ecbafa
VS
564 $text =~ s/\t+/<td>/g;
565 $text =~ s/^/<tr><td>/gm;
566 $text = '<table cellspacing="0" cellpadding="0">' .
567 $text . '</table>';
2a28b791
GS
568 }
569 }
570 }
571 ## end of experimental
572
573 if( $after_item ){
574 print HTML "$text\n";
69348ecf 575 $After_Lpar = 1;
2a28b791 576 } else {
59ecbafa 577 print HTML "<p>$text</p>\n";
2a28b791
GS
578 }
579 }
59ecbafa 580 print HTML "</dd>\n" if $need_dd;
2a28b791 581 $after_item = 0;
54310121
PP
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
PP
597END_OF_TAIL
598
599 # close the html file
600 close(HTML);
601
69348ecf 602 warn "Finished\n" if $Verbose;
54310121
PP
603}
604
605##############################################################################
606
54310121
PP
607sub usage {
608 my $podfile = shift;
609 warn "$0: $podfile: @_\n" if @_;
69348ecf 610 die <<END_OF_USAGE;
54310121
PP
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 .).
640 --[no]quiet - supress some benign warning messages (default is off).
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
PP
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
PP
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
PP
676 'recurse!' => \$opt_recurse,
677 'title=s' => \$opt_title,
0e4548d5 678 'verbose!' => \$opt_verbose,
54310121
PP
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
PP
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
PP
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
PP
754# them and returns a non-zero value.
755#
3e3baf6d 756sub load_cache {
54310121
PP
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
PP
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
PP
780 return 0;
781 }
782
69348ecf 783 warn "loading item cache\n" if $Verbose;
54310121
PP
784 while (<CACHE>) {
785 /(.*?) (.*)$/;
69348ecf 786 $Items{$1} = $2;
54310121
PP
787 }
788 close(CACHE);
789
69348ecf 790 warn "scanning for directory cache\n" if $Verbose;
54310121
PP
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
PP
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
PP
809 return 0;
810 }
811
69348ecf 812 warn "loading directory cache\n" if $Verbose;
54310121
PP
813 while (<CACHE>) {
814 /(.*?) (.*)$/;
69348ecf 815 $Pages{$1} = $2;
54310121
PP
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
PP
827#
828sub scan_podpath {
3e3baf6d 829 my($podroot, $recurse, $append) = @_;
54310121
PP
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
PP
839 $pwd = getcwd();
840 chdir($podroot)
841 || die "$0: error changing to directory $podroot: $!\n";
69348ecf 842 foreach $dir (@Podpath) {
54310121
PP
843 scan_dir($dir, $recurse);
844 }
845
69348ecf
MS
846 # scan the pods listed in @Libpods for =item directives
847 foreach $libpod (@Libpods) {
54310121
PP
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
PP
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
PP
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
PP
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
PP
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
PP
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
PP
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
PP
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
PP
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
PP
961 push(@pods, "$dir/$_.pm");
962 }
963 }
964 closedir(DIR);
965
966 # recurse on the subdirectories if necessary
967 if ($recurse) {
968 foreach my $subdir (@subdirs) {
969 scan_dir("$dir/$subdir", $recurse);
970 }
971 }
972}
973
974#
975# scan_headings - scan a pod file for head[1-6] tags, note the tags, and
976# build an index.
977#
978sub scan_headings {
979 my($sections, @data) = @_;
2a28b791 980 my($tag, $which_head, $otitle, $listdepth, $index);
54310121 981
69348ecf 982 local $Ignore = 0;
be173d55 983
54310121
PP
984 $listdepth = 0;
985 $index = "";
986
987 # scan for =head directives, note their name, and build an index
988 # pointing to each of them.
989 foreach my $line (@data) {
59ecbafa
VS
990 if ($line =~ /^=(head)([1-6])\s+(.*)/) {
991 ($tag, $which_head, $otitle) = ($1,$2,$3);
2a28b791 992
59ecbafa 993 my $title = depod( $otitle );
2beb85b7 994 my $name = anchorify( $title );
59ecbafa 995 $$sections{$name} = 1;
59ecbafa 996 $title = process_text( \$otitle );
54310121 997
102c538a
DS
998 while ($which_head != $listdepth) {
999 if ($which_head > $listdepth) {
59ecbafa 1000 $index .= "\n" . ("\t" x $listdepth) . "<ul>\n";
102c538a
DS
1001 $listdepth++;
1002 } elsif ($which_head < $listdepth) {
1003 $listdepth--;
59ecbafa 1004 $index .= "\n" . ("\t" x $listdepth) . "</ul>\n";
102c538a 1005 }
54310121 1006 }
54310121 1007
59ecbafa
VS
1008 $index .= "\n" . ("\t" x $listdepth) . "<li>" .
1009 "<a href=\"#" . $name . "\">" .
1010 $title . "</a></li>";
54310121
PP
1011 }
1012 }
1013
1014 # finish off the lists
1015 while ($listdepth--) {
59ecbafa 1016 $index .= "\n" . ("\t" x $listdepth) . "</ul>\n";
54310121
PP
1017 }
1018
1019 # get rid of bogus lists
59ecbafa 1020 $index =~ s,\t*<ul>\s*</ul>\n,,g;
54310121
PP
1021
1022 return $index;
1023}
1024
1025#
1026# scan_items - scans the pod specified by $pod for =item directives. we
1027# will use this information later on in resolving C<> links.
1028#
1029sub scan_items {
2a28b791 1030 my( $itemref, $pod, @poddata ) = @_;
54310121
PP
1031 my($i, $item);
1032 local $_;
1033
fe6f1558 1034 $pod =~ s/\.pod\z//;
54310121
PP
1035 $pod .= ".html" if $pod;
1036
1037 foreach $i (0..$#poddata) {
2a28b791
GS
1038 my $txt = depod( $poddata[$i] );
1039
1040 # figure out what kind of item it is.
1041 # Build string for referencing this item.
1042 if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bullet
1043 next unless $1;
1044 $item = $1;
1045 } elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list
1046 $item = $1;
1047 } elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # plain item
1048 $item = $1;
1049 } else {
1050 next;
54310121 1051 }
2a28b791
GS
1052 my $fid = fragment_id( $item );
1053 $$itemref{$fid} = "$pod" if $fid;
54310121
PP
1054 }
1055}
1056
1057#
1058# process_head - convert a pod head[1-6] tag and convert it to HTML format.
1059#
1060sub process_head {
2a28b791 1061 my($tag, $heading, $hasindex) = @_;
54310121
PP
1062
1063 # figure out the level of the =head
1064 $tag =~ /head([1-6])/;
1065 my $level = $1;
1066
69348ecf 1067 if( $Listlevel ){
ac094485 1068 warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph. ignoring.\n" unless $Quiet;
69348ecf 1069 while( $Listlevel ){
2a28b791
GS
1070 process_back();
1071 }
1072 }
1073
59ecbafa 1074 print HTML "<p>\n";
69348ecf
MS
1075 if( $level == 1 && ! $Top ){
1076 print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n"
1077 if $hasindex and $Backlink;
59ecbafa
VS
1078 print HTML "</p>\n<hr />\n"
1079 } else {
1080 print HTML "</p>\n";
2a28b791
GS
1081 }
1082
0d396dd4 1083 my $name = anchorify( depod( $heading ) );
2a28b791 1084 my $convert = process_text( \$heading );
59ecbafa 1085 print HTML "<h$level><a name=\"$name\">$convert</a></h$level>\n";
54310121
PP
1086}
1087
2a28b791 1088
54310121 1089#
2a28b791
GS
1090# emit_item_tag - print an =item's text
1091# Note: The global $EmittedItem is used for inhibiting self-references.
54310121 1092#
2a28b791
GS
1093my $EmittedItem;
1094
1095sub emit_item_tag($$$){
1096 my( $otext, $text, $compact ) = @_;
1097 my $item = fragment_id( $text );
54310121 1098
2a28b791
GS
1099 $EmittedItem = $item;
1100 ### print STDERR "emit_item_tag=$item ($text)\n";
54310121 1101
59ecbafa 1102 print HTML '<strong>';
69348ecf 1103 if ($Items_Named{$item}++) {
2a28b791
GS
1104 print HTML process_text( \$otext );
1105 } else {
0d396dd4
SB
1106 my $name = 'item_' . $item;
1107 $name = anchorify($name);
59ecbafa 1108 print HTML qq{<a name="$name">}, process_text( \$otext ), '</a>';
2a28b791 1109 }
59ecbafa 1110 print HTML "</strong><br />\n";
2a28b791
GS
1111 undef( $EmittedItem );
1112}
1113
1114sub emit_li {
1115 my( $tag ) = @_;
69348ecf
MS
1116 if( $Items_Seen[$Listlevel]++ == 0 ){
1117 push( @Listend, "</$tag>" );
2a28b791
GS
1118 print HTML "<$tag>\n";
1119 }
59ecbafa
VS
1120 my $emitted = $tag eq 'dl' ? 'dt' : 'li';
1121 print HTML "<$emitted>";
1122 return $emitted;
2a28b791
GS
1123}
1124
1125#
1126# process_item - convert a pod item tag and convert it to HTML format.
1127#
1128sub process_item {
1129 my( $otext ) = @_;
59ecbafa 1130 my $need_dd = 0; # set to 1 if we need a <dd></dd> after an item
54310121
PP
1131
1132 # lots of documents start a list without doing an =over. this is
1133 # bad! but, the proper thing to do seems to be to just assume
1134 # they did do an =over. so warn them once and then continue.
69348ecf 1135 if( $Listlevel == 0 ){
ac094485 1136 warn "$0: $Podfile: unexpected =item directive in paragraph $Paragraph. ignoring.\n" unless $Quiet;
2a28b791
GS
1137 process_over();
1138 }
54310121 1139
2a28b791 1140 # formatting: insert a paragraph if preceding item has >1 paragraph
69348ecf 1141 if( $After_Lpar ){
59ecbafa 1142 print HTML "<p></p>\n";
69348ecf 1143 $After_Lpar = 0;
2a28b791 1144 }
54310121
PP
1145
1146 # remove formatting instructions from the text
2a28b791
GS
1147 my $text = depod( $otext );
1148
59ecbafa
VS
1149 my $emitted; # the tag actually emitted, used for closing
1150
2a28b791
GS
1151 # all the list variants:
1152 if( $text =~ /\A\*/ ){ # bullet
59ecbafa
VS
1153 $emitted = emit_li( 'ul' );
1154 if ($text =~ /\A\*\s+(.+)\Z/s ) { # with additional text
1155 my $tag = $1;
1156 $otext =~ s/\A\*\s+//;
1157 emit_item_tag( $otext, $tag, 1 );
1158 }
54310121 1159
2a28b791 1160 } elsif( $text =~ /\A\d+/ ){ # numbered list
59ecbafa
VS
1161 $emitted = emit_li( 'ol' );
1162 if ($text =~ /\A(?>\d+\.?)\s*(.+)\Z/s ) { # with additional text
1163 my $tag = $1;
1164 $otext =~ s/\A\d+\.?\s*//;
1165 emit_item_tag( $otext, $tag, 1 );
1166 }
54310121 1167
2a28b791 1168 } else { # definition list
59ecbafa
VS
1169 $emitted = emit_li( 'dl' );
1170 if ($text =~ /\A(.+)\Z/s ){ # should have text
1171 emit_item_tag( $otext, $text, 1 );
1172 }
1173 $need_dd = 1;
54310121 1174 }
59ecbafa 1175 print HTML "</$emitted>" if $emitted;
54310121 1176 print HTML "\n";
59ecbafa 1177 return $need_dd;
54310121
PP
1178}
1179
1180#
2a28b791 1181# process_over - process a pod over tag and start a corresponding HTML list.
54310121
PP
1182#
1183sub process_over {
1184 # start a new list
69348ecf
MS
1185 $Listlevel++;
1186 push( @Items_Seen, 0 );
1187 $After_Lpar = 0;
54310121
PP
1188}
1189
1190#
1191# process_back - process a pod back tag and convert it to HTML format.
1192#
1193sub process_back {
69348ecf 1194 if( $Listlevel == 0 ){
ac094485 1195 warn "$0: $Podfile: unexpected =back directive in paragraph $Paragraph. ignoring.\n" unless $Quiet;
2a28b791
GS
1196 return;
1197 }
54310121 1198
69348ecf 1199 # close off the list. note, I check to see if $Listend[$Listlevel] is
54310121 1200 # defined because an =item directive may have never appeared and thus
69348ecf
MS
1201 # $Listend[$Listlevel] may have never been initialized.
1202 $Listlevel--;
1203 if( defined $Listend[$Listlevel] ){
1204 print HTML '<p></p>' if $After_Lpar;
1205 print HTML $Listend[$Listlevel];
2a28b791 1206 print HTML "\n";
69348ecf 1207 pop( @Listend );
2a28b791 1208 }
69348ecf 1209 $After_Lpar = 0;
54310121 1210
2a28b791 1211 # clean up item count
69348ecf 1212 pop( @Items_Seen );
54310121
PP
1213}
1214
1215#
2a28b791 1216# process_cut - process a pod cut tag, thus start ignoring pod directives.
54310121
PP
1217#
1218sub process_cut {
69348ecf 1219 $Ignore = 1;
54310121
PP
1220}
1221
1222#
d1be9408 1223# process_pod - process a pod tag, thus stop ignoring pod directives
2a28b791 1224# until we see a corresponding cut.
54310121
PP
1225#
1226sub process_pod {
69348ecf 1227 # no need to set $Ignore to 0 cause the main loop did it
54310121
PP
1228}
1229
1230#
2a28b791 1231# process_for - process a =for pod tag. if it's for html, spit
c4d9b39d 1232# it out verbatim, if illustration, center it, otherwise ignore it.
54310121
PP
1233#
1234sub process_for {
1235 my($whom, $text) = @_;
1236 if ( $whom =~ /^(pod2)?html$/i) {
1237 print HTML $text;
c4d9b39d
IZ
1238 } elsif ($whom =~ /^illustration$/i) {
1239 1 while chomp $text;
1240 for my $ext (qw[.png .gif .jpeg .jpg .tga .pcl .bmp]) {
1241 $text .= $ext, last if -r "$text$ext";
1242 }
59ecbafa 1243 print HTML qq{<p align="center"><img src="$text" alt="$text illustration" /></p>};
c4d9b39d 1244 }
54310121
PP
1245}
1246
1247#
1248# process_begin - process a =begin pod tag. this pushes
1249# whom we're beginning on the begin stack. if there's a
1250# begin stack, we only print if it us.
1251#
1252sub process_begin {
1253 my($whom, $text) = @_;
1254 $whom = lc($whom);
69348ecf 1255 push (@Begin_Stack, $whom);
54310121
PP
1256 if ( $whom =~ /^(pod2)?html$/) {
1257 print HTML $text if $text;
1258 }
1259}
1260
1261#
1262# process_end - process a =end pod tag. pop the
1263# begin stack. die if we're mismatched.
1264#
1265sub process_end {
1266 my($whom, $text) = @_;
1267 $whom = lc($whom);
69348ecf
MS
1268 if ($Begin_Stack[-1] ne $whom ) {
1269 die "Unmatched begin/end at chunk $Paragraph\n"
59ecbafa 1270 }
69348ecf 1271 pop( @Begin_Stack );
54310121
PP
1272}
1273
1274#
59ecbafa 1275# process_pre - indented paragraph, made into <pre></pre>
54310121 1276#
2a28b791
GS
1277sub process_pre {
1278 my( $text ) = @_;
1279 my( $rest );
69348ecf 1280 return if $Ignore;
54310121 1281
54310121
PP
1282 $rest = $$text;
1283
2a28b791 1284 # insert spaces in place of tabs
24e08cba
JF
1285 $rest =~ s#(.+)#
1286 my $line = $1;
1287 1 while $line =~ s/(\t+)/' ' x ((length($1) * 8) - $-[0] % 8)/e;
be173d55
UC
1288 $line;
1289 #eg;
54310121 1290
2a28b791 1291 # convert some special chars to HTML escapes
59ecbafa 1292 $rest = html_escape($rest);
2a28b791
GS
1293
1294 # try and create links for all occurrences of perl.* within
1295 # the preformatted text.
1296 $rest =~ s{
1297 (\s*)(perl\w+)
1298 }{
69348ecf
MS
1299 if ( defined $Pages{$2} ){ # is a link
1300 qq($1<a href="$Htmlroot/$Pages{$2}">$2</a>);
1301 } elsif (defined $Pages{dosify($2)}) { # is a link
1302 qq($1<a href="$Htmlroot/$Pages{dosify($2)}">$2</a>);
2a28b791
GS
1303 } else {
1304 "$1$2";
1305 }
1306 }xeg;
1307 $rest =~ s{
59ecbafa 1308 (<a\ href="?) ([^>:]*:)? ([^>:]*) \.pod: ([^>:]*:)?
2a28b791
GS
1309 }{
1310 my $url ;
69348ecf 1311 if ( $Htmlfileurl ne '' ){
59ecbafa 1312 # Here, we take advantage of the knowledge
69348ecf
MS
1313 # that $Htmlfileurl ne '' implies $Htmlroot eq ''.
1314 # Since $Htmlroot eq '', we need to prepend $Htmldir
2a28b791
GS
1315 # on the fron of the link to get the absolute path
1316 # of the link's target. We check for a leading '/'
1317 # to avoid corrupting links that are #, file:, etc.
1318 my $old_url = $3 ;
69348ecf
MS
1319 $old_url = "$Htmldir$old_url" if $old_url =~ m{^\/};
1320 $url = relativize_url( "$old_url.html", $Htmlfileurl );
2a28b791
GS
1321 } else {
1322 $url = "$3.html" ;
1323 }
1324 "$1$url" ;
1325 }xeg;
1326
1327 # Look for embedded URLs and make them into links. We don't
1328 # relativize them since they are best left as the author intended.
1329
1330 my $urls = '(' . join ('|', qw{
54310121
PP
1331 http
1332 telnet
1333 mailto
1334 news
1335 gopher
1336 file
1337 wais
1338 ftp
59ecbafa 1339 } )
54310121 1340 . ')';
59ecbafa 1341
2a28b791
GS
1342 my $ltrs = '\w';
1343 my $gunk = '/#~:.?+=&%@!\-';
add5afb0 1344 my $punc = '.:!?\-;';
2a28b791 1345 my $any = "${ltrs}${gunk}${punc}";
54310121 1346
2a28b791 1347 $rest =~ s{
69e2f044
D
1348 \b # start at word boundary
1349 ( # begin $1 {
1350 $urls : # need resource and a colon
1351 (?!:) # Ignore File::, among others.
1352 [$any] +? # followed by one or more of any valid
1353 # character, but be conservative and
1354 # take only what you need to....
1355 ) # end $1 }
1356 (?=
1357 &quot; &gt; # maybe pre-quoted '<a href="...">'
1358 | # or:
1359 [$punc]* # 0 or more punctuation
1360 (?: # followed
1361 [^$any] # by a non-url char
1362 | # or
1363 $ # end of the string
1364 ) #
1365 | # or else
1366 $ # then end of the string
54310121 1367 )
59ecbafa 1368 }{<a href="$1">$1</a>}igox;
54310121 1369
2a28b791
GS
1370 # text should be as it is (verbatim)
1371 $$text = $rest;
1372}
54310121 1373
54310121 1374
2a28b791
GS
1375#
1376# pure text processing
1377#
1378# pure_text/inIS_text: differ with respect to automatic C<> recognition.
1379# we don't want this to happen within IS
1380#
1381sub pure_text($){
1382 my $text = shift();
69348ecf 1383 process_puretext( $text, \$PTQuote, 1 );
54310121
PP
1384}
1385
2a28b791
GS
1386sub inIS_text($){
1387 my $text = shift();
69348ecf 1388 process_puretext( $text, \$PTQuote, 0 );
2a28b791 1389}
54310121
PP
1390
1391#
1392# process_puretext - process pure text (without pod-escapes) converting
1393# double-quotes and handling implicit C<> links.
1394#
1395sub process_puretext {
2a28b791 1396 my($text, $quote, $notinIS) = @_;
54310121 1397
2a28b791
GS
1398 ## Guessing at func() or [$@%&]*var references in plain text is destined
1399 ## to produce some strange looking ref's. uncomment to disable:
1400 ## $notinIS = 0;
1401
1402 my(@words, $lead, $trail);
54310121 1403
2a28b791
GS
1404 # convert double-quotes to single-quotes
1405 if( $$quote && $text =~ s/"/''/s ){
1406 $$quote = 0;
1407 }
1408 while ($text =~ s/"([^"]*)"/``$1''/sg) {};
1409 $$quote = 1 if $text =~ s/"/``/s;
54310121
PP
1410
1411 # keep track of leading and trailing white-space
2a28b791
GS
1412 $lead = ($text =~ s/\A(\s+)//s ? $1 : "");
1413 $trail = ($text =~ s/(\s+)\Z//s ? $1 : "");
54310121 1414
2a28b791
GS
1415 # split at space/non-space boundaries
1416 @words = split( /(?<=\s)(?=\S)|(?<=\S)(?=\s)/, $text );
54310121
PP
1417
1418 # process each word individually
1419 foreach my $word (@words) {
2a28b791
GS
1420 # skip space runs
1421 next if $word =~ /^\s*$/;
54310121 1422 # see if we can infer a link
02369fa5 1423 if( $notinIS && $word =~ /^(\w+)\((.*)\)$/ ) {
54310121 1424 # has parenthesis so should have been a C<> ref
2a28b791 1425 ## try for a pagename (perlXXX(1))?
02369fa5
GS
1426 my( $func, $args ) = ( $1, $2 );
1427 if( $args =~ /^\d+$/ ){
2a28b791
GS
1428 my $url = page_sect( $word, '' );
1429 if( defined $url ){
59ecbafa 1430 $word = "<a href=\"$url\">the $word manpage</a>";
2a28b791
GS
1431 next;
1432 }
1433 }
02369fa5
GS
1434 ## try function name for a link, append tt'ed argument list
1435 $word = emit_C( $func, '', "($args)");
2a28b791
GS
1436
1437#### disabled. either all (including $\W, $\w+{.*} etc.) or nothing.
1438## } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) {
1439## # perl variables, should be a C<> ref
1440## $word = emit_C( $word );
1441
54310121
PP
1442 } elsif ($word =~ m,^\w+://\w,) {
1443 # looks like a URL
5a039dd3 1444 # Don't relativize it: leave it as the author intended
59ecbafa 1445 $word = qq(<a href="$word">$word</a>);
af47ee55 1446 } elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) {
54310121 1447 # looks like an e-mail address
7b8d334a
GS
1448 my ($w1, $w2, $w3) = ("", $word, "");
1449 ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
1450 ($w1, $w2, $w3) = ("&lt;", $1, "&gt;$2") if $word =~ /^<(.*?)>(,?)/;
59ecbafa
VS
1451 $word = qq($w1<a href="mailto:$w2">$w2</a>$w3);
1452 } else {
7b8d334a 1453 $word = html_escape($word) if $word =~ /["&<>]/;
54310121
PP
1454 }
1455 }
1456
2a28b791
GS
1457 # put everything back together
1458 return $lead . join( '', @words ) . $trail;
1459}
1460
54310121 1461
2a28b791
GS
1462#
1463# process_text - handles plaintext that appears in the input pod file.
1464# there may be pod commands embedded within the text so those must be
1465# converted to html commands.
1466#
7ba65c74 1467
c68ea5d1
GS
1468sub process_text1($$;$$);
1469sub pattern ($) { $_[0] ? '[^\S\n]+'.('>' x ($_[0] + 1)) : '>' }
1470sub closing ($) { local($_) = shift; (defined && s/\s+$//) ? length : 0 }
7ba65c74 1471
2a28b791 1472sub process_text {
69348ecf 1473 return if $Ignore;
2a28b791
GS
1474 my( $tref ) = @_;
1475 my $res = process_text1( 0, $tref );
1476 $$tref = $res;
1477}
1478
c68ea5d1
GS
1479sub process_text1($$;$$){
1480 my( $lev, $rstr, $func, $closing ) = @_;
2a28b791
GS
1481 my $res = '';
1482
60a48b2d
GS
1483 unless (defined $func) {
1484 $func = '';
1485 $lev++;
1486 }
1487
2a28b791
GS
1488 if( $func eq 'B' ){
1489 # B<text> - boldface
59ecbafa 1490 $res = '<strong>' . process_text1( $lev, $rstr ) . '</strong>';
2a28b791
GS
1491
1492 } elsif( $func eq 'C' ){
59ecbafa 1493 # C<code> - can be a ref or <code></code>
2a28b791 1494 # need to extract text
c68ea5d1 1495 my $par = go_ahead( $rstr, 'C', $closing );
2a28b791
GS
1496
1497 ## clean-up of the link target
1498 my $text = depod( $par );
1499
1500 ### my $x = $par =~ /[BI]</ ? 'yes' : 'no' ;
59ecbafa 1501 ### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n";
2a28b791
GS
1502
1503 $res = emit_C( $text, $lev > 1 || ($par =~ /[BI]</) );
1504
1505 } elsif( $func eq 'E' ){
1506 # E<x> - convert to character
be3174d2
GS
1507 $$rstr =~ s/^([^>]*)>//;
1508 my $escape = $1;
1509 $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i;
1510 $res = "&$escape;";
2a28b791
GS
1511
1512 } elsif( $func eq 'F' ){
1513 # F<filename> - italizice
59ecbafa 1514 $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
2a28b791
GS
1515
1516 } elsif( $func eq 'I' ){
1517 # I<text> - italizice
59ecbafa 1518 $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
2a28b791
GS
1519
1520 } elsif( $func eq 'L' ){
1521 # L<link> - link
59ecbafa 1522 ## L<text|cross-ref> => produce text, use cross-ref for linking
2a28b791
GS
1523 ## L<cross-ref> => make text from cross-ref
1524 ## need to extract text
c68ea5d1 1525 my $par = go_ahead( $rstr, 'L', $closing );
2a28b791
GS
1526
1527 # some L<>'s that shouldn't be:
1528 # a) full-blown URL's are emitted as-is
1529 if( $par =~ m{^\w+://}s ){
1530 return make_URL_href( $par );
1531 }
1532 # b) C<...> is stripped and treated as C<>
1533 if( $par =~ /^C<(.*)>$/ ){
1534 my $text = depod( $1 );
1535 return emit_C( $text, $lev > 1 || ($par =~ /[BI]</) );
1536 }
1537
1538 # analyze the contents
1539 $par =~ s/\n/ /g; # undo word-wrapped tags
1540 my $opar = $par;
1541 my $linktext;
1542 if( $par =~ s{^([^|]+)\|}{} ){
1543 $linktext = $1;
1544 }
59ecbafa 1545
2a28b791
GS
1546 # make sure sections start with a /
1547 $par =~ s{^"}{/"};
1548
1549 my( $page, $section, $ident );
1550
1551 # check for link patterns
1552 if( $par =~ m{^([^/]+?)/(?!")(.*?)$} ){ # name/ident
59ecbafa 1553 # we've got a name/ident (no quotes)
2a28b791
GS
1554 ( $page, $ident ) = ( $1, $2 );
1555 ### print STDERR "--> L<$par> to page $page, ident $ident\n";
1556
1557 } elsif( $par =~ m{^(.*?)/"?(.*?)"?$} ){ # [name]/"section"
1558 # even though this should be a "section", we go for ident first
1559 ( $page, $ident ) = ( $1, $2 );
1560 ### print STDERR "--> L<$par> to page $page, section $section\n";
1561
1562 } elsif( $par =~ /\s/ ){ # this must be a section with missing quotes
1563 ( $page, $section ) = ( '', $par );
1564 ### print STDERR "--> L<$par> to void page, section $section\n";
1565
1566 } else {
1567 ( $page, $section ) = ( $par, '' );
1568 ### print STDERR "--> L<$par> to page $par, void section\n";
1569 }
1570
1571 # now, either $section or $ident is defined. the convoluted logic
1572 # below tries to resolve L<> according to what the user specified.
1573 # failing this, we try to find the next best thing...
1574 my( $url, $ltext, $fid );
1575
1576 RESOLVE: {
1577 if( defined $ident ){
1578 ## try to resolve $ident as an item
1579 ( $url, $fid ) = coderef( $page, $ident );
1580 if( $url ){
1581 if( ! defined( $linktext ) ){
1582 $linktext = $ident;
1583 $linktext .= " in " if $ident && $page;
1584 $linktext .= "the $page manpage" if $page;
1585 }
1586 ### print STDERR "got coderef url=$url\n";
1587 last RESOLVE;
1588 }
1589 ## no luck: go for a section (auto-quoting!)
1590 $section = $ident;
1591 }
1592 ## now go for a section
1593 my $htmlsection = htmlify( $section );
1594 $url = page_sect( $page, $htmlsection );
1595 if( $url ){
1596 if( ! defined( $linktext ) ){
1597 $linktext = $section;
1598 $linktext .= " in " if $section && $page;
1599 $linktext .= "the $page manpage" if $page;
1600 }
1601 ### print STDERR "got page/section url=$url\n";
1602 last RESOLVE;
1603 }
59ecbafa 1604 ## no luck: go for an ident
2a28b791
GS
1605 if( $section ){
1606 $ident = $section;
1607 } else {
1608 $ident = $page;
1609 $page = undef();
1610 }
1611 ( $url, $fid ) = coderef( $page, $ident );
1612 if( $url ){
1613 if( ! defined( $linktext ) ){
1614 $linktext = $ident;
1615 $linktext .= " in " if $ident && $page;
1616 $linktext .= "the $page manpage" if $page;
1617 }
1618 ### print STDERR "got section=>coderef url=$url\n";
1619 last RESOLVE;
1620 }
1621
1622 # warning; show some text.
1623 $linktext = $opar unless defined $linktext;
ac094485 1624 warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n" unless $Quiet;
2a28b791
GS
1625 }
1626
d1be9408 1627 # now we have a URL or just plain code
2a28b791
GS
1628 $$rstr = $linktext . '>' . $$rstr;
1629 if( defined( $url ) ){
59ecbafa 1630 $res = "<a href=\"$url\">" . process_text1( $lev, $rstr ) . '</a>';
2a28b791 1631 } else {
59ecbafa 1632 $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
2a28b791
GS
1633 }
1634
1635 } elsif( $func eq 'S' ){
1636 # S<text> - non-breaking spaces
1637 $res = process_text1( $lev, $rstr );
1638 $res =~ s/ /&nbsp;/g;
1639
1640 } elsif( $func eq 'X' ){
1641 # X<> - ignore
1642 $$rstr =~ s/^[^>]*>//;
1643
1644 } elsif( $func eq 'Z' ){
59ecbafa 1645 # Z<> - empty
69348ecf 1646 warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n"
ac094485 1647 unless $$rstr =~ s/^>// or $Quiet;
2a28b791
GS
1648
1649 } else {
c68ea5d1
GS
1650 my $term = pattern $closing;
1651 while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){
2a28b791 1652 # all others: either recurse into new function or
c68ea5d1 1653 # terminate at closing angle bracket(s)
2a28b791 1654 my $pt = $1;
c68ea5d1 1655 $pt .= $2 if !$3 && $lev == 1;
2a28b791 1656 $res .= $lev == 1 ? pure_text( $pt ) : inIS_text( $pt );
c68ea5d1
GS
1657 return $res if !$3 && $lev > 1;
1658 if( $3 ){
1659 $res .= process_text1( $lev, $rstr, $3, closing $4 );
1660 }
2a28b791
GS
1661 }
1662 if( $lev == 1 ){
1663 $res .= pure_text( $$rstr );
54310121 1664 } else {
ac094485 1665 warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet;
54310121
PP
1666 }
1667 }
2a28b791
GS
1668 return $res;
1669}
54310121 1670
2a28b791
GS
1671#
1672# go_ahead: extract text of an IS (can be nested)
1673#
c68ea5d1
GS
1674sub go_ahead($$$){
1675 my( $rstr, $func, $closing ) = @_;
2a28b791 1676 my $res = '';
c68ea5d1
GS
1677 my @closing = ($closing);
1678 while( $$rstr =~
1679 s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|@{[pattern $closing[0]]})//s ){
2a28b791 1680 $res .= $1;
c68ea5d1
GS
1681 unless( $3 ){
1682 shift @closing;
1683 return $res unless @closing;
2a28b791 1684 } else {
c68ea5d1 1685 unshift @closing, closing $4;
2a28b791
GS
1686 }
1687 $res .= $2;
1688 }
ac094485 1689 warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph.\n" unless $Quiet;
2a28b791 1690 return $res;
54310121
PP
1691}
1692
1693#
2a28b791
GS
1694# emit_C - output result of C<text>
1695# $text is the depod-ed text
54310121 1696#
02369fa5
GS
1697sub emit_C($;$$){
1698 my( $text, $nocode, $args ) = @_;
60a48b2d 1699 $args = '' unless defined $args;
2a28b791
GS
1700 my $res;
1701 my( $url, $fid ) = coderef( undef(), $text );
1702
1703 # need HTML-safe text
02369fa5 1704 my $linktext = html_escape( "$text$args" );
2a28b791
GS
1705
1706 if( defined( $url ) &&
1707 (!defined( $EmittedItem ) || $EmittedItem ne $fid ) ){
59ecbafa 1708 $res = "<a href=\"$url\"><code>$linktext</code></a>";
2a28b791
GS
1709 } elsif( 0 && $nocode ){
1710 $res = $linktext;
1711 } else {
59ecbafa 1712 $res = "<code>$linktext</code>";
2a28b791
GS
1713 }
1714 return $res;
54310121
PP
1715}
1716
1717#
2a28b791
GS
1718# html_escape: make text safe for HTML
1719#
1720sub html_escape {
1721 my $rest = $_[0];
1722 $rest =~ s/&/&amp;/g;
1723 $rest =~ s/</&lt;/g;
1724 $rest =~ s/>/&gt;/g;
1725 $rest =~ s/"/&quot;/g;
5b25816d
RS
1726 # &apos; is only in XHTML, not HTML4. Be conservative
1727 #$rest =~ s/'/&apos;/g;
2a28b791 1728 return $rest;
59ecbafa 1729}
2a28b791
GS
1730
1731
1732#
39e571d4
ML
1733# dosify - convert filenames to 8.3
1734#
1735sub dosify {
1736 my($str) = @_;
fe4c6be1 1737 return lc($str) if $^O eq 'VMS'; # VMS just needs casing
39e571d4
ML
1738 if ($Is83) {
1739 $str = lc $str;
1740 $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
1741 $str =~ s/(\w+)/substr ($1,0,8)/ge;
1742 }
1743 return $str;
1744}
1745
1746#
d1be9408 1747# page_sect - make a URL from the text of a L<>
54310121 1748#
2a28b791
GS
1749sub page_sect($$) {
1750 my( $page, $section ) = @_;
1751 my( $linktext, $page83, $link); # work strings
1752
1753 # check if we know that this is a section in this page
69348ecf 1754 if (!defined $Pages{$page} && defined $Sections{$page}) {
2a28b791
GS
1755 $section = $page;
1756 $page = "";
1757 ### print STDERR "reset page='', section=$section\n";
54310121
PP
1758 }
1759
39e571d4 1760 $page83=dosify($page);
69348ecf 1761 $page=$page83 if (defined $Pages{$page83});
54310121 1762 if ($page eq "") {
0d396dd4 1763 $link = "#" . anchorify( $section );
350ccacd 1764 } elsif ( $page =~ /::/ ) {
350ccacd 1765 $page =~ s,::,/,g;
29f227c9
BS
1766 # Search page cache for an entry keyed under the html page name,
1767 # then look to see what directory that page might be in. NOTE:
1768 # this will only find one page. A better solution might be to produce
1769 # an intermediate page that is an index to all such pages.
1770 my $page_name = $page ;
fe6f1558 1771 $page_name =~ s,^.*/,,s ;
69348ecf
MS
1772 if ( defined( $Pages{ $page_name } ) &&
1773 $Pages{ $page_name } =~ /([^:]*$page)\.(?:pod|pm):/
29f227c9
BS
1774 ) {
1775 $page = $1 ;
1776 }
1777 else {
1778 # NOTE: This branch assumes that all A::B pages are located in
69348ecf
MS
1779 # $Htmlroot/A/B.html . This is often incorrect, since they are
1780 # often in $Htmlroot/lib/A/B.html or such like. Perhaps we could
1781 # analyze the contents of %Pages and figure out where any
29f227c9
BS
1782 # cousins of A::B are, then assume that. So, if A::B isn't found,
1783 # but A::C is found in lib/A/C.pm, then A::B is assumed to be in
1784 # lib/A/B.pm. This is also limited, but it's an improvement.
1785 # Maybe a hints file so that the links point to the correct places
2a28b791
GS
1786 # nonetheless?
1787
29f227c9 1788 }
69348ecf 1789 $link = "$Htmlroot/$page.html";
0d396dd4 1790 $link .= "#" . anchorify( $section ) if ($section);
69348ecf 1791 } elsif (!defined $Pages{$page}) {
54310121 1792 $link = "";
54310121 1793 } else {
0d396dd4 1794 $section = anchorify( $section ) if $section ne "";
2a28b791 1795 ### print STDERR "...section=$section\n";
54310121
PP
1796
1797 # if there is a directory by the name of the page, then assume that an
1798 # appropriate section will exist in the subdirectory
69348ecf
MS
1799# if ($section ne "" && $Pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
1800 if ($section ne "" && $Pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
1801 $link = "$Htmlroot/$1/$section.html";
2a28b791 1802 ### print STDERR "...link=$link\n";
54310121
PP
1803
1804 # since there is no directory by the name of the page, the section will
1805 # have to exist within a .html of the same name. thus, make sure there
1806 # is a .pod or .pm that might become that .html
1807 } else {
2a28b791
GS
1808 $section = "#$section" if $section;
1809 ### print STDERR "...section=$section\n";
1810
54310121 1811 # check if there is a .pod with the page name
69348ecf
MS
1812 if ($Pages{$page} =~ /([^:]*)\.pod:/) {
1813 $link = "$Htmlroot/$1.html$section";
1814 } elsif ($Pages{$page} =~ /([^:]*)\.pm:/) {
1815 $link = "$Htmlroot/$1.html$section";
54310121 1816 } else {
54310121 1817 $link = "";
54310121
PP
1818 }
1819 }
1820 }
1821
54310121 1822 if ($link) {
69348ecf
MS
1823 # Here, we take advantage of the knowledge that $Htmlfileurl ne ''
1824 # implies $Htmlroot eq ''. This means that the link in question
1825 # needs a prefix of $Htmldir if it begins with '/'. The test for
29f227c9
BS
1826 # the initial '/' is done to avoid '#'-only links, and to allow
1827 # for other kinds of links, like file:, ftp:, etc.
1828 my $url ;
69348ecf
MS
1829 if ( $Htmlfileurl ne '' ) {
1830 $link = "$Htmldir$link" if $link =~ m{^/}s;
1831 $url = relativize_url( $link, $Htmlfileurl );
1832# print( " b: [$link,$Htmlfileurl,$url]\n" );
29f227c9
BS
1833 }
1834 else {
1835 $url = $link ;
1836 }
2a28b791 1837 return $url;
29f227c9 1838
54310121 1839 } else {
2a28b791 1840 return undef();
54310121 1841 }
54310121
PP
1842}
1843
1844#
29f227c9
BS
1845# relativize_url - convert an absolute URL to one relative to a base URL.
1846# Assumes both end in a filename.
1847#
1848sub relativize_url {
1849 my ($dest,$source) = @_ ;
1850
59ecbafa 1851 my ($dest_volume,$dest_directory,$dest_file) =
29f227c9
BS
1852 File::Spec::Unix->splitpath( $dest ) ;
1853 $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ) ;
1854
59ecbafa 1855 my ($source_volume,$source_directory,$source_file) =
29f227c9
BS
1856 File::Spec::Unix->splitpath( $source ) ;
1857 $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ) ;
1858
1859 my $rel_path = '' ;
1860 if ( $dest ne '' ) {
1861 $rel_path = File::Spec::Unix->abs2rel( $dest, $source ) ;
1862 }
1863
59ecbafa 1864 if ( $rel_path ne '' &&
29f227c9 1865 substr( $rel_path, -1 ) ne '/' &&
59ecbafa 1866 substr( $dest_file, 0, 1 ) ne '#'
29f227c9
BS
1867 ) {
1868 $rel_path .= "/$dest_file" ;
1869 }
1870 else {
1871 $rel_path .= "$dest_file" ;
1872 }
1873
1874 return $rel_path ;
1875}
1876
54310121
PP
1877
1878#
2a28b791 1879# coderef - make URL from the text of a C<>
54310121 1880#
2a28b791
GS
1881sub coderef($$){
1882 my( $page, $item ) = @_;
1883 my( $url );
1884
1885 my $fid = fragment_id( $item );
6e38a594 1886 if( defined( $page ) && $page ne "" ){
2a28b791
GS
1887 # we have been given a $page...
1888 $page =~ s{::}{/}g;
1889
1890 # Do we take it? Item could be a section!
69348ecf 1891 my $base = $Items{$fid} || "";
2a28b791
GS
1892 $base =~ s{[^/]*/}{};
1893 if( $base ne "$page.html" ){
69348ecf 1894 ### print STDERR "coderef( $page, $item ): items{$fid} = $Items{$fid} = $base => discard page!\n";
2a28b791
GS
1895 $page = undef();
1896 }
54310121 1897
2a28b791
GS
1898 } else {
1899 # no page - local items precede cached items
67398a75 1900 if( defined( $fid ) ){
69348ecf
MS
1901 if( exists $Local_Items{$fid} ){
1902 $page = $Local_Items{$fid};
67398a75 1903 } else {
69348ecf 1904 $page = $Items{$fid};
67398a75 1905 }
2a28b791
GS
1906 }
1907 }
54310121
PP
1908
1909 # if there was a pod file that we found earlier with an appropriate
1910 # =item directive, then create a link to that page.
2a28b791
GS
1911 if( defined $page ){
1912 if( $page ){
69348ecf 1913 if( exists $Pages{$page} and $Pages{$page} =~ /([^:.]*)\.[^:]*:/){
2a28b791 1914 $page = $1 . '.html';
29f227c9 1915 }
69348ecf 1916 my $link = "$Htmlroot/$page#item_" . anchorify($fid);
54310121 1917
69348ecf
MS
1918 # Here, we take advantage of the knowledge that $Htmlfileurl
1919 # ne '' implies $Htmlroot eq ''.
1920 if ( $Htmlfileurl ne '' ) {
1921 $link = "$Htmldir$link" ;
1922 $url = relativize_url( $link, $Htmlfileurl ) ;
2a28b791
GS
1923 } else {
1924 $url = $link ;
1925 }
1926 } else {
2beb85b7 1927 $url = "#item_" . anchorify($fid);
2a28b791 1928 }
54310121 1929
2a28b791 1930 confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/;
59ecbafa 1931 }
2a28b791 1932 return( $url, $fid );
54310121
PP
1933}
1934
54310121
PP
1935
1936
1937#
29f227c9
BS
1938# Adapted from Nick Ing-Simmons' PodToHtml package.
1939sub relative_url {
1940 my $source_file = shift ;
1941 my $destination_file = shift;
1942
1943 my $source = URI::file->new_abs($source_file);
1944 my $uo = URI::file->new($destination_file,$source)->abs;
1945 return $uo->rel->as_string;
1946}
1947
1948
1949#
54310121
PP
1950# finish_list - finish off any pending HTML lists. this should be called
1951# after the entire pod file has been read and converted.
1952#
1953sub finish_list {
69348ecf 1954 while ($Listlevel > 0) {
59ecbafa 1955 print HTML "</dl>\n";
69348ecf 1956 $Listlevel--;
54310121
PP
1957 }
1958}
1959
1960#
1961# htmlify - converts a pod section specification to a suitable section
2a28b791
GS
1962# specification for HTML. Note that we keep spaces and special characters
1963# except ", ? (Netscape problem) and the hyphen (writer's problem...).
54310121
PP
1964#
1965sub htmlify {
2a28b791
GS
1966 my( $heading) = @_;
1967 $heading =~ s/(\s+)/ /g;
1968 $heading =~ s/\s+\Z//;
1969 $heading =~ s/\A\s+//;
1970 # The hyphen is a disgrace to the English language.
1971 $heading =~ s/[-"?]//g;
1972 $heading = lc( $heading );
1973 return $heading;
1974}
54310121 1975
2a28b791 1976#
776d31fe 1977# similar to htmlify, but turns non-alphanumerics into underscores
0d396dd4
SB
1978#
1979sub anchorify {
1980 my ($anchor) = @_;
1981 $anchor = htmlify($anchor);
776d31fe 1982 $anchor =~ s/\W/_/g;
0d396dd4
SB
1983 return $anchor;
1984}
1985
1986#
2a28b791
GS
1987# depod - convert text by eliminating all interior sequences
1988# Note: can be called with copy or modify semantics
1989#
1990my %E2c;
67398a75
GS
1991$E2c{lt} = '<';
1992$E2c{gt} = '>';
1993$E2c{sol} = '/';
2a28b791 1994$E2c{verbar} = '|';
67398a75 1995$E2c{amp} = '&'; # in Tk's pods
2a28b791 1996
c68ea5d1 1997sub depod1($;$$);
7ba65c74 1998
2a28b791
GS
1999sub depod($){
2000 my $string;
2001 if( ref( $_[0] ) ){
2002 $string = ${$_[0]};
2003 ${$_[0]} = depod1( \$string );
2004 } else {
2005 $string = $_[0];
2006 depod1( \$string );
59ecbafa 2007 }
2a28b791 2008}
54310121 2009
c68ea5d1
GS
2010sub depod1($;$$){
2011 my( $rstr, $func, $closing ) = @_;
2a28b791 2012 my $res = '';
228a48a5 2013 return $res unless defined $$rstr;
2a28b791
GS
2014 if( ! defined( $func ) ){
2015 # skip to next begin of an interior sequence
c68ea5d1 2016 while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?// ){
2a28b791 2017 # recurse into its text
c68ea5d1 2018 $res .= $1 . depod1( $rstr, $2, closing $3);
2a28b791
GS
2019 }
2020 $res .= $$rstr;
2021 } elsif( $func eq 'E' ){
2022 # E<x> - convert to character
be3174d2 2023 $$rstr =~ s/^([^>]*)>//;
228a48a5 2024 $res .= $E2c{$1} || "";
2a28b791
GS
2025 } elsif( $func eq 'X' ){
2026 # X<> - ignore
2027 $$rstr =~ s/^[^>]*>//;
2028 } elsif( $func eq 'Z' ){
59ecbafa 2029 # Z<> - empty
2a28b791
GS
2030 $$rstr =~ s/^>//;
2031 } else {
2032 # all others: either recurse into new function or
2033 # terminate at closing angle bracket
c68ea5d1
GS
2034 my $term = pattern $closing;
2035 while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)// ){
2a28b791 2036 $res .= $1;
c68ea5d1
GS
2037 last unless $3;
2038 $res .= depod1( $rstr, $3, closing $4 );
2a28b791
GS
2039 }
2040 ## If we're here and $2 ne '>': undelimited interior sequence.
2041 ## Ignored, as this is called without proper indication of where we are.
2042 ## Rely on process_text to produce diagnostics.
2043 }
2044 return $res;
2045}
54310121 2046
2a28b791
GS
2047#
2048# fragment_id - construct a fragment identifier from:
2049# a) =item text
2050# b) contents of C<...>
2051#
69348ecf 2052my @HC;
2a28b791
GS
2053sub fragment_id {
2054 my $text = shift();
2055 $text =~ s/\s+\Z//s;
2056 if( $text ){
2057 # a method or function?
2058 return $1 if $text =~ /(\w+)\s*\(/;
2059 return $1 if $text =~ /->\s*(\w+)\s*\(?/;
2060
2061 # a variable name?
2062 return $1 if $text =~ /^([$@%*]\S+)/;
2063
2064 # some pattern matching operator?
2065 return $1 if $text =~ m|^(\w+/).*/\w*$|;
2066
2067 # fancy stuff... like "do { }"
2068 return $1 if $text =~ m|^(\w+)\s*{.*}$|;
2069
2070 # honour the perlfunc manpage: func [PAR[,[ ]PAR]...]
2071 # and some funnies with ... Module ...
ac094485 2072 return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z\d,/& ]+)?$};
2a28b791
GS
2073 return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$};
2074
2075 # text? normalize!
2076 $text =~ s/\s+/_/sg;
2077 $text =~ s{(\W)}{
69348ecf
MS
2078 defined( $HC[ord($1)] ) ? $HC[ord($1)]
2079 : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
2a28b791
GS
2080 $text = substr( $text, 0, 50 );
2081 } else {
2082 return undef();
2083 }
54310121
PP
2084}
2085
2a28b791
GS
2086#
2087# make_URL_href - generate HTML href from URL
2088# Special treatment for CGI queries.
2089#
2090sub make_URL_href($){
2091 my( $url ) = @_;
59ecbafa
VS
2092 if( $url !~
2093 s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i ){
2094 $url = "<a href=\"$url\">$url</a>";
2a28b791
GS
2095 }
2096 return $url;
54310121
PP
2097}
2098
20991;