This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
fix links in generated HTML documentation
[perl5.git] / ext / Pod-Html / lib / Pod / Html.pm
CommitLineData
54310121 1package Pod::Html;
0e4548d5 2use strict;
54310121 3require Exporter;
0e4548d5 4
38e30ca7 5our $VERSION = 1.23;
fd55ca4f
N
6our @ISA = qw(Exporter);
7our @EXPORT = qw(pod2html htmlify);
0bd1c35e 8our @EXPORT_OK = qw(anchorify relativize_url);
54310121
PP
9
10use Carp;
0e4548d5
GS
11use Config;
12use Cwd;
99499175 13use File::Basename;
af75be11 14use File::Spec;
0e4548d5
GS
15use File::Spec::Unix;
16use Getopt::Long;
76589d6f 17use Pod::Simple::Search;
38e30ca7 18use Pod::Simple::SimpleTree ();
5f1269ab 19use locale; # make \w work right in non-ASCII lands
3ec07288 20
54310121
PP
21=head1 NAME
22
7b8d334a 23Pod::Html - module to convert pod files to HTML
54310121
PP
24
25=head1 SYNOPSIS
26
7b8d334a 27 use Pod::Html;
54310121
PP
28 pod2html([options]);
29
30=head1 DESCRIPTION
31
32Converts files from pod format (see L<perlpod>) to HTML format. It
b09e89a9
MG
33can automatically generate indexes and cross-references, and it keeps
34a cache of things it knows how to cross-reference.
54310121 35
95fb620e 36=head1 FUNCTIONS
54310121 37
95fb620e
SP
38=head2 pod2html
39
40 pod2html("pod2html",
41 "--podpath=lib:ext:pod:vms",
42 "--podroot=/usr/src/perl",
43 "--htmlroot=/perl/nmanual",
95fb620e
SP
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
5c988a71 54 --backlink
0e4548d5 55
5c988a71
MG
56Turns every C<head1> heading into a link back to the top of the page.
57By default, no backlinks are generated.
0e4548d5 58
b09e89a9
MG
59=item cachedir
60
61 --cachedir=name
62
63Creates the directory cache 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 71
b09e89a9
MG
72=item flush
73
74 --flush
75
76Flushes the directory cache.
77
3ada32a3
MG
78=item header
79
80 --header
81 --noheader
82
83Creates header and footer blocks containing the text of the C<NAME>
84section. By default, no headers are generated.
85
54310121
PP
86=item help
87
88 --help
89
90Displays the usage message.
91
5a039dd3
BS
92=item htmldir
93
94 --htmldir=name
95
707a94fe
MG
96Sets the directory to which all cross references in the resulting
97html file will be relative. Not passing this causes all links to be
98absolute since this is the value that tells Pod::Html the root of the
99documentation tree.
100
101Do not use this and --htmlroot in the same call to pod2html; they are
102mutually exclusive.
5a039dd3 103
54310121
PP
104=item htmlroot
105
106 --htmlroot=name
107
108Sets the base URL for the HTML files. When cross-references are made,
109the HTML root is prepended to the URL.
110
707a94fe
MG
111Do not use this if relative links are desired: use --htmldir instead.
112
113Do not pass both this and --htmldir to pod2html; they are mutually
114exclusive.
115
0e4548d5
GS
116=item index
117
118 --index
119 --noindex
120
121Generate an index at the top of the HTML file. This is the default
122behaviour.
123
54310121
PP
124=item infile
125
126 --infile=name
127
128Specify the pod file to convert. Input is taken from STDIN if no
129infile is specified.
130
0e4548d5 131=item outfile
54310121 132
0e4548d5 133 --outfile=name
54310121 134
0e4548d5
GS
135Specify the HTML file to create. Output goes to STDOUT if no outfile
136is specified.
54310121 137
8ef5953c
MG
138=item poderrors
139
140 --poderrors
141 --nopoderrors
142
143Include a "POD ERRORS" section in the outfile if there were any POD
144errors in the infile. This section is included by default.
145
0e4548d5 146=item podpath
54310121 147
0e4548d5 148 --podpath=name:...:name
54310121 149
0e4548d5 150Specify which subdirectories of the podroot contain pod files whose
59ecbafa 151HTML converted forms can be linked to in cross references.
54310121 152
0e4548d5 153=item podroot
54310121 154
0e4548d5 155 --podroot=name
54310121 156
042c2bc8 157Specify the base directory for finding library pods. Default is the
f360b455 158current working directory.
54310121 159
0e4548d5 160=item quiet
54310121 161
0e4548d5
GS
162 --quiet
163 --noquiet
54310121 164
0e4548d5
GS
165Don't display I<mostly harmless> warning messages. These messages
166will be displayed by default. But this is not the same as C<verbose>
167mode.
54310121 168
0e4548d5 169=item recurse
54310121 170
0e4548d5 171 --recurse
54310121
PP
172 --norecurse
173
0e4548d5 174Recurse into subdirectories specified in podpath (default behaviour).
54310121
PP
175
176=item title
177
178 --title=title
179
180Specify the title of the resulting HTML file.
181
182=item verbose
183
184 --verbose
0e4548d5 185 --noverbose
54310121 186
0e4548d5 187Display progress messages. By default, they won't be displayed.
34db337b 188
54310121
PP
189=back
190
95fb620e 191=head2 htmlify
54310121 192
95fb620e
SP
193 htmlify($heading);
194
195Converts a pod section specification to a suitable section specification
d42858b2 196for HTML. Note that we keep spaces and special characters except
95fb620e
SP
197C<", ?> (Netscape problem) and the hyphen (writer's problem...).
198
199=head2 anchorify
200
201 anchorify(@heading);
202
203Similar to C<htmlify()>, but turns non-alphanumerics into underscores. Note
204that C<anchorify()> is not exported by default.
54310121 205
34db337b
JD
206=head1 ENVIRONMENT
207
59ecbafa 208Uses C<$Config{pod2html}> to setup default options.
34db337b 209
54310121
PP
210=head1 AUTHOR
211
e812cb3f
MG
212Marc Green, E<lt>marcgreen@cpan.orgE<gt>.
213
214Original version by Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
54310121 215
54310121
PP
216=head1 SEE ALSO
217
218L<perlpod>
219
220=head1 COPYRIGHT
221
222This program is distributed under the Artistic License.
223
224=cut
225
38e30ca7
Z
226# This sub duplicates the guts of Pod::Simple::FromTree. We could have
227# used that module, except that it would have been a non-core dependency.
228sub feed_tree_to_parser {
229 my($parser, $tree) = @_;
230 if(ref($tree) eq "") {
231 $parser->_handle_text($tree);
232 } elsif(!($tree->[0] eq "X" && $parser->nix_X_codes)) {
233 $parser->_handle_element_start($tree->[0], $tree->[1]);
234 feed_tree_to_parser($parser, $_) foreach @{$tree}[2..$#$tree];
235 $parser->_handle_element_end($tree->[0]);
236 }
237}
238
b09e89a9
MG
239my $Cachedir;
240my $Dircache;
8e1ba33c 241my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl);
69348ecf 242my($Podfile, @Podpath, $Podroot);
8ef5953c 243my $Poderrors;
69348ecf 244my $Css;
54310121 245
69348ecf
MS
246my $Recurse;
247my $Quiet;
248my $Verbose;
249my $Doindex;
54310121 250
69348ecf 251my $Backlink;
99cb6bd8 252
3ada32a3 253my($Title, $Header);
99cb6bd8 254
ed36117c 255my %Pages = (); # associative array used to find the location
4979c083 256 # of pages referenced by L<> links.
99cb6bd8
MS
257
258my $Curdir = File::Spec->curdir;
259
260init_globals();
39e571d4 261
54310121 262sub init_globals {
b09e89a9
MG
263 $Cachedir = "."; # The directory to which directory caches
264 # will be written.
265
266 $Dircache = "pod2htmd.tmp";
267
ed36117c 268 $Htmlroot = "/"; # http-server base directory from which all
4979c083 269 # relative paths in $podpath stem.
ed36117c 270 $Htmldir = ""; # The directory to which the html pages
707a94fe 271 # will (eventually) be written.
ed36117c
MG
272 $Htmlfile = ""; # write to stdout by default
273 $Htmlfileurl = ""; # The url that other files would use to
4979c083
MG
274 # refer to this file. This is only used
275 # to make relative urls that point to
276 # other files.
99cb6bd8 277
8ef5953c 278 $Poderrors = 1;
ed36117c
MG
279 $Podfile = ""; # read from stdin by default
280 @Podpath = (); # list of directories containing library pods.
281 $Podroot = $Curdir; # filesystem base directory from which all
4979c083 282 # relative paths in $podpath stem.
69348ecf 283 $Css = ''; # Cascading style sheet
ed36117c
MG
284 $Recurse = 1; # recurse on subdirectories in $podpath.
285 $Quiet = 0; # not quiet by default
286 $Verbose = 0; # not verbose by default
287 $Doindex = 1; # non-zero if we should generate an index
288 $Backlink = 0; # no backlinks added by default
289 $Header = 0; # produce block header/footer
38e30ca7 290 $Title = undef; # title to give the pod(s)
2a28b791
GS
291}
292
54310121
PP
293sub pod2html {
294 local(@ARGV) = @_;
54310121
PP
295 local $_;
296
297 init_globals();
54310121
PP
298 parse_command_line();
299
8e1ba33c 300 # prevent '//' in urls
a4fca471
MG
301 $Htmlroot = "" if $Htmlroot eq "/";
302 $Htmldir =~ s#/\z##;
8e1ba33c
MG
303
304 if ( $Htmlroot eq ''
305 && defined( $Htmldir )
306 && $Htmldir ne ''
307 && substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir
ed36117c
MG
308 ) {
309 # Set the 'base' url for this file, so that we can use it
310 # as the location from which to calculate relative links
311 # to other files. If this is '', then absolute links will
312 # be used throughout.
7c41f1ea
MG
313 #$Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1);
314 # Is the above not just "$Htmlfileurl = $Htmlfile"?
b069bc5e 315 $Htmlfileurl = Pod::Html::_unixify($Htmlfile);
7c41f1ea 316
8e1ba33c 317 }
d5c3bc55 318
b09e89a9
MG
319 # load or generate/cache %Pages
320 unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) {
321 # generate %Pages
322 my $pwd = getcwd();
323 chdir($Podroot) ||
324 die "$0: error changing to directory $Podroot: $!\n";
325
326 # find all pod modules/pages in podpath, store in %Pages
327 # - callback used to remove Podroot and extension from each file
328 # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
329 Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1)
330 ->callback(\&_save_page)->recurse($Recurse)->survey(@Podpath);
331
332 chdir($pwd) || die "$0: error changing to directory $pwd: $!\n";
333
334 # cache the directory list for later use
335 warn "caching directories for later use\n" if $Verbose;
336 open my $cache, '>', $Dircache
337 or die "$0: error open $Dircache for writing: $!\n";
338
339 print $cache join(":", @Podpath) . "\n$Podroot\n";
495a00a1 340 my $_updirs_only = ($Podroot =~ /\.\./) && !($Podroot =~ /[^\.\\\/]/);
b09e89a9 341 foreach my $key (keys %Pages) {
495a00a1
RS
342 if($_updirs_only) {
343 my $_dirlevel = $Podroot;
344 while($_dirlevel =~ /\.\./) {
345 $_dirlevel =~ s/\.\.//;
346 # Assume $Pages{$key} has '/' separators (html dir separators).
53a8d1b8 347 $Pages{$key} =~ s/^[\w\s\-\.]+\///;
495a00a1
RS
348 }
349 }
b09e89a9
MG
350 print $cache "$key $Pages{$key}\n";
351 }
042c2bc8 352
b09e89a9
MG
353 close $cache or die "error closing $Dircache: $!";
354 }
f6e6d881 355
38e30ca7
Z
356 my $input;
357 unless (@ARGV && $ARGV[0]) {
358 if ($Podfile and $Podfile ne '-') {
359 $input = $Podfile;
360 } else {
361 $input = '-'; # XXX: make a test case for this
362 }
363 } else {
364 $Podfile = $ARGV[0];
365 $input = *ARGV;
366 }
367
368 # set options for input parser
369 my $parser = Pod::Simple::SimpleTree->new;
370 $parser->codes_in_verbatim(0);
371 $parser->accept_targets(qw(html HTML));
372 $parser->no_errata_section(!$Poderrors); # note the inverse
373
374 warn "Converting input file $Podfile\n" if $Verbose;
375 my $podtree = $parser->parse_file($input)->root;
376
377 unless(defined $Title) {
378 if($podtree->[0] eq "Document" && ref($podtree->[2]) eq "ARRAY" &&
379 $podtree->[2]->[0] eq "head1" && @{$podtree->[2]} == 3 &&
380 ref($podtree->[2]->[2]) eq "" && $podtree->[2]->[2] eq "NAME" &&
381 ref($podtree->[3]) eq "ARRAY" && $podtree->[3]->[0] eq "Para" &&
382 @{$podtree->[3]} >= 3 &&
383 !(grep { ref($_) ne "" }
384 @{$podtree->[3]}[2..$#{$podtree->[3]}]) &&
385 (@$podtree == 4 ||
386 (ref($podtree->[4]) eq "ARRAY" &&
387 $podtree->[4]->[0] eq "head1"))) {
388 $Title = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]);
389 }
390 }
391
392 $Title //= "";
393 $Title = html_escape($Title);
394
395 # set options for the HTML generator
396 $parser = Pod::Simple::XHTML::LocalPodLinks->new();
642ef7c1 397 $parser->codes_in_verbatim(0);
8ef5953c 398 $parser->anchor_items(1); # the old Pod::Html always did
f360b455 399 $parser->backlink($Backlink); # linkify =head1 directives
38e30ca7 400 $parser->force_title($Title);
a4fca471 401 $parser->htmldir($Htmldir);
8e1ba33c 402 $parser->htmlfileurl($Htmlfileurl);
a4fca471 403 $parser->htmlroot($Htmlroot);
5c988a71 404 $parser->index($Doindex);
5c988a71 405 $parser->output_string(\my $output); # written to file later
f360b455 406 $parser->pages(\%Pages);
d5c3bc55 407 $parser->quiet($Quiet);
99499175 408 $parser->verbose($Verbose);
3ada32a3 409
f360b455 410 # We need to add this ourselves because we use our own header, not
e7721e60 411 # ::XHTML's header. We need to set $parser->backlink to linkify
f360b455 412 # the =head1 directives
73c2e3ad 413 my $bodyid = $Backlink ? ' id="_podtop_"' : '';
f360b455 414
401f7940 415 my $csslink = '';
e6afd145 416 my $tdstyle = ' style="background-color: #cccccc; color: #000"';
401f7940 417
3ada32a3 418 if ($Css) {
ed36117c
MG
419 $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />);
420 $csslink =~ s,\\,/,g;
421 $csslink =~ s,(/.):,$1|,;
ed36117c 422 $tdstyle= '';
3ada32a3
MG
423 }
424
401f7940 425 # header/footer block
3ada32a3
MG
426 my $block = $Header ? <<END_OF_BLOCK : '';
427<table border="0" width="100%" cellspacing="0" cellpadding="3">
401f7940
MG
428<tr><td class="_podblock_"$tdstyle valign="middle">
429<big><strong><span class="_podblock_">&nbsp;$Title</span></strong></big>
3ada32a3
MG
430</td></tr>
431</table>
432END_OF_BLOCK
433
a4fca471 434 # create own header/footer because of --header
3ada32a3
MG
435 $parser->html_header(<<"HTMLHEAD");
436<?xml version="1.0" ?>
437<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
438<html xmlns="http://www.w3.org/1999/xhtml">
439<head>
440<title>$Title</title>$csslink
441<meta http-equiv="content-type" content="text/html; charset=utf-8" />
442<link rev="made" href="mailto:$Config{perladmin}" />
443</head>
444
e6afd145 445<body$bodyid>
3ada32a3
MG
446$block
447HTMLHEAD
59ecbafa 448
401f7940
MG
449 $parser->html_footer(<<"HTMLFOOT");
450$block
451</body>
452
453</html>
454HTMLFOOT
455
38e30ca7 456 feed_tree_to_parser($parser, $podtree);
5c988a71 457
953c3c52 458 # Write output to file
99499175
MG
459 $Htmlfile = "-" unless $Htmlfile; # stdout
460 my $fhout;
461 if($Htmlfile and $Htmlfile ne '-') {
462 open $fhout, ">", $Htmlfile
463 or die "$0: cannot open $Htmlfile file for output: $!\n";
464 } else {
465 open $fhout, ">-";
466 }
dad26a17 467 binmode $fhout, ":utf8";
99499175
MG
468 print $fhout $output;
469 close $fhout or die "Failed to close $Htmlfile: $!";
c960cc81 470 chmod 0644, $Htmlfile unless $Htmlfile eq '-';
54310121
PP
471}
472
473##############################################################################
474
54310121
PP
475sub usage {
476 my $podfile = shift;
477 warn "$0: $podfile: @_\n" if @_;
69348ecf 478 die <<END_OF_USAGE;
9b9923c6
P
479Usage: $0 --help --htmldir=<name> --htmlroot=<URL>
480 --infile=<name> --outfile=<name>
481 --podpath=<name>:...:<name> --podroot=<name>
482 --cachedir=<name> --flush --recurse --norecurse
483 --quiet --noquiet --verbose --noverbose
484 --index --noindex --backlink --nobacklink
485 --header --noheader --poderrors --nopoderrors
486 --css=<URL> --title=<name>
54310121 487
8ef5953c
MG
488 --[no]backlink - turn =head1 directives into links pointing to the top of
489 the page (off by default).
b09e89a9 490 --cachedir - directory for the directory cache files.
8ef5953c 491 --css - stylesheet URL
b09e89a9 492 --flush - flushes the directory cache.
8ef5953c
MG
493 --[no]header - produce block header/footer (default is no headers).
494 --help - prints this message.
495 --htmldir - directory for resulting HTML files.
496 --htmlroot - http-server base directory from which all relative paths
497 in podpath stem (default is /).
498 --[no]index - generate an index at the top of the resulting html
499 (default behaviour).
500 --infile - filename for the pod to convert (input taken from stdin
ed36117c 501 by default).
8ef5953c
MG
502 --outfile - filename for the resulting html file (output sent to
503 stdout by default).
504 --[no]poderrors - include a POD ERRORS section in the output if there were
505 any POD errors in the input (default behavior).
506 --podpath - colon-separated list of directories containing library
507 pods (empty by default).
508 --podroot - filesystem base directory from which all relative paths
509 in podpath stem (default is .).
510 --[no]quiet - suppress some benign warning messages (default is off).
511 --[no]recurse - recurse on those subdirectories listed in podpath
512 (default behaviour).
513 --title - title that will appear in resulting html file.
514 --[no]verbose - self-explanatory (off by default).
54310121
PP
515
516END_OF_USAGE
517
69348ecf
MS
518}
519
54310121 520sub parse_command_line {
b09e89a9
MG
521 my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,
522 $opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,
ed36117c 523 $opt_outfile,$opt_poderrors,$opt_podpath,$opt_podroot,
856f8944 524 $opt_quiet,$opt_recurse,$opt_title,$opt_verbose);
0e4548d5 525
34db337b 526 unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
54310121 527 my $result = GetOptions(
ed36117c 528 'backlink!' => \$opt_backlink,
b09e89a9 529 'cachedir=s' => \$opt_cachedir,
ed36117c 530 'css=s' => \$opt_css,
b09e89a9 531 'flush' => \$opt_flush,
ed36117c
MG
532 'help' => \$opt_help,
533 'header!' => \$opt_header,
534 'htmldir=s' => \$opt_htmldir,
535 'htmlroot=s' => \$opt_htmlroot,
536 'index!' => \$opt_index,
537 'infile=s' => \$opt_infile,
538 'outfile=s' => \$opt_outfile,
539 'poderrors!' => \$opt_poderrors,
540 'podpath=s' => \$opt_podpath,
541 'podroot=s' => \$opt_podroot,
542 'quiet!' => \$opt_quiet,
543 'recurse!' => \$opt_recurse,
544 'title=s' => \$opt_title,
545 'verbose!' => \$opt_verbose,
4979c083 546 );
54310121
PP
547 usage("-", "invalid parameters") if not $result;
548
ed36117c
MG
549 usage("-") if defined $opt_help; # see if the user asked for help
550 $opt_help = ""; # just to make -w shut-up.
54310121 551
69348ecf 552 @Podpath = split(":", $opt_podpath) if defined $opt_podpath;
69348ecf 553
ac2b477c
RS
554 $Backlink = $opt_backlink if defined $opt_backlink;
555 $Cachedir = _unixify($opt_cachedir) if defined $opt_cachedir;
556 $Css = $opt_css if defined $opt_css;
557 $Header = $opt_header if defined $opt_header;
558 $Htmldir = _unixify($opt_htmldir) if defined $opt_htmldir;
559 $Htmlroot = _unixify($opt_htmlroot) if defined $opt_htmlroot;
560 $Doindex = $opt_index if defined $opt_index;
561 $Podfile = _unixify($opt_infile) if defined $opt_infile;
562 $Htmlfile = _unixify($opt_outfile) if defined $opt_outfile;
563 $Poderrors = $opt_poderrors if defined $opt_poderrors;
564 $Podroot = _unixify($opt_podroot) if defined $opt_podroot;
565 $Quiet = $opt_quiet if defined $opt_quiet;
566 $Recurse = $opt_recurse if defined $opt_recurse;
567 $Title = $opt_title if defined $opt_title;
568 $Verbose = $opt_verbose if defined $opt_verbose;
b09e89a9
MG
569
570 warn "Flushing directory caches\n"
571 if $opt_verbose && defined $opt_flush;
572 $Dircache = "$Cachedir/pod2htmd.tmp";
573 if (defined $opt_flush) {
574 1 while unlink($Dircache);
575 }
54310121
PP
576}
577
b09e89a9
MG
578my $Saved_Cache_Key;
579
580sub get_cache {
581 my($dircache, $podpath, $podroot, $recurse) = @_;
582 my @cache_key_args = @_;
583
584 # A first-level cache:
585 # Don't bother reading the cache files if they still apply
586 # and haven't changed since we last read them.
587
588 my $this_cache_key = cache_key(@cache_key_args);
589 return 1 if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key;
590 $Saved_Cache_Key = $this_cache_key;
591
592 # load the cache of %Pages if possible. $tests will be
593 # non-zero if successful.
594 my $tests = 0;
595 if (-f $dircache) {
596 warn "scanning for directory cache\n" if $Verbose;
597 $tests = load_cache($dircache, $podpath, $podroot);
598 }
599
600 return $tests;
601}
602
603sub cache_key {
604 my($dircache, $podpath, $podroot, $recurse) = @_;
605 return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache));
606}
607
608#
609# load_cache - tries to find if the cache stored in $dircache is a valid
610# cache of %Pages. if so, it loads them and returns a non-zero value.
611#
612sub load_cache {
613 my($dircache, $podpath, $podroot) = @_;
614 my $tests = 0;
615 local $_;
616
617 warn "scanning for directory cache\n" if $Verbose;
3fabeba8 618 open(my $cachefh, '<', $dircache) ||
b09e89a9
MG
619 die "$0: error opening $dircache for reading: $!\n";
620 $/ = "\n";
621
622 # is it the same podpath?
3fabeba8 623 $_ = <$cachefh>;
b09e89a9
MG
624 chomp($_);
625 $tests++ if (join(":", @$podpath) eq $_);
626
627 # is it the same podroot?
3fabeba8 628 $_ = <$cachefh>;
b09e89a9
MG
629 chomp($_);
630 $tests++ if ($podroot eq $_);
631
632 # load the cache if its good
633 if ($tests != 2) {
3fabeba8 634 close($cachefh);
b09e89a9
MG
635 return 0;
636 }
637
638 warn "loading directory cache\n" if $Verbose;
3fabeba8 639 while (<$cachefh>) {
b09e89a9
MG
640 /(.*?) (.*)$/;
641 $Pages{$1} = $2;
642 }
643
3fabeba8 644 close($cachefh);
b09e89a9
MG
645 return 1;
646}
647
648
54310121 649#
2a28b791
GS
650# html_escape: make text safe for HTML
651#
652sub html_escape {
653 my $rest = $_[0];
654 $rest =~ s/&/&amp;/g;
655 $rest =~ s/</&lt;/g;
656 $rest =~ s/>/&gt;/g;
657 $rest =~ s/"/&quot;/g;
38e30ca7 658 $rest =~ s/([^ -~])/sprintf("&#x%x;", ord($1))/eg;
2a28b791 659 return $rest;
59ecbafa 660}
2a28b791 661
54310121
PP
662#
663# htmlify - converts a pod section specification to a suitable section
0bd1c35e
Z
664# specification for HTML. We adopt the mechanism used by the formatter
665# that we use.
54310121
PP
666#
667sub htmlify {
2a28b791 668 my( $heading) = @_;
0bd1c35e 669 return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1);
2a28b791 670}
54310121 671
2a28b791 672#
776d31fe 673# similar to htmlify, but turns non-alphanumerics into underscores
0d396dd4
SB
674#
675sub anchorify {
676 my ($anchor) = @_;
677 $anchor = htmlify($anchor);
776d31fe 678 $anchor =~ s/\W/_/g;
0d396dd4
SB
679 return $anchor;
680}
681
8e1ba33c
MG
682#
683# store POD files in %Pages
684#
99499175
MG
685sub _save_page {
686 my ($modspec, $modname) = @_;
687
042c2bc8 688 # Remove Podroot from path
1e33ffe4
CB
689 $modspec = $Podroot eq File::Spec->curdir
690 ? File::Spec->abs2rel($modspec)
691 : File::Spec->abs2rel($modspec,
692 File::Spec->canonpath($Podroot));
042c2bc8 693
7c41f1ea 694 # Convert path to unix style path
b069bc5e 695 $modspec = Pod::Html::_unixify($modspec);
7c41f1ea 696
042c2bc8 697 my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext
7c41f1ea 698 $Pages{$modname} = $dir.$file;
99499175
MG
699}
700
b069bc5e
RS
701sub _unixify {
702 my $full_path = shift;
703 return '' unless $full_path;
1e33ffe4 704 return $full_path if $full_path eq '/';
b069bc5e 705
1e33ffe4
CB
706 my ($vol, $dirs, $file) = File::Spec->splitpath($full_path);
707 my @dirs = $dirs eq File::Spec->curdir()
708 ? (File::Spec::Unix->curdir())
709 : File::Spec->splitdir($dirs);
710 if (defined($vol) && $vol) {
711 $vol =~ s/:$// if $^O eq 'VMS';
8376a7bf 712 $vol = uc $vol if $^O eq 'MSWin32';
1e33ffe4
CB
713
714 if( $dirs[0] ) {
715 unshift @dirs, $vol;
716 }
717 else {
718 $dirs[0] = $vol;
719 }
720 }
721 unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path);
722 return $file unless scalar(@dirs);
723 $full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs),
724 $file);
725 $full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't
4330eab4 726 $full_path =~ s/\^\././g if $^O eq 'VMS'; # unescape dots
1e33ffe4 727 return $full_path;
b069bc5e 728}
8e1ba33c 729
1be43d30
MG
730package Pod::Simple::XHTML::LocalPodLinks;
731use strict;
732use warnings;
2a93a16c 733use parent 'Pod::Simple::XHTML';
1be43d30
MG
734
735use File::Spec;
7c41f1ea 736use File::Spec::Unix;
1be43d30
MG
737
738__PACKAGE__->_accessorize(
739 'htmldir',
740 'htmlfileurl',
741 'htmlroot',
742 'pages', # Page name => relative/path/to/page from root POD dir
743 'quiet',
744 'verbose',
745);
746
747sub resolve_pod_page_link {
748 my ($self, $to, $section) = @_;
749
750 return undef unless defined $to || defined $section;
751 if (defined $section) {
752 $section = '#' . $self->idify($section, 1);
753 return $section unless defined $to;
754 } else {
755 $section = '';
756 }
757
4979c083
MG
758 my $path; # path to $to according to %Pages
759 unless (exists $self->pages->{$to}) {
ed36117c
MG
760 # Try to find a POD that ends with $to and use that.
761 # e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages,
762 # look for $Podpath/*/XHTML in %Pages, with * being any path,
763 # as a substitute (e.g., $Podpath/Pod/Simple/XHTML)
764 my @matches;
765 foreach my $modname (keys %{$self->pages}) {
632c5d30 766 push @matches, $modname if $modname =~ /::\Q$to\E\z/;
ed36117c
MG
767 }
768
769 if ($#matches == -1) {
770 warn "Cannot find \"$to\" in podpath: " .
771 "cannot find suitable replacement path, cannot resolve link\n"
772 unless $self->quiet;
773 return '';
774 } elsif ($#matches == 0) {
775 warn "Cannot find \"$to\" in podpath: " .
776 "using $matches[0] as replacement path to $to\n"
777 unless $self->quiet;
778 $path = $self->pages->{$matches[0]};
779 } else {
780 warn "Cannot find \"$to\" in podpath: " .
781 "more than one possible replacement path to $to, " .
782 "using $matches[-1]\n" unless $self->quiet;
e7721e60 783 # Use [-1] so newer (higher numbered) perl PODs are used
ed36117c
MG
784 $path = $self->pages->{$matches[-1]};
785 }
4979c083 786 } else {
ed36117c 787 $path = $self->pages->{$to};
1be43d30
MG
788 }
789
707a94fe 790 my $url = File::Spec::Unix->catfile(Pod::Html::_unixify($self->htmlroot),
7c41f1ea 791 $path);
707a94fe 792
1be43d30 793 if ($self->htmlfileurl ne '') {
ed36117c
MG
794 # then $self->htmlroot eq '' (by definition of htmlfileurl) so
795 # $self->htmldir needs to be prepended to link to get the absolute path
796 # that will be relativized
0bd1c35e 797 $url = Pod::Html::relativize_url(
707a94fe 798 File::Spec::Unix->catdir(Pod::Html::_unixify($self->htmldir), $url),
7c41f1ea
MG
799 $self->htmlfileurl # already unixified
800 );
4979c083
MG
801 }
802
1be43d30
MG
803 return $url . ".html$section";
804}
805
0bd1c35e
Z
806package Pod::Html;
807
1be43d30
MG
808#
809# relativize_url - convert an absolute URL to one relative to a base URL.
810# Assumes both end in a filename.
811#
812sub relativize_url {
813 my ($dest, $source) = @_;
814
815 # Remove each file from its path
816 my ($dest_volume, $dest_directory, $dest_file) =
ed36117c 817 File::Spec::Unix->splitpath( $dest );
1be43d30
MG
818 $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' );
819
820 my ($source_volume, $source_directory, $source_file) =
821 File::Spec::Unix->splitpath( $source );
822 $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' );
823
824 my $rel_path = '';
825 if ($dest ne '') {
826 $rel_path = File::Spec::Unix->abs2rel( $dest, $source );
827 }
828
829 if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') {
830 $rel_path .= "/$dest_file";
831 } else {
832 $rel_path .= "$dest_file";
833 }
834
835 return $rel_path;
836}
837
8381;