summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm
Initial commit
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm838
1 files changed, 838 insertions, 0 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm
new file mode 100644
index 0000000000..64cf376f3c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm
@@ -0,0 +1,838 @@
+package Pod::Html;
+use strict;
+require Exporter;
+
+our $VERSION = 1.24;
+our @ISA = qw(Exporter);
+our @EXPORT = qw(pod2html htmlify);
+our @EXPORT_OK = qw(anchorify relativize_url);
+
+use Carp;
+use Config;
+use Cwd;
+use File::Basename;
+use File::Spec;
+use File::Spec::Unix;
+use Getopt::Long;
+use Pod::Simple::Search;
+use Pod::Simple::SimpleTree ();
+use locale; # make \w work right in non-ASCII lands
+
+=head1 NAME
+
+Pod::Html - module to convert pod files to HTML
+
+=head1 SYNOPSIS
+
+ use Pod::Html;
+ pod2html([options]);
+
+=head1 DESCRIPTION
+
+Converts files from pod format (see L<perlpod>) to HTML format. It
+can automatically generate indexes and cross-references, and it keeps
+a cache of things it knows how to cross-reference.
+
+=head1 FUNCTIONS
+
+=head2 pod2html
+
+ pod2html("pod2html",
+ "--podpath=lib:ext:pod:vms",
+ "--podroot=/usr/src/perl",
+ "--htmlroot=/perl/nmanual",
+ "--recurse",
+ "--infile=foo.pod",
+ "--outfile=/perl/nmanual/foo.html");
+
+pod2html takes the following arguments:
+
+=over 4
+
+=item backlink
+
+ --backlink
+
+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
+ --noheader
+
+Creates header and footer blocks containing the text of the C<NAME>
+section. By default, no headers are generated.
+
+=item help
+
+ --help
+
+Displays the usage message.
+
+=item htmldir
+
+ --htmldir=name
+
+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
+
+ --htmlroot=name
+
+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
+ --noindex
+
+Generate an index at the top of the HTML file. This is the default
+behaviour.
+
+=item infile
+
+ --infile=name
+
+Specify the pod file to convert. Input is taken from STDIN if no
+infile is specified.
+
+=item outfile
+
+ --outfile=name
+
+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
+
+Specify which subdirectories of the podroot contain pod files whose
+HTML converted forms can be linked to in cross references.
+
+=item podroot
+
+ --podroot=name
+
+Specify the base directory for finding library pods. Default is the
+current working directory.
+
+=item quiet
+
+ --quiet
+ --noquiet
+
+Don't display I<mostly harmless> warning messages. These messages
+will be displayed by default. But this is not the same as C<verbose>
+mode.
+
+=item recurse
+
+ --recurse
+ --norecurse
+
+Recurse into subdirectories specified in podpath (default behaviour).
+
+=item title
+
+ --title=title
+
+Specify the title of the resulting HTML file.
+
+=item verbose
+
+ --verbose
+ --noverbose
+
+Display progress messages. By default, they won't be displayed.
+
+=back
+
+=head2 htmlify
+
+ htmlify($heading);
+
+Converts a pod section specification to a suitable section specification
+for HTML. Note that we keep spaces and special characters except
+C<", ?> (Netscape problem) and the hyphen (writer's problem...).
+
+=head2 anchorify
+
+ anchorify(@heading);
+
+Similar to C<htmlify()>, but turns non-alphanumerics into underscores. Note
+that C<anchorify()> is not exported by default.
+
+=head1 ENVIRONMENT
+
+Uses C<$Config{pod2html}> to setup default options.
+
+=head1 AUTHOR
+
+Marc Green, E<lt>marcgreen@cpan.orgE<gt>.
+
+Original version by Tom Christiansen, E<lt>tchrist@perl.comE<gt>.
+
+=head1 SEE ALSO
+
+L<perlpod>
+
+=head1 COPYRIGHT
+
+This program is distributed under the Artistic License.
+
+=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 $Quiet;
+my $Verbose;
+my $Doindex;
+
+my $Backlink;
+
+my($Title, $Header);
+
+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 {
+ $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
+ # refer to this file. This is only used
+ # to make relative urls that point to
+ # other files.
+
+ $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 = undef; # title to give the pod(s)
+}
+
+sub pod2html {
+ local(@ARGV) = @_;
+ local $_;
+
+ init_globals();
+ parse_command_line();
+
+ # prevent '//' in urls
+ $Htmlroot = "" if $Htmlroot eq "/";
+ $Htmldir =~ s#/\z##;
+
+ if ( $Htmlroot eq ''
+ && 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);
+ # Is the above not just "$Htmlfileurl = $Htmlfile"?
+ $Htmlfileurl = Pod::Html::_unixify($Htmlfile);
+
+ }
+
+ # 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->index($Doindex);
+ $parser->output_string(\my $output); # written to file later
+ $parser->pages(\%Pages);
+ $parser->quiet($Quiet);
+ $parser->verbose($Verbose);
+
+ # We need to add this ourselves because we use our own header, not
+ # ::XHTML's header. We need to set $parser->backlink to linkify
+ # the =head1 directives
+ my $bodyid = $Backlink ? ' id="_podtop_"' : '';
+
+ my $csslink = '';
+ 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|,;
+ $tdstyle= '';
+ }
+
+ # header/footer block
+ my $block = $Header ? <<END_OF_BLOCK : '';
+<table border="0" width="100%" cellspacing="0" cellpadding="3">
+<tr><td class="_podblock_"$tdstyle valign="middle">
+<big><strong><span class="_podblock_">&nbsp;$Title</span></strong></big>
+</td></tr>
+</table>
+END_OF_BLOCK
+
+ # create own header/footer because of --header
+ $parser->html_header(<<"HTMLHEAD");
+<?xml version="1.0" ?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+<title>$Title</title>$csslink
+<meta http-equiv="content-type" content="text/html; charset=utf-8" />
+<link rev="made" href="mailto:$Config{perladmin}" />
+</head>
+
+<body$bodyid>
+$block
+HTMLHEAD
+
+ $parser->html_footer(<<"HTMLFOOT");
+$block
+</body>
+
+</html>
+HTMLFOOT
+
+ feed_tree_to_parser($parser, $podtree);
+
+ # Write output to file
+ $Htmlfile = "-" unless $Htmlfile; # stdout
+ my $fhout;
+ if($Htmlfile and $Htmlfile ne '-') {
+ open $fhout, ">", $Htmlfile
+ or die "$0: cannot open $Htmlfile file for output: $!\n";
+ } else {
+ open $fhout, ">-";
+ }
+ binmode $fhout, ":utf8";
+ print $fhout $output;
+ close $fhout or die "Failed to close $Htmlfile: $!";
+ chmod 0644, $Htmlfile unless $Htmlfile eq '-';
+}
+
+##############################################################################
+
+sub usage {
+ my $podfile = shift;
+ warn "$0: $podfile: @_\n" if @_;
+ die <<END_OF_USAGE;
+Usage: $0 --help --htmldir=<name> --htmlroot=<URL>
+ --infile=<name> --outfile=<name>
+ --podpath=<name>:...:<name> --podroot=<name>
+ --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_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,
+ '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.
+
+ @Podpath = split(":", $opt_podpath) if defined $opt_podpath;
+
+ $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 {
+ my $rest = $_[0];
+ $rest =~ s/&/&amp;/g;
+ $rest =~ s/</&lt;/g;
+ $rest =~ s/>/&gt;/g;
+ $rest =~ s/"/&quot;/g;
+ $rest =~ s/([[:^print:]])/sprintf("&#x%x;", ord($1))/aeg;
+ return $rest;
+}
+
+#
+# htmlify - converts a pod section specification to a suitable section
+# specification for HTML. We adopt the mechanism used by the formatter
+# that we use.
+#
+sub htmlify {
+ my( $heading) = @_;
+ return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1);
+}
+
+#
+# similar to htmlify, but turns non-alphanumerics into underscores
+#
+sub anchorify {
+ my ($anchor) = @_;
+ $anchor = htmlify($anchor);
+ $anchor =~ s/\W/_/g;
+ return $anchor;
+}
+
+#
+# store POD files in %Pages
+#
+sub _save_page {
+ my ($modspec, $modname) = @_;
+
+ # 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;
+}
+
+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 parent 'Pod::Simple::XHTML';
+
+use File::Spec;
+use File::Spec::Unix;
+
+__PACKAGE__->_accessorize(
+ 'htmldir',
+ 'htmlfileurl',
+ 'htmlroot',
+ 'pages', # Page name => relative/path/to/page from root POD dir
+ 'quiet',
+ 'verbose',
+);
+
+sub resolve_pod_page_link {
+ my ($self, $to, $section) = @_;
+
+ return undef unless defined $to || defined $section;
+ if (defined $section) {
+ $section = '#' . $self->idify($section, 1);
+ return $section unless defined $to;
+ } else {
+ $section = '';
+ }
+
+ 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 =~ /::\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};
+ }
+
+ 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 = 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.
+#
+sub relativize_url {
+ my ($dest, $source) = @_;
+
+ # Remove each file from its path
+ my ($dest_volume, $dest_directory, $dest_file) =
+ File::Spec::Unix->splitpath( $dest );
+ $dest = File::Spec::Unix->catpath( $dest_volume, $dest_directory, '' );
+
+ my ($source_volume, $source_directory, $source_file) =
+ File::Spec::Unix->splitpath( $source );
+ $source = File::Spec::Unix->catpath( $source_volume, $source_directory, '' );
+
+ my $rel_path = '';
+ if ($dest ne '') {
+ $rel_path = File::Spec::Unix->abs2rel( $dest, $source );
+ }
+
+ if ($rel_path ne '' && substr( $rel_path, -1 ) ne '/') {
+ $rel_path .= "/$dest_file";
+ } else {
+ $rel_path .= "$dest_file";
+ }
+
+ return $rel_path;
+}
+
+1;