From d7b9d805e51812db07a246d21539b02b67ac4575 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Thu, 11 Mar 2021 14:35:18 +0000 Subject: Introduce Testing::record_state_of_cache() A method to assist in debugging cache problems. Should assist in resolving https://github.com/Perl/perl5/issues/12271. Signed-off-by: James E Keenan --- ext/Pod-Html/t/htmldir3.t | 19 ++++++- ext/Pod-Html/t/lib/Testing.pm | 119 ++++++++++++++++++++++++++++++++++++++---- 2 files changed, 126 insertions(+), 12 deletions(-) diff --git a/ext/Pod-Html/t/htmldir3.t b/ext/Pod-Html/t/htmldir3.t index a586babd03..63490eede8 100644 --- a/ext/Pod-Html/t/htmldir3.t +++ b/ext/Pod-Html/t/htmldir3.t @@ -8,7 +8,7 @@ BEGIN { use strict; use warnings; -use Test::More tests => 2; +use Test::More tests => 3; use Testing qw( setup_testing_dir xconvert ); use Cwd; @@ -28,6 +28,23 @@ my @dirs = splitdir($d); shift @dirs if $dirs[0] eq ''; my $relcwd = join '/', @dirs; +$args = { + podstub => "htmldir3", + description => "test --htmldir and --htmlroot 3c: as expected pod file not yet locatable either under podroot or in cache: GH 12271", + expect => $expect_raw, + expect_fail => 1, + p2h => { + podpath => catdir($relcwd, 't'), + podroot => catpath($v, '/', ''), + htmldir => 't', + outfile => 't/htmldir3.html', + quiet => 1, + }, + debug => $debug, +}; +$args->{core} = 1 if $ENV{PERL_CORE}; +xconvert($args); + $args = { podstub => "htmldir3", description => "test --htmldir and --htmlroot 3a", diff --git a/ext/Pod-Html/t/lib/Testing.pm b/ext/Pod-Html/t/lib/Testing.pm index 81a779e665..e3aa62197e 100644 --- a/ext/Pod-Html/t/lib/Testing.pm +++ b/ext/Pod-Html/t/lib/Testing.pm @@ -7,6 +7,7 @@ our @ISA = qw(Exporter); our @EXPORT_OK = qw( setup_testing_dir xconvert + record_state_of_cache ); use Cwd; use Pod::Html; @@ -444,6 +445,7 @@ sub xconvert { my $podstub = $args->{podstub}; my $description = $args->{description}; my $debug = $args->{debug} // 0; + $args->{expect_fail} //= 0; if (defined $args->{p2h}) { die "Value for 'p2h' must be hashref" unless ref($args->{p2h}) eq 'HASH'; # TEST ME @@ -479,6 +481,7 @@ sub xconvert { podstub => $podstub, outfile => $outfile, debug => $debug, + expect_fail => $args->{expect_fail}, } ); # pod2html creates these @@ -567,17 +570,28 @@ sub _process_diff { $diff = 'fc/n' if $^O =~ /^MSWin/; $diff = 'differences' if $^O eq 'VMS'; if ($diff) { - ok($args->{expect} eq $args->{result}, $args->{description}) or do { - my $expectfile = $args->{podstub} . "_expected.tmp"; - open my $tmpfile, ">", $expectfile or die $!; - print $tmpfile $args->{expect}, "\n"; - close $tmpfile; - open my $diff_fh, "-|", "$diff $diffopt $expectfile $args->{outfile}" - or die("problem diffing: $!"); - print STDERR "# $_" while <$diff_fh>; - close $diff_fh; - unlink $expectfile unless $args->{debug}; - }; + my $outcome = $args->{expect} eq $args->{result}; + if ($outcome) { + ok($outcome, $args->{description}); + } + else { + if ($args->{expect_fail}) { + ok(! $outcome, $args->{description}); + } + else { + ok($outcome, $args->{description}) or do { + my $expectfile = $args->{podstub} . "_expected.tmp"; + open my $tmpfile, ">", $expectfile or die $!; + print $tmpfile $args->{expect}, "\n"; + close $tmpfile; + open my $diff_fh, "-|", "$diff $diffopt $expectfile $args->{outfile}" + or die("problem diffing: $!"); + print STDERR "# $_" while <$diff_fh>; + close $diff_fh; + unlink $expectfile unless $args->{debug}; + }; + } + } } else { # This is fairly evil, but lets us get detailed failure modes @@ -587,6 +601,89 @@ sub _process_diff { return 1; } +=head2 C + +=over 4 + +=item * Purpose + +During debugging, enable developer to examine the state of the Pod-Html cache +after each call to C. + +=item * Arguments + +Single hash reference. + + record_state_of_cache( { + outdir => "$ENV{P5P_DIR}/pod-html", + stub => $args->{podstub}, + run => 1, + } ); + +Hash reference has the following key-value pairs: + +=over 4 + +=item * C + +Any directory of your system to which you want a sorted copy of the cache to +be printed. + +=item * C + +The same value you passed in C<$args> to C. + +=item * C + +Integer which you set manually to distinguish among multiple runs of this +function within the same test file (presumably corresponding to multiple +invocations of C). + +=back + +=item * Return Value + +Implicitly returns Perl-true value. + +=item * Comment + +Function will print out location of cache files and other information. + +=back + +=cut + +sub record_state_of_cache { + my $args = shift; + die("record_state_of_cache() takes hash reference") + unless ref($args) eq 'HASH'; + for my $k ( qw| outdir stub run | ) { + die("Argument to record_state_of_cache() lacks defined $k element") + unless defined $args->{$k}; + } + my $cwd = cwd(); + my $cache = catfile($cwd, 'pod2htmd.tmp'); + die("Could not locate file $cache") unless -f $cache; + die("Could not locate directory $args->{outdir}") unless -d $args->{outdir}; + die("'run' element takes integer") unless $args->{run} =~ m/^\d+$/; + + my @cachelines = (); + open my $IN, '<', $cache or die "Unable to open $cache for reading"; + while (my $l = <$IN>) { + chomp $l; + push @cachelines, $l; + } + close $IN or die "Unable to close $cache after reading"; + + my $outfile = catfile($args->{outdir}, "$args->{run}.cache.$args->{stub}.$$.txt"); + die("$outfile already exists; did you remember to increment the 'run' argument?") + if -f $outfile; + open my $OUT, '>', $outfile or die "Unable to open $outfile for writing"; + print $OUT "$_\n" for (sort @cachelines); + close $OUT or die "Unable to close after writing"; + print STDERR "XXX: cache (sorted): $outfile\n"; +} + =head1 AUTHORS The testing code reworked into its present form has many authors and dates -- cgit v1.2.1 From 9fd74660ade9f738757ab2f0255a502ff8fd277b Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Thu, 11 Mar 2021 14:36:39 +0000 Subject: Reduce default arguments for Testing:_prepare_argstable() Touch-up t/htmlview.t --- ext/Pod-Html/t/htmlview.t | 1 + ext/Pod-Html/t/lib/Testing.pm | 8 ++++---- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/ext/Pod-Html/t/htmlview.t b/ext/Pod-Html/t/htmlview.t index 56dcaa8f27..f73418bb56 100644 --- a/ext/Pod-Html/t/htmlview.t +++ b/ext/Pod-Html/t/htmlview.t @@ -27,6 +27,7 @@ $args = { description => "html rendering", expect => $expect_raw, p2h => { + podpath => 't', quiet => 1, }, }; diff --git a/ext/Pod-Html/t/lib/Testing.pm b/ext/Pod-Html/t/lib/Testing.pm index e3aa62197e..084a84cd90 100644 --- a/ext/Pod-Html/t/lib/Testing.pm +++ b/ext/Pod-Html/t/lib/Testing.pm @@ -406,7 +406,10 @@ this key. Required. Hash reference holding arguments passed to C (though without the leading double hyphens (C<-->). See documentation for -F. Optional, but mostly necessary. +F. Optional, but mostly necessary. In particular, if a F<.pod> +file contains any CE> tags, a C element almost always +needs to be supplied with a colon-delimited list of directories from which to +begin a search for files containing POD. =item * C @@ -496,9 +499,6 @@ sub _prepare_argstable { my %args_table = ( infile => $args->{infile}, outfile => $args->{outfile}, - podpath => 't', - htmlroot => '/', - podroot => $args->{cwd}, ); my %no_arg_switches = map { $_ => 1 } @no_arg_switches; if (defined $args->{p2h}) { -- cgit v1.2.1 From 1906cbf52f374975647233a566ec1c711cfed623 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Fri, 12 Mar 2021 14:48:58 +0000 Subject: Start refactoring lib/Pod/Html.pm Group all the "global" variables into a hashref $globals. This variable will be the return value of init_globals() within pod2html(), will be passed through, and augmented by, parse_command_line() and then used through the balance of pod2html(). In essence, so far this is just a renaming of variables. Remove declarations of superseded variables. Pass $globals to get_cache(), cache_key() and load_cache(). --- ext/Pod-Html/lib/Pod/Html.pm | 261 +++++++++++++++++++++---------------------- 1 file changed, 128 insertions(+), 133 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index cf11f77e29..5fad10e086 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -236,109 +236,98 @@ sub feed_tree_to_parser { } } -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 $Podroot; 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) + my %globals = (); + $globals{Cachedir} = "."; # The directory to which directory caches + # will be written. + + $globals{Dircache} = "pod2htmd.tmp"; + + $globals{Htmlroot} = "/"; # http-server base directory from which all + # relative paths in $podpath stem. + $globals{Htmldir} = ""; # The directory to which the html pages + # will (eventually) be written. + $globals{Htmlfile} = ""; # write to stdout by default + $globals{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. + + $globals{Poderrors} = 1; + $globals{Podfile} = ""; # read from stdin by default + $globals{Podpath} = []; # list of directories containing library pods. + $globals{Podroot} = $globals{Curdir} = File::Spec->curdir; + # filesystem base directory from which all + # relative paths in $podpath stem. + $globals{Css} = ''; # Cascading style sheet + $globals{Recurse} = 1; # recurse on subdirectories in $podpath. + $globals{Quiet} = 0; # not quiet by default + $globals{Verbose} = 0; # not verbose by default + $globals{Doindex} = 1; # non-zero if we should generate an index + $globals{Backlink} = 0; # no backlinks added by default + $globals{Header} = 0; # produce block header/footer + $globals{Title} = undef; # title to give the pod(s) + $globals{Saved_Cache_Key} = ''; + return \%globals; } sub pod2html { local(@ARGV) = @_; local $_; - init_globals(); - parse_command_line(); + my $globals = init_globals(); + $globals = parse_command_line($globals); # prevent '//' in urls - $Htmlroot = "" if $Htmlroot eq "/"; - $Htmldir =~ s#/\z##; + $globals->{Htmlroot} = "" if $globals->{Htmlroot} eq "/"; + $globals->{Htmldir} =~ s#/\z##; - if ( $Htmlroot eq '' - && defined( $Htmldir ) - && $Htmldir ne '' - && substr( $Htmlfile, 0, length( $Htmldir ) ) eq $Htmldir + if ( $globals->{Htmlroot} eq '' + && defined( $globals->{Htmldir} ) + && $globals->{Htmldir} ne '' + && substr( $globals->{Htmlfile}, 0, length( $globals->{Htmldir} ) ) eq $globals->{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); + #$globals->{Htmlfileurl} = "$globals->{Htmldir}/" . substr( $globals->{Htmlfile}, length( $globals->{Htmldir} ) + 1); + # Is the above not just "$globals->{Htmlfileurl} = $globals->{Htmlfile}"? + $globals->{Htmlfileurl} = Pod::Html::_unixify($globals->{Htmlfile}); } # load or generate/cache %Pages - unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) { + unless (get_cache($globals)) { # generate %Pages my $pwd = getcwd(); - chdir($Podroot) || - die "$0: error changing to directory $Podroot: $!\n"; + chdir($globals->{Podroot}) || + die "$0: error changing to directory $globals->{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); + Pod::Simple::Search->new->inc(0)->verbose($globals->{Verbose})->laborious(1) + ->callback(\&_save_page)->recurse($globals->{Recurse})->survey(@{$globals->{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"; + warn "caching directories for later use\n" if $globals->{Verbose}; + open my $cache, '>', $globals->{Dircache} + or die "$0: error open $globals->{Dircache} for writing: $!\n"; - print $cache join(":", @Podpath) . "\n$Podroot\n"; - my $_updirs_only = ($Podroot =~ /\.\./) && !($Podroot =~ /[^\.\\\/]/); + print $cache join(":", @{$globals->{Podpath}}) . "\n$globals->{Podroot}\n"; + my $_updirs_only = ($globals->{Podroot} =~ /\.\./) && !($globals->{Podroot} =~ /[^\.\\\/]/); foreach my $key (keys %Pages) { if($_updirs_only) { - my $_dirlevel = $Podroot; + my $_dirlevel = $globals->{Podroot}; while($_dirlevel =~ /\.\./) { $_dirlevel =~ s/\.\.//; # Assume $Pages{$key} has '/' separators (html dir separators). @@ -348,18 +337,18 @@ sub pod2html { print $cache "$key $Pages{$key}\n"; } - close $cache or die "error closing $Dircache: $!"; + close $cache or die "error closing $globals->{Dircache}: $!"; } my $input; unless (@ARGV && $ARGV[0]) { - if ($Podfile and $Podfile ne '-') { - $input = $Podfile; + if ($globals->{Podfile} and $globals->{Podfile} ne '-') { + $input = $globals->{Podfile}; } else { $input = '-'; # XXX: make a test case for this } } else { - $Podfile = $ARGV[0]; + $globals->{Podfile} = $ARGV[0]; $input = *ARGV; } @@ -370,12 +359,12 @@ sub pod2html { $parser->codes_in_verbatim(0); $parser->accept_targets(qw(html HTML)); - $parser->no_errata_section(!$Poderrors); # note the inverse + $parser->no_errata_section(!$globals->{Poderrors}); # note the inverse - warn "Converting input file $Podfile\n" if $Verbose; + warn "Converting input file $globals->{Podfile}\n" if $globals->{Verbose}; my $podtree = $parser->parse_file($input)->root; - unless(defined $Title) { + unless(defined $globals->{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" && @@ -386,48 +375,48 @@ sub pod2html { (@$podtree == 4 || (ref($podtree->[4]) eq "ARRAY" && $podtree->[4]->[0] eq "head1"))) { - $Title = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]); + $globals->{Title} = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]); } } - $Title //= ""; - $Title = html_escape($Title); + $globals->{Title} //= ""; + $globals->{Title} = html_escape($globals->{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->backlink($globals->{Backlink}); # linkify =head1 directives + $parser->force_title($globals->{Title}); + $parser->htmldir($globals->{Htmldir}); + $parser->htmlfileurl($globals->{Htmlfileurl}); + $parser->htmlroot($globals->{Htmlroot}); + $parser->index($globals->{Doindex}); $parser->output_string(\my $output); # written to file later $parser->pages(\%Pages); - $parser->quiet($Quiet); - $parser->verbose($Verbose); + $parser->quiet($globals->{Quiet}); + $parser->verbose($globals->{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 $bodyid = $globals->{Backlink} ? ' id="_podtop_"' : ''; my $csslink = ''; my $tdstyle = ' style="background-color: #cccccc; color: #000"'; - if ($Css) { - $csslink = qq(\n); + if ($globals->{Css}) { + $csslink = qq(\n); $csslink =~ s,\\,/,g; $csslink =~ s,(/.):,$1|,; $tdstyle= ''; } # header/footer block - my $block = $Header ? <{Header} ? < - $Title + $globals->{Title} END_OF_BLOCK @@ -438,7 +427,7 @@ END_OF_BLOCK -$Title$csslink +$globals->{Title}$csslink @@ -457,18 +446,18 @@ HTMLFOOT feed_tree_to_parser($parser, $podtree); # Write output to file - $Htmlfile = "-" unless $Htmlfile; # stdout + $globals->{Htmlfile} = "-" unless $globals->{Htmlfile}; # stdout my $fhout; - if($Htmlfile and $Htmlfile ne '-') { - open $fhout, ">", $Htmlfile - or die "$0: cannot open $Htmlfile file for output: $!\n"; + if($globals->{Htmlfile} and $globals->{Htmlfile} ne '-') { + open $fhout, ">", $globals->{Htmlfile} + or die "$0: cannot open $globals->{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 '-'; + close $fhout or die "Failed to close $globals->{Htmlfile}: $!"; + chmod 0644, $globals->{Htmlfile} unless $globals->{Htmlfile} eq '-'; } ############################################################################## @@ -519,6 +508,7 @@ END_OF_USAGE } sub parse_command_line { + my $globals = shift; 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, @@ -550,59 +540,64 @@ sub parse_command_line { 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; + @{$globals->{Podpath}} = split(":", $opt_podpath) if defined $opt_podpath; + + $globals->{Backlink} = $opt_backlink if defined $opt_backlink; + $globals->{Cachedir} = _unixify($opt_cachedir) if defined $opt_cachedir; + $globals->{Css} = $opt_css if defined $opt_css; + $globals->{Header} = $opt_header if defined $opt_header; + $globals->{Htmldir} = _unixify($opt_htmldir) if defined $opt_htmldir; + $globals->{Htmlroot} = _unixify($opt_htmlroot) if defined $opt_htmlroot; + $globals->{Doindex} = $opt_index if defined $opt_index; + $globals->{Podfile} = _unixify($opt_infile) if defined $opt_infile; + $globals->{Htmlfile} = _unixify($opt_outfile) if defined $opt_outfile; + $globals->{Poderrors} = $opt_poderrors if defined $opt_poderrors; + $globals->{Podroot} = _unixify($opt_podroot) if defined $opt_podroot; + $globals->{Quiet} = $opt_quiet if defined $opt_quiet; + $globals->{Recurse} = $opt_recurse if defined $opt_recurse; + $globals->{Title} = $opt_title if defined $opt_title; + $globals->{Verbose} = $opt_verbose if defined $opt_verbose; warn "Flushing directory caches\n" if $opt_verbose && defined $opt_flush; - $Dircache = "$Cachedir/pod2htmd.tmp"; + $globals->{Dircache} = "$globals->{Cachedir}/pod2htmd.tmp"; if (defined $opt_flush) { - 1 while unlink($Dircache); + 1 while unlink($globals->{Dircache}); } + return $globals; } -my $Saved_Cache_Key; - sub get_cache { - my($dircache, $podpath, $podroot, $recurse) = @_; + my $globals = 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 = cache_key($globals); + return 1 if $globals->{Saved_Cache_Key} and $this_cache_key eq $globals->{Saved_Cache_Key}; + $globals->{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 $globals->{Dircache}) { + warn "scanning for directory cache\n" if $globals->{Verbose}; + $tests = load_cache($globals); } return $tests; } sub cache_key { - my($dircache, $podpath, $podroot, $recurse) = @_; - return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache)); + my $globals = shift; + return join('!', + $globals->{Dircache}, + $globals->{Recurse}, + @{$globals->{Podpath}}, + $globals->{Podroot}, + stat($globals->{Dircache}), + ); } # @@ -610,24 +605,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 $globals = 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 $globals->{Verbose}; + open(my $cachefh, '<', $globals->{Dircache}) || + die "$0: error opening $globals->{Dircache} for reading: $!\n"; $/ = "\n"; # is it the same podpath? $_ = <$cachefh>; chomp($_); - $tests++ if (join(":", @$podpath) eq $_); + $tests++ if (join(":", @{$globals->{Podpath}}) eq $_); # is it the same podroot? $_ = <$cachefh>; chomp($_); - $tests++ if ($podroot eq $_); + $tests++ if ($globals->{Podroot} eq $_); # load the cache if its good if ($tests != 2) { @@ -635,7 +630,7 @@ sub load_cache { return 0; } - warn "loading directory cache\n" if $Verbose; + warn "loading directory cache\n" if $globals->{Verbose}; while (<$cachefh>) { /(.*?) (.*)$/; $Pages{$1} = $2; -- cgit v1.2.1 From d32e5dc4f13e3a8f42c445ab32d50f7aff8d1cd7 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sun, 14 Mar 2021 00:08:47 +0000 Subject: Introduce Pod::Html::Auxiliary This package will hold helper subroutines used within the main package or in tests. They can be placed in a separate module and imported into Pod::Html because they won't depend on having the globals passed as an argument. They will also be potentially independently testable. Start with html_escape(). Move anchorify(), htmlify() to Auxiliary.pm. Also _unixify -- now as unixify(). Move relativize_url() to Auxiliary. Move usage() to Auxiliary. Move trim_leading_whitespace to Auxiliary. Move parse_command_line() to Auxiliary. Keep porting tests happy. Increment $VERSION. Run: ./perl -Ilib regen/lib_cleanup.pl anchorify.t, eol.t: Correct excessive corrections. Standardize setting of $VERSION. --- MANIFEST | 1 + Makefile.SH | 2 +- ext/Pod-Html/lib/Pod/Html.pm | 264 ++--------------------------- ext/Pod-Html/lib/Pod/Html/Auxiliary.pm | 292 +++++++++++++++++++++++++++++++++ ext/Pod-Html/t/anchorify.t | 5 +- ext/Pod-Html/t/cache.t | 5 +- ext/Pod-Html/t/crossref2.t | 5 +- ext/Pod-Html/t/eol.t | 3 +- ext/Pod-Html/t/feature2.t | 1 - ext/Pod-Html/t/lib/Testing.pm | 8 +- lib/.gitignore | 1 + win32/GNUmakefile | 1 + win32/Makefile | 1 + 13 files changed, 333 insertions(+), 256 deletions(-) create mode 100644 ext/Pod-Html/lib/Pod/Html/Auxiliary.pm diff --git a/MANIFEST b/MANIFEST index bb895e9085..60c1ee462f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4324,6 +4324,7 @@ ext/Pod-Html/bin/pod2html Translator to turn pod into HTML ext/Pod-Html/corpus/perlpodspec-copy.pod ext/Pod-Html/corpus/perlvar-copy.pod ext/Pod-Html/lib/Pod/Html.pm Convert POD data to HTML +ext/Pod-Html/lib/Pod/Html/Auxiliary.pm Helper functions for Pod-Html ext/Pod-Html/t/anchorify.t ext/Pod-Html/t/cache.pod ext/Pod-Html/t/cache.t diff --git a/Makefile.SH b/Makefile.SH index e1caa20cd8..0033a0e145 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -1447,7 +1447,7 @@ _cleaner2: -rmdir lib/TAP/Formatter/File lib/TAP/Formatter/Console -rmdir lib/TAP/Formatter lib/TAP lib/Sys/Syslog lib/Sys lib/Sub -rmdir lib/Search lib/Scalar lib/Pod/Text lib/Pod/Simple - -rmdir lib/Pod/Perldoc lib/PerlIO/via lib/PerlIO lib/Perl + -rmdir lib/Pod/Perldoc lib/Pod/Html lib/PerlIO/via lib/PerlIO lib/Perl -rmdir lib/Parse/CPAN lib/Parse lib/Params lib/Net/FTP lib/Module/Load -rmdir lib/Module/CoreList lib/Module lib/Memoize lib/Math/BigInt -rmdir lib/Math/BigFloat lib/Math lib/MIME lib/Locale/Maketext diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index 5fad10e086..781122968a 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -2,20 +2,27 @@ package Pod::Html; use strict; use Exporter 'import'; -our $VERSION = 1.28; -our @EXPORT = qw(pod2html htmlify); -our @EXPORT_OK = qw(anchorify relativize_url); +our $VERSION = 1.29; +eval $VERSION; +our @ISA = qw(Exporter); +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::Auxiliary qw( + html_escape + htmlify + parse_command_line + relativize_url + trim_leading_whitespace + unixify + usage +); use locale; # make \w work right in non-ASCII lands =head1 NAME @@ -188,21 +195,6 @@ 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, but turns non-alphanumerics into underscores. Note -that C is not exported by default. - =head1 ENVIRONMENT Uses C<$Config{pod2html}> to setup default options. @@ -299,7 +291,7 @@ sub pod2html { # be used throughout. #$globals->{Htmlfileurl} = "$globals->{Htmldir}/" . substr( $globals->{Htmlfile}, length( $globals->{Htmldir} ) + 1); # Is the above not just "$globals->{Htmlfileurl} = $globals->{Htmlfile}"? - $globals->{Htmlfileurl} = Pod::Html::_unixify($globals->{Htmlfile}); + $globals->{Htmlfileurl} = unixify($globals->{Htmlfile}); } @@ -460,113 +452,6 @@ HTMLFOOT chmod 0644, $globals->{Htmlfile} unless $globals->{Htmlfile} eq '-'; } -############################################################################## - -sub usage { - my $podfile = shift; - warn "$0: $podfile: @_\n" if @_; - die < --htmlroot= - --infile= --outfile= - --podpath=:...: --podroot= - --cachedir= --flush --recurse --norecurse - --quiet --noquiet --verbose --noverbose - --index --noindex --backlink --nobacklink - --header --noheader --poderrors --nopoderrors - --css= --title= - - --[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 $globals = shift; - 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. - - @{$globals->{Podpath}} = split(":", $opt_podpath) if defined $opt_podpath; - - $globals->{Backlink} = $opt_backlink if defined $opt_backlink; - $globals->{Cachedir} = _unixify($opt_cachedir) if defined $opt_cachedir; - $globals->{Css} = $opt_css if defined $opt_css; - $globals->{Header} = $opt_header if defined $opt_header; - $globals->{Htmldir} = _unixify($opt_htmldir) if defined $opt_htmldir; - $globals->{Htmlroot} = _unixify($opt_htmlroot) if defined $opt_htmlroot; - $globals->{Doindex} = $opt_index if defined $opt_index; - $globals->{Podfile} = _unixify($opt_infile) if defined $opt_infile; - $globals->{Htmlfile} = _unixify($opt_outfile) if defined $opt_outfile; - $globals->{Poderrors} = $opt_poderrors if defined $opt_poderrors; - $globals->{Podroot} = _unixify($opt_podroot) if defined $opt_podroot; - $globals->{Quiet} = $opt_quiet if defined $opt_quiet; - $globals->{Recurse} = $opt_recurse if defined $opt_recurse; - $globals->{Title} = $opt_title if defined $opt_title; - $globals->{Verbose} = $opt_verbose if defined $opt_verbose; - - warn "Flushing directory caches\n" - if $opt_verbose && defined $opt_flush; - $globals->{Dircache} = "$globals->{Cachedir}/pod2htmd.tmp"; - if (defined $opt_flush) { - 1 while unlink($globals->{Dircache}); - } - return $globals; -} - sub get_cache { my $globals = shift; @@ -641,38 +526,6 @@ sub load_cache { } -# -# html_escape: make text safe for HTML -# -sub html_escape { - my $rest = $_[0]; - $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 @@ -687,41 +540,12 @@ sub _save_page { File::Spec->canonpath($Podroot)); # Convert path to unix style path - $modspec = Pod::Html::_unixify($modspec); + $modspec = 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; @@ -789,15 +613,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::Auxiliary::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::Auxiliary::relativize_url( + File::Spec::Unix->catdir(Pod::Html::Auxiliary::unixify($self->htmldir), $url), $self->htmlfileurl # already unixified ); } @@ -805,56 +629,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; diff --git a/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm b/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm new file mode 100644 index 0000000000..86cfafbdef --- /dev/null +++ b/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm @@ -0,0 +1,292 @@ +package Pod::Html::Auxiliary; +use strict; +require Exporter; + +our $VERSION = 1.27_001; # Please keep in synch with lib/Pod/Html.pm +$VERSION = eval $VERSION; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw( + anchorify + html_escape + htmlify + parse_command_line + relativize_url + trim_leading_whitespace + unixify + usage +); + +use Config; +use File::Spec; +use File::Spec::Unix; +use Getopt::Long; +use Pod::Simple::XHTML; +use Text::Tabs; +use locale; # make \w work right in non-ASCII lands + +=head1 NAME + +Pod::Html::Auxiliary - helper functions for Pod-Html + +=head1 SUBROUTINES + +=head2 C + +TK + +=cut + +sub parse_command_line { + my $globals = shift; + 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. + + @{$globals->{Podpath}} = split(":", $opt_podpath) if defined $opt_podpath; + + $globals->{Backlink} = $opt_backlink if defined $opt_backlink; + $globals->{Cachedir} = unixify($opt_cachedir) if defined $opt_cachedir; + $globals->{Css} = $opt_css if defined $opt_css; + $globals->{Header} = $opt_header if defined $opt_header; + $globals->{Htmldir} = unixify($opt_htmldir) if defined $opt_htmldir; + $globals->{Htmlroot} = unixify($opt_htmlroot) if defined $opt_htmlroot; + $globals->{Doindex} = $opt_index if defined $opt_index; + $globals->{Podfile} = unixify($opt_infile) if defined $opt_infile; + $globals->{Htmlfile} = unixify($opt_outfile) if defined $opt_outfile; + $globals->{Poderrors} = $opt_poderrors if defined $opt_poderrors; + $globals->{Podroot} = unixify($opt_podroot) if defined $opt_podroot; + $globals->{Quiet} = $opt_quiet if defined $opt_quiet; + $globals->{Recurse} = $opt_recurse if defined $opt_recurse; + $globals->{Title} = $opt_title if defined $opt_title; + $globals->{Verbose} = $opt_verbose if defined $opt_verbose; + + warn "Flushing directory caches\n" + if $opt_verbose && defined $opt_flush; + $globals->{Dircache} = "$globals->{Cachedir}/pod2htmd.tmp"; + if (defined $opt_flush) { + 1 while unlink($globals->{Dircache}); + } + return $globals; +} + +=head2 C + +TK + +=cut + +sub usage { + my $podfile = shift; + warn "$0: $podfile: @_\n" if @_; + die < --htmlroot= + --infile= --outfile= + --podpath=:...: --podroot= + --cachedir= --flush --recurse --norecurse + --quiet --noquiet --verbose --noverbose + --index --noindex --backlink --nobacklink + --header --noheader --poderrors --nopoderrors + --css= --title= + + --[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 + +} + +=head2 C + +TK + +=cut + +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; +} + +=head2 C + +Convert an absolute URL to one relative to a base URL. +Assumes both end in a filename. + +=cut + +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; +} + +=head2 C + +Make text safe for HTML. + +=cut + +sub html_escape { + my $rest = $_[0]; + $rest =~ s/&/&/g; + $rest =~ s//>/g; + $rest =~ s/"/"/g; + $rest =~ s/([[:^print:]])/sprintf("&#x%x;", ord($1))/aeg; + return $rest; +} + +=head2 C + + 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...). + +=cut + +sub htmlify { + my( $heading) = @_; + return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1); +} + +=head2 C + + anchorify(@heading); + +Similar to C, but turns non-alphanumerics into underscores. Note +that C is not exported by default. + +=cut + +sub anchorify { + my ($anchor) = @_; + $anchor = htmlify($anchor); + $anchor =~ s/\W/_/g; + return $anchor; +} + +=head2 C + +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 + +=cut + +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; + diff --git a/ext/Pod-Html/t/anchorify.t b/ext/Pod-Html/t/anchorify.t index 0677f9ed30..68bc8834be 100644 --- a/ext/Pod-Html/t/anchorify.t +++ b/ext/Pod-Html/t/anchorify.t @@ -1,6 +1,7 @@ # -*- perl -*- + use strict; -use Pod::Html qw( anchorify ); +use Pod::Html::Auxiliary qw( anchorify ); use Test::More tests => 1; my @filedata; @@ -45,7 +46,7 @@ is_deeply( __DATA__ =head1 NAME -anchorify - Test C +anchorify - Test C =head1 DESCRIPTION diff --git a/ext/Pod-Html/t/cache.t b/ext/Pod-Html/t/cache.t index 425a7b7b00..d2a48ae2f9 100644 --- a/ext/Pod-Html/t/cache.t +++ b/ext/Pod-Html/t/cache.t @@ -11,6 +11,9 @@ use warnings; use Test::More tests => 10; use Testing qw( setup_testing_dir xconvert ); use Cwd; +use Pod::Html::Auxiliary qw( + unixify +); my $debug = 0; my $startdir = cwd(); @@ -21,7 +24,7 @@ my $tdir = setup_testing_dir( { debug => $debug, } ); -my $cwd = Pod::Html::_unixify(Cwd::cwd()); +my $cwd = unixify(Cwd::cwd()); my $infile = catfile('t', 'cache.pod'); my $outfile = "cacheout.html"; my $cachefile = "pod2htmd.tmp"; diff --git a/ext/Pod-Html/t/crossref2.t b/ext/Pod-Html/t/crossref2.t index 5843330f22..bdc801a724 100644 --- a/ext/Pod-Html/t/crossref2.t +++ b/ext/Pod-Html/t/crossref2.t @@ -11,6 +11,9 @@ use warnings; use Test::More tests => 1; use Testing qw( setup_testing_dir xconvert ); use Cwd; +use Pod::Html::Auxiliary qw( + unixify +); my $debug = 0; my $startdir = cwd(); @@ -22,7 +25,7 @@ my $tdir = setup_testing_dir( { debug => $debug, } ); -my $cwd = Pod::Html::_unixify(cwd()); +my $cwd = unixify(cwd()); $args = { podstub => "crossref", diff --git a/ext/Pod-Html/t/eol.t b/ext/Pod-Html/t/eol.t index a159fb7551..ba04def1af 100644 --- a/ext/Pod-Html/t/eol.t +++ b/ext/Pod-Html/t/eol.t @@ -1,5 +1,6 @@ #!./perl -w +use Pod::Html; use Test::More tests => 3; my $podfile = "$$.pod"; @@ -34,8 +35,6 @@ crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf crlf __EOF__ close $pod or die $!; -use Pod::Html; - my $i = 0; foreach my $eol ("\r", "\n", "\r\n") { open $pod, '<', $podfile or die "$podfile: $!"; diff --git a/ext/Pod-Html/t/feature2.t b/ext/Pod-Html/t/feature2.t index 2a0ba32c27..c8f8025aa3 100644 --- a/ext/Pod-Html/t/feature2.t +++ b/ext/Pod-Html/t/feature2.t @@ -38,7 +38,6 @@ $args = { podroot => $cwd, norecurse => 1, verbose => 1, - quiet => 1, }, debug => $debug, }; diff --git a/ext/Pod-Html/t/lib/Testing.pm b/ext/Pod-Html/t/lib/Testing.pm index 084a84cd90..4b3355456b 100644 --- a/ext/Pod-Html/t/lib/Testing.pm +++ b/ext/Pod-Html/t/lib/Testing.pm @@ -2,7 +2,8 @@ package Testing; use 5.10.0; use warnings; require Exporter; -our $VERSION = 1.26; # Let's keep this same as lib/Pod/Html.pm +our $VERSION = 1.27_001; # Let's keep this same as lib/Pod/Html.pm +$VERSION = eval $VERSION; our @ISA = qw(Exporter); our @EXPORT_OK = qw( setup_testing_dir @@ -18,6 +19,9 @@ use File::Path ( qw| make_path | ); use File::Spec::Functions ':ALL'; use File::Temp ( qw| tempdir | ); use Data::Dumper;$Data::Dumper::Sortkeys=1; +use Pod::Html::Auxiliary qw( + unixify +); *ok = \&Test::More::ok; *is = \&Test::More::is; @@ -453,7 +457,7 @@ sub xconvert { die "Value for 'p2h' must be hashref" unless ref($args->{p2h}) eq 'HASH'; # TEST ME } - my $cwd = Pod::Html::_unixify( Cwd::cwd() ); + my $cwd = unixify( Cwd::cwd() ); my ($vol, $dir) = splitpath($cwd, 1); my @dirs = splitdir($dir); shift @dirs if $dirs[0] eq ''; diff --git a/lib/.gitignore b/lib/.gitignore index 4973b08c7d..6d023351fa 100644 --- a/lib/.gitignore +++ b/lib/.gitignore @@ -139,6 +139,7 @@ /Pod/Escapes.pm /Pod/Functions.pm /Pod/Html.pm +/Pod/Html/ /Pod/Man.pm /Pod/ParseLink.pm /Pod/Perldoc.pm diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 8177dd5311..3114cd2ab4 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -1851,6 +1851,7 @@ distclean: realclean -if exist $(LIBDIR)\Parse rmdir /s /q $(LIBDIR)\Parse -if exist $(LIBDIR)\Perl rmdir /s /q $(LIBDIR)\Perl -if exist $(LIBDIR)\PerlIO rmdir /s /q $(LIBDIR)\PerlIO + -if exist $(LIBDIR)\Pod\Html rmdir /s /q $(LIBDIR)\Pod\Html -if exist $(LIBDIR)\Pod\Perldoc rmdir /s /q $(LIBDIR)\Pod\Perldoc -if exist $(LIBDIR)\Pod\Simple rmdir /s /q $(LIBDIR)\Pod\Simple -if exist $(LIBDIR)\Pod\Text rmdir /s /q $(LIBDIR)\Pod\Text diff --git a/win32/Makefile b/win32/Makefile index 6a56513af7..69ed79bc11 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1316,6 +1316,7 @@ distclean: realclean -if exist $(LIBDIR)\Parse rmdir /s /q $(LIBDIR)\Parse -if exist $(LIBDIR)\Perl rmdir /s /q $(LIBDIR)\Perl -if exist $(LIBDIR)\PerlIO rmdir /s /q $(LIBDIR)\PerlIO + -if exist $(LIBDIR)\Pod\Html rmdir /s /q $(LIBDIR)\Pod\Html -if exist $(LIBDIR)\Pod\Perldoc rmdir /s /q $(LIBDIR)\Pod\Perldoc -if exist $(LIBDIR)\Pod\Simple rmdir /s /q $(LIBDIR)\Pod\Simple -if exist $(LIBDIR)\Pod\Text rmdir /s /q $(LIBDIR)\Pod\Text -- cgit v1.2.1 From e6a748aad5d10020f861c87e5fd37e167d6257c3 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 15 Mar 2021 00:25:29 +0000 Subject: Create sub write_file() We now start placing parts of sub pod2html() into separate subs so that we reduce the length of pod2html(), making it more readable and (ultimately) preparing for method calls. Signed-off-by: James E Keenan --- ext/Pod-Html/lib/Pod/Html.pm | 38 +++++++++++++++++++++----------------- 1 file changed, 21 insertions(+), 17 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index 781122968a..d9f343d5c8 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -220,11 +220,11 @@ This program is distributed under the Artistic License. sub feed_tree_to_parser { my($parser, $tree) = @_; if(ref($tree) eq "") { - $parser->_handle_text($tree); + $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]); + $parser->_handle_element_start($tree->[0], $tree->[1]); + feed_tree_to_parser($parser, $_) foreach @{$tree}[2..$#$tree]; + $parser->_handle_element_end($tree->[0]); } } @@ -437,19 +437,7 @@ HTMLFOOT feed_tree_to_parser($parser, $podtree); - # Write output to file - $globals->{Htmlfile} = "-" unless $globals->{Htmlfile}; # stdout - my $fhout; - if($globals->{Htmlfile} and $globals->{Htmlfile} ne '-') { - open $fhout, ">", $globals->{Htmlfile} - or die "$0: cannot open $globals->{Htmlfile} file for output: $!\n"; - } else { - open $fhout, ">-"; - } - binmode $fhout, ":utf8"; - print $fhout $output; - close $fhout or die "Failed to close $globals->{Htmlfile}: $!"; - chmod 0644, $globals->{Htmlfile} unless $globals->{Htmlfile} eq '-'; + write_file($globals, $output); } sub get_cache { @@ -546,6 +534,22 @@ sub _save_page { $Pages{$modname} = $dir.$file; } +sub write_file { + my ($globals, $output) = @_; + $globals->{Htmlfile} = "-" unless $globals->{Htmlfile}; # stdout + my $FHOUT; + if($globals->{Htmlfile} and $globals->{Htmlfile} ne '-') { + open $FHOUT, ">", $globals->{Htmlfile} + or die "$0: cannot open $globals->{Htmlfile} file for output: $!\n"; + } else { + open $FHOUT, ">-"; + } + binmode $FHOUT, ":utf8"; + print $FHOUT $output; + close $FHOUT or die "Failed to close $globals->{Htmlfile}: $!"; + chmod 0644, $globals->{Htmlfile} unless $globals->{Htmlfile} eq '-'; +} + package Pod::Simple::XHTML::LocalPodLinks; use strict; use warnings; -- cgit v1.2.1 From 5cae71e5baf19f8c46e55ab0222d90a874b66726 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 15 Mar 2021 00:41:49 +0000 Subject: Remove last hard-tabs from Html.pm Signed-off-by: James E Keenan --- ext/Pod-Html/lib/Pod/Html.pm | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index d9f343d5c8..d2b2d8c051 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -328,7 +328,6 @@ sub pod2html { } print $cache "$key $Pages{$key}\n"; } - close $cache or die "error closing $globals->{Dircache}: $!"; } @@ -357,18 +356,18 @@ sub pod2html { my $podtree = $parser->parse_file($input)->root; unless(defined $globals->{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"))) { - $globals->{Title} = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]); - } + 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"))) { + $globals->{Title} = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]); + } } $globals->{Title} //= ""; -- cgit v1.2.1 From c97f73fe8db20adb57725eac1957667c9036399b Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Tue, 16 Mar 2021 21:46:19 +0000 Subject: Create internal sub parse_input_for_podtree() This clears up a bit of semantic confusion. We were using one lexically scoped variable -- my $parser -- to hold two different objects: one for parsing input, one for writing output. We can encapsulate the working of the input parser to make the code more readable. Signed-off-by: James E Keenan --- ext/Pod-Html/lib/Pod/Html.pm | 33 ++++++++++++++++++++------------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index d2b2d8c051..118812bf76 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -343,17 +343,7 @@ sub pod2html { $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(!$globals->{Poderrors}); # note the inverse - - warn "Converting input file $globals->{Podfile}\n" if $globals->{Verbose}; - my $podtree = $parser->parse_file($input)->root; + my $podtree = parse_input_for_podtree($globals, $input); unless(defined $globals->{Title}) { if($podtree->[0] eq "Document" && ref($podtree->[2]) eq "ARRAY" && @@ -374,7 +364,8 @@ sub pod2html { $globals->{Title} = html_escape($globals->{Title}); # set options for the HTML generator - $parser = Pod::Simple::XHTML::LocalPodLinks->new(); + my $parser = Pod::Simple::XHTML::LocalPodLinks->new(); + my $output; $parser->codes_in_verbatim(0); $parser->anchor_items(1); # the old Pod::Html always did $parser->backlink($globals->{Backlink}); # linkify =head1 directives @@ -383,7 +374,7 @@ sub pod2html { $parser->htmlfileurl($globals->{Htmlfileurl}); $parser->htmlroot($globals->{Htmlroot}); $parser->index($globals->{Doindex}); - $parser->output_string(\my $output); # written to file later + $parser->output_string(\$output); # written to file later $parser->pages(\%Pages); $parser->quiet($globals->{Quiet}); $parser->verbose($globals->{Verbose}); @@ -439,6 +430,22 @@ HTMLFOOT write_file($globals, $output); } +sub parse_input_for_podtree { + my ($globals, $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(!$globals->{Poderrors}); # note the inverse + + warn "Converting input file $globals->{Podfile}\n" if $globals->{Verbose}; + my $podtree = $input_parser->parse_file($input)->root; + return $podtree; +} + sub get_cache { my $globals = shift; -- cgit v1.2.1 From 8bb63676d3ee2ba429cc110c534beb95eca613bf Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Tue, 16 Mar 2021 21:52:12 +0000 Subject: Introduce internal sub refine_globals() Encapsulate! Encapsulate! Signed-off-by: James E Keenan --- ext/Pod-Html/lib/Pod/Html.pm | 44 +++++++++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 19 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index 118812bf76..69c416798c 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -275,25 +275,7 @@ sub pod2html { my $globals = init_globals(); $globals = parse_command_line($globals); - - # prevent '//' in urls - $globals->{Htmlroot} = "" if $globals->{Htmlroot} eq "/"; - $globals->{Htmldir} =~ s#/\z##; - - if ( $globals->{Htmlroot} eq '' - && defined( $globals->{Htmldir} ) - && $globals->{Htmldir} ne '' - && substr( $globals->{Htmlfile}, 0, length( $globals->{Htmldir} ) ) eq $globals->{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. - #$globals->{Htmlfileurl} = "$globals->{Htmldir}/" . substr( $globals->{Htmlfile}, length( $globals->{Htmldir} ) + 1); - # Is the above not just "$globals->{Htmlfileurl} = $globals->{Htmlfile}"? - $globals->{Htmlfileurl} = unixify($globals->{Htmlfile}); - - } + $globals = refine_globals($globals); # load or generate/cache %Pages unless (get_cache($globals)) { @@ -430,6 +412,30 @@ HTMLFOOT write_file($globals, $output); } +sub refine_globals { + my $globals = shift; + require Data::Dumper if $globals->{verbose}; + + # prevent '//' in urls + $globals->{Htmlroot} = "" if $globals->{Htmlroot} eq "/"; + $globals->{Htmldir} =~ s#/\z##; + + if ( $globals->{Htmlroot} eq '' + && defined( $globals->{Htmldir} ) + && $globals->{Htmldir} ne '' + && substr( $globals->{Htmlfile}, 0, length( $globals->{Htmldir} ) ) eq $globals->{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. + #$globals->{Htmlfileurl} = "$globals->{Htmldir}/" . substr( $globals->{Htmlfile}, length( $globals->{Htmldir} ) + 1); + # Is the above not just "$globals->{Htmlfileurl} = $globals->{Htmlfile}"? + $globals->{Htmlfileurl} = unixify($globals->{Htmlfile}); + } + return $globals; +} + sub parse_input_for_podtree { my ($globals, $input) = @_; # set options for input parser -- cgit v1.2.1 From 072fb5ad1cd4a5c18cef31dfdfb6cc7c80bd2a5d Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Tue, 16 Mar 2021 22:00:45 +0000 Subject: Introduce internal sub set_Title(); Encapsulate more code within pod2html(). The return value is for convenience. It's the setting inside $globals that counts. Signed-off-by: James E Keenan --- ext/Pod-Html/lib/Pod/Html.pm | 41 +++++++++++++++++++++++------------------ 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index 69c416798c..defc2253b7 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -326,24 +326,7 @@ sub pod2html { } my $podtree = parse_input_for_podtree($globals, $input); - - unless(defined $globals->{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"))) { - $globals->{Title} = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]); - } - } - - $globals->{Title} //= ""; - $globals->{Title} = html_escape($globals->{Title}); + $globals->{Title} = set_Title($globals, $podtree); # set options for the HTML generator my $parser = Pod::Simple::XHTML::LocalPodLinks->new(); @@ -452,6 +435,28 @@ sub parse_input_for_podtree { return $podtree; } +sub set_Title { + my ($globals, $podtree) = @_; + unless(defined $globals->{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"))) { + $globals->{Title} = join("", @{$podtree->[3]}[2..$#{$podtree->[3]}]); + } + } + + $globals->{Title} //= ""; + #$globals->{Title} = html_escape($globals->{Title}); + return html_escape($globals->{Title}); +} + sub get_cache { my $globals = shift; -- cgit v1.2.1 From 8405b171b4f19b2f4cc493ef3ef6871c2bd5147f Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Wed, 12 May 2021 12:53:01 +0000 Subject: Rename one method per suggestion from rjbs --- ext/Pod-Html/lib/Pod/Html.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index defc2253b7..0ebbf2b879 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -326,7 +326,7 @@ sub pod2html { } my $podtree = parse_input_for_podtree($globals, $input); - $globals->{Title} = set_Title($globals, $podtree); + $globals->{Title} = set_Title_from_podtree($globals, $podtree); # set options for the HTML generator my $parser = Pod::Simple::XHTML::LocalPodLinks->new(); @@ -435,7 +435,7 @@ sub parse_input_for_podtree { return $podtree; } -sub set_Title { +sub set_Title_from_podtree { my ($globals, $podtree) = @_; unless(defined $globals->{Title}) { if($podtree->[0] eq "Document" && ref($podtree->[2]) eq "ARRAY" && -- cgit v1.2.1 From 193189d2f47ded0eeb4cdc4223082e1fc7e23adb Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Tue, 16 Mar 2021 22:15:56 +0000 Subject: Introduce generate_cache() and identify_input() Further encapsulation of code to improve readability. Signed-off-by: James E Keenan --- ext/Pod-Html/lib/Pod/Html.pm | 103 +++++++++++++++++++++++++------------------ 1 file changed, 61 insertions(+), 42 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index 0ebbf2b879..253585b112 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -280,50 +280,10 @@ sub pod2html { # load or generate/cache %Pages unless (get_cache($globals)) { # generate %Pages - my $pwd = getcwd(); - chdir($globals->{Podroot}) || - die "$0: error changing to directory $globals->{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($globals->{Verbose})->laborious(1) - ->callback(\&_save_page)->recurse($globals->{Recurse})->survey(@{$globals->{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 $globals->{Verbose}; - open my $cache, '>', $globals->{Dircache} - or die "$0: error open $globals->{Dircache} for writing: $!\n"; - - print $cache join(":", @{$globals->{Podpath}}) . "\n$globals->{Podroot}\n"; - my $_updirs_only = ($globals->{Podroot} =~ /\.\./) && !($globals->{Podroot} =~ /[^\.\\\/]/); - foreach my $key (keys %Pages) { - if($_updirs_only) { - my $_dirlevel = $globals->{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 $globals->{Dircache}: $!"; + %Pages = generate_cache($globals, \%Pages); } - my $input; - unless (@ARGV && $ARGV[0]) { - if ($globals->{Podfile} and $globals->{Podfile} ne '-') { - $input = $globals->{Podfile}; - } else { - $input = '-'; # XXX: make a test case for this - } - } else { - $globals->{Podfile} = $ARGV[0]; - $input = *ARGV; - } + my $input = identify_input($globals); my $podtree = parse_input_for_podtree($globals, $input); $globals->{Title} = set_Title_from_podtree($globals, $podtree); @@ -419,6 +379,65 @@ sub refine_globals { return $globals; } +sub generate_cache { + my ($globals, $Pagesref) = @_; + my $pwd = getcwd(); + chdir($globals->{Podroot}) || + die "$0: error changing to directory $globals->{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 @{$globals->{Podpath}} + # - verbose: report (via 'warn') what search is doing + # - laborious: to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1) + # - callback: used to remove Podroot and extension from each file + # - recurse: go into subdirectories + # - survey: search for POD files in PodPath + my ($name2path, $path2name) = + Pod::Simple::Search->new->inc(0)->verbose($globals->{Verbose})->laborious(1) + ->callback(\&_save_page)->recurse($globals->{Recurse})->survey(@{$globals->{Podpath}}); + #print STDERR Data::Dumper::Dumper($name2path, $path2name) if ($globals->{Verbose}); + + 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 $globals->{Verbose}; + open my $cache, '>', $globals->{Dircache} + or die "$0: error open $globals->{Dircache} for writing: $!\n"; + + print $cache join(":", @{$globals->{Podpath}}) . "\n$globals->{Podroot}\n"; + my $_updirs_only = ($globals->{Podroot} =~ /\.\./) && !($globals->{Podroot} =~ /[^\.\\\/]/); + foreach my $key (keys %{$Pagesref}) { + if($_updirs_only) { + my $_dirlevel = $globals->{Podroot}; + while($_dirlevel =~ /\.\./) { + $_dirlevel =~ s/\.\.//; + # Assume $Pagesref->{$key} has '/' separators (html dir separators). + $Pagesref->{$key} =~ s/^[\w\s\-\.]+\///; + } + } + print $cache "$key $Pagesref->{$key}\n"; + } + close $cache or die "error closing $globals->{Dircache}: $!"; + return %{$Pagesref}; +} + +sub identify_input { + my $globals = shift; + my $input; + unless (@ARGV && $ARGV[0]) { + if ($globals->{Podfile} and $globals->{Podfile} ne '-') { + $input = $globals->{Podfile}; + } else { + $input = '-'; # XXX: make a test case for this + } + } else { + $globals->{Podfile} = $ARGV[0]; + $input = *ARGV; + } + return $input; +} + sub parse_input_for_podtree { my ($globals, $input) = @_; # set options for input parser -- cgit v1.2.1 From 0fdc91cf964e8337a7ad7b10ac9999bbad280140 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Tue, 16 Mar 2021 22:42:09 +0000 Subject: Introduce refine_parser() Further encapsulation of code internal to pod2html(). At this point we face obstacles: %Pages; $output. Signed-off-by: James E Keenan --- ext/Pod-Html/lib/Pod/Html.pm | 100 ++++++++++++++++++++++--------------------- 1 file changed, 51 insertions(+), 49 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index 253585b112..cfaa6c81b3 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -284,7 +284,6 @@ sub pod2html { } my $input = identify_input($globals); - my $podtree = parse_input_for_podtree($globals, $input); $globals->{Title} = set_Title_from_podtree($globals, $podtree); @@ -304,54 +303,8 @@ sub pod2html { $parser->quiet($globals->{Quiet}); $parser->verbose($globals->{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 = $globals->{Backlink} ? ' id="_podtop_"' : ''; - - my $csslink = ''; - my $tdstyle = ' style="background-color: #cccccc; color: #000"'; - - if ($globals->{Css}) { - $csslink = qq(\n); - $csslink =~ s,\\,/,g; - $csslink =~ s,(/.):,$1|,; - $tdstyle= ''; - } - - # header/footer block - my $block = $globals->{Header} ? < - - $globals->{Title} - - -END_OF_BLOCK - - # create own header/footer because of --header - $parser->html_header(<<"HTMLHEAD"); - - - - -$globals->{Title}$csslink - - - - - -$block -HTMLHEAD - - $parser->html_footer(<<"HTMLFOOT"); -$block - - - -HTMLFOOT - + $parser = refine_parser($globals, $parser); feed_tree_to_parser($parser, $podtree); - write_file($globals, $output); } @@ -472,10 +425,59 @@ sub set_Title_from_podtree { } $globals->{Title} //= ""; - #$globals->{Title} = html_escape($globals->{Title}); return html_escape($globals->{Title}); } +sub refine_parser { + my ($globals, $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 = $globals->{Backlink} ? ' id="_podtop_"' : ''; + + my $csslink = ''; + my $tdstyle = ' style="background-color: #cccccc; color: #000"'; + + if ($globals->{Css}) { + $csslink = qq(\n); + $csslink =~ s,\\,/,g; + $csslink =~ s,(/.):,$1|,; + $tdstyle= ''; + } + + # header/footer block + my $block = $globals->{Header} ? < + + $globals->{Title} + + +END_OF_BLOCK + + # create own header/footer because of --header + $parser->html_header(<<"HTMLHEAD"); + + + + +$globals->{Title}$csslink + + + + + +$block +HTMLHEAD + + $parser->html_footer(<<"HTMLFOOT"); +$block + + + +HTMLFOOT + return $parser; +} + sub get_cache { my $globals = shift; -- cgit v1.2.1 From 4868111cdda45578ae3b7b6e8b4a5e9a91ae37cc Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Tue, 29 Jun 2021 17:08:56 +0000 Subject: Keep $VERSION in synch --- ext/Pod-Html/lib/Pod/Html/Auxiliary.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm b/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm index 86cfafbdef..47d2054115 100644 --- a/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm +++ b/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm @@ -2,7 +2,7 @@ package Pod::Html::Auxiliary; use strict; require Exporter; -our $VERSION = 1.27_001; # Please keep in synch with lib/Pod/Html.pm +our $VERSION = 1.29; # Please keep in synch with lib/Pod/Html.pm $VERSION = eval $VERSION; our @ISA = qw(Exporter); our @EXPORT_OK = qw( -- cgit v1.2.1 From ae244ac41efafec56a6f2d477f2c71549ebc4df5 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 5 Jul 2021 00:41:01 +0000 Subject: Pod-Html: rename Auxiliary.pm to Util.pm Per rjbs code review in https://github.com/Perl/perl5/pull/18950 --- MANIFEST | 2 +- ext/Pod-Html/lib/Pod/Html.pm | 8 +- ext/Pod-Html/lib/Pod/Html/Auxiliary.pm | 292 --------------------------------- ext/Pod-Html/lib/Pod/Html/Util.pm | 292 +++++++++++++++++++++++++++++++++ ext/Pod-Html/t/anchorify.t | 4 +- ext/Pod-Html/t/cache.t | 2 +- ext/Pod-Html/t/crossref2.t | 2 +- ext/Pod-Html/t/lib/Testing.pm | 2 +- 8 files changed, 302 insertions(+), 302 deletions(-) delete mode 100644 ext/Pod-Html/lib/Pod/Html/Auxiliary.pm create mode 100644 ext/Pod-Html/lib/Pod/Html/Util.pm diff --git a/MANIFEST b/MANIFEST index 60c1ee462f..c00b86265b 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4324,7 +4324,7 @@ ext/Pod-Html/bin/pod2html Translator to turn pod into HTML ext/Pod-Html/corpus/perlpodspec-copy.pod ext/Pod-Html/corpus/perlvar-copy.pod ext/Pod-Html/lib/Pod/Html.pm Convert POD data to HTML -ext/Pod-Html/lib/Pod/Html/Auxiliary.pm Helper functions for Pod-Html +ext/Pod-Html/lib/Pod/Html/Util.pm Helper functions for Pod-Html ext/Pod-Html/t/anchorify.t ext/Pod-Html/t/cache.pod ext/Pod-Html/t/cache.t diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index cfaa6c81b3..e6d54b3be5 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -14,7 +14,7 @@ use File::Spec; use File::Spec::Unix; use Pod::Simple::Search; use Pod::Simple::SimpleTree (); -use Pod::Html::Auxiliary qw( +use Pod::Html::Util qw( html_escape htmlify parse_command_line @@ -655,15 +655,15 @@ sub resolve_pod_page_link { $path = $self->pages->{$to}; } - my $url = File::Spec::Unix->catfile(Pod::Html::Auxiliary::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::Auxiliary::relativize_url( - File::Spec::Unix->catdir(Pod::Html::Auxiliary::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 ); } diff --git a/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm b/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm deleted file mode 100644 index 47d2054115..0000000000 --- a/ext/Pod-Html/lib/Pod/Html/Auxiliary.pm +++ /dev/null @@ -1,292 +0,0 @@ -package Pod::Html::Auxiliary; -use strict; -require Exporter; - -our $VERSION = 1.29; # Please keep in synch with lib/Pod/Html.pm -$VERSION = eval $VERSION; -our @ISA = qw(Exporter); -our @EXPORT_OK = qw( - anchorify - html_escape - htmlify - parse_command_line - relativize_url - trim_leading_whitespace - unixify - usage -); - -use Config; -use File::Spec; -use File::Spec::Unix; -use Getopt::Long; -use Pod::Simple::XHTML; -use Text::Tabs; -use locale; # make \w work right in non-ASCII lands - -=head1 NAME - -Pod::Html::Auxiliary - helper functions for Pod-Html - -=head1 SUBROUTINES - -=head2 C - -TK - -=cut - -sub parse_command_line { - my $globals = shift; - 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. - - @{$globals->{Podpath}} = split(":", $opt_podpath) if defined $opt_podpath; - - $globals->{Backlink} = $opt_backlink if defined $opt_backlink; - $globals->{Cachedir} = unixify($opt_cachedir) if defined $opt_cachedir; - $globals->{Css} = $opt_css if defined $opt_css; - $globals->{Header} = $opt_header if defined $opt_header; - $globals->{Htmldir} = unixify($opt_htmldir) if defined $opt_htmldir; - $globals->{Htmlroot} = unixify($opt_htmlroot) if defined $opt_htmlroot; - $globals->{Doindex} = $opt_index if defined $opt_index; - $globals->{Podfile} = unixify($opt_infile) if defined $opt_infile; - $globals->{Htmlfile} = unixify($opt_outfile) if defined $opt_outfile; - $globals->{Poderrors} = $opt_poderrors if defined $opt_poderrors; - $globals->{Podroot} = unixify($opt_podroot) if defined $opt_podroot; - $globals->{Quiet} = $opt_quiet if defined $opt_quiet; - $globals->{Recurse} = $opt_recurse if defined $opt_recurse; - $globals->{Title} = $opt_title if defined $opt_title; - $globals->{Verbose} = $opt_verbose if defined $opt_verbose; - - warn "Flushing directory caches\n" - if $opt_verbose && defined $opt_flush; - $globals->{Dircache} = "$globals->{Cachedir}/pod2htmd.tmp"; - if (defined $opt_flush) { - 1 while unlink($globals->{Dircache}); - } - return $globals; -} - -=head2 C - -TK - -=cut - -sub usage { - my $podfile = shift; - warn "$0: $podfile: @_\n" if @_; - die < --htmlroot= - --infile= --outfile= - --podpath=:...: --podroot= - --cachedir= --flush --recurse --norecurse - --quiet --noquiet --verbose --noverbose - --index --noindex --backlink --nobacklink - --header --noheader --poderrors --nopoderrors - --css= --title= - - --[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 - -} - -=head2 C - -TK - -=cut - -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; -} - -=head2 C - -Convert an absolute URL to one relative to a base URL. -Assumes both end in a filename. - -=cut - -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; -} - -=head2 C - -Make text safe for HTML. - -=cut - -sub html_escape { - my $rest = $_[0]; - $rest =~ s/&/&/g; - $rest =~ s//>/g; - $rest =~ s/"/"/g; - $rest =~ s/([[:^print:]])/sprintf("&#x%x;", ord($1))/aeg; - return $rest; -} - -=head2 C - - 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...). - -=cut - -sub htmlify { - my( $heading) = @_; - return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1); -} - -=head2 C - - anchorify(@heading); - -Similar to C, but turns non-alphanumerics into underscores. Note -that C is not exported by default. - -=cut - -sub anchorify { - my ($anchor) = @_; - $anchor = htmlify($anchor); - $anchor =~ s/\W/_/g; - return $anchor; -} - -=head2 C - -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 - -=cut - -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; - diff --git a/ext/Pod-Html/lib/Pod/Html/Util.pm b/ext/Pod-Html/lib/Pod/Html/Util.pm new file mode 100644 index 0000000000..2ecedfdc9e --- /dev/null +++ b/ext/Pod-Html/lib/Pod/Html/Util.pm @@ -0,0 +1,292 @@ +package Pod::Html::Util; +use strict; +require Exporter; + +our $VERSION = 1.29; # Please keep in synch with lib/Pod/Html.pm +$VERSION = eval $VERSION; +our @ISA = qw(Exporter); +our @EXPORT_OK = qw( + anchorify + html_escape + htmlify + parse_command_line + relativize_url + trim_leading_whitespace + unixify + usage +); + +use Config; +use File::Spec; +use File::Spec::Unix; +use Getopt::Long; +use Pod::Simple::XHTML; +use Text::Tabs; +use locale; # make \w work right in non-ASCII lands + +=head1 NAME + +Pod::Html::Util - helper functions for Pod-Html + +=head1 SUBROUTINES + +=head2 C + +TK + +=cut + +sub parse_command_line { + my $globals = shift; + 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. + + @{$globals->{Podpath}} = split(":", $opt_podpath) if defined $opt_podpath; + + $globals->{Backlink} = $opt_backlink if defined $opt_backlink; + $globals->{Cachedir} = unixify($opt_cachedir) if defined $opt_cachedir; + $globals->{Css} = $opt_css if defined $opt_css; + $globals->{Header} = $opt_header if defined $opt_header; + $globals->{Htmldir} = unixify($opt_htmldir) if defined $opt_htmldir; + $globals->{Htmlroot} = unixify($opt_htmlroot) if defined $opt_htmlroot; + $globals->{Doindex} = $opt_index if defined $opt_index; + $globals->{Podfile} = unixify($opt_infile) if defined $opt_infile; + $globals->{Htmlfile} = unixify($opt_outfile) if defined $opt_outfile; + $globals->{Poderrors} = $opt_poderrors if defined $opt_poderrors; + $globals->{Podroot} = unixify($opt_podroot) if defined $opt_podroot; + $globals->{Quiet} = $opt_quiet if defined $opt_quiet; + $globals->{Recurse} = $opt_recurse if defined $opt_recurse; + $globals->{Title} = $opt_title if defined $opt_title; + $globals->{Verbose} = $opt_verbose if defined $opt_verbose; + + warn "Flushing directory caches\n" + if $opt_verbose && defined $opt_flush; + $globals->{Dircache} = "$globals->{Cachedir}/pod2htmd.tmp"; + if (defined $opt_flush) { + 1 while unlink($globals->{Dircache}); + } + return $globals; +} + +=head2 C + +TK + +=cut + +sub usage { + my $podfile = shift; + warn "$0: $podfile: @_\n" if @_; + die < --htmlroot= + --infile= --outfile= + --podpath=:...: --podroot= + --cachedir= --flush --recurse --norecurse + --quiet --noquiet --verbose --noverbose + --index --noindex --backlink --nobacklink + --header --noheader --poderrors --nopoderrors + --css= --title= + + --[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 + +} + +=head2 C + +TK + +=cut + +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; +} + +=head2 C + +Convert an absolute URL to one relative to a base URL. +Assumes both end in a filename. + +=cut + +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; +} + +=head2 C + +Make text safe for HTML. + +=cut + +sub html_escape { + my $rest = $_[0]; + $rest =~ s/&/&/g; + $rest =~ s//>/g; + $rest =~ s/"/"/g; + $rest =~ s/([[:^print:]])/sprintf("&#x%x;", ord($1))/aeg; + return $rest; +} + +=head2 C + + 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...). + +=cut + +sub htmlify { + my( $heading) = @_; + return Pod::Simple::XHTML->can("idify")->(undef, $heading, 1); +} + +=head2 C + + anchorify(@heading); + +Similar to C, but turns non-alphanumerics into underscores. Note +that C is not exported by default. + +=cut + +sub anchorify { + my ($anchor) = @_; + $anchor = htmlify($anchor); + $anchor =~ s/\W/_/g; + return $anchor; +} + +=head2 C + +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 + +=cut + +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; + diff --git a/ext/Pod-Html/t/anchorify.t b/ext/Pod-Html/t/anchorify.t index 68bc8834be..03d87f80d6 100644 --- a/ext/Pod-Html/t/anchorify.t +++ b/ext/Pod-Html/t/anchorify.t @@ -1,7 +1,7 @@ # -*- perl -*- use strict; -use Pod::Html::Auxiliary qw( anchorify ); +use Pod::Html::Util qw( anchorify ); use Test::More tests => 1; my @filedata; @@ -46,7 +46,7 @@ is_deeply( __DATA__ =head1 NAME -anchorify - Test C +anchorify - Test C =head1 DESCRIPTION diff --git a/ext/Pod-Html/t/cache.t b/ext/Pod-Html/t/cache.t index d2a48ae2f9..7a261fb4eb 100644 --- a/ext/Pod-Html/t/cache.t +++ b/ext/Pod-Html/t/cache.t @@ -11,7 +11,7 @@ use warnings; use Test::More tests => 10; use Testing qw( setup_testing_dir xconvert ); use Cwd; -use Pod::Html::Auxiliary qw( +use Pod::Html::Util qw( unixify ); diff --git a/ext/Pod-Html/t/crossref2.t b/ext/Pod-Html/t/crossref2.t index bdc801a724..9398c11f51 100644 --- a/ext/Pod-Html/t/crossref2.t +++ b/ext/Pod-Html/t/crossref2.t @@ -11,7 +11,7 @@ use warnings; use Test::More tests => 1; use Testing qw( setup_testing_dir xconvert ); use Cwd; -use Pod::Html::Auxiliary qw( +use Pod::Html::Util qw( unixify ); diff --git a/ext/Pod-Html/t/lib/Testing.pm b/ext/Pod-Html/t/lib/Testing.pm index 4b3355456b..3b993b10f2 100644 --- a/ext/Pod-Html/t/lib/Testing.pm +++ b/ext/Pod-Html/t/lib/Testing.pm @@ -19,7 +19,7 @@ use File::Path ( qw| make_path | ); use File::Spec::Functions ':ALL'; use File::Temp ( qw| tempdir | ); use Data::Dumper;$Data::Dumper::Sortkeys=1; -use Pod::Html::Auxiliary qw( +use Pod::Html::Util qw( unixify ); -- cgit v1.2.1 From b7797b7529bd03ccca65f2ce2ee8ffdff2bbb9bb Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 5 Jul 2021 00:42:17 +0000 Subject: After eval-ing $VERSION, assign return value back to $VERSION Remove superfluous assignment to @ISA. Per rjbs code review in https://github.com/Perl/perl5/pull/18950 --- ext/Pod-Html/lib/Pod/Html.pm | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index e6d54b3be5..46ff0da9ea 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -3,8 +3,7 @@ use strict; use Exporter 'import'; our $VERSION = 1.29; -eval $VERSION; -our @ISA = qw(Exporter); +$VERSION = eval $VERSION; our @EXPORT = qw(pod2html); use Config; -- cgit v1.2.1 From ca8c8b63777e14372e9669546eaebed1575d73b1 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 5 Jul 2021 01:06:27 +0000 Subject: Use lowercase for lexical variables -- even filehandles Per rjbs code review in https://github.com/Perl/perl5/pull/18950 --- ext/Pod-Html/lib/Pod/Html.pm | 12 ++++++------ ext/Pod-Html/t/lib/Testing.pm | 12 ++++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm index 46ff0da9ea..cb0f6b8152 100644 --- a/ext/Pod-Html/lib/Pod/Html.pm +++ b/ext/Pod-Html/lib/Pod/Html.pm @@ -574,16 +574,16 @@ sub _save_page { sub write_file { my ($globals, $output) = @_; $globals->{Htmlfile} = "-" unless $globals->{Htmlfile}; # stdout - my $FHOUT; + my $fhout; if($globals->{Htmlfile} and $globals->{Htmlfile} ne '-') { - open $FHOUT, ">", $globals->{Htmlfile} + open $fhout, ">", $globals->{Htmlfile} or die "$0: cannot open $globals->{Htmlfile} file for output: $!\n"; } else { - open $FHOUT, ">-"; + open $fhout, ">-"; } - binmode $FHOUT, ":utf8"; - print $FHOUT $output; - close $FHOUT or die "Failed to close $globals->{Htmlfile}: $!"; + binmode $fhout, ":utf8"; + print $fhout $output; + close $fhout or die "Failed to close $globals->{Htmlfile}: $!"; chmod 0644, $globals->{Htmlfile} unless $globals->{Htmlfile} eq '-'; } diff --git a/ext/Pod-Html/t/lib/Testing.pm b/ext/Pod-Html/t/lib/Testing.pm index 3b993b10f2..8bfb6b8b65 100644 --- a/ext/Pod-Html/t/lib/Testing.pm +++ b/ext/Pod-Html/t/lib/Testing.pm @@ -672,19 +672,19 @@ sub record_state_of_cache { die("'run' element takes integer") unless $args->{run} =~ m/^\d+$/; my @cachelines = (); - open my $IN, '<', $cache or die "Unable to open $cache for reading"; - while (my $l = <$IN>) { + open my $in, '<', $cache or die "Unable to open $cache for reading"; + while (my $l = <$in>) { chomp $l; push @cachelines, $l; } - close $IN or die "Unable to close $cache after reading"; + close $in or die "Unable to close $cache after reading"; my $outfile = catfile($args->{outdir}, "$args->{run}.cache.$args->{stub}.$$.txt"); die("$outfile already exists; did you remember to increment the 'run' argument?") if -f $outfile; - open my $OUT, '>', $outfile or die "Unable to open $outfile for writing"; - print $OUT "$_\n" for (sort @cachelines); - close $OUT or die "Unable to close after writing"; + open my $out, '>', $outfile or die "Unable to open $outfile for writing"; + print $out "$_\n" for (sort @cachelines); + close $out or die "Unable to close after writing"; print STDERR "XXX: cache (sorted): $outfile\n"; } -- cgit v1.2.1