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