use strict;
require Exporter;
-use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.11;
-@ISA = qw(Exporter);
-@EXPORT = qw(pod2html htmlify);
-@EXPORT_OK = qw(anchorify);
+our $VERSION = 1.23;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(pod2html htmlify);
+our @EXPORT_OK = qw(anchorify relativize_url);
use Carp;
use Config;
use File::Spec::Unix;
use Getopt::Long;
use Pod::Simple::Search;
-
-use locale; # make \w work right in non-ASCII lands
+use Pod::Simple::SimpleTree ();
+use locale; # make \w work right in non-ASCII lands
=head1 NAME
=head1 DESCRIPTION
Converts files from pod format (see L<perlpod>) to HTML format. It
-can automatically generate indexes and cross-references.
+can automatically generate indexes and cross-references, and it keeps
+a cache of things it knows how to cross-reference.
=head1 FUNCTIONS
Turns every C<head1> heading into a link back to the top of the page.
By default, no backlinks are generated.
+=item cachedir
+
+ --cachedir=name
+
+Creates the directory cache in the given directory.
+
=item css
--css=stylesheet
Specify the URL of a cascading style sheet. Also disables all HTML/CSS
C<style> attributes that are output by default (to avoid conflicts).
+=item flush
+
+ --flush
+
+Flushes the directory cache.
+
=item header
--header
--htmldir=name
-Sets the directory in which the resulting HTML file is placed. This
-is used to generate relative links to other files. Not passing this
-causes all links to be absolute, since this is the value that tells
-Pod::Html the root of the documentation tree.
+Sets the directory to which all cross references in the resulting
+html file will be relative. Not passing this causes all links to be
+absolute since this is the value that tells Pod::Html the root of the
+documentation tree.
+
+Do not use this and --htmlroot in the same call to pod2html; they are
+mutually exclusive.
=item htmlroot
Sets the base URL for the HTML files. When cross-references are made,
the HTML root is prepended to the URL.
+Do not use this if relative links are desired: use --htmldir instead.
+
+Do not pass both this and --htmldir to pod2html; they are mutually
+exclusive.
+
=item index
--index
Specify the HTML file to create. Output goes to STDOUT if no outfile
is specified.
+=item poderrors
+
+ --poderrors
+ --nopoderrors
+
+Include a "POD ERRORS" section in the outfile if there were any POD
+errors in the infile. This section is included by default.
+
=item podpath
--podpath=name:...:name
--podroot=name
-Specify the base directory for finding library pods. This is prepended
-to each directory in podpath before searching for PODs. Default is the
+Specify the base directory for finding library pods. Default is the
current working directory.
=item quiet
=head1 AUTHOR
-Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
+Marc Green, E<lt>marcgreen@cpan.orgE<gt>.
+
+Original version by Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
=head1 SEE ALSO
=cut
+# This sub duplicates the guts of Pod::Simple::FromTree. We could have
+# used that module, except that it would have been a non-core dependency.
+sub feed_tree_to_parser {
+ my($parser, $tree) = @_;
+ if(ref($tree) eq "") {
+ $parser->_handle_text($tree);
+ } elsif(!($tree->[0] eq "X" && $parser->nix_X_codes)) {
+ $parser->_handle_element_start($tree->[0], $tree->[1]);
+ feed_tree_to_parser($parser, $_) foreach @{$tree}[2..$#$tree];
+ $parser->_handle_element_end($tree->[0]);
+ }
+}
+
+my $Cachedir;
+my $Dircache;
my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl);
my($Podfile, @Podpath, $Podroot);
+my $Poderrors;
my $Css;
my $Recurse;
my($Title, $Header);
-my %Pages = (); # associative array used to find the location
+my %Pages = (); # associative array used to find the location
# of pages referenced by L<> links.
my $Curdir = File::Spec->curdir;
init_globals();
sub init_globals {
- $Htmlroot = "/"; # http-server base directory from which all
+ $Cachedir = "."; # The directory to which directory caches
+ # will be written.
+
+ $Dircache = "pod2htmd.tmp";
+
+ $Htmlroot = "/"; # http-server base directory from which all
# relative paths in $podpath stem.
- $Htmldir = ""; # The directory to which the html pages
- # will (eventually) be written.
- $Htmlfile = ""; # write to stdout by default
- $Htmlfileurl = ""; # The url that other files would use to
+ $Htmldir = ""; # The directory to which the html pages
+ # will (eventually) be written.
+ $Htmlfile = ""; # write to stdout by default
+ $Htmlfileurl = ""; # The url that other files would use to
# refer to this file. This is only used
# to make relative urls that point to
# other files.
- $Podfile = ""; # read from stdin by default
- @Podpath = (); # list of directories containing library pods.
- $Podroot = $Curdir; # filesystem base directory from which all
+ $Poderrors = 1;
+ $Podfile = ""; # read from stdin by default
+ @Podpath = (); # list of directories containing library pods.
+ $Podroot = $Curdir; # filesystem base directory from which all
# relative paths in $podpath stem.
$Css = ''; # Cascading style sheet
- $Recurse = 1; # recurse on subdirectories in $podpath.
- $Quiet = 0; # not quiet by default
- $Verbose = 0; # not verbose by default
- $Doindex = 1; # non-zero if we should generate an index
- $Backlink = 0; # no backlinks added by default
- $Header = 0; # produce block header/footer
- $Title = ''; # title to give the pod(s)
+ $Recurse = 1; # recurse on subdirectories in $podpath.
+ $Quiet = 0; # not quiet by default
+ $Verbose = 0; # not verbose by default
+ $Doindex = 1; # non-zero if we should generate an index
+ $Backlink = 0; # no backlinks added by default
+ $Header = 0; # produce block header/footer
+ $Title = undef; # title to give the pod(s)
}
sub pod2html {
&& defined( $Htmldir )
&& $Htmldir ne ''
&& substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir
- )
- {
- # Set the 'base' url for this file, so that we can use it
- # as the location from which to calculate relative links
- # to other files. If this is '', then absolute links will
- # be used throughout.
- $Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1);
+ ) {
+ # Set the 'base' url for this file, so that we can use it
+ # as the location from which to calculate relative links
+ # to other files. If this is '', then absolute links will
+ # be used throughout.
+ #$Htmlfileurl = "$Htmldir/" . substr( $Htmlfile, length( $Htmldir ) + 1);
+ # Is the above not just "$Htmlfileurl = $Htmlfile"?
+ $Htmlfileurl = Pod::Html::_unixify($Htmlfile);
+
}
-
- # get the full path
- @Podpath = map { File::Spec->catdir($Podroot, $_) } @Podpath;
-
- # find all pod modules/pages in podpath, store in %Pages
- # - callback used to remove $Podroot from each file
- # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
- Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1)
- ->callback(\&_save_page)->survey(@Podpath);
-
- # set options for the parser
- my $parser = Pod::Simple::XHTML::LocalPodLinks->new();
+
+ # load or generate/cache %Pages
+ unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) {
+ # generate %Pages
+ my $pwd = getcwd();
+ chdir($Podroot) ||
+ die "$0: error changing to directory $Podroot: $!\n";
+
+ # find all pod modules/pages in podpath, store in %Pages
+ # - callback used to remove Podroot and extension from each file
+ # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
+ Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1)
+ ->callback(\&_save_page)->recurse($Recurse)->survey(@Podpath);
+
+ chdir($pwd) || die "$0: error changing to directory $pwd: $!\n";
+
+ # cache the directory list for later use
+ warn "caching directories for later use\n" if $Verbose;
+ open my $cache, '>', $Dircache
+ or die "$0: error open $Dircache for writing: $!\n";
+
+ print $cache join(":", @Podpath) . "\n$Podroot\n";
+ my $_updirs_only = ($Podroot =~ /\.\./) && !($Podroot =~ /[^\.\\\/]/);
+ foreach my $key (keys %Pages) {
+ if($_updirs_only) {
+ my $_dirlevel = $Podroot;
+ while($_dirlevel =~ /\.\./) {
+ $_dirlevel =~ s/\.\.//;
+ # Assume $Pages{$key} has '/' separators (html dir separators).
+ $Pages{$key} =~ s/^[\w\s\-\.]+\///;
+ }
+ }
+ print $cache "$key $Pages{$key}\n";
+ }
+
+ close $cache or die "error closing $Dircache: $!";
+ }
+
+ my $input;
+ unless (@ARGV && $ARGV[0]) {
+ if ($Podfile and $Podfile ne '-') {
+ $input = $Podfile;
+ } else {
+ $input = '-'; # XXX: make a test case for this
+ }
+ } else {
+ $Podfile = $ARGV[0];
+ $input = *ARGV;
+ }
+
+ # set options for input parser
+ my $parser = Pod::Simple::SimpleTree->new;
+ $parser->codes_in_verbatim(0);
+ $parser->accept_targets(qw(html HTML));
+ $parser->no_errata_section(!$Poderrors); # note the inverse
+
+ warn "Converting input file $Podfile\n" if $Verbose;
+ my $podtree = $parser->parse_file($input)->root;
+
+ unless(defined $Title) {
+ if($podtree->[0] eq "Document" && ref($podtree->[2]) eq "ARRAY" &&
+ $podtree->[2]->[0] eq "head1" && @{$podtree->[2]} == 3 &&
+ ref($podtree->[2]->[2]) eq "" && $podtree->[2]->[2] eq "NAME" &&
+ ref($podtree->[3]) eq "ARRAY" && $podtree->[3]->[0] eq "Para" &&
+ @{$podtree->[3]} >= 3 &&
+ !(grep { ref($_) ne "" }
+ @{$podtree->[3]}[2..$#{$podtree->[3]}]) &&
+ (@$podtree == 4 ||
+ (ref($podtree->[4]) eq "ARRAY" &&
+ $podtree->[4]->[0] eq "head1"))) {
+ $Title = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]);
+ }
+ }
+
+ $Title //= "";
+ $Title = html_escape($Title);
+
+ # set options for the HTML generator
+ $parser = Pod::Simple::XHTML::LocalPodLinks->new();
+ $parser->codes_in_verbatim(0);
+ $parser->anchor_items(1); # the old Pod::Html always did
$parser->backlink($Backlink); # linkify =head1 directives
+ $parser->force_title($Title);
$parser->htmldir($Htmldir);
$parser->htmlfileurl($Htmlfileurl);
$parser->htmlroot($Htmlroot);
$parser->quiet($Quiet);
$parser->verbose($Verbose);
- # TODO: implement default title generator in pod::simple::xhtml
- $Title = html_escape($Title);
-
# We need to add this ourselves because we use our own header, not
- # ::XHTML's header. We still need to set $parser->backlink to linkify
+ # ::XHTML's header. We need to set $parser->backlink to linkify
# the =head1 directives
my $bodyid = $Backlink ? ' id="_podtop_"' : '';
my $csslink = '';
- my $bodystyle = ' style="background-color: white"';
- my $tdstyle = ' style="background-color: #cccccc"';
+ my $tdstyle = ' style="background-color: #cccccc; color: #000"';
if ($Css) {
- $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />);
- $csslink =~ s,\\,/,g;
- $csslink =~ s,(/.):,$1|,;
- $bodystyle = '';
- $tdstyle= '';
+ $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />);
+ $csslink =~ s,\\,/,g;
+ $csslink =~ s,(/.):,$1|,;
+ $tdstyle= '';
}
# header/footer block
<link rev="made" href="mailto:$Config{perladmin}" />
</head>
-<body$bodyid$bodystyle>
+<body$bodyid>
$block
HTMLHEAD
</html>
HTMLFOOT
- my $input;
- unless (@ARGV && $ARGV[0]) {
- if ($Podfile and $Podfile ne '-') {
- $input = $Podfile;
- } else {
- $input = '-'; # note: make a test case for this
- }
- } else {
- $Podfile = $ARGV[0];
- $input = *ARGV;
- }
-
- warn "Converting input file $Podfile\n" if $Verbose;
- $parser->parse_file($input);
+ feed_tree_to_parser($parser, $podtree);
# Write output to file
$Htmlfile = "-" unless $Htmlfile; # stdout
} else {
open $fhout, ">-";
}
+ binmode $fhout, ":utf8";
print $fhout $output;
close $fhout or die "Failed to close $Htmlfile: $!";
+ chmod 0644, $Htmlfile unless $Htmlfile eq '-';
}
##############################################################################
my $podfile = shift;
warn "$0: $podfile: @_\n" if @_;
die <<END_OF_USAGE;
-Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
+Usage: $0 --help --htmldir=<name> --htmlroot=<URL>
+ --infile=<name> --outfile=<name>
--podpath=<name>:...:<name> --podroot=<name>
- --recurse --verbose --index --norecurse --noindex
-
- --backlink - turn =head1 directives into links pointing to the top of
- the page (off by default).
- --css - stylesheet URL
- --[no]header - produce block header/footer (default is no headers).
- --help - prints this message.
- --htmldir - directory for resulting HTML files.
- --htmlroot - http-server base directory from which all relative paths
- in podpath stem (default is /).
- --[no]index - generate an index at the top of the resulting html
- (default behaviour).
- --infile - filename for the pod to convert (input taken from stdin
- by default).
- --outfile - filename for the resulting html file (output sent to
- stdout by default).
- --podpath - colon-separated list of directories containing library
- pods (empty by default).
- --podroot - filesystem base directory from which all relative paths
- in podpath stem (default is .).
- --[no]quiet - suppress some benign warning messages (default is off).
- --[no]recurse - recurse on those subdirectories listed in podpath
- (default behaviour).
- --title - title that will appear in resulting html file.
- --[no]verbose - self-explanatory (off by default).
+ --cachedir=<name> --flush --recurse --norecurse
+ --quiet --noquiet --verbose --noverbose
+ --index --noindex --backlink --nobacklink
+ --header --noheader --poderrors --nopoderrors
+ --css=<URL> --title=<name>
+
+ --[no]backlink - turn =head1 directives into links pointing to the top of
+ the page (off by default).
+ --cachedir - directory for the directory cache files.
+ --css - stylesheet URL
+ --flush - flushes the directory cache.
+ --[no]header - produce block header/footer (default is no headers).
+ --help - prints this message.
+ --htmldir - directory for resulting HTML files.
+ --htmlroot - http-server base directory from which all relative paths
+ in podpath stem (default is /).
+ --[no]index - generate an index at the top of the resulting html
+ (default behaviour).
+ --infile - filename for the pod to convert (input taken from stdin
+ by default).
+ --outfile - filename for the resulting html file (output sent to
+ stdout by default).
+ --[no]poderrors - include a POD ERRORS section in the output if there were
+ any POD errors in the input (default behavior).
+ --podpath - colon-separated list of directories containing library
+ pods (empty by default).
+ --podroot - filesystem base directory from which all relative paths
+ in podpath stem (default is .).
+ --[no]quiet - suppress some benign warning messages (default is off).
+ --[no]recurse - recurse on those subdirectories listed in podpath
+ (default behaviour).
+ --title - title that will appear in resulting html file.
+ --[no]verbose - self-explanatory (off by default).
END_OF_USAGE
}
sub parse_command_line {
- my ($opt_backlink,$opt_css,$opt_header,$opt_help,
- $opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,
- $opt_outfile,$opt_podpath,$opt_podroot,$opt_quiet,
- $opt_recurse,$opt_title,$opt_verbose);
+ my ($opt_backlink,$opt_cachedir,$opt_css,$opt_flush,$opt_header,
+ $opt_help,$opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,
+ $opt_outfile,$opt_poderrors,$opt_podpath,$opt_podroot,
+ $opt_quiet,$opt_recurse,$opt_title,$opt_verbose);
unshift @ARGV, split ' ', $Config{pod2html} if $Config{pod2html};
my $result = GetOptions(
- 'backlink!' => \$opt_backlink,
- 'css=s' => \$opt_css,
- 'help' => \$opt_help,
- 'header!' => \$opt_header,
- 'htmldir=s' => \$opt_htmldir,
- 'htmlroot=s' => \$opt_htmlroot,
- 'index!' => \$opt_index,
- 'infile=s' => \$opt_infile,
- 'outfile=s' => \$opt_outfile,
- 'podpath=s' => \$opt_podpath,
- 'podroot=s' => \$opt_podroot,
- 'quiet!' => \$opt_quiet,
- 'recurse!' => \$opt_recurse,
- 'title=s' => \$opt_title,
- 'verbose!' => \$opt_verbose,
+ 'backlink!' => \$opt_backlink,
+ 'cachedir=s' => \$opt_cachedir,
+ 'css=s' => \$opt_css,
+ 'flush' => \$opt_flush,
+ 'help' => \$opt_help,
+ 'header!' => \$opt_header,
+ 'htmldir=s' => \$opt_htmldir,
+ 'htmlroot=s' => \$opt_htmlroot,
+ 'index!' => \$opt_index,
+ 'infile=s' => \$opt_infile,
+ 'outfile=s' => \$opt_outfile,
+ 'poderrors!' => \$opt_poderrors,
+ 'podpath=s' => \$opt_podpath,
+ 'podroot=s' => \$opt_podroot,
+ 'quiet!' => \$opt_quiet,
+ 'recurse!' => \$opt_recurse,
+ 'title=s' => \$opt_title,
+ 'verbose!' => \$opt_verbose,
);
usage("-", "invalid parameters") if not $result;
- usage("-") if defined $opt_help; # see if the user asked for help
- $opt_help = ""; # just to make -w shut-up.
+ usage("-") if defined $opt_help; # see if the user asked for help
+ $opt_help = ""; # just to make -w shut-up.
@Podpath = split(":", $opt_podpath) if defined $opt_podpath;
- $Backlink = $opt_backlink if defined $opt_backlink;
- $Css = $opt_css if defined $opt_css;
- $Header = $opt_header if defined $opt_header;
- $Htmldir = $opt_htmldir if defined $opt_htmldir;
- $Htmlroot = $opt_htmlroot if defined $opt_htmlroot;
- $Doindex = $opt_index if defined $opt_index;
- $Podfile = $opt_infile if defined $opt_infile;
- $Htmlfile = $opt_outfile if defined $opt_outfile;
- $Podroot = $opt_podroot if defined $opt_podroot;
- $Quiet = $opt_quiet if defined $opt_quiet;
- $Recurse = $opt_recurse if defined $opt_recurse;
- $Title = $opt_title if defined $opt_title;
- $Verbose = $opt_verbose if defined $opt_verbose;
+ $Backlink = $opt_backlink if defined $opt_backlink;
+ $Cachedir = _unixify($opt_cachedir) if defined $opt_cachedir;
+ $Css = $opt_css if defined $opt_css;
+ $Header = $opt_header if defined $opt_header;
+ $Htmldir = _unixify($opt_htmldir) if defined $opt_htmldir;
+ $Htmlroot = _unixify($opt_htmlroot) if defined $opt_htmlroot;
+ $Doindex = $opt_index if defined $opt_index;
+ $Podfile = _unixify($opt_infile) if defined $opt_infile;
+ $Htmlfile = _unixify($opt_outfile) if defined $opt_outfile;
+ $Poderrors = $opt_poderrors if defined $opt_poderrors;
+ $Podroot = _unixify($opt_podroot) if defined $opt_podroot;
+ $Quiet = $opt_quiet if defined $opt_quiet;
+ $Recurse = $opt_recurse if defined $opt_recurse;
+ $Title = $opt_title if defined $opt_title;
+ $Verbose = $opt_verbose if defined $opt_verbose;
+
+ warn "Flushing directory caches\n"
+ if $opt_verbose && defined $opt_flush;
+ $Dircache = "$Cachedir/pod2htmd.tmp";
+ if (defined $opt_flush) {
+ 1 while unlink($Dircache);
+ }
+}
+
+my $Saved_Cache_Key;
+
+sub get_cache {
+ my($dircache, $podpath, $podroot, $recurse) = @_;
+ my @cache_key_args = @_;
+
+ # A first-level cache:
+ # Don't bother reading the cache files if they still apply
+ # and haven't changed since we last read them.
+
+ my $this_cache_key = cache_key(@cache_key_args);
+ return 1 if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key;
+ $Saved_Cache_Key = $this_cache_key;
+
+ # load the cache of %Pages if possible. $tests will be
+ # non-zero if successful.
+ my $tests = 0;
+ if (-f $dircache) {
+ warn "scanning for directory cache\n" if $Verbose;
+ $tests = load_cache($dircache, $podpath, $podroot);
+ }
+
+ return $tests;
+}
+
+sub cache_key {
+ my($dircache, $podpath, $podroot, $recurse) = @_;
+ return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache));
}
#
+# load_cache - tries to find if the cache stored in $dircache is a valid
+# cache of %Pages. if so, it loads them and returns a non-zero value.
+#
+sub load_cache {
+ my($dircache, $podpath, $podroot) = @_;
+ my $tests = 0;
+ local $_;
+
+ warn "scanning for directory cache\n" if $Verbose;
+ open(my $cachefh, '<', $dircache) ||
+ die "$0: error opening $dircache for reading: $!\n";
+ $/ = "\n";
+
+ # is it the same podpath?
+ $_ = <$cachefh>;
+ chomp($_);
+ $tests++ if (join(":", @$podpath) eq $_);
+
+ # is it the same podroot?
+ $_ = <$cachefh>;
+ chomp($_);
+ $tests++ if ($podroot eq $_);
+
+ # load the cache if its good
+ if ($tests != 2) {
+ close($cachefh);
+ return 0;
+ }
+
+ warn "loading directory cache\n" if $Verbose;
+ while (<$cachefh>) {
+ /(.*?) (.*)$/;
+ $Pages{$1} = $2;
+ }
+
+ close($cachefh);
+ return 1;
+}
+
+
+#
# html_escape: make text safe for HTML
#
sub html_escape {
$rest =~ s/</</g;
$rest =~ s/>/>/g;
$rest =~ s/"/"/g;
- # ' is only in XHTML, not HTML4. Be conservative
- #$rest =~ s/'/'/g;
+ $rest =~ s/([^ -~])/sprintf("&#x%x;", ord($1))/eg;
return $rest;
}
#
# htmlify - converts a pod section specification to a suitable section
-# specification for HTML. Note that we keep spaces and special characters
-# except ", ? (Netscape problem) and the hyphen (writer's problem...).
+# specification for HTML. We adopt the mechanism used by the formatter
+# that we use.
#
sub htmlify {
my( $heading) = @_;
- $heading =~ s/(\s+)/ /g;
- $heading =~ s/\s+\Z//;
- $heading =~ s/\A\s+//;
- # The hyphen is a disgrace to the English language.
- # $heading =~ s/[-"?]//g;
- $heading =~ s/["?]//g;
- $heading = lc( $heading );
- return $heading;
+ return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1);
}
#
sub _save_page {
my ($modspec, $modname) = @_;
- # Remove $Podroot from path for cross referencing
- my $rel_path = substr($modspec, length($Podroot));
-
- my ($file, $dir) = fileparse($rel_path, qr/\.[^.]*/); # strip .ext
- $Pages{$modname} = $dir . $file;
+ # Remove Podroot from path
+ $modspec = $Podroot eq File::Spec->curdir
+ ? File::Spec->abs2rel($modspec)
+ : File::Spec->abs2rel($modspec,
+ File::Spec->canonpath($Podroot));
+
+ # Convert path to unix style path
+ $modspec = Pod::Html::_unixify($modspec);
+
+ my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext
+ $Pages{$modname} = $dir.$file;
}
-1;
+sub _unixify {
+ my $full_path = shift;
+ return '' unless $full_path;
+ return $full_path if $full_path eq '/';
+
+ my ($vol, $dirs, $file) = File::Spec->splitpath($full_path);
+ my @dirs = $dirs eq File::Spec->curdir()
+ ? (File::Spec::Unix->curdir())
+ : File::Spec->splitdir($dirs);
+ if (defined($vol) && $vol) {
+ $vol =~ s/:$// if $^O eq 'VMS';
+ $vol = uc $vol if $^O eq 'MSWin32';
+
+ if( $dirs[0] ) {
+ unshift @dirs, $vol;
+ }
+ else {
+ $dirs[0] = $vol;
+ }
+ }
+ unshift @dirs, '' if File::Spec->file_name_is_absolute($full_path);
+ return $file unless scalar(@dirs);
+ $full_path = File::Spec::Unix->catfile(File::Spec::Unix->catdir(@dirs),
+ $file);
+ $full_path =~ s|^\/|| if $^O eq 'MSWin32'; # C:/foo works, /C:/foo doesn't
+ $full_path =~ s/\^\././g if $^O eq 'VMS'; # unescape dots
+ return $full_path;
+}
package Pod::Simple::XHTML::LocalPodLinks;
use strict;
use warnings;
-use base 'Pod::Simple::XHTML';
+use parent 'Pod::Simple::XHTML';
use File::Spec;
+use File::Spec::Unix;
__PACKAGE__->_accessorize(
'htmldir',
my $path; # path to $to according to %Pages
unless (exists $self->pages->{$to}) {
- # Try to find a POD that ends with $to and use that.
- # e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages,
- # look for $Podpath/*/XHTML in %Pages, with * being any path,
- # as a substitute (e.g., $Podpath/Pod/Simple/XHTML)
- my @matches;
- foreach my $modname (keys %{$self->pages}) {
- push @matches, $modname if $modname =~ /::$to\z/;
- }
-
- if ($#matches == -1) {
- warn "Cannot find \"$to\" in podpath: " .
- "cannot find suitable replacement path, cannot resolve link\n"
- unless $self->quiet;
- return '';
- } elsif ($#matches == 0) {
- warn "Cannot find \"$to\" in podpath: " .
- "using $matches[0] as replacement path to $to\n"
- unless $self->quiet;
- $path = $self->pages->{$matches[0]};
- } else {
- warn "Cannot find \"$to\" in podpath: " .
- "more than one possible replacement path to $to, " .
- "using $matches[-1]\n" unless $self->quiet;
- # Use last one found so that newer perl PODs are used
- $path = $self->pages->{$matches[-1]};
- }
+ # Try to find a POD that ends with $to and use that.
+ # e.g., given L<XHTML>, if there is no $Podpath/XHTML in %Pages,
+ # look for $Podpath/*/XHTML in %Pages, with * being any path,
+ # as a substitute (e.g., $Podpath/Pod/Simple/XHTML)
+ my @matches;
+ foreach my $modname (keys %{$self->pages}) {
+ push @matches, $modname if $modname =~ /::\Q$to\E\z/;
+ }
+
+ if ($#matches == -1) {
+ warn "Cannot find \"$to\" in podpath: " .
+ "cannot find suitable replacement path, cannot resolve link\n"
+ unless $self->quiet;
+ return '';
+ } elsif ($#matches == 0) {
+ warn "Cannot find \"$to\" in podpath: " .
+ "using $matches[0] as replacement path to $to\n"
+ unless $self->quiet;
+ $path = $self->pages->{$matches[0]};
+ } else {
+ warn "Cannot find \"$to\" in podpath: " .
+ "more than one possible replacement path to $to, " .
+ "using $matches[-1]\n" unless $self->quiet;
+ # Use [-1] so newer (higher numbered) perl PODs are used
+ $path = $self->pages->{$matches[-1]};
+ }
} else {
- $path = $self->pages->{$to};
+ $path = $self->pages->{$to};
}
- # catdir takes care of a leading '//', so I use it here
- my $url = File::Spec->catdir($self->htmlroot, $path);
+ my $url = File::Spec::Unix->catfile(Pod::Html::_unixify($self->htmlroot),
+ $path);
+
if ($self->htmlfileurl ne '') {
- # then $self->htmlroot eq '' (by definition of htmlfileurl) so
- # $self->htmldir needs to be prepended to link to get the absolute path
- # that will be relativized
- $url = relativize_url($self->htmldir.$url, $self->htmlfileurl);
+ # then $self->htmlroot eq '' (by definition of htmlfileurl) so
+ # $self->htmldir needs to be prepended to link to get the absolute path
+ # that will be relativized
+ $url = Pod::Html::relativize_url(
+ File::Spec::Unix->catdir(Pod::Html::_unixify($self->htmldir), $url),
+ $self->htmlfileurl # already unixified
+ );
}
return $url . ".html$section";
}
+package Pod::Html;
+
#
# relativize_url - convert an absolute URL to one relative to a base URL.
# Assumes both end in a filename.
# Remove each file from its path
my ($dest_volume, $dest_directory, $dest_file) =
- File::Spec::Unix->splitpath( $dest );
+ File::Spec::Unix->splitpath( $dest );
$dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' );
my ($source_volume, $source_directory, $source_file) =
https://perl5.git.perl.org / perl5.git / blobdiff