diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /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.pm | 838 |
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_"> $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/&/&/g; + $rest =~ s/</</g; + $rest =~ s/>/>/g; + $rest =~ s/"/"/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; |