Permalink
Browse files

- 違うバージョンの pod もみれるようにした

- pod も SQLite に保存するようにした
  • Loading branch information...
tokuhirom committed Feb 13, 2011
1 parent 4ae9d17 commit 9c01a4711e6ae4f54c7d644f20f077d832e640e5
Showing with 179 additions and 84 deletions.
  1. +2 −0 htdocs/static/css/main.css
  2. +4 −0 htdocs/static/css/main.scss
  3. +13 −2 lib/PJP/DBI.pm
  4. +1 −1 lib/PJP/M/Pod.pm
  5. +101 −0 lib/PJP/M/PodFile.pm
  6. +37 −79 lib/PJP/Web/Dispatcher.pm
  7. +11 −0 sql/sqlite.sql
  8. +2 −2 tmpl/directory_index.tt
  9. +8 −0 tmpl/pod.tt
@@ -376,6 +376,8 @@ body {
float: right;
text-align: right;
overflow: visible; }
+ .PodPage .PodInfo .OtherVersions {
+ margin-top: 20px; }
.PodPage .PodBody ul.pod_toc {
list-style: none;
margin-bottom: 10px; }
@@ -113,6 +113,10 @@ body {
float: right;
text-align: right;
overflow: visible;
+
+ .OtherVersions {
+ margin-top: 20px;
+ }
}
.PodBody {
View
@@ -8,8 +8,11 @@ use parent qw/DBI/;
sub connect {
my ($self, $dsn, $user, $pass, $attr) = @_;
- $attr->{RaiseError} = 1;
- $attr->{AutoInactiveDestroy} = 1;
+ $attr->{RaiseError} //= 1;
+ $attr->{AutoInactiveDestroy} //= 1;
+ if ($dsn =~ /^dbi:SQLite:/) {
+ $attr->{sqlite_unicode} //= 1;
+ }
return $self->SUPER::connect($dsn, $user, $pass, $attr);
}
@@ -42,6 +45,14 @@ sub insert {
$self->do($sql, {}, @bind);
}
+sub replace {
+ my ($self, $table, $vars, $attr) = @_;
+ $attr //= {};
+ $attr->{prefix} = 'REPLACE ';
+ my ($sql, @bind) = $self->sql_maker->insert($table, $vars, $attr);
+ $self->do($sql, {}, @bind);
+}
+
sub single {
my ($self, $table, $where, $opt) = @_;
my $sth = $self->search($table, $where, $opt);
View
@@ -135,7 +135,7 @@ sub get_latest_file_path {
s/^\s+//; s/\s+$//; # Strip white space.
s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars.
# s/^[^a-zA-Z]+//; # First char must be a letter.
- s/([^-a-zA-Z0-9_:.]+)/unpack('H*', $1)/eg; # All other chars must be valid.
+ s/([^-a-zA-Z0-9_:.]+)/unpack("U*", $1)/eg; # All other chars must be valid.
}
return $t if $not_unique;
my $i = '';
View
@@ -0,0 +1,101 @@
+use strict;
+use warnings;
+use utf8;
+
+package PJP::M::PodFile;
+use Amon2::Declare;
+use File::Spec::Functions qw/abs2rel catfile catdir/;
+use File::Find::Rule;
+use PJP::M::Pod;
+use Log::Minimal;
+
+sub retrieve {
+ my ($class, $path) = @_;
+
+ my $c = c();
+ $c->dbh->single(
+ 'pod' => {
+ path => $path,
+ },
+ );
+}
+
+sub other_versions {
+ my ($class, $package) = @_;
+ my $c = c();
+ @{$c->dbh->selectall_arrayref(q{SELECT distvname, path FROM pod WHERE package=?}, {Slice => {}}, $package)};
+}
+
+sub get_latest {
+ my ($class, $package) = @_;
+
+ my $c = c();
+ my @versions =
+ map { $_->[0] }
+ sort { $a->[1] <=> $b->[1] }
+ map { [ $_, version->parse(CPAN::DistnameInfo->new($_)->version) ] } map { @$_ } @{
+ $c->dbh->selectall_arrayref( q{SELECT distvname FROM pod WHERE package=?},
+ {}, $package )
+ };
+ return undef unless @versions;
+
+ my($path) = $c->dbh->selectrow_array(
+ q{SELECT path FROM pod WHERE package=? AND distvname=?}, {}, $package, $versions[0]
+ );
+ return $path;
+}
+
+sub search_by_distvname {
+ my ($class, $distvname) = @_;
+ my $c = c();
+ @{ $c->dbh->selectall_arrayref(q{SELECT package, path, description FROM pod WHERE distvname=? ORDER BY package}, {Slice => {}}, $distvname) };
+}
+
+sub generate {
+ my ($class, $c) = @_;
+
+ my $txn = $c->dbh->txn_scope();
+ $c->dbh->do(q{DELETE FROM pod});
+ my @bases = glob(catdir($c->base_dir(), 'assets', '*', 'docs'));
+ for my $base (@bases) {
+ my @files = File::Find::Rule->file()
+ ->name('*.pod')
+ ->in($base);
+
+ for my $file (@files) {
+ infof("Processing: %s", $file);
+ my $args = $c->cache->file_cache(
+ "path:20",
+ $file,
+ sub {
+ my $html = PJP::M::Pod->pod2html($file);
+ my $relpath = abs2rel( $file, $base );
+ my ( $package, $description ) =
+ PJP::M::Pod->parse_name_section($file);
+ if ( !defined $package ) {
+ $package = $relpath;
+ $package =~ s/\.pod$//;
+ $package =~ s!^modules/!!;
+ }
+ ( my $distvname = $relpath ) =~ s!^modules/!!;
+ $distvname =~ s!^perl/!!;
+ $distvname =~ s!/.+!!;
+ +{
+ path => $relpath,
+ package => $package,
+ description => $description,
+ distvname => $distvname,
+ html => $html,
+ };
+ }
+ );
+ $c->dbh->replace(
+ pod => $args
+ );
+ }
+ }
+ $txn->commit;
+}
+
+1;
+
View
@@ -13,6 +13,7 @@ use Text::Xslate::Util qw/mark_raw/;
use PJP::M::TOC;
use PJP::M::Index::Module;
use PJP::M::Pod;
+use PJP::M::PodFile;
get '/' => sub {
my $c = shift;
@@ -64,31 +65,15 @@ get '/index/module' => sub {
# 添付 pod の表示
get '/pod/*' => sub {
my ($c, $p) = @_;
- my ($splat) = @{$p->{splat}};
+ my ($package) = @{$p->{splat}};
- 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 $path = PJP::M::PodFile->get_latest(
+ $package
+ );
+ return $c->res_404() unless $path;
+ # my $is_old = $path !~ /delta/ && eval { version->parse($version) } < eval { version->parse("5.8.5") };
- my ($path, $version) = @$path_info;
- my ($html, $package, $description) = @{$c->cache->file_cache("pod:17", $path, sub {
- [PJP::M::Pod->pod2html($path), PJP::M::Pod->parse_name_section($path)];
- })};
- my $is_old = $path !~ /delta/ && eval { version->parse($version) } < eval { version->parse("5.8.5") };
-
- return $c->render('pod.tt' => {
- is_old => $is_old,
- version => $version,
- 'title' => "$package - $description 【perldoc.jp】",
- 'PodVersion' => "perl-$version",
- 'body' => $html,
- });
+ return $c->redirect("/docs/$path");
};
use PJP::M::BuiltinFunction;
@@ -112,76 +97,49 @@ get '/func/*' => sub {
}
};
-use File::Spec::Functions qw/catfile abs2rel catdir/;
-use Cwd ();
-use File::Find qw/finddepth/;
-get '/docs/modules/{dist:[A-Za-z0-9._-]+}{trailingslash:/?}' => sub {
+get '/docs/modules/{distvname:[A-Za-z0-9._-]+}{trailingslash:/?}' => sub {
my ($c, $p) = @_;
- my ($path, ) = glob(catdir($c->base_dir(), 'assets', '*', 'docs', 'modules', $p->{dist}));
- unless (-d $path) {
- warnf("path '%s' is missing", $p->{path});
- return $c->res_404();
- }
+ my $distvname = $p->{distvname};
- # directory index
- my @index;
- finddepth(sub {
- unless (/^\./ || /^CVS$/ || $File::Find::name =~ m{/CVS/} || -d $_) {
- if (/\.pod$/) {
- my ($package, $desc) = PJP::M::Pod->parse_name_section($File::Find::name);
- push @index,
- [
- abs2rel( $File::Find::name, $path ),
- $package || abs2rel($File::Find::name, $path),
- $desc
- ];
- }
- }
- return 1; # need true value
- }, $path);
+ my @rows = PJP::M::PodFile->search_by_distvname($distvname);
+ return $c->res_404() unless @rows;
- my $distvname = $c->req->path_info;
- $distvname =~ s!\/$!!;
- $distvname =~ s!.+\/!!;
return $c->render(
'directory_index.tt' => {
- index => [ sort { $a->[0] cmp $b->[0] } @index ],
+ index => \@rows,
distvname => $distvname,
- 'title' => "$distvname 【perldoc.jp】",
+ 'title' => "$distvname 【perldoc.jp】",
}
);
};
-get '/docs/modules/{path:.+\.pod}' => sub {
+get '/docs/{path:(modules|perl)/.+\.pod}' => sub {
my ($c, $p) = @_;
- my ($path, ) = map { Cwd::realpath($_) } glob(catdir($c->base_dir(), 'assets', '*', 'docs', 'modules', $p->{path}));
- unless (-f $path) {
- warnf("path '%s' is missing", $p->{path});
+ my $pod = PJP::M::PodFile->retrieve($p->{path});
+ if ($pod) {
+ my @others = do {
+ if ($pod->{package}) {
+ grep { $_->{distvname} ne $pod->{distvname} }
+ PJP::M::PodFile->other_versions( $pod->{package} );
+ } else {
+ ();
+ }
+ };
+ return $c->render(
+ 'pod.tt' => {
+ body => mark_raw( $pod->{html} ),
+ others => \@others,
+ distvname => $pod->{distvname},
+ package => $pod->{package},
+ description => $pod->{description},
+ 'PodVersion' => $pod->{distvname},
+ 'title' => "$pod->{package} - $pod->{description} 【perldoc.jp】",
+ }
+ );
+ } else {
return $c->res_404();
}
-
- return $c->show_403() if $path =~ m{/CVS(/|$)};
- return $c->show_403() if $p->{path} =~ m{\.\.};
- my $base = Cwd::realpath(catdir($c->base_dir(), 'assets'));
- return $c->show_403() unless $path =~ qr{^\Q$base\E/[a-zA-Z0-9._-]+/docs/modules/([^/]+)/};
- my $distvname = $1;
-
- my ($html, $package, $description) = @{$c->cache->file_cache("path:19", $path, sub {
- infof("rendering %s", $path);
- [PJP::M::Pod->pod2html($path), PJP::M::Pod->parse_name_section($path)];
- })};
- return $c->render(
- 'pod.tt' => {
- body => $html,
- distvname => $distvname,
- subtitle => do { ( my $subtitle = $path ) =~ s!/modules/!!; $subtitle },
- package => $package,
- description => $description,
- 'PodVersion' => $distvname,
- 'title' => "$package - $description 【perldoc.jp】",
- }
- );
};
get '/perl*' => sub {
View
@@ -3,3 +3,14 @@ create table func (
version varchar(255) not null,
html text
);
+
+create table pod (
+ package varchar(255) not null,
+ description varchar(255),
+ path varchar(255) not null PRIMARY KEY,
+ distvname varchar(255) not null,
+ html text
+);
+CREAte INDEX if not exists package on pod (package);
+CREAte INDEX if not exists distvname on pod (distvname);
+
View
@@ -8,8 +8,8 @@
<table>
[% FOR v IN index %]
<tr>
- <td><a href="./[% v.0 %]">[% v.1 %]</a></td>
- <td>[% v.2 %]</td>
+ <td><a href="/docs/[% v.path %]">[% v.package || v.path %]</a></td>
+ <td>[% v.description %]</td>
</tr>
[% END %]
</table>
View
@@ -7,6 +7,14 @@
[% IF package %]
<div class="CheckAtCPAN"><a href="http://search.cpan.org/perldoc?[% package %]">CPANで確認する</a></div>
[% END %]
+ [% IF others.size() > 0 %]
+ <div class="OtherVersions">
+ Other versions:<br />
+ [% FOR v IN others %]
+ <a href="/docs/[% v.path %]">[% v.distvname %]</a><br />
+ [% END %]
+ </div>
+ [% END %]
</div>
[% IF is_old %]

0 comments on commit 9c01a47

Please sign in to comment.