summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm820
1 files changed, 339 insertions, 481 deletions
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm b/systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm
index ba0ab0b39a..7c568f9e91 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/lib/Pod/Html.pm
@@ -1,22 +1,27 @@
package Pod::Html;
use strict;
-require Exporter;
+use Exporter 'import';
-our $VERSION = 1.27;
-our @ISA = qw(Exporter);
-our @EXPORT = qw(pod2html htmlify);
-our @EXPORT_OK = qw(anchorify relativize_url);
+our $VERSION = 1.34;
+$VERSION = eval $VERSION;
+our @EXPORT = qw(pod2html);
-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 Text::Tabs;
+use Pod::Html::Util qw(
+ html_escape
+ process_command_line
+ trim_leading_whitespace
+ unixify
+ usage
+ htmlify
+ anchorify
+ relativize_url
+);
use locale; # make \w work right in non-ASCII lands
=head1 NAME
@@ -189,20 +194,26 @@ Display progress messages. By default, they won't be displayed.
=back
-=head2 htmlify
+=head2 Formerly Exported Auxiliary Functions
- htmlify($heading);
+Prior to perl-5.36, the following three functions were exported by
+F<Pod::Html>, either by default or on request:
+
+=over 4
-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...).
+=item * C<htmlify()> (by default)
-=head2 anchorify
+=item * C<anchorify()> (upon request)
+
+=item * C<relativize_url()> (upon request)
+
+=back
- anchorify(@heading);
+The definition and documentation of these functions have been moved to
+F<Pod::Html::Util>, viewable via C<perldoc Pod::Html::Util>.
-Similar to C<htmlify()>, but turns non-alphanumerics into underscores. Note
-that C<anchorify()> is not exported by default.
+Beginning with perl-5.38 these functions must be explicitly imported from
+F<Pod::Html::Util>. Please modify your code as needed.
=head1 ENVIRONMENT
@@ -224,386 +235,234 @@ 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;
-
-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 new {
+ my $class = shift;
+ return bless {}, $class;
}
sub pod2html {
local(@ARGV) = @_;
local $_;
- init_globals();
- parse_command_line();
+ my $self = Pod::Html->new();
+ $self->init_globals();
- # prevent '//' in urls
- $Htmlroot = "" if $Htmlroot eq "/";
- $Htmldir =~ s#/\z##;
+ my $opts = process_command_line;
+ $self->process_options($opts);
- 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);
-
- }
+ $self->refine_globals();
# load or generate/cache %Pages
- unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) {
+ unless ($self->get_cache()) {
# 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: $!";
+ #%Pages = $self->generate_cache(\%Pages);
+ $self->generate_cache($self->{Pages});
}
-
- 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;
- # Normalize whitespace indenting
- $parser->strip_verbatim_indent(\&trim_leading_whitespace);
-
- $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);
+ my $input = $self->identify_input();
+ my $podtree = $self->parse_input_for_podtree($input);
+ $self->set_Title_from_podtree($podtree);
# set options for the HTML generator
- $parser = Pod::Simple::XHTML::LocalPodLinks->new();
+ my $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);
+ $parser->backlink($self->{Backlink}); # linkify =head1 directives
+ $parser->force_title($self->{Title});
+ $parser->htmldir($self->{Htmldir});
+ $parser->htmlfileurl($self->{Htmlfileurl});
+ $parser->htmlroot($self->{Htmlroot});
+ $parser->index($self->{Doindex});
+ $parser->output_string(\$self->{output}); # written to file later
+ #$parser->pages(\%Pages);
+ $parser->pages($self->{Pages});
+ $parser->quiet($self->{Quiet});
+ $parser->verbose($self->{Verbose});
+
+ $parser = $self->refine_parser($parser);
+ $self->feed_tree_to_parser($parser, $podtree);
+ $self->write_file();
+}
- # 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_"' : '';
+sub init_globals {
+ my $self = shift;
+ $self->{Cachedir} = "."; # The directory to which directory caches
+ # will be written.
+
+ $self->{Dircache} = "pod2htmd.tmp";
+
+ $self->{Htmlroot} = "/"; # http-server base directory from which all
+ # relative paths in $podpath stem.
+ $self->{Htmldir} = ""; # The directory to which the html pages
+ # will (eventually) be written.
+ $self->{Htmlfile} = ""; # write to stdout by default
+ $self->{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.
+
+ $self->{Poderrors} = 1;
+ $self->{Podfile} = ""; # read from stdin by default
+ $self->{Podpath} = []; # list of directories containing library pods.
+ $self->{Podroot} = $self->{Curdir} = File::Spec->curdir;
+ # filesystem base directory from which all
+ # relative paths in $podpath stem.
+ $self->{Css} = ''; # Cascading style sheet
+ $self->{Recurse} = 1; # recurse on subdirectories in $podpath.
+ $self->{Quiet} = 0; # not quiet by default
+ $self->{Verbose} = 0; # not verbose by default
+ $self->{Doindex} = 1; # non-zero if we should generate an index
+ $self->{Backlink} = 0; # no backlinks added by default
+ $self->{Header} = 0; # produce block header/footer
+ $self->{Title} = undef; # title to give the pod(s)
+ $self->{Saved_Cache_Key} = '';
+ $self->{Pages} = {};
+ return $self;
+}
- my $csslink = '';
- my $tdstyle = ' style="background-color: #cccccc; color: #000"';
+sub process_options {
+ my ($self, $opts) = @_;
+
+ $self->{Podpath} = (defined $opts->{podpath})
+ ? [ split(":", $opts->{podpath}) ]
+ : [];
+
+ $self->{Backlink} = $opts->{backlink} if defined $opts->{backlink};
+ $self->{Cachedir} = unixify($opts->{cachedir}) if defined $opts->{cachedir};
+ $self->{Css} = $opts->{css} if defined $opts->{css};
+ $self->{Header} = $opts->{header} if defined $opts->{header};
+ $self->{Htmldir} = unixify($opts->{htmldir}) if defined $opts->{htmldir};
+ $self->{Htmlroot} = unixify($opts->{htmlroot}) if defined $opts->{htmlroot};
+ $self->{Doindex} = $opts->{index} if defined $opts->{index};
+ $self->{Podfile} = unixify($opts->{infile}) if defined $opts->{infile};
+ $self->{Htmlfile} = unixify($opts->{outfile}) if defined $opts->{outfile};
+ $self->{Poderrors} = $opts->{poderrors} if defined $opts->{poderrors};
+ $self->{Podroot} = unixify($opts->{podroot}) if defined $opts->{podroot};
+ $self->{Quiet} = $opts->{quiet} if defined $opts->{quiet};
+ $self->{Recurse} = $opts->{recurse} if defined $opts->{recurse};
+ $self->{Title} = $opts->{title} if defined $opts->{title};
+ $self->{Verbose} = $opts->{verbose} if defined $opts->{verbose};
- if ($Css) {
- $csslink = qq(\n<link rel="stylesheet" href="$Css" type="text/css" />);
- $csslink =~ s,\\,/,g;
- $csslink =~ s,(/.):,$1|,;
- $tdstyle= '';
+ warn "Flushing directory caches\n"
+ if $opts->{verbose} && defined $opts->{flush};
+ $self->{Dircache} = "$self->{Cachedir}/pod2htmd.tmp";
+ if (defined $opts->{flush}) {
+ 1 while unlink($self->{Dircache});
}
+ return $self;
+}
- # 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
+sub refine_globals {
+ my $self = shift;
- feed_tree_to_parser($parser, $podtree);
+ # prevent '//' in urls
+ $self->{Htmlroot} = "" if $self->{Htmlroot} eq "/";
+ $self->{Htmldir} =~ s#/\z##;
- # 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, ">-";
+ if ( $self->{Htmlroot} eq ''
+ && defined( $self->{Htmldir} )
+ && $self->{Htmldir} ne ''
+ && substr( $self->{Htmlfile}, 0, length( $self->{Htmldir} ) ) eq $self->{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.
+ #$self->{Htmlfileurl} = "$self->{Htmldir}/" . substr( $self->{Htmlfile}, length( $self->{Htmldir} ) + 1);
+ # Is the above not just "$self->{Htmlfileurl} = $self->{Htmlfile}"?
+ $self->{Htmlfileurl} = unixify($self->{Htmlfile});
}
- binmode $fhout, ":utf8";
- print $fhout $output;
- close $fhout or die "Failed to close $Htmlfile: $!";
- chmod 0644, $Htmlfile unless $Htmlfile eq '-';
+ return $self;
}
-##############################################################################
-
-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 generate_cache {
+ my $self = shift;
+ my $pwd = getcwd();
+ chdir($self->{Podroot}) ||
+ die "$0: error changing to directory $self->{Podroot}: $!\n";
+
+ # find all pod modules/pages in podpath, store in %Pages
+ # - inc(0): do not prepend directories in @INC to search list;
+ # limit search to those in @{$self->{Podpath}}
+ # - verbose: report (via 'warn') what search is doing
+ # - laborious: to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
+ # - recurse: go into subdirectories
+ # - survey: search for POD files in PodPath
+ my ($name2path, $path2name) =
+ Pod::Simple::Search->new->inc(0)->verbose($self->{Verbose})->laborious(1)
+ ->recurse($self->{Recurse})->survey(@{$self->{Podpath}});
+ # remove Podroot and extension from each file
+ for my $k (keys %{$name2path}) {
+ $self->{Pages}{$k} = _transform($self, $name2path->{$k});
+ }
+ 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 $self->{Verbose};
+ open my $cache, '>', $self->{Dircache}
+ or die "$0: error open $self->{Dircache} for writing: $!\n";
+
+ print $cache join(":", @{$self->{Podpath}}) . "\n$self->{Podroot}\n";
+ my $_updirs_only = ($self->{Podroot} =~ /\.\./) && !($self->{Podroot} =~ /[^\.\\\/]/);
+ foreach my $key (keys %{$self->{Pages}}) {
+ if($_updirs_only) {
+ my $_dirlevel = $self->{Podroot};
+ while($_dirlevel =~ /\.\./) {
+ $_dirlevel =~ s/\.\.//;
+ # Assume $Pagesref->{$key} has '/' separators (html dir separators).
+ $self->{Pages}->{$key} =~ s/^[\w\s\-\.]+\///;
+ }
+ }
+ print $cache "$key $self->{Pages}->{$key}\n";
+ }
+ close $cache or die "error closing $self->{Dircache}: $!";
}
-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;
+sub _transform {
+ my ($self, $v) = @_;
+ $v = $self->{Podroot} eq File::Spec->curdir
+ ? File::Spec->abs2rel($v)
+ : File::Spec->abs2rel($v,
+ File::Spec->canonpath($self->{Podroot}));
- warn "Flushing directory caches\n"
- if $opt_verbose && defined $opt_flush;
- $Dircache = "$Cachedir/pod2htmd.tmp";
- if (defined $opt_flush) {
- 1 while unlink($Dircache);
- }
-}
+ # Convert path to unix style path
+ $v = unixify($v);
-my $Saved_Cache_Key;
+ my ($file, $dir) = fileparse($v, qr/\.[^.]*/); # strip .ext
+ return $dir.$file;
+}
sub get_cache {
- my($dircache, $podpath, $podroot, $recurse) = @_;
+ my $self = shift;
# 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($dircache, $podpath, $podroot, $recurse);
- return 1 if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key;
- $Saved_Cache_Key = $this_cache_key;
+ my $this_cache_key = $self->cache_key();
+ return 1 if $self->{Saved_Cache_Key} and $this_cache_key eq $self->{Saved_Cache_Key};
+ $self->{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);
+ if (-f $self->{Dircache}) {
+ warn "scanning for directory cache\n" if $self->{Verbose};
+ $tests = $self->load_cache();
}
return $tests;
}
sub cache_key {
- my($dircache, $podpath, $podroot, $recurse) = @_;
- return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache));
+ my $self = shift;
+ return join('!',
+ $self->{Dircache},
+ $self->{Recurse},
+ @{$self->{Podpath}},
+ $self->{Podroot},
+ stat($self->{Dircache}),
+ );
}
#
@@ -611,24 +470,24 @@ sub cache_key {
# cache of %Pages. if so, it loads them and returns a non-zero value.
#
sub load_cache {
- my($dircache, $podpath, $podroot) = @_;
+ my $self = shift;
my $tests = 0;
local $_;
- warn "scanning for directory cache\n" if $Verbose;
- open(my $cachefh, '<', $dircache) ||
- die "$0: error opening $dircache for reading: $!\n";
+ warn "scanning for directory cache\n" if $self->{Verbose};
+ open(my $cachefh, '<', $self->{Dircache}) ||
+ die "$0: error opening $self->{Dircache} for reading: $!\n";
$/ = "\n";
# is it the same podpath?
$_ = <$cachefh>;
chomp($_);
- $tests++ if (join(":", @$podpath) eq $_);
+ $tests++ if (join(":", @{$self->{Podpath}}) eq $_);
# is it the same podroot?
$_ = <$cachefh>;
chomp($_);
- $tests++ if ($podroot eq $_);
+ $tests++ if ($self->{Podroot} eq $_);
# load the cache if its good
if ($tests != 2) {
@@ -636,96 +495,147 @@ sub load_cache {
return 0;
}
- warn "loading directory cache\n" if $Verbose;
+ warn "loading directory cache\n" if $self->{Verbose};
while (<$cachefh>) {
/(.*?) (.*)$/;
- $Pages{$1} = $2;
+ $self->{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;
+sub identify_input {
+ my $self = shift;
+ my $input;
+ unless (@ARGV && $ARGV[0]) {
+ if ($self->{Podfile} and $self->{Podfile} ne '-') {
+ $input = $self->{Podfile};
+ } else {
+ $input = '-'; # XXX: make a test case for this
+ }
+ } else {
+ $self->{Podfile} = $ARGV[0];
+ $input = *ARGV;
+ }
+ return $input;
}
-#
-# 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);
+sub parse_input_for_podtree {
+ my ($self, $input) = @_;
+ # set options for input parser
+ my $input_parser = Pod::Simple::SimpleTree->new;
+ # Normalize whitespace indenting
+ $input_parser->strip_verbatim_indent(\&trim_leading_whitespace);
+
+ $input_parser->codes_in_verbatim(0);
+ $input_parser->accept_targets(qw(html HTML));
+ $input_parser->no_errata_section(!$self->{Poderrors}); # note the inverse
+
+ warn "Converting input file $self->{Podfile}\n" if $self->{Verbose};
+ my $podtree = $input_parser->parse_file($input)->root;
+ return $podtree;
}
-#
-# similar to htmlify, but turns non-alphanumerics into underscores
-#
-sub anchorify {
- my ($anchor) = @_;
- $anchor = htmlify($anchor);
- $anchor =~ s/\W/_/g;
- return $anchor;
+sub set_Title_from_podtree {
+ my ($self, $podtree) = @_;
+ unless(defined $self->{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"))) {
+ $self->{Title} = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]);
+ }
+ }
+
+ $self->{Title} //= "";
+ $self->{Title} = html_escape($self->{Title});
+ return $self;
}
-#
-# store POD files in %Pages
-#
-sub _save_page {
- my ($modspec, $modname) = @_;
+sub refine_parser {
+ my ($self, $parser) = @_;
+ # 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 = $self->{Backlink} ? ' id="_podtop_"' : '';
- # Remove Podroot from path
- $modspec = $Podroot eq File::Spec->curdir
- ? File::Spec->abs2rel($modspec)
- : File::Spec->abs2rel($modspec,
- File::Spec->canonpath($Podroot));
+ my $csslink = '';
+ my $tdstyle = ' style="background-color: #cccccc; color: #000"';
- # Convert path to unix style path
- $modspec = Pod::Html::_unixify($modspec);
+ if ($self->{Css}) {
+ $csslink = qq(\n<link rel="stylesheet" href="$self->{Css}" type="text/css" />);
+ $csslink =~ s,\\,/,g;
+ $csslink =~ s,(/.):,$1|,;
+ $tdstyle= '';
+ }
+
+ # header/footer block
+ my $block = $self->{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;$self->{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>$self->{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>
- my ($file, $dir) = fileparse($modspec, qr/\.[^.]*/); # strip .ext
- $Pages{$modname} = $dir.$file;
+</html>
+HTMLFOOT
+ return $parser;
}
-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;
- }
+# 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($self, $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]);
+ $self->feed_tree_to_parser($parser, $_) foreach @{$tree}[2..$#$tree];
+ $parser->_handle_element_end($tree->[0]);
}
- 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;
+}
+
+sub write_file {
+ my $self = shift;
+ $self->{Htmlfile} = "-" unless $self->{Htmlfile}; # stdout
+ my $fhout;
+ if($self->{Htmlfile} and $self->{Htmlfile} ne '-') {
+ open $fhout, ">", $self->{Htmlfile}
+ or die "$0: cannot open $self->{Htmlfile} file for output: $!\n";
+ } else {
+ open $fhout, ">-";
+ }
+ binmode $fhout, ":utf8";
+ print $fhout $self->{output};
+ close $fhout or die "Failed to close $self->{Htmlfile}: $!";
+ chmod 0644, $self->{Htmlfile} unless $self->{Htmlfile} eq '-';
}
package Pod::Simple::XHTML::LocalPodLinks;
@@ -795,15 +705,15 @@ sub resolve_pod_page_link {
$path = $self->pages->{$to};
}
- my $url = File::Spec::Unix->catfile(Pod::Html::_unixify($self->htmlroot),
+ my $url = File::Spec::Unix->catfile(Pod::Html::Util::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),
+ $url = Pod::Html::Util::relativize_url(
+ File::Spec::Unix->catdir(Pod::Html::Util::unixify($self->htmldir), $url),
$self->htmlfileurl # already unixified
);
}
@@ -811,56 +721,4 @@ sub resolve_pod_page_link {
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;
-}
-
-# Remove any level of indentation (spaces or tabs) from each code block consistently
-# Adapted from: https://metacpan.org/source/HAARG/MetaCPAN-Pod-XHTML-0.002001/lib/Pod/Simple/Role/StripVerbatimIndent.pm
-sub trim_leading_whitespace {
- my ($para) = @_;
-
- # Start by converting tabs to spaces
- @$para = Text::Tabs::expand(@$para);
-
- # Find the line with the least amount of indent, as that's our "base"
- my @indent_levels = (sort(map { $_ =~ /^( *)./mg } @$para));
- my $indent = $indent_levels[0] || "";
-
- # Remove the "base" amount of indent from each line
- foreach (@$para) {
- $_ =~ s/^\Q$indent//mg;
- }
-
- return;
-}
-
1;