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