diff options
Diffstat (limited to 'lib/Pod/Html.pm')
| -rw-r--r-- | lib/Pod/Html.pm | 105 |
1 files changed, 72 insertions, 33 deletions
diff --git a/lib/Pod/Html.pm b/lib/Pod/Html.pm index 6efaf1ffa2..82453344d8 100644 --- a/lib/Pod/Html.pm +++ b/lib/Pod/Html.pm @@ -236,10 +236,13 @@ $top = 1; # true if we are at the top of the doc. used # to prevent the first <HR> directive. $paragraph = ''; # which paragraph we're processing (used # for error messages) -%pages = (); # associative array used to find the location - # of pages referenced by L<> links. %sections = (); # sections within this page -%items = (); # associative array used to find the location + +# These are not reinitialised here but are kept as a cache. +# See get_cache and related cache management code. +#%pages = (); # associative array used to find the location + # of pages referenced by L<> links. +#%items = (); # associative array used to find the location # of =item directives referenced by C<> links } @@ -252,7 +255,6 @@ sub pod2html { init_globals(); # cache of %pages and %items from last time we ran pod2html - my $podpath = ''; #undef $opt_help if defined $opt_help; @@ -281,6 +283,11 @@ sub pod2html { # scan the pod for =head[1-6] directives and build an index my $index = scan_headings(\%sections, @poddata); + unless($index) { + warn "No pod in $podfile\n" if $verbose; + return; + } + # open the output file open(HTML, ">$htmlfile") || die "$0: cannot open $htmlfile file for output: $!\n"; @@ -297,14 +304,19 @@ sub pod2html { } } + if (!$title and $podfile =~ /\.pod$/) { + # probably a split pod so take first =head[12] as title + for (my $i = 0; $i < @poddata; $i++) { + last if ($title) = $poddata[$i] =~ /^=head[12]\s*(.*)/; + } + warn "adopted '$title' as title for $podfile\n" + if $verbose and $title; + } unless ($title) { + warn "$0: no title for $podfile"; $podfile =~ /^(.*)(\.[^.\/]+)?$/; $title = ($podfile eq "-" ? 'No Title' : $1); - warn "found $title" if $verbose; - } - if ($title =~ /\.pm/) { - warn "$0: no title for $podfile"; - $title = $podfile; + warn "using $title" if $verbose; } print HTML <<END_OF_HEAD; <HTML> @@ -316,20 +328,8 @@ sub pod2html { END_OF_HEAD - # load a cache of %pages and %items if possible. $tests will be - # non-zero if successful. - my $tests = 0; - if (-f $dircache && -f $itemcache) { - warn "scanning for item cache\n" if $verbose; - $tests = find_cache($dircache, $itemcache, $podpath, $podroot); - } - - # if we didn't succeed in loading the cache then we must (re)build - # %pages and %items. - if (!$tests) { - warn "scanning directories in pod-path\n" if $verbose; - scan_podpath($podroot, $recurse); - } + # load/reload/validate/cache %pages and %items + get_cache($dircache, $itemcache, \@podpath, $podroot, $recurse); # scan the pod for =item directives scan_items("", \%items, @poddata); @@ -492,12 +492,51 @@ sub parse_command_line { $netscape = $opt_netscape if defined $opt_netscape; } + +my $saved_cache_key; + +sub get_cache { + my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_; + my @cache_key_args = @_; + + # A first-level cache: + # Don't bother reading the cache files if they still apply + # and haven't changed since we last read them. + + my $this_cache_key = cache_key(@cache_key_args); + + return if $saved_cache_key and $this_cache_key eq $saved_cache_key; + + # load the cache of %pages and %items if possible. $tests will be + # non-zero if successful. + my $tests = 0; + if (-f $dircache && -f $itemcache) { + warn "scanning for item cache\n" if $verbose; + $tests = load_cache($dircache, $itemcache, $podpath, $podroot); + } + + # if we didn't succeed in loading the cache then we must (re)build + # %pages and %items. + if (!$tests) { + warn "scanning directories in pod-path\n" if $verbose; + scan_podpath($podroot, $recurse, 0); + } + $saved_cache_key = cache_key(@cache_key_args); +} + +sub cache_key { + my($dircache, $itemcache, $podpath, $podroot, $recurse) = @_; + return join('!', $dircache, $itemcache, $recurse, + @$podpath, $podroot, stat($dircache), stat($itemcache)); +} + # -# find_cache - tries to find if the caches stored in $dircache and $itemcache +# load_cache - tries to find if the caches stored in $dircache and $itemcache # are valid caches of %pages and %items. if they are valid then it loads # them and returns a non-zero value. # -sub find_cache { + +sub load_cache { my($dircache, $itemcache, $podpath, $podroot) = @_; my($tests); local $_; @@ -511,7 +550,7 @@ sub find_cache { # is it the same podpath? $_ = <CACHE>; chomp($_); - $tests++ if (join(":", @podpath) eq $_); + $tests++ if (join(":", @$podpath) eq $_); # is it the same podroot? $_ = <CACHE>; @@ -521,8 +560,6 @@ sub find_cache { # load the cache if its good if ($tests != 2) { close(CACHE); - - %items = (); return 0; } @@ -542,7 +579,7 @@ sub find_cache { # is it the same podpath? $_ = <CACHE>; chomp($_); - $tests++ if (join(":", @podpath) eq $_); + $tests++ if (join(":", @$podpath) eq $_); # is it the same podroot? $_ = <CACHE>; @@ -552,9 +589,6 @@ sub find_cache { # load the cache if its good if ($tests != 2) { close(CACHE); - - %pages = (); - %items = (); return 0; } @@ -575,10 +609,15 @@ sub find_cache { # @libpods for =item directives. # sub scan_podpath { - my($podroot, $recurse) = @_; + my($podroot, $recurse, $append) = @_; my($pwd, $dir); my($libpod, $dirname, $pod, @files, @poddata); + unless($append) { + %items = (); + %pages = (); + } + # scan each directory listed in @podpath $pwd = getcwd(); chdir($podroot) |