summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMarc Green <marcgreen@cpan.org>2012-01-13 11:42:00 -0500
committerRicardo Signes <rjbs@cpan.org>2012-02-06 21:21:17 -0500
commitb09e89a9fc6a3133146f94636ce3727fd8d1cbca (patch)
treea5422e36d3230418ad417afb3d0b10092033fafa
parentc51c16dc23b2bd769e343362fd570ff2428828de (diff)
downloadperl-b09e89a9fc6a3133146f94636ce3727fd8d1cbca.tar.gz
Re-add cache feature
./installhtml was unacceptably slow without pod2html caching, so this commit re-adds it.
-rw-r--r--ext/Pod-Html/lib/Pod/Html.pm148
-rw-r--r--ext/Pod-Html/t/cache.pod3
-rw-r--r--ext/Pod-Html/t/cache.t71
-rw-r--r--ext/Pod-Html/t/pod2html-lib.pl1
4 files changed, 209 insertions, 14 deletions
diff --git a/ext/Pod-Html/lib/Pod/Html.pm b/ext/Pod-Html/lib/Pod/Html.pm
index 444174274a..1816c523ea 100644
--- a/ext/Pod-Html/lib/Pod/Html.pm
+++ b/ext/Pod-Html/lib/Pod/Html.pm
@@ -3,7 +3,7 @@ use strict;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
-$VERSION = 1.13;
+$VERSION = 1.14;
@ISA = qw(Exporter);
@EXPORT = qw(pod2html htmlify);
@EXPORT_OK = qw(anchorify);
@@ -31,7 +31,8 @@ Pod::Html - module to convert pod files to HTML
=head1 DESCRIPTION
Converts files from pod format (see L<perlpod>) to HTML format. It
-can automatically generate indexes and cross-references.
+can automatically generate indexes and cross-references, and it keeps
+a cache of things it knows how to cross-reference.
=head1 FUNCTIONS
@@ -56,6 +57,12 @@ pod2html takes the following arguments:
Turns every C<head1> heading into a link back to the top of the page.
By default, no backlinks are generated.
+=item cachedir
+
+ --cachedir=name
+
+Creates the directory cache in the given directory.
+
=item css
--css=stylesheet
@@ -63,6 +70,12 @@ By default, no backlinks are generated.
Specify the URL of a cascading style sheet. Also disables all HTML/CSS
C<style> attributes that are output by default (to avoid conflicts).
+=item flush
+
+ --flush
+
+Flushes the directory cache.
+
=item header
--header
@@ -203,6 +216,8 @@ This program is distributed under the Artistic License.
=cut
+my $Cachedir;
+my $Dircache;
my($Htmlroot, $Htmldir, $Htmlfile, $Htmlfileurl);
my($Podfile, @Podpath, $Podroot);
my $Poderrors;
@@ -225,6 +240,11 @@ my $Curdir = File::Spec->curdir;
init_globals();
sub init_globals {
+ $Cachedir = "."; # The directory to which directory caches
+ # will be written.
+
+ $Dircache = "pod2htmd.tmp";
+
$Htmlroot = "/"; # http-server base directory from which all
# relative paths in $podpath stem.
$Htmldir = ""; # The directory to which the html pages
@@ -275,17 +295,34 @@ sub pod2html {
$Htmlfileurl = Unixify::unixify($Htmlfile);
}
-
- my $pwd = getcwd();
- chdir($Podroot) || die "$0: error changing to directory $Podroot: $!\n";
- # find all pod modules/pages in podpath, store in %Pages
- # - callback used to remove Podroot and extension from each file
- # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
- Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1)
- ->callback(\&_save_page)->recurse($Recurse)->survey(@Podpath);
+ # load or generate/cache %Pages
+ unless (get_cache($Dircache, \@Podpath, $Podroot, $Recurse)) {
+ # generate %Pages
+ my $pwd = getcwd();
+ chdir($Podroot) ||
+ die "$0: error changing to directory $Podroot: $!\n";
+
+ # find all pod modules/pages in podpath, store in %Pages
+ # - callback used to remove Podroot and extension from each file
+ # - laborious to allow '.' in dirnames (e.g., /usr/share/perl/5.14.1)
+ Pod::Simple::Search->new->inc(0)->verbose($Verbose)->laborious(1)
+ ->callback(\&_save_page)->recurse($Recurse)->survey(@Podpath);
+
+ chdir($pwd) || die "$0: error changing to directory $pwd: $!\n";
+
+ # cache the directory list for later use
+ warn "caching directories for later use\n" if $Verbose;
+ open my $cache, '>', $Dircache
+ or die "$0: error open $Dircache for writing: $!\n";
+
+ print $cache join(":", @Podpath) . "\n$Podroot\n";
+ foreach my $key (keys %Pages) {
+ print $cache "$key $Pages{$key}\n";
+ }
- chdir($pwd) || die "$0: error changing to directory $pwd: $!\n";
+ close $cache or die "error closing $Dircache: $!";
+ }
# set options for the parser
my $parser = Pod::Simple::XHTML::LocalPodLinks->new();
@@ -388,12 +425,14 @@ sub usage {
warn "$0: $podfile: @_\n" if @_;
die <<END_OF_USAGE;
Usage: $0 --help --htmlroot=<name> --infile=<name> --outfile=<name>
- --podpath=<name>:...:<name> --podroot=<name>
+ --podpath=<name>:...:<name> --podroot=<name> --cachedir=<name>
--recurse --verbose --index --norecurse --noindex
--[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.
@@ -422,15 +461,17 @@ END_OF_USAGE
}
sub parse_command_line {
- my ($opt_backlink,$opt_css,$opt_header,$opt_help,
- $opt_htmldir,$opt_htmlroot,$opt_index,$opt_infile,
+ 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,
@@ -454,6 +495,7 @@ sub parse_command_line {
@Podpath = split(":", $opt_podpath) if defined $opt_podpath;
$Backlink = $opt_backlink if defined $opt_backlink;
+ $Cachedir = $opt_cachedir if defined $opt_cachedir;
$Css = $opt_css if defined $opt_css;
$Header = $opt_header if defined $opt_header;
$Htmldir = $opt_htmldir if defined $opt_htmldir;
@@ -467,8 +509,86 @@ sub parse_command_line {
$Recurse = $opt_recurse if defined $opt_recurse;
$Title = $opt_title if defined $opt_title;
$Verbose = $opt_verbose if defined $opt_verbose;
+
+ warn "Flushing directory caches\n"
+ if $opt_verbose && defined $opt_flush;
+ $Dircache = "$Cachedir/pod2htmd.tmp";
+ if (defined $opt_flush) {
+ 1 while unlink($Dircache);
+ }
}
+my $Saved_Cache_Key;
+
+sub get_cache {
+ my($dircache, $podpath, $podroot, $recurse) = @_;
+ my @cache_key_args = @_;
+
+ # A first-level cache:
+ # Don't bother reading the cache files if they still apply
+ # and haven't changed since we last read them.
+
+ my $this_cache_key = cache_key(@cache_key_args);
+ return 1 if $Saved_Cache_Key and $this_cache_key eq $Saved_Cache_Key;
+ $Saved_Cache_Key = $this_cache_key;
+
+ # load the cache of %Pages if possible. $tests will be
+ # non-zero if successful.
+ my $tests = 0;
+ if (-f $dircache) {
+ warn "scanning for directory cache\n" if $Verbose;
+ $tests = load_cache($dircache, $podpath, $podroot);
+ }
+
+ return $tests;
+}
+
+sub cache_key {
+ my($dircache, $podpath, $podroot, $recurse) = @_;
+ return join('!',$dircache,$recurse,@$podpath,$podroot,stat($dircache));
+}
+
+#
+# load_cache - tries to find if the cache stored in $dircache is a valid
+# cache of %Pages. if so, it loads them and returns a non-zero value.
+#
+sub load_cache {
+ my($dircache, $podpath, $podroot) = @_;
+ my $tests = 0;
+ local $_;
+
+ warn "scanning for directory cache\n" if $Verbose;
+ open(CACHE, "<$dircache") ||
+ die "$0: error opening $dircache for reading: $!\n";
+ $/ = "\n";
+
+ # is it the same podpath?
+ $_ = <CACHE>;
+ chomp($_);
+ $tests++ if (join(":", @$podpath) eq $_);
+
+ # is it the same podroot?
+ $_ = <CACHE>;
+ chomp($_);
+ $tests++ if ($podroot eq $_);
+
+ # load the cache if its good
+ if ($tests != 2) {
+ close(CACHE);
+ return 0;
+ }
+
+ warn "loading directory cache\n" if $Verbose;
+ while (<CACHE>) {
+ /(.*?) (.*)$/;
+ $Pages{$1} = $2;
+ }
+
+ close(CACHE);
+ return 1;
+}
+
+
#
# html_escape: make text safe for HTML
#
diff --git a/ext/Pod-Html/t/cache.pod b/ext/Pod-Html/t/cache.pod
new file mode 100644
index 0000000000..04010b440c
--- /dev/null
+++ b/ext/Pod-Html/t/cache.pod
@@ -0,0 +1,3 @@
+=head1 NAME
+
+the contents of this file doesn't matter
diff --git a/ext/Pod-Html/t/cache.t b/ext/Pod-Html/t/cache.t
new file mode 100644
index 0000000000..3c4734a2dc
--- /dev/null
+++ b/ext/Pod-Html/t/cache.t
@@ -0,0 +1,71 @@
+#!/usr/bin/perl -w # -*- perl -*-
+
+BEGIN {
+ die "Run me from outside the t/ directory, please" unless -d 't';
+}
+
+# test the directory cache
+# XXX test --flush and %Pages being loaded/used for cross references
+
+use strict;
+use Cwd;
+use Pod::Html;
+use Data::Dumper;
+use File::Spec;
+use Test::More tests => 10;
+
+my $cwd = Cwd::cwd();
+my $infile = "t/cache.pod";
+my $outfile = "cacheout.html";
+my $cachefile = "pod2htmd.tmp";
+my $tcachefile = "t/pod2htmd.tmp";
+
+unlink $cachefile, $tcachefile;
+is(-f $cachefile, undef, "No cache file to start");
+is(-f $tcachefile, undef, "No cache file to start");
+
+# test podpath and podroot
+Pod::Html::pod2html(
+ "--infile=$infile",
+ "--outfile=$outfile",
+ "--podpath=scooby:shaggy:fred:velma:daphne",
+ "--podroot=$cwd",
+ );
+is(-f $cachefile, 1, "Cache created");
+open(my $cache, '<', $cachefile) or die "Cannot open cache file: $!";
+chomp(my $podpath = <$cache>);
+chomp(my $podroot = <$cache>);
+close $cache;
+is($podpath, "scooby:shaggy:fred:velma:daphne", "podpath");
+is($podroot, "$cwd", "podroot");
+
+# test cache contents
+Pod::Html::pod2html(
+ "--infile=$infile",
+ "--outfile=$outfile",
+ "--cachedir=t",
+ "--podpath=t",
+ "--htmldir=$cwd",
+ );
+is(-f $tcachefile, 1, "Cache created");
+open($cache, '<', $tcachefile) or die "Cannot open cache file: $!";
+chomp($podpath = <$cache>);
+chomp($podroot = <$cache>);
+is($podpath, "t", "podpath");
+my %pages;
+while (<$cache>) {
+ /(.*?) (.*)$/;
+ $pages{$1} = $2;
+}
+chdir("t");
+my %expected_pages =
+ map { my $f = substr($_, 0, -4); $f => File::Spec->catfile($cwd,'t',$f) }
+ <*.pod>;
+chdir($cwd);
+is_deeply(\%pages, \%expected_pages, "cache contents");
+close $cache;
+
+unlink $outfile;
+unlink $cachefile, $tcachefile;
+is(-f $cachefile, undef, "No cache file to end");
+is(-f $tcachefile, undef, "No cache file to end");
diff --git a/ext/Pod-Html/t/pod2html-lib.pl b/ext/Pod-Html/t/pod2html-lib.pl
index 7a71e4c5b7..1567b3342f 100644
--- a/ext/Pod-Html/t/pod2html-lib.pl
+++ b/ext/Pod-Html/t/pod2html-lib.pl
@@ -84,6 +84,7 @@ sub convert_n_test {
# pod2html creates these
1 while unlink $outfile;
+ 1 while unlink "pod2htmd.tmp";
}
1;