diff --git a/Makefile.PL b/Makefile.PL index ad413b7..f2e5418 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -9,6 +9,7 @@ requires 'Plack::Middleware::ReverseProxy'; requires 'Time::Piece'; requires 'Pod::Simple::XHTML'; requires 'Log::Minimal'; +requires 'Cache::FileCache'; recursive_author_tests('xt'); diff --git a/lib/PJP.pm b/lib/PJP.pm index 48016fd..2cfde10 100644 --- a/lib/PJP.pm +++ b/lib/PJP.pm @@ -7,6 +7,8 @@ our $VERSION='0.01'; use Amon2::Config::Simple; sub load_config { Amon2::Config::Simple->load(shift) } - +use PJP::Cache; +my $cache = PJP::Cache->new(); +sub cache { $cache } 1; diff --git a/lib/PJP/Cache.pm b/lib/PJP/Cache.pm new file mode 100644 index 0000000..53aa97d --- /dev/null +++ b/lib/PJP/Cache.pm @@ -0,0 +1,32 @@ +use strict; +use warnings; +use utf8; + +package PJP::Cache; +use Cache::FileCache; +use File::stat; + +sub new { + my $class = shift; + bless { + cache => Cache::FileCache->new(), + }, $class; +} + +sub file_cache { + my ($self, $prefix, $file, $cb) = @_; + my $cache = $self->{cache}; + my $key = "${prefix}::${file}"; + my $data = $cache->get($key); + my $stat = stat($file) or die "Cannot stat $file: $!"; + if ($data && $data->[0] eq $stat->mtime) { + return $data->[1]; + } else { + my $out = $cb->(); + $cache->set($key => [$stat->mtime, $out]); + return $out; + } +} + +1; + diff --git a/lib/PJP/M/Pod.pm b/lib/PJP/M/Pod.pm index 81ef3ea..5cd41b0 100644 --- a/lib/PJP/M/Pod.pm +++ b/lib/PJP/M/Pod.pm @@ -23,6 +23,21 @@ sub pod2html { return mark_raw($out); } +sub get_file_list { + my ($class, $name) = @_; + + my @path = reverse sort { eval { version->parse($a->[1]) } <=> eval { version->parse($b->[1]) } } map { + +[ $_, map { local $_=$_; s!.*/perl/!!; s!/$name.pod!!; $_ } $_ ] + } glob("assets/perldoc.jp/docs/perl/*/$name.pod"); + return @path; +} + +sub get_latest_file_path { + my ($class, $name) = @_; + my ($latest) = $class->get_file_list($name); + return $latest; +} + { package PJP::Pod::Parser; use parent qw/Pod::Simple::XHTML/; # for google source code prettifier diff --git a/lib/PJP/M/TOC.pm b/lib/PJP/M/TOC.pm index df5a3fa..676e20a 100644 --- a/lib/PJP/M/TOC.pm +++ b/lib/PJP/M/TOC.pm @@ -4,9 +4,23 @@ use utf8; package PJP::M::TOC; use Text::Xslate::Util qw/html_escape mark_raw/; +use File::stat; +use Log::Minimal; sub render { - my $class = shift; + my ($class, $c) = @_; + + return mark_raw($c->cache->file_cache( + "toc", 'toc.txt', sub { + infof("regen toc"); + $class->_render(); + } + )); +} + +sub _render { + my ($class) = @_; + open my $fh, '<:utf8', 'toc.txt' or die "Cannot open toc.txt: $!"; my $out; while (<$fh>) { @@ -27,7 +41,7 @@ sub render { $out .= "
\n"; } } - return mark_raw($out); + $out; } 1; diff --git a/lib/PJP/Web/Dispatcher.pm b/lib/PJP/Web/Dispatcher.pm index ab0333f..8b0c543 100644 --- a/lib/PJP/Web/Dispatcher.pm +++ b/lib/PJP/Web/Dispatcher.pm @@ -7,11 +7,12 @@ use Pod::Simple::XHTML; use Log::Minimal; use PJP::M::TOC; use PJP::M::Pod; +use File::stat; get '/' => sub { my $c = shift; - my $toc = PJP::M::TOC->render(); + my $toc = PJP::M::TOC->render($c); $c->render('index.tt', {toc => $toc}); }; @@ -19,20 +20,17 @@ get '/pod/*' => sub { my ($c, $p) = @_; my ($splat) = @{$p->{splat}}; - my @path = map { $_->[0] } reverse sort { eval { version->parse($a->[1]) } <=> eval { version->parse($b->[1]) } } map { - +[ $_, map { local $_=$_; s!.*/perl/!!; s!/$splat.pod!!; $_ } $_ ] - } glob("assets/perldoc.jp/docs/perl/*/$splat.pod"); - my ($latest) = @path; - my $path = $latest; - - unless ($path) { - warnf("missing %s, %s", ddf($splat), ddf(\@path)); + my $path_info = PJP::M::Pod->get_latest_file_path($splat); + unless ($path_info) { + warnf("missing %s, %s", $splat); return $c->render('please-translate.tt', {name => $splat}); } - my ($version) = ($path =~ m{([^/]+)\/\Q$splat.pod\E\Z}); + my ($path, $version) = @$path_info; + my $out = $c->cache->file_cache("pod:2", $path, sub { + PJP::M::Pod->pod2html($path); + }); - my $out = PJP::M::Pod->pod2html($path); return $c->render('pod.tt', { body => $out, version => $version }); };