This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #45823] [PATCH] v5.8.8. pod2html: <a name="example"> anchor, but <a href="item_...
[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);
5d05e460 6$VERSION = 1.08;
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
69348ecf
MS
234my($Cachedir);
235my($Dircache, $Itemcache);
236my @Begin_Stack;
237my @Libpods;
238my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl);
239my($Podfile, @Podpath, $Podroot);
240my $Css;
54310121 241
69348ecf
MS
242my $Recurse;
243my $Quiet;
99a6169d 244my $HiddenDirs;
69348ecf
MS
245my $Verbose;
246my $Doindex;
54310121 247
69348ecf
MS
248my $Backlink;
249my($Listlevel, @Listend);
250my $After_Lpar;
251use vars qw($Ignore); # need to localize it later.
99cb6bd8 252
69348ecf
MS
253my(%Items_Named, @Items_Seen);
254my($Title, $Header);
99cb6bd8 255
69348ecf
MS
256my $Top;
257my $Paragraph;
99cb6bd8 258
69348ecf 259my %Sections;
99cb6bd8
MS
260
261# Caches
69348ecf 262my %Pages = (); # associative array used to find the location
54310121 263 # of pages referenced by L<> links.
69348ecf 264my %Items = (); # associative array used to find the location
54310121 265 # of =item directives referenced by C<> links
99cb6bd8 266
69348ecf 267my %Local_Items;
99cb6bd8 268my $Is83;
99cb6bd8
MS
269
270my $Curdir = File::Spec->curdir;
271
272init_globals();
39e571d4 273
54310121 274sub init_globals {
69348ecf 275 $Cachedir = "."; # The directory to which item and directory
99cb6bd8
MS
276 # caches will be written.
277
69348ecf
MS
278 $Dircache = "pod2htmd.tmp";
279 $Itemcache = "pod2htmi.tmp";
54310121 280
69348ecf 281 @Begin_Stack = (); # begin/end stack
54310121 282
69348ecf
MS
283 @Libpods = (); # files to search for links from C<> directives
284 $Htmlroot = "/"; # http-server base directory from which all
54310121 285 # relative paths in $podpath stem.
69348ecf 286 $Htmldir = ""; # The directory to which the html pages
67398a75 287 # will (eventually) be written.
69348ecf
MS
288 $Htmlfile = ""; # write to stdout by default
289 $Htmlfileurl = "" ; # The url that other files would use to
99cb6bd8
MS
290 # refer to this file. This is only used
291 # to make relative urls that point to
292 # other files.
293
69348ecf
MS
294 $Podfile = ""; # read from stdin by default
295 @Podpath = (); # list of directories containing library pods.
296 $Podroot = $Curdir; # filesystem base directory from which all
54310121 297 # relative paths in $podpath stem.
69348ecf
MS
298 $Css = ''; # Cascading style sheet
299 $Recurse = 1; # recurse on subdirectories in $podpath.
300 $Quiet = 0; # not quiet by default
301 $Verbose = 0; # not verbose by default
302 $Doindex = 1; # non-zero if we should generate an index
303 $Backlink = ''; # text for "back to top" links
304 $Listlevel = 0; # current list depth
305 @Listend = (); # the text to use to end the list.
306 $After_Lpar = 0; # set to true after a par in an =item
307 $Ignore = 1; # whether or not to format text. we don't
54310121
PP
308 # format text until we hit our first pod
309 # directive.
310
69348ecf
MS
311 @Items_Seen = (); # for multiples of the same item in perlfunc
312 %Items_Named = ();
313 $Header = 0; # produce block header/footer
314 $Title = ''; # title to give the pod(s)
315 $Top = 1; # true if we are at the top of the doc. used
59ecbafa 316 # to prevent the first <hr /> directive.
69348ecf 317 $Paragraph = ''; # which paragraph we're processing (used
54310121 318 # for error messages)
69348ecf 319 %Sections = (); # sections within this page
3e3baf6d 320
69348ecf 321 %Local_Items = ();
99cb6bd8 322 $Is83 = $^O eq 'dos'; # Is it an 8.3 filesystem?
54310121
PP
323}
324
2a28b791
GS
325#
326# clean_data: global clean-up of pod data
327#
328sub clean_data($){
329 my( $dataref ) = @_;
bf202ccd 330 for my $i ( 0..$#{$dataref} ) {
2a28b791
GS
331 ${$dataref}[$i] =~ s/\s+\Z//;
332
333 # have a look for all-space lines
4135c0a0 334 if( ${$dataref}[$i] =~ /^\s+$/m and $dataref->[$i] !~ /^\s/ ){
2a28b791
GS
335 my @chunks = split( /^\s+$/m, ${$dataref}[$i] );
336 splice( @$dataref, $i, 1, @chunks );
337 }
338 }
339}
340
341
54310121
PP
342sub pod2html {
343 local(@ARGV) = @_;
344 local($/);
345 local $_;
346
347 init_globals();
348
39e571d4
ML
349 $Is83 = 0 if (defined (&Dos::UseLFN) && Dos::UseLFN());
350
69348ecf 351 # cache of %Pages and %Items from last time we ran pod2html
54310121
PP
352
353 #undef $opt_help if defined $opt_help;
354
355 # parse the command-line parameters
356 parse_command_line();
357
59ecbafa 358 # escape the backlink argument (same goes for title but is done later...)
69348ecf 359 $Backlink = html_escape($Backlink) if defined $Backlink;
59ecbafa 360
54310121
PP
361 # set some variables to their default values if necessary
362 local *POD;
59ecbafa 363 unless (@ARGV && $ARGV[0]) {
69348ecf
MS
364 $Podfile = "-" unless $Podfile; # stdin
365 open(POD, "<$Podfile")
366 || die "$0: cannot open $Podfile file for input: $!\n";
54310121 367 } else {
69348ecf 368 $Podfile = $ARGV[0]; # XXX: might be more filenames
54310121 369 *POD = *ARGV;
59ecbafa 370 }
69348ecf
MS
371 $Htmlfile = "-" unless $Htmlfile; # stdout
372 $Htmlroot = "" if $Htmlroot eq "/"; # so we don't get a //
373 $Htmldir =~ s#/\z## ; # so we don't get a //
374 if ( $Htmlroot eq ''
375 && defined( $Htmldir )
376 && $Htmldir ne ''
377 && substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir
59ecbafa 378 )
5a039dd3 379 {
29f227c9 380 # Set the 'base' url for this file, so that we can use it
59ecbafa 381 # as the location from which to calculate relative links
29f227c9
BS
382 # to other files. If this is '', then absolute links will
383 # be used throughout.
69348ecf 384 $Htmlfileurl= "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1);
5a039dd3 385 }
54310121
PP
386
387 # read the pod a paragraph at a time
69348ecf 388 warn "Scanning for sections in input file(s)\n" if $Verbose;
54310121
PP
389 $/ = "";
390 my @poddata = <POD>;
391 close(POD);
bbed45f6
JH
392
393 # be eol agnostic
394 for (@poddata) {
5551e547
JH
395 if (/\r/) {
396 if (/\r\n/) {
397 @poddata = map { s/\r\n/\n/g;
bbed45f6
JH
398 /\n\n/ ?
399 map { "$_\n\n" } split /\n\n/ :
400 $_ } @poddata;
401 } else {
5551e547 402 @poddata = map { s/\r/\n/g;
bbed45f6
JH
403 /\n\n/ ?
404 map { "$_\n\n" } split /\n\n/ :
405 $_ } @poddata;
406 }
407 last;
408 }
409 }
410
2a28b791 411 clean_data( \@poddata );
54310121
PP
412
413 # scan the pod for =head[1-6] directives and build an index
69348ecf 414 my $index = scan_headings(\%Sections, @poddata);
54310121 415
3e3baf6d 416 unless($index) {
69348ecf 417 warn "No headings in $Podfile\n" if $Verbose;
3e3baf6d
TB
418 }
419
54310121 420 # open the output file
69348ecf
MS
421 open(HTML, ">$Htmlfile")
422 || die "$0: cannot open $Htmlfile file for output: $!\n";
54310121 423
d011ffae 424 # put a title in the HTML file if one wasn't specified
69348ecf 425 if ($Title eq '') {
d011ffae 426 TITLE_SEARCH: {
59ecbafa 427 for (my $i = 0; $i < @poddata; $i++) {
d011ffae 428 if ($poddata[$i] =~ /^=head1\s*NAME\b/m) {
59ecbafa 429 for my $para ( @poddata[$i, $i+1] ) {
d011ffae 430 last TITLE_SEARCH
69348ecf 431 if ($Title) = $para =~ /(\S+\s+-+.*\S)/s;
d011ffae 432 }
59ecbafa 433 }
54310121 434
59ecbafa 435 }
d011ffae
GS
436 }
437 }
69348ecf 438 if (!$Title and $Podfile =~ /\.pod\z/) {
3e3baf6d 439 # probably a split pod so take first =head[12] as title
59ecbafa 440 for (my $i = 0; $i < @poddata; $i++) {
69348ecf 441 last if ($Title) = $poddata[$i] =~ /^=head[12]\s*(.*)/;
59ecbafa 442 }
69348ecf
MS
443 warn "adopted '$Title' as title for $Podfile\n"
444 if $Verbose and $Title;
59ecbafa 445 }
69348ecf
MS
446 if ($Title) {
447 $Title =~ s/\s*\(.*\)//;
7b8d334a 448 } else {
69348ecf
MS
449 warn "$0: no title for $Podfile.\n" unless $Quiet;
450 $Podfile =~ /^(.*)(\.[^.\/]+)?\z/s;
451 $Title = ($Podfile eq "-" ? 'No Title' : $1);
452 warn "using $Title" if $Verbose;
54310121 453 }
69348ecf 454 $Title = html_escape($Title);
59ecbafa
VS
455
456 my $csslink = '';
457 my $bodystyle = ' style="background-color: white"';
458 my $tdstyle = ' style="background-color: #cccccc"';
459
69348ecf
MS
460 if ($Css) {
461 $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />);
59ecbafa
VS
462 $csslink =~ s,\\,/,g;
463 $csslink =~ s,(/.):,$1|,;
464 $bodystyle = '';
465 $tdstyle = '';
466 }
467
69348ecf 468 my $block = $Header ? <<END_OF_BLOCK : '';
59ecbafa
VS
469<table border="0" width="100%" cellspacing="0" cellpadding="3">
470<tr><td class="block"$tdstyle valign="middle">
69348ecf 471<big><strong><span class="block">&nbsp;$Title</span></strong></big>
59ecbafa
VS
472</td></tr>
473</table>
34db337b
JD
474END_OF_BLOCK
475
54310121 476 print HTML <<END_OF_HEAD;
ae021980 477<?xml version="1.0" ?>
59ecbafa
VS
478<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
479<html xmlns="http://www.w3.org/1999/xhtml">
8d481ee5 480<head>
69348ecf 481<title>$Title</title>$csslink
ae021980 482<meta http-equiv="content-type" content="text/html; charset=utf-8" />
59ecbafa
VS
483<link rev="made" href="mailto:$Config{perladmin}" />
484</head>
485
486<body$bodystyle>
34db337b 487$block
54310121
PP
488END_OF_HEAD
489
69348ecf
MS
490 # load/reload/validate/cache %Pages and %Items
491 get_cache($Dircache, $Itemcache, \@Podpath, $Podroot, $Recurse);
54310121
PP
492
493 # scan the pod for =item directives
69348ecf 494 scan_items( \%Local_Items, "", @poddata);
54310121 495
69348ecf 496 # put an index at the top of the file. note, if $Doindex is 0 we
54310121
PP
497 # still generate an index, but surround it with an html comment.
498 # that way some other program can extract it if desired.
499 $index =~ s/--+/-/g;
25ff0154
JA
500
501 my $hr = ($Doindex and $index) ? qq(<hr name="index" />) : "";
502
503 unless ($Doindex)
504 {
505 $index = qq(<!--\n$index\n-->\n);
506 }
507
508 print HTML << "END_OF_INDEX";
509
510<!-- INDEX BEGIN -->
511<div name="index">
512<p><a name=\"__index__\"></a></p>
513$index
514$hr
515</div>
516<!-- INDEX END -->
517
518END_OF_INDEX
54310121
PP
519
520 # now convert this file
2a28b791 521 my $after_item; # set to true after an =item
59ecbafa 522 my $need_dd = 0;
69348ecf 523 warn "Converting input file $Podfile\n" if $Verbose;
2a28b791 524 foreach my $i (0..$#poddata){
54310121 525 $_ = $poddata[$i];
69348ecf 526 $Paragraph = $i+1;
54310121 527 if (/^(=.*)/s) { # is it a pod directive?
69348ecf 528 $Ignore = 0;
2a28b791 529 $after_item = 0;
59ecbafa 530 $need_dd = 0;
54310121
PP
531 $_ = $1;
532 if (/^=begin\s+(\S+)\s*(.*)/si) {# =begin
533 process_begin($1, $2);
534 } elsif (/^=end\s+(\S+)\s*(.*)/si) {# =end
535 process_end($1, $2);
536 } elsif (/^=cut/) { # =cut
537 process_cut();
538 } elsif (/^=pod/) { # =pod
539 process_pod();
540 } else {
69348ecf 541 next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
54310121 542
7b8d334a 543 if (/^=(head[1-6])\s+(.*\S)/s) { # =head[1-6] heading
69348ecf 544 process_head( $1, $2, $Doindex && $index );
2a28b791 545 } elsif (/^=item\s*(.*\S)?/sm) { # =item text
59ecbafa 546 $need_dd = process_item( $1 );
2a28b791 547 $after_item = 1;
54310121
PP
548 } elsif (/^=over\s*(.*)/) { # =over N
549 process_over();
550 } elsif (/^=back/) { # =back
945ffa4f 551 process_back($need_dd);
a45bd81d 552 } elsif (/^=for\s+(\S+)\s*(.*)/si) {# =for
54310121
PP
553 process_for($1,$2);
554 } else {
555 /^=(\S*)\s*/;
69348ecf 556 warn "$0: $Podfile: unknown pod directive '$1' in "
ac094485 557 . "paragraph $Paragraph. ignoring.\n" unless $Quiet;
54310121
PP
558 }
559 }
69348ecf 560 $Top = 0;
54310121
PP
561 }
562 else {
69348ecf
MS
563 next if $Ignore;
564 next if @Begin_Stack && $Begin_Stack[-1] ne 'html';
565 print HTML and next if @Begin_Stack && $Begin_Stack[-1] eq 'html';
59ecbafa 566 print HTML "<dd>\n" if $need_dd;
54310121 567 my $text = $_;
2a28b791
GS
568 if( $text =~ /\A\s+/ ){
569 process_pre( \$text );
59ecbafa 570 print HTML "<pre>\n$text</pre>\n";
2a28b791
GS
571
572 } else {
573 process_text( \$text );
574
575 # experimental: check for a paragraph where all lines
576 # have some ...\t...\t...\n pattern
577 if( $text =~ /\t/ ){
578 my @lines = split( "\n", $text );
579 if( @lines > 1 ){
580 my $all = 2;
581 foreach my $line ( @lines ){
582 if( $line =~ /\S/ && $line !~ /\t/ ){
583 $all--;
584 last if $all == 0;
585 }
586 }
587 if( $all > 0 ){
59ecbafa
VS
588 $text =~ s/\t+/<td>/g;
589 $text =~ s/^/<tr><td>/gm;
590 $text = '<table cellspacing="0" cellpadding="0">' .
591 $text . '</table>';
2a28b791
GS
592 }
593 }
594 }
595 ## end of experimental
596
597 if( $after_item ){
69348ecf 598 $After_Lpar = 1;
2a28b791 599 }
945ffa4f 600 print HTML "<p>$text</p>\n";
2a28b791 601 }
59ecbafa 602 print HTML "</dd>\n" if $need_dd;
2a28b791 603 $after_item = 0;
54310121
PP
604 }
605 }
606
607 # finish off any pending directives
608 finish_list();
2a28b791
GS
609
610 # link to page index
69348ecf
MS
611 print HTML "<p><a href=\"#__index__\"><small>$Backlink</small></a></p>\n"
612 if $Doindex and $index and $Backlink;
2a28b791 613
54310121 614 print HTML <<END_OF_TAIL;
34db337b 615$block
59ecbafa 616</body>
54310121 617
59ecbafa 618</html>
54310121
PP
619END_OF_TAIL
620
621 # close the html file
622 close(HTML);
623
69348ecf 624 warn "Finished\n" if $Verbose;
54310121
PP
625}
626
627##############################################################################
628
54310121
PP
629sub usage {
630 my $podfile = shift;
631 warn "$0: $podfile: @_\n" if @_;
69348ecf 632 die <<END_OF_USAGE;
54310121
PP
633Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
634 --podpath=<name>:...:<name> --podroot=<name>
635 --libpods=<name>:...:<name> --recurse --verbose --index
b42210d7 636 --netscape --norecurse --noindex --cachedir=<name>
54310121 637
0e4548d5 638 --backlink - set text for "back to top" links (default: none).
b42210d7 639 --cachedir - directory for the item and directory cache files.
0e4548d5
GS
640 --css - stylesheet URL
641 --flush - flushes the item and directory caches.
642 --[no]header - produce block header/footer (default is no headers).
643 --help - prints this message.
99a6169d 644 --hiddendirs - search hidden directories in podpath
0e4548d5
GS
645 --htmldir - directory for resulting HTML files.
646 --htmlroot - http-server base directory from which all relative paths
647 in podpath stem (default is /).
648 --[no]index - generate an index at the top of the resulting html
649 (default behaviour).
650 --infile - filename for the pod to convert (input taken from stdin
651 by default).
652 --libpods - colon-separated list of pages to search for =item pod
653 directives in as targets of C<> and implicit links (empty
654 by default). note, these are not filenames, but rather
655 page names like those that appear in L<> links.
0e4548d5
GS
656 --outfile - filename for the resulting html file (output sent to
657 stdout by default).
658 --podpath - colon-separated list of directories containing library
659 pods (empty by default).
660 --podroot - filesystem base directory from which all relative paths
661 in podpath stem (default is .).
3c4b39be 662 --[no]quiet - suppress some benign warning messages (default is off).
0e4548d5
GS
663 --[no]recurse - recurse on those subdirectories listed in podpath
664 (default behaviour).
665 --title - title that will appear in resulting html file.
666 --[no]verbose - self-explanatory (off by default).
59ecbafa 667 --[no]netscape - deprecated, has no effect. for backwards compatibility only.
54310121
PP
668
669END_OF_USAGE
670
69348ecf
MS
671}
672
54310121 673sub parse_command_line {
b42210d7
RV
674 my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,$opt_help,
675 $opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,$opt_libpods,
676 $opt_netscape,$opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet,
99a6169d 677 $opt_recurse,$opt_title,$opt_verbose,$opt_hiddendirs);
0e4548d5 678
34db337b 679 unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
54310121 680 my $result = GetOptions(
0e4548d5 681 'backlink=s' => \$opt_backlink,
b42210d7 682 'cachedir=s' => \$opt_cachedir,
0e4548d5 683 'css=s' => \$opt_css,
29f227c9 684 'flush' => \$opt_flush,
0e4548d5 685 'header!' => \$opt_header,
29f227c9 686 'help' => \$opt_help,
99a6169d 687 'hiddendirs!'=> \$opt_hiddendirs,
29f227c9 688 'htmldir=s' => \$opt_htmldir,
54310121 689 'htmlroot=s' => \$opt_htmlroot,
29f227c9 690 'index!' => \$opt_index,
54310121
PP
691 'infile=s' => \$opt_infile,
692 'libpods=s' => \$opt_libpods,
693 'netscape!' => \$opt_netscape,
694 'outfile=s' => \$opt_outfile,
695 'podpath=s' => \$opt_podpath,
696 'podroot=s' => \$opt_podroot,
0e4548d5 697 'quiet!' => \$opt_quiet,
54310121
PP
698 'recurse!' => \$opt_recurse,
699 'title=s' => \$opt_title,
0e4548d5 700 'verbose!' => \$opt_verbose,
54310121
PP
701 );
702 usage("-", "invalid parameters") if not $result;
703
704 usage("-") if defined $opt_help; # see if the user asked for help
705 $opt_help = ""; # just to make -w shut-up.
706
69348ecf
MS
707 @Podpath = split(":", $opt_podpath) if defined $opt_podpath;
708 @Libpods = split(":", $opt_libpods) if defined $opt_libpods;
709
710 $Backlink = $opt_backlink if defined $opt_backlink;
711 $Cachedir = $opt_cachedir if defined $opt_cachedir;
712 $Css = $opt_css if defined $opt_css;
713 $Header = $opt_header if defined $opt_header;
714 $Htmldir = $opt_htmldir if defined $opt_htmldir;
715 $Htmlroot = $opt_htmlroot if defined $opt_htmlroot;
716 $Doindex = $opt_index if defined $opt_index;
717 $Podfile = $opt_infile if defined $opt_infile;
99a6169d 718 $HiddenDirs = $opt_hiddendirs if defined $opt_hiddendirs;
69348ecf
MS
719 $Htmlfile = $opt_outfile if defined $opt_outfile;
720 $Podroot = $opt_podroot if defined $opt_podroot;
721 $Quiet = $opt_quiet if defined $opt_quiet;
722 $Recurse = $opt_recurse if defined $opt_recurse;
723 $Title = $opt_title if defined $opt_title;
724 $Verbose = $opt_verbose if defined $opt_verbose;
0e4548d5 725
54310121
PP
726 warn "Flushing item and directory caches\n"
727 if $opt_verbose && defined $opt_flush;
69348ecf
MS
728 $Dircache = "$Cachedir/pod2htmd.tmp";
729 $Itemcache = "$Cachedir/pod2htmi.tmp";
383e43c7 730 if (defined $opt_flush) {
69348ecf 731 1 while unlink($Dircache, $Itemcache);
383e43c7 732 }
54310121
PP
733}
734
3e3baf6d 735
69348ecf 736my $Saved_Cache_Key;
3e3baf6d
TB
737
738sub get_cache {
739 my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
740 my @cache_key_args = @_;
741
742 # A first-level cache:
743 # Don't bother reading the cache files if they still apply
744 # and haven't changed since we last read them.
745
746 my $this_cache_key = cache_key(@cache_key_args);
747
69348ecf 748 return if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key;
3e3baf6d 749
69348ecf 750 # load the cache of %Pages and %Items if possible. $tests will be
3e3baf6d
TB
751 # non-zero if successful.
752 my $tests = 0;
753 if (-f $dircache && -f $itemcache) {
69348ecf 754 warn "scanning for item cache\n" if $Verbose;
3e3baf6d
TB
755 $tests = load_cache($dircache, $itemcache, $podpath, $podroot);
756 }
757
758 # if we didn't succeed in loading the cache then we must (re)build
69348ecf 759 # %Pages and %Items.
3e3baf6d 760 if (!$tests) {
69348ecf 761 warn "scanning directories in pod-path\n" if $Verbose;
3e3baf6d
TB
762 scan_podpath($podroot, $recurse, 0);
763 }
69348ecf 764 $Saved_Cache_Key = cache_key(@cache_key_args);
3e3baf6d
TB
765}
766
767sub cache_key {
768 my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_;
769 return join('!', $dircache, $itemcache, $recurse,
29f227c9 770 @$podpath, $podroot, stat($dircache), stat($itemcache));
3e3baf6d
TB
771}
772
54310121 773#
3e3baf6d 774# load_cache - tries to find if the caches stored in $dircache and $itemcache
69348ecf 775# are valid caches of %Pages and %Items. if they are valid then it loads
54310121
PP
776# them and returns a non-zero value.
777#
3e3baf6d 778sub load_cache {
54310121
PP
779 my($dircache, $itemcache, $podpath, $podroot) = @_;
780 my($tests);
781 local $_;
782
783 $tests = 0;
784
785 open(CACHE, "<$itemcache") ||
786 die "$0: error opening $itemcache for reading: $!\n";
787 $/ = "\n";
788
789 # is it the same podpath?
790 $_ = <CACHE>;
791 chomp($_);
3e3baf6d 792 $tests++ if (join(":", @$podpath) eq $_);
54310121
PP
793
794 # is it the same podroot?
795 $_ = <CACHE>;
796 chomp($_);
797 $tests++ if ($podroot eq $_);
798
799 # load the cache if its good
800 if ($tests != 2) {
801 close(CACHE);
54310121
PP
802 return 0;
803 }
804
69348ecf 805 warn "loading item cache\n" if $Verbose;
54310121
PP
806 while (<CACHE>) {
807 /(.*?) (.*)$/;
69348ecf 808 $Items{$1} = $2;
54310121
PP
809 }
810 close(CACHE);
811
69348ecf 812 warn "scanning for directory cache\n" if $Verbose;
54310121
PP
813 open(CACHE, "<$dircache") ||
814 die "$0: error opening $dircache for reading: $!\n";
815 $/ = "\n";
816 $tests = 0;
817
818 # is it the same podpath?
819 $_ = <CACHE>;
820 chomp($_);
3e3baf6d 821 $tests++ if (join(":", @$podpath) eq $_);
54310121
PP
822
823 # is it the same podroot?
824 $_ = <CACHE>;
825 chomp($_);
826 $tests++ if ($podroot eq $_);
827
828 # load the cache if its good
829 if ($tests != 2) {
830 close(CACHE);
54310121
PP
831 return 0;
832 }
833
69348ecf 834 warn "loading directory cache\n" if $Verbose;
54310121
PP
835 while (<CACHE>) {
836 /(.*?) (.*)$/;
69348ecf 837 $Pages{$1} = $2;
54310121
PP
838 }
839
840 close(CACHE);
841
842 return 1;
843}
844
845#
846# scan_podpath - scans the directories specified in @podpath for directories,
847# .pod files, and .pm files. it also scans the pod files specified in
69348ecf 848# @Libpods for =item directives.
54310121
PP
849#
850sub scan_podpath {
3e3baf6d 851 my($podroot, $recurse, $append) = @_;
54310121
PP
852 my($pwd, $dir);
853 my($libpod, $dirname, $pod, @files, @poddata);
854
3e3baf6d 855 unless($append) {
69348ecf
MS
856 %Items = ();
857 %Pages = ();
3e3baf6d
TB
858 }
859
69348ecf 860 # scan each directory listed in @Podpath
54310121
PP
861 $pwd = getcwd();
862 chdir($podroot)
863 || die "$0: error changing to directory $podroot: $!\n";
69348ecf 864 foreach $dir (@Podpath) {
54310121
PP
865 scan_dir($dir, $recurse);
866 }
867
69348ecf
MS
868 # scan the pods listed in @Libpods for =item directives
869 foreach $libpod (@Libpods) {
54310121
PP
870 # if the page isn't defined then we won't know where to find it
871 # on the system.
69348ecf 872 next unless defined $Pages{$libpod} && $Pages{$libpod};
54310121
PP
873
874 # if there is a directory then use the .pod and .pm files within it.
29f227c9 875 # NOTE: Only finds the first so-named directory in the tree.
69348ecf
MS
876# if ($Pages{$libpod} =~ /([^:]*[^(\.pod|\.pm)]):/) {
877 if ($Pages{$libpod} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
54310121
PP
878 # find all the .pod and .pm files within the directory
879 $dirname = $1;
880 opendir(DIR, $dirname) ||
881 die "$0: error opening directory $dirname: $!\n";
fe6f1558 882 @files = grep(/(\.pod|\.pm)\z/ && ! -d $_, readdir(DIR));
54310121
PP
883 closedir(DIR);
884
885 # scan each .pod and .pm file for =item directives
886 foreach $pod (@files) {
887 open(POD, "<$dirname/$pod") ||
888 die "$0: error opening $dirname/$pod for input: $!\n";
889 @poddata = <POD>;
890 close(POD);
2a28b791 891 clean_data( \@poddata );
54310121 892
69348ecf 893 scan_items( \%Items, "$dirname/$pod", @poddata);
54310121
PP
894 }
895
896 # use the names of files as =item directives too.
2a28b791
GS
897### Don't think this should be done this way - confuses issues.(WL)
898### foreach $pod (@files) {
899### $pod =~ /^(.*)(\.pod|\.pm)$/;
69348ecf 900### $Items{$1} = "$dirname/$1.html" if $1;
2a28b791 901### }
69348ecf
MS
902 } elsif ($Pages{$libpod} =~ /([^:]*\.pod):/ ||
903 $Pages{$libpod} =~ /([^:]*\.pm):/) {
54310121
PP
904 # scan the .pod or .pm file for =item directives
905 $pod = $1;
906 open(POD, "<$pod") ||
907 die "$0: error opening $pod for input: $!\n";
908 @poddata = <POD>;
909 close(POD);
2a28b791 910 clean_data( \@poddata );
54310121 911
69348ecf 912 scan_items( \%Items, "$pod", @poddata);
54310121 913 } else {
ac094485 914 warn "$0: shouldn't be here (line ".__LINE__."\n" unless $Quiet;
54310121
PP
915 }
916 }
917 @poddata = (); # clean-up a bit
918
919 chdir($pwd)
920 || die "$0: error changing to directory $pwd: $!\n";
921
922 # cache the item list for later use
69348ecf
MS
923 warn "caching items for later use\n" if $Verbose;
924 open(CACHE, ">$Itemcache") ||
925 die "$0: error open $Itemcache for writing: $!\n";
54310121 926
69348ecf
MS
927 print CACHE join(":", @Podpath) . "\n$podroot\n";
928 foreach my $key (keys %Items) {
929 print CACHE "$key $Items{$key}\n";
54310121
PP
930 }
931
932 close(CACHE);
933
934 # cache the directory list for later use
69348ecf
MS
935 warn "caching directories for later use\n" if $Verbose;
936 open(CACHE, ">$Dircache") ||
937 die "$0: error open $Dircache for writing: $!\n";
54310121 938
69348ecf
MS
939 print CACHE join(":", @Podpath) . "\n$podroot\n";
940 foreach my $key (keys %Pages) {
941 print CACHE "$key $Pages{$key}\n";
54310121
PP
942 }
943
944 close(CACHE);
945}
946
947#
948# scan_dir - scans the directory specified in $dir for subdirectories, .pod
949# files, and .pm files. notes those that it finds. this information will
950# be used later in order to figure out where the pages specified in L<>
951# links are on the filesystem.
952#
953sub scan_dir {
954 my($dir, $recurse) = @_;
955 my($t, @subdirs, @pods, $pod, $dirname, @dirs);
956 local $_;
957
958 @subdirs = ();
959 @pods = ();
960
961 opendir(DIR, $dir) ||
962 die "$0: error opening directory $dir: $!\n";
963 while (defined($_ = readdir(DIR))) {
99a6169d
AJ
964 if (-d "$dir/$_" && $_ ne "." && $_ ne ".."
965 && ($HiddenDirs || !/^\./)
966 ) { # directory
69348ecf
MS
967 $Pages{$_} = "" unless defined $Pages{$_};
968 $Pages{$_} .= "$dir/$_:";
54310121 969 push(@subdirs, $_);
fe6f1558
GS
970 } elsif (/\.pod\z/) { # .pod
971 s/\.pod\z//;
69348ecf
MS
972 $Pages{$_} = "" unless defined $Pages{$_};
973 $Pages{$_} .= "$dir/$_.pod:";
54310121 974 push(@pods, "$dir/$_.pod");
d3f9d0fb
SB
975 } elsif (/\.html\z/) { # .html
976 s/\.html\z//;
69348ecf
MS
977 $Pages{$_} = "" unless defined $Pages{$_};
978 $Pages{$_} .= "$dir/$_.pod:";
fe6f1558
GS
979 } elsif (/\.pm\z/) { # .pm
980 s/\.pm\z//;
69348ecf
MS
981 $Pages{$_} = "" unless defined $Pages{$_};
982 $Pages{$_} .= "$dir/$_.pm:";
54310121 983 push(@pods, "$dir/$_.pm");
945ffa4f
EH
984 } elsif (-T "$dir/$_") { # script(?)
985 local *F;
986 if (open(F, "$dir/$_")) {
987 my $line;
988 while (defined($line = <F>)) {
989 if ($line =~ /^=(?:pod|head1)/) {
990 $Pages{$_} = "" unless defined $Pages{$_};
991 $Pages{$_} .= "$dir/$_.pod:";
992 last;
993 }
994 }
995 close(F);
996 }
54310121
PP
997 }
998 }
999 closedir(DIR);
1000
1001 # recurse on the subdirectories if necessary
1002 if ($recurse) {
1003 foreach my $subdir (@subdirs) {
1004 scan_dir("$dir/$subdir", $recurse);
1005 }
1006 }
1007}
1008
1009#
1010# scan_headings - scan a pod file for head[1-6] tags, note the tags, and
1011# build an index.
1012#
1013sub scan_headings {
1014 my($sections, @data) = @_;
2a28b791 1015 my($tag, $which_head, $otitle, $listdepth, $index);
54310121 1016
69348ecf 1017 local $Ignore = 0;
be173d55 1018
54310121
PP
1019 $listdepth = 0;
1020 $index = "";
1021
1022 # scan for =head directives, note their name, and build an index
1023 # pointing to each of them.
1024 foreach my $line (@data) {
59ecbafa
VS
1025 if ($line =~ /^=(head)([1-6])\s+(.*)/) {
1026 ($tag, $which_head, $otitle) = ($1,$2,$3);
2a28b791 1027
59ecbafa 1028 my $title = depod( $otitle );
2beb85b7 1029 my $name = anchorify( $title );
59ecbafa 1030 $$sections{$name} = 1;
59ecbafa 1031 $title = process_text( \$otitle );
54310121 1032
102c538a
DS
1033 while ($which_head != $listdepth) {
1034 if ($which_head > $listdepth) {
59ecbafa 1035 $index .= "\n" . ("\t" x $listdepth) . "<ul>\n";
102c538a
DS
1036 $listdepth++;
1037 } elsif ($which_head < $listdepth) {
1038 $listdepth--;
59ecbafa 1039 $index .= "\n" . ("\t" x $listdepth) . "</ul>\n";
102c538a 1040 }
54310121 1041 }
54310121 1042
59ecbafa
VS
1043 $index .= "\n" . ("\t" x $listdepth) . "<li>" .
1044 "<a href=\"#" . $name . "\">" .
1045 $title . "</a></li>";
54310121
PP
1046 }
1047 }
1048
1049 # finish off the lists
1050 while ($listdepth--) {
59ecbafa 1051 $index .= "\n" . ("\t" x $listdepth) . "</ul>\n";
54310121
PP
1052 }
1053
1054 # get rid of bogus lists
59ecbafa 1055 $index =~ s,\t*<ul>\s*</ul>\n,,g;
54310121
PP
1056
1057 return $index;
1058}
1059
1060#
1061# scan_items - scans the pod specified by $pod for =item directives. we
1062# will use this information later on in resolving C<> links.
1063#
1064sub scan_items {
2a28b791 1065 my( $itemref, $pod, @poddata ) = @_;
54310121
PP
1066 my($i, $item);
1067 local $_;
1068
fe6f1558 1069 $pod =~ s/\.pod\z//;
54310121
PP
1070 $pod .= ".html" if $pod;
1071
1072 foreach $i (0..$#poddata) {
2a28b791
GS
1073 my $txt = depod( $poddata[$i] );
1074
1075 # figure out what kind of item it is.
1076 # Build string for referencing this item.
1077 if ( $txt =~ /\A=item\s+\*\s*(.*)\Z/s ) { # bullet
1078 next unless $1;
1079 $item = $1;
1080 } elsif( $txt =~ /\A=item\s+(?>\d+\.?)\s*(.*)\Z/s ) { # numbered list
1081 $item = $1;
1082 } elsif( $txt =~ /\A=item\s+(.*)\Z/s ) { # plain item
1083 $item = $1;
1084 } else {
1085 next;
54310121 1086 }
2a28b791
GS
1087 my $fid = fragment_id( $item );
1088 $$itemref{$fid} = "$pod" if $fid;
54310121
PP
1089 }
1090}
1091
1092#
1093# process_head - convert a pod head[1-6] tag and convert it to HTML format.
1094#
1095sub process_head {
2a28b791 1096 my($tag, $heading, $hasindex) = @_;
54310121
PP
1097
1098 # figure out the level of the =head
1099 $tag =~ /head([1-6])/;
1100 my $level = $1;
1101
69348ecf 1102 if( $Listlevel ){
ac094485 1103 warn "$0: $Podfile: unterminated list at =head in paragraph $Paragraph. ignoring.\n" unless $Quiet;
69348ecf 1104 while( $Listlevel ){
2a28b791
GS
1105 process_back();
1106 }
1107 }
1108
59ecbafa 1109 print HTML "<p>\n";
69348ecf
MS
1110 if( $level == 1 && ! $Top ){
1111 print HTML "<a href=\"#__index__\"><small>$Backlink</small></a>\n"
1112 if $hasindex and $Backlink;
59ecbafa
VS
1113 print HTML "</p>\n<hr />\n"
1114 } else {
1115 print HTML "</p>\n";
2a28b791
GS
1116 }
1117
0d396dd4 1118 my $name = anchorify( depod( $heading ) );
2a28b791 1119 my $convert = process_text( \$heading );
59ecbafa 1120 print HTML "<h$level><a name=\"$name\">$convert</a></h$level>\n";
54310121
PP
1121}
1122
2a28b791 1123
54310121 1124#
2a28b791
GS
1125# emit_item_tag - print an =item's text
1126# Note: The global $EmittedItem is used for inhibiting self-references.
54310121 1127#
2a28b791
GS
1128my $EmittedItem;
1129
1130sub emit_item_tag($$$){
1131 my( $otext, $text, $compact ) = @_;
e1b7525f
YO
1132 my $item = fragment_id( depod($text) , -generate);
1133 Carp::confess("Undefined fragment '$text' (".depod($text).") from fragment_id() in emit_item_tag() in $Podfile")
1134 if !defined $item;
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 {
bc75160c 1142 my $name = $item;
0d396dd4 1143 $name = anchorify($name);
bc75160c 1144 print HTML qq{<a name="$name" class="item">}, 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 1189 $emitted = emit_li( 'ul' );
e1b7525f 1190 if ($text =~ /\A\*\s+(\S.*)\Z/s ) { # with additional text
59ecbafa
VS
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 1197 $emitted = emit_li( 'ol' );
e1b7525f 1198 if ($text =~ /\A(?>\d+\.?)\s*(\S.*)\Z/s ) { # with additional text
59ecbafa
VS
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);
e1b7525f
YO
1304 if (!defined $Begin_Stack[-1] or $Begin_Stack[-1] ne $whom ) {
1305 Carp::confess("Unmatched begin/end at chunk $Paragraph in pod $Podfile\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*$/;
54e8619f
JA
1451 # see if we can infer a link or a function call
1452 #
1453 # NOTE: This is a word based search, it won't automatically
1454 # mark "substr($var, 1, 2)" because the 1st word would be "substr($var"
1455 # User has to enclose those with proper C<>
1456
1457 if( $notinIS && $word =~
1458 m/
1459 ^([a-z_]{2,}) # The function name
1460 \(
1461 ([0-9][a-z]* # Manual page(1) or page(1M)
1462 |[^)]*[\$\@\%][^)]+ # ($foo), (1, @foo), (%hash)
1463 | # ()
1464 )
1465 \)
1466 ([.,;]?)$ # a possible punctuation follows
1467 /xi
1468 ) {
54310121 1469 # has parenthesis so should have been a C<> ref
2a28b791 1470 ## try for a pagename (perlXXX(1))?
54e8619f 1471 my( $func, $args, $rest ) = ( $1, $2, $3 || '' );
02369fa5 1472 if( $args =~ /^\d+$/ ){
2a28b791
GS
1473 my $url = page_sect( $word, '' );
1474 if( defined $url ){
54e8619f 1475 $word = qq(<a href="$url" class="man">the $word manpage</a>$rest);
2a28b791
GS
1476 next;
1477 }
1478 }
02369fa5 1479 ## try function name for a link, append tt'ed argument list
54e8619f 1480 $word = emit_C( $func, '', "($args)") . $rest;
2a28b791
GS
1481
1482#### disabled. either all (including $\W, $\w+{.*} etc.) or nothing.
1483## } elsif( $notinIS && $word =~ /^[\$\@%&*]+\w+$/) {
1484## # perl variables, should be a C<> ref
1485## $word = emit_C( $word );
1486
54310121
PP
1487 } elsif ($word =~ m,^\w+://\w,) {
1488 # looks like a URL
5a039dd3 1489 # Don't relativize it: leave it as the author intended
59ecbafa 1490 $word = qq(<a href="$word">$word</a>);
af47ee55 1491 } elsif ($word =~ /[\w.-]+\@[\w-]+\.\w/) {
54310121 1492 # looks like an e-mail address
7b8d334a
GS
1493 my ($w1, $w2, $w3) = ("", $word, "");
1494 ($w1, $w2, $w3) = ("(", $1, ")$2") if $word =~ /^\((.*?)\)(,?)/;
1495 ($w1, $w2, $w3) = ("&lt;", $1, "&gt;$2") if $word =~ /^<(.*?)>(,?)/;
59ecbafa
VS
1496 $word = qq($w1<a href="mailto:$w2">$w2</a>$w3);
1497 } else {
7b8d334a 1498 $word = html_escape($word) if $word =~ /["&<>]/;
54310121
PP
1499 }
1500 }
1501
2a28b791
GS
1502 # put everything back together
1503 return $lead . join( '', @words ) . $trail;
1504}
1505
54310121 1506
2a28b791
GS
1507#
1508# process_text - handles plaintext that appears in the input pod file.
1509# there may be pod commands embedded within the text so those must be
1510# converted to html commands.
1511#
7ba65c74 1512
c68ea5d1 1513sub process_text1($$;$$);
e1b7525f
YO
1514sub pattern ($) { $_[0] ? '\s+'.('>' x ($_[0] + 1)) : '>' }
1515sub closing ($) { local($_) = shift; (defined && s/\s+\z//) ? length : 0 }
7ba65c74 1516
2a28b791 1517sub process_text {
69348ecf 1518 return if $Ignore;
2a28b791
GS
1519 my( $tref ) = @_;
1520 my $res = process_text1( 0, $tref );
066b3271 1521 $res =~ s/\s+$//s;
2a28b791
GS
1522 $$tref = $res;
1523}
1524
f9568fed
JA
1525sub process_text_rfc_links {
1526 my $text = shift;
1527
5d05e460
JA
1528 # For every "RFCnnnn" or "RFC nnn", link it to the authoritative
1529 # ource. Do not use the /i modifier here. Require "RFC" to be written in
f9568fed
JA
1530 # in capital letters.
1531
1532 $text =~ s{
5d05e460
JA
1533 (?<=[^<>[:alpha:]]) # Make sure this is not an URL already
1534 (RFC\s*([0-9]{1,5}))(?![0-9]) # max 5 digits
f9568fed 1535 }
e1b7525f 1536 {<a href="http://www.ietf.org/rfc/rfc$2.txt" class="rfc">$1</a>}gx;
f9568fed
JA
1537
1538 $text;
1539}
1540
c68ea5d1
GS
1541sub process_text1($$;$$){
1542 my( $lev, $rstr, $func, $closing ) = @_;
2a28b791
GS
1543 my $res = '';
1544
60a48b2d
GS
1545 unless (defined $func) {
1546 $func = '';
1547 $lev++;
1548 }
1549
2a28b791
GS
1550 if( $func eq 'B' ){
1551 # B<text> - boldface
59ecbafa 1552 $res = '<strong>' . process_text1( $lev, $rstr ) . '</strong>';
2a28b791
GS
1553
1554 } elsif( $func eq 'C' ){
59ecbafa 1555 # C<code> - can be a ref or <code></code>
2a28b791 1556 # need to extract text
c68ea5d1 1557 my $par = go_ahead( $rstr, 'C', $closing );
2a28b791
GS
1558
1559 ## clean-up of the link target
1560 my $text = depod( $par );
1561
1562 ### my $x = $par =~ /[BI]</ ? 'yes' : 'no' ;
59ecbafa 1563 ### print STDERR "-->call emit_C($par) lev=$lev, par with BI=$x\n";
2a28b791
GS
1564
1565 $res = emit_C( $text, $lev > 1 || ($par =~ /[BI]</) );
1566
1567 } elsif( $func eq 'E' ){
1568 # E<x> - convert to character
be3174d2
GS
1569 $$rstr =~ s/^([^>]*)>//;
1570 my $escape = $1;
1571 $escape =~ s/^(\d+|X[\dA-F]+)$/#$1/i;
1572 $res = "&$escape;";
2a28b791
GS
1573
1574 } elsif( $func eq 'F' ){
8e3df7c8
JA
1575 # F<filename> - italicize
1576 $res = '<em class="file">' . process_text1( $lev, $rstr ) . '</em>';
2a28b791
GS
1577
1578 } elsif( $func eq 'I' ){
8e3df7c8 1579 # I<text> - italicize
59ecbafa 1580 $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
2a28b791
GS
1581
1582 } elsif( $func eq 'L' ){
1583 # L<link> - link
59ecbafa 1584 ## L<text|cross-ref> => produce text, use cross-ref for linking
2a28b791
GS
1585 ## L<cross-ref> => make text from cross-ref
1586 ## need to extract text
c68ea5d1 1587 my $par = go_ahead( $rstr, 'L', $closing );
2a28b791
GS
1588
1589 # some L<>'s that shouldn't be:
1590 # a) full-blown URL's are emitted as-is
1591 if( $par =~ m{^\w+://}s ){
1592 return make_URL_href( $par );
1593 }
1594 # b) C<...> is stripped and treated as C<>
1595 if( $par =~ /^C<(.*)>$/ ){
1596 my $text = depod( $1 );
1597 return emit_C( $text, $lev > 1 || ($par =~ /[BI]</) );
1598 }
1599
1600 # analyze the contents
1601 $par =~ s/\n/ /g; # undo word-wrapped tags
1602 my $opar = $par;
1603 my $linktext;
1604 if( $par =~ s{^([^|]+)\|}{} ){
1605 $linktext = $1;
1606 }
59ecbafa 1607
2a28b791
GS
1608 # make sure sections start with a /
1609 $par =~ s{^"}{/"};
1610
1611 my( $page, $section, $ident );
1612
1613 # check for link patterns
1614 if( $par =~ m{^([^/]+?)/(?!")(.*?)$} ){ # name/ident
59ecbafa 1615 # we've got a name/ident (no quotes)
e1b7525f
YO
1616 if (length $2) {
1617 ( $page, $ident ) = ( $1, $2 );
1618 } else {
1619 ( $page, $section ) = ( $1, $2 );
1620 }
2a28b791
GS
1621 ### print STDERR "--> L<$par> to page $page, ident $ident\n";
1622
1623 } elsif( $par =~ m{^(.*?)/"?(.*?)"?$} ){ # [name]/"section"
1624 # even though this should be a "section", we go for ident first
1625 ( $page, $ident ) = ( $1, $2 );
1626 ### print STDERR "--> L<$par> to page $page, section $section\n";
1627
1628 } elsif( $par =~ /\s/ ){ # this must be a section with missing quotes
1629 ( $page, $section ) = ( '', $par );
1630 ### print STDERR "--> L<$par> to void page, section $section\n";
1631
1632 } else {
1633 ( $page, $section ) = ( $par, '' );
1634 ### print STDERR "--> L<$par> to page $par, void section\n";
1635 }
1636
1637 # now, either $section or $ident is defined. the convoluted logic
1638 # below tries to resolve L<> according to what the user specified.
1639 # failing this, we try to find the next best thing...
1640 my( $url, $ltext, $fid );
1641
1642 RESOLVE: {
1643 if( defined $ident ){
1644 ## try to resolve $ident as an item
1645 ( $url, $fid ) = coderef( $page, $ident );
1646 if( $url ){
1647 if( ! defined( $linktext ) ){
1648 $linktext = $ident;
1649 $linktext .= " in " if $ident && $page;
1650 $linktext .= "the $page manpage" if $page;
1651 }
1652 ### print STDERR "got coderef url=$url\n";
1653 last RESOLVE;
1654 }
1655 ## no luck: go for a section (auto-quoting!)
1656 $section = $ident;
1657 }
1658 ## now go for a section
1659 my $htmlsection = htmlify( $section );
1660 $url = page_sect( $page, $htmlsection );
1661 if( $url ){
1662 if( ! defined( $linktext ) ){
1663 $linktext = $section;
1664 $linktext .= " in " if $section && $page;
1665 $linktext .= "the $page manpage" if $page;
1666 }
1667 ### print STDERR "got page/section url=$url\n";
1668 last RESOLVE;
1669 }
59ecbafa 1670 ## no luck: go for an ident
2a28b791
GS
1671 if( $section ){
1672 $ident = $section;
1673 } else {
1674 $ident = $page;
1675 $page = undef();
1676 }
1677 ( $url, $fid ) = coderef( $page, $ident );
1678 if( $url ){
1679 if( ! defined( $linktext ) ){
1680 $linktext = $ident;
1681 $linktext .= " in " if $ident && $page;
1682 $linktext .= "the $page manpage" if $page;
1683 }
1684 ### print STDERR "got section=>coderef url=$url\n";
1685 last RESOLVE;
1686 }
1687
1688 # warning; show some text.
1689 $linktext = $opar unless defined $linktext;
ac094485 1690 warn "$0: $Podfile: cannot resolve L<$opar> in paragraph $Paragraph.\n" unless $Quiet;
2a28b791
GS
1691 }
1692
d1be9408 1693 # now we have a URL or just plain code
2a28b791
GS
1694 $$rstr = $linktext . '>' . $$rstr;
1695 if( defined( $url ) ){
59ecbafa 1696 $res = "<a href=\"$url\">" . process_text1( $lev, $rstr ) . '</a>';
2a28b791 1697 } else {
59ecbafa 1698 $res = '<em>' . process_text1( $lev, $rstr ) . '</em>';
2a28b791
GS
1699 }
1700
1701 } elsif( $func eq 'S' ){
1702 # S<text> - non-breaking spaces
1703 $res = process_text1( $lev, $rstr );
1704 $res =~ s/ /&nbsp;/g;
1705
1706 } elsif( $func eq 'X' ){
1707 # X<> - ignore
e1b7525f
YO
1708 warn "$0: $Podfile: invalid X<> in paragraph $Paragraph.\n"
1709 unless $$rstr =~ s/^[^>]*>// or $Quiet;
2a28b791 1710 } elsif( $func eq 'Z' ){
59ecbafa 1711 # Z<> - empty
e1b7525f 1712 warn "$0: $Podfile: invalid Z<> in paragraph $Paragraph.\n"
ac094485 1713 unless $$rstr =~ s/^>// or $Quiet;
2a28b791
GS
1714
1715 } else {
c68ea5d1
GS
1716 my $term = pattern $closing;
1717 while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){
2a28b791 1718 # all others: either recurse into new function or
c68ea5d1 1719 # terminate at closing angle bracket(s)
2a28b791 1720 my $pt = $1;
c68ea5d1 1721 $pt .= $2 if !$3 && $lev == 1;
2a28b791 1722 $res .= $lev == 1 ? pure_text( $pt ) : inIS_text( $pt );
c68ea5d1
GS
1723 return $res if !$3 && $lev > 1;
1724 if( $3 ){
1725 $res .= process_text1( $lev, $rstr, $3, closing $4 );
1726 }
2a28b791
GS
1727 }
1728 if( $lev == 1 ){
1729 $res .= pure_text( $$rstr );
e1b7525f
YO
1730 } elsif( ! $Quiet ) {
1731 my $snippet = substr($$rstr,0,60);
1732 warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph: '$snippet'.\n"
1733
54310121 1734 }
f9568fed 1735 $res = process_text_rfc_links($res);
54310121 1736 }
2a28b791
GS
1737 return $res;
1738}
54310121 1739
2a28b791
GS
1740#
1741# go_ahead: extract text of an IS (can be nested)
1742#
c68ea5d1
GS
1743sub go_ahead($$$){
1744 my( $rstr, $func, $closing ) = @_;
2a28b791 1745 my $res = '';
c68ea5d1
GS
1746 my @closing = ($closing);
1747 while( $$rstr =~
e1b7525f 1748 s/\A(.*?)(([BCEFILSXZ])<(<+\s+)?|@{[pattern $closing[0]]})//s ){
2a28b791 1749 $res .= $1;
c68ea5d1
GS
1750 unless( $3 ){
1751 shift @closing;
1752 return $res unless @closing;
2a28b791 1753 } else {
c68ea5d1 1754 unshift @closing, closing $4;
2a28b791
GS
1755 }
1756 $res .= $2;
1757 }
e1b7525f
YO
1758 unless ($Quiet) {
1759 my $snippet = substr($$rstr,0,60);
1760 warn "$0: $Podfile: undelimited $func<> in paragraph $Paragraph (go_ahead): '$snippet'.\n"
1761 }
2a28b791 1762 return $res;
54310121
PP
1763}
1764
1765#
2a28b791
GS
1766# emit_C - output result of C<text>
1767# $text is the depod-ed text
54310121 1768#
02369fa5
GS
1769sub emit_C($;$$){
1770 my( $text, $nocode, $args ) = @_;
60a48b2d 1771 $args = '' unless defined $args;
2a28b791
GS
1772 my $res;
1773 my( $url, $fid ) = coderef( undef(), $text );
1774
1775 # need HTML-safe text
02369fa5 1776 my $linktext = html_escape( "$text$args" );
2a28b791
GS
1777
1778 if( defined( $url ) &&
1779 (!defined( $EmittedItem ) || $EmittedItem ne $fid ) ){
59ecbafa 1780 $res = "<a href=\"$url\"><code>$linktext</code></a>";
2a28b791
GS
1781 } elsif( 0 && $nocode ){
1782 $res = $linktext;
1783 } else {
59ecbafa 1784 $res = "<code>$linktext</code>";
2a28b791
GS
1785 }
1786 return $res;
54310121
PP
1787}
1788
1789#
2a28b791
GS
1790# html_escape: make text safe for HTML
1791#
1792sub html_escape {
1793 my $rest = $_[0];
1794 $rest =~ s/&/&amp;/g;
1795 $rest =~ s/</&lt;/g;
1796 $rest =~ s/>/&gt;/g;
1797 $rest =~ s/"/&quot;/g;
5b25816d
RS
1798 # &apos; is only in XHTML, not HTML4. Be conservative
1799 #$rest =~ s/'/&apos;/g;
2a28b791 1800 return $rest;
59ecbafa 1801}
2a28b791
GS
1802
1803
1804#
39e571d4
ML
1805# dosify - convert filenames to 8.3
1806#
1807sub dosify {
1808 my($str) = @_;
fe4c6be1 1809 return lc($str) if $^O eq 'VMS'; # VMS just needs casing
39e571d4
ML
1810 if ($Is83) {
1811 $str = lc $str;
1812 $str =~ s/(\.\w+)/substr ($1,0,4)/ge;
1813 $str =~ s/(\w+)/substr ($1,0,8)/ge;
1814 }
1815 return $str;
1816}
1817
1818#
d1be9408 1819# page_sect - make a URL from the text of a L<>
54310121 1820#
2a28b791
GS
1821sub page_sect($$) {
1822 my( $page, $section ) = @_;
1823 my( $linktext, $page83, $link); # work strings
1824
1825 # check if we know that this is a section in this page
69348ecf 1826 if (!defined $Pages{$page} && defined $Sections{$page}) {
2a28b791
GS
1827 $section = $page;
1828 $page = "";
1829 ### print STDERR "reset page='', section=$section\n";
54310121
PP
1830 }
1831
39e571d4 1832 $page83=dosify($page);
69348ecf 1833 $page=$page83 if (defined $Pages{$page83});
54310121 1834 if ($page eq "") {
0d396dd4 1835 $link = "#" . anchorify( $section );
350ccacd 1836 } elsif ( $page =~ /::/ ) {
350ccacd 1837 $page =~ s,::,/,g;
29f227c9
BS
1838 # Search page cache for an entry keyed under the html page name,
1839 # then look to see what directory that page might be in. NOTE:
1840 # this will only find one page. A better solution might be to produce
1841 # an intermediate page that is an index to all such pages.
1842 my $page_name = $page ;
fe6f1558 1843 $page_name =~ s,^.*/,,s ;
69348ecf
MS
1844 if ( defined( $Pages{ $page_name } ) &&
1845 $Pages{ $page_name } =~ /([^:]*$page)\.(?:pod|pm):/
29f227c9
BS
1846 ) {
1847 $page = $1 ;
1848 }
1849 else {
1850 # NOTE: This branch assumes that all A::B pages are located in
69348ecf
MS
1851 # $Htmlroot/A/B.html . This is often incorrect, since they are
1852 # often in $Htmlroot/lib/A/B.html or such like. Perhaps we could
1853 # analyze the contents of %Pages and figure out where any
29f227c9
BS
1854 # cousins of A::B are, then assume that. So, if A::B isn't found,
1855 # but A::C is found in lib/A/C.pm, then A::B is assumed to be in
1856 # lib/A/B.pm. This is also limited, but it's an improvement.
1857 # Maybe a hints file so that the links point to the correct places
2a28b791
GS
1858 # nonetheless?
1859
29f227c9 1860 }
69348ecf 1861 $link = "$Htmlroot/$page.html";
0d396dd4 1862 $link .= "#" . anchorify( $section ) if ($section);
69348ecf 1863 } elsif (!defined $Pages{$page}) {
54310121 1864 $link = "";
54310121 1865 } else {
0d396dd4 1866 $section = anchorify( $section ) if $section ne "";
2a28b791 1867 ### print STDERR "...section=$section\n";
54310121
PP
1868
1869 # if there is a directory by the name of the page, then assume that an
1870 # appropriate section will exist in the subdirectory
69348ecf
MS
1871# if ($section ne "" && $Pages{$page} =~ /([^:]*[^(\.pod|\.pm)]):/) {
1872 if ($section ne "" && $Pages{$page} =~ /([^:]*(?<!\.pod)(?<!\.pm)):/) {
1873 $link = "$Htmlroot/$1/$section.html";
2a28b791 1874 ### print STDERR "...link=$link\n";
54310121
PP
1875
1876 # since there is no directory by the name of the page, the section will
1877 # have to exist within a .html of the same name. thus, make sure there
1878 # is a .pod or .pm that might become that .html
1879 } else {
2a28b791
GS
1880 $section = "#$section" if $section;
1881 ### print STDERR "...section=$section\n";
1882
61743a65
ST
1883 # check if there is a .pod with the page name.
1884 # for L<Foo>, Foo.(pod|pm) is preferred to A/Foo.(pod|pm)
1885 if ($Pages{$page} =~ /([^:]*)\.(?:pod|pm):/) {
69348ecf 1886 $link = "$Htmlroot/$1.html$section";
54310121 1887 } else {
54310121 1888 $link = "";
54310121
PP
1889 }
1890 }
1891 }
1892
54310121 1893 if ($link) {
69348ecf
MS
1894 # Here, we take advantage of the knowledge that $Htmlfileurl ne ''
1895 # implies $Htmlroot eq ''. This means that the link in question
1896 # needs a prefix of $Htmldir if it begins with '/'. The test for
29f227c9
BS
1897 # the initial '/' is done to avoid '#'-only links, and to allow
1898 # for other kinds of links, like file:, ftp:, etc.
1899 my $url ;
69348ecf
MS
1900 if ( $Htmlfileurl ne '' ) {
1901 $link = "$Htmldir$link" if $link =~ m{^/}s;
1902 $url = relativize_url( $link, $Htmlfileurl );
1903# print( " b: [$link,$Htmlfileurl,$url]\n" );
29f227c9
BS
1904 }
1905 else {
1906 $url = $link ;
1907 }
2a28b791 1908 return $url;
29f227c9 1909
54310121 1910 } else {
2a28b791 1911 return undef();
54310121 1912 }
54310121
PP
1913}
1914
1915#
29f227c9
BS
1916# relativize_url - convert an absolute URL to one relative to a base URL.
1917# Assumes both end in a filename.
1918#
1919sub relativize_url {
1920 my ($dest,$source) = @_ ;
1921
59ecbafa 1922 my ($dest_volume,$dest_directory,$dest_file) =
29f227c9
BS
1923 File::Spec::Unix->splitpath( $dest ) ;
1924 $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' ) ;
1925
59ecbafa 1926 my ($source_volume,$source_directory,$source_file) =
29f227c9
BS
1927 File::Spec::Unix->splitpath( $source ) ;
1928 $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' ) ;
1929
1930 my $rel_path = '' ;
1931 if ( $dest ne '' ) {
1932 $rel_path = File::Spec::Unix->abs2rel( $dest, $source ) ;
1933 }
1934
59ecbafa 1935 if ( $rel_path ne '' &&
29f227c9 1936 substr( $rel_path, -1 ) ne '/' &&
59ecbafa 1937 substr( $dest_file, 0, 1 ) ne '#'
29f227c9
BS
1938 ) {
1939 $rel_path .= "/$dest_file" ;
1940 }
1941 else {
1942 $rel_path .= "$dest_file" ;
1943 }
1944
1945 return $rel_path ;
1946}
1947
54310121
PP
1948
1949#
2a28b791 1950# coderef - make URL from the text of a C<>
54310121 1951#
2a28b791
GS
1952sub coderef($$){
1953 my( $page, $item ) = @_;
1954 my( $url );
1955
1956 my $fid = fragment_id( $item );
e1b7525f 1957
6e38a594 1958 if( defined( $page ) && $page ne "" ){
2a28b791
GS
1959 # we have been given a $page...
1960 $page =~ s{::}{/}g;
1961
e1b7525f
YO
1962 Carp::confess("Undefined fragment '$item' from fragment_id() in coderef() in $Podfile")
1963 if !defined $fid;
2a28b791 1964 # Do we take it? Item could be a section!
69348ecf 1965 my $base = $Items{$fid} || "";
2a28b791
GS
1966 $base =~ s{[^/]*/}{};
1967 if( $base ne "$page.html" ){
69348ecf 1968 ### print STDERR "coderef( $page, $item ): items{$fid} = $Items{$fid} = $base => discard page!\n";
2a28b791
GS
1969 $page = undef();
1970 }
54310121 1971
2a28b791
GS
1972 } else {
1973 # no page - local items precede cached items
67398a75 1974 if( defined( $fid ) ){
69348ecf
MS
1975 if( exists $Local_Items{$fid} ){
1976 $page = $Local_Items{$fid};
67398a75 1977 } else {
69348ecf 1978 $page = $Items{$fid};
67398a75 1979 }
2a28b791
GS
1980 }
1981 }
54310121
PP
1982
1983 # if there was a pod file that we found earlier with an appropriate
1984 # =item directive, then create a link to that page.
2a28b791
GS
1985 if( defined $page ){
1986 if( $page ){
69348ecf 1987 if( exists $Pages{$page} and $Pages{$page} =~ /([^:.]*)\.[^:]*:/){
2a28b791 1988 $page = $1 . '.html';
29f227c9 1989 }
ffb0b41d 1990 my $link = "$Htmlroot/$page#" . anchorify($fid);
54310121 1991
69348ecf
MS
1992 # Here, we take advantage of the knowledge that $Htmlfileurl
1993 # ne '' implies $Htmlroot eq ''.
1994 if ( $Htmlfileurl ne '' ) {
1995 $link = "$Htmldir$link" ;
1996 $url = relativize_url( $link, $Htmlfileurl ) ;
2a28b791
GS
1997 } else {
1998 $url = $link ;
1999 }
2000 } else {
ffb0b41d 2001 $url = "#" . anchorify($fid);
2a28b791 2002 }
54310121 2003
2a28b791 2004 confess "url has space: $url" if $url =~ /"[^"]*\s[^"]*"/;
59ecbafa 2005 }
2a28b791 2006 return( $url, $fid );
54310121
PP
2007}
2008
54310121
PP
2009
2010
2011#
29f227c9
BS
2012# Adapted from Nick Ing-Simmons' PodToHtml package.
2013sub relative_url {
2014 my $source_file = shift ;
2015 my $destination_file = shift;
2016
2017 my $source = URI::file->new_abs($source_file);
2018 my $uo = URI::file->new($destination_file,$source)->abs;
2019 return $uo->rel->as_string;
2020}
2021
2022
2023#
54310121
PP
2024# finish_list - finish off any pending HTML lists. this should be called
2025# after the entire pod file has been read and converted.
2026#
2027sub finish_list {
69348ecf 2028 while ($Listlevel > 0) {
59ecbafa 2029 print HTML "</dl>\n";
69348ecf 2030 $Listlevel--;
54310121
PP
2031 }
2032}
2033
2034#
2035# htmlify - converts a pod section specification to a suitable section
2a28b791
GS
2036# specification for HTML. Note that we keep spaces and special characters
2037# except ", ? (Netscape problem) and the hyphen (writer's problem...).
54310121
PP
2038#
2039sub htmlify {
2a28b791
GS
2040 my( $heading) = @_;
2041 $heading =~ s/(\s+)/ /g;
2042 $heading =~ s/\s+\Z//;
2043 $heading =~ s/\A\s+//;
2044 # The hyphen is a disgrace to the English language.
bc75160c
JA
2045 # $heading =~ s/[-"?]//g;
2046 $heading =~ s/["?]//g;
2a28b791
GS
2047 $heading = lc( $heading );
2048 return $heading;
2049}
54310121 2050
2a28b791 2051#
776d31fe 2052# similar to htmlify, but turns non-alphanumerics into underscores
0d396dd4
SB
2053#
2054sub anchorify {
2055 my ($anchor) = @_;
2056 $anchor = htmlify($anchor);
776d31fe 2057 $anchor =~ s/\W/_/g;
0d396dd4
SB
2058 return $anchor;
2059}
2060
2061#
2a28b791
GS
2062# depod - convert text by eliminating all interior sequences
2063# Note: can be called with copy or modify semantics
2064#
2065my %E2c;
67398a75
GS
2066$E2c{lt} = '<';
2067$E2c{gt} = '>';
2068$E2c{sol} = '/';
2a28b791 2069$E2c{verbar} = '|';
67398a75 2070$E2c{amp} = '&'; # in Tk's pods
2a28b791 2071
c68ea5d1 2072sub depod1($;$$);
7ba65c74 2073
2a28b791
GS
2074sub depod($){
2075 my $string;
2076 if( ref( $_[0] ) ){
2077 $string = ${$_[0]};
2078 ${$_[0]} = depod1( \$string );
2079 } else {
2080 $string = $_[0];
2081 depod1( \$string );
59ecbafa 2082 }
2a28b791 2083}
54310121 2084
c68ea5d1
GS
2085sub depod1($;$$){
2086 my( $rstr, $func, $closing ) = @_;
2a28b791 2087 my $res = '';
228a48a5 2088 return $res unless defined $$rstr;
2a28b791
GS
2089 if( ! defined( $func ) ){
2090 # skip to next begin of an interior sequence
d0ff30b5 2091 while( $$rstr =~ s/\A(.*?)([BCEFILSXZ])<(<+[^\S\n]+)?//s ){
2a28b791 2092 # recurse into its text
c68ea5d1 2093 $res .= $1 . depod1( $rstr, $2, closing $3);
2a28b791
GS
2094 }
2095 $res .= $$rstr;
2096 } elsif( $func eq 'E' ){
2097 # E<x> - convert to character
be3174d2 2098 $$rstr =~ s/^([^>]*)>//;
228a48a5 2099 $res .= $E2c{$1} || "";
2a28b791
GS
2100 } elsif( $func eq 'X' ){
2101 # X<> - ignore
2102 $$rstr =~ s/^[^>]*>//;
2103 } elsif( $func eq 'Z' ){
59ecbafa 2104 # Z<> - empty
2a28b791
GS
2105 $$rstr =~ s/^>//;
2106 } else {
2107 # all others: either recurse into new function or
2108 # terminate at closing angle bracket
c68ea5d1 2109 my $term = pattern $closing;
d0ff30b5 2110 while( $$rstr =~ s/\A(.*?)(([BCEFILSXZ])<(<+[^\S\n]+)?|$term)//s ){
2a28b791 2111 $res .= $1;
c68ea5d1
GS
2112 last unless $3;
2113 $res .= depod1( $rstr, $3, closing $4 );
2a28b791
GS
2114 }
2115 ## If we're here and $2 ne '>': undelimited interior sequence.
2116 ## Ignored, as this is called without proper indication of where we are.
2117 ## Rely on process_text to produce diagnostics.
2118 }
2119 return $res;
2120}
54310121 2121
bc75160c
JA
2122{
2123 my %seen; # static fragment record hash
2124
2125sub fragment_id_readable {
2126 my $text = shift;
2127 my $generate = shift; # optional flag
2128
2129 my $orig = $text;
2130
c24033b9
JH
2131 # leave the words for the fragment identifier,
2132 # change everything else to underbars.
2133 $text =~ s/[^A-Za-z0-9_]+/_/g; # do not use \W to avoid locale dependency.
2134 $text =~ s/_{2,}/_/g;
2135 $text =~ s/\A_//;
2136 $text =~ s/_\Z//;
bc75160c
JA
2137
2138 unless ($text)
2139 {
2140 # Nothing left after removing punctuation, so leave it as is
2141 # E.g. if option is named: "=item -#"
2142
2143 $text = $orig;
2144 }
2145
2146 if ($generate) {
2147 if ( exists $seen{$text} ) {
2148 # This already exists, make it unique
2149 $seen{$text}++;
2150 $text = $text . $seen{$text};
2151 } else {
2152 $seen{$text} = 1; # first time seen this fragment
2153 }
2154 }
2155
2156 $text;
2157}}
2158
2159my @HC;
c24033b9 2160sub fragment_id_obfuscated { # This was the old "_2d_2d__"
bc75160c
JA
2161 my $text = shift;
2162 my $generate = shift; # optional flag
2163
c24033b9 2164 # text? Normalize by obfuscating the fragment id to make it unique
bc75160c
JA
2165 $text =~ s/\s+/_/sg;
2166
2167 $text =~ s{(\W)}{
2168 defined( $HC[ord($1)] ) ? $HC[ord($1)]
2169 : ( $HC[ord($1)] = sprintf( "%%%02X", ord($1) ) ) }gxe;
2170 $text = substr( $text, 0, 50 );
2171
2172 $text;
2173}
2174
2a28b791
GS
2175#
2176# fragment_id - construct a fragment identifier from:
2177# a) =item text
2178# b) contents of C<...>
2179#
bc75160c 2180
2a28b791 2181sub fragment_id {
bc75160c
JA
2182 my $text = shift;
2183 my $generate = shift; # optional flag
2184
2a28b791
GS
2185 $text =~ s/\s+\Z//s;
2186 if( $text ){
2187 # a method or function?
2188 return $1 if $text =~ /(\w+)\s*\(/;
2189 return $1 if $text =~ /->\s*(\w+)\s*\(?/;
2190
2191 # a variable name?
fab416db 2192 return $1 if $text =~ /^([\$\@%*]\S+)/;
2a28b791
GS
2193
2194 # some pattern matching operator?
2195 return $1 if $text =~ m|^(\w+/).*/\w*$|;
2196
2197 # fancy stuff... like "do { }"
2198 return $1 if $text =~ m|^(\w+)\s*{.*}$|;
2199
2200 # honour the perlfunc manpage: func [PAR[,[ ]PAR]...]
2201 # and some funnies with ... Module ...
bee6d115 2202 return $1 if $text =~ m{^([a-z\d_]+)(\s+[A-Z,/& ][A-Z\d,/& ]*)?$};
2a28b791
GS
2203 return $1 if $text =~ m{^([a-z\d]+)\s+Module(\s+[A-Z\d,/& ]+)?$};
2204
c24033b9 2205 return fragment_id_readable($text, $generate);
2a28b791 2206 } else {
c24033b9 2207 return;
2a28b791 2208 }
54310121
PP
2209}
2210
2a28b791
GS
2211#
2212# make_URL_href - generate HTML href from URL
2213# Special treatment for CGI queries.
2214#
2215sub make_URL_href($){
2216 my( $url ) = @_;
59ecbafa
VS
2217 if( $url !~
2218 s{^(http:[-\w/#~:.+=&%@!]+)(\?.*)$}{<a href="$1$2">$1</a>}i ){
2219 $url = "<a href=\"$url\">$url</a>";
2a28b791
GS
2220 }
2221 return $url;
54310121
PP
2222}
2223
22241;