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