Skip to content

Commit

Permalink
Merge pull request #58 from perldoc-jp/fix-tests
Browse files Browse the repository at this point in the history
Fix tests
kfly8 authored Dec 6, 2023
2 parents 7e937bf + 842a5f4 commit 91942bb
Showing 18 changed files with 523 additions and 204 deletions.
1 change: 1 addition & 0 deletions cpanfile
Original file line number Diff line number Diff line change
@@ -37,5 +37,6 @@ requires 'Router::Simple::Sinatraish';
requires 'Log::Minimal';

on 'test' => sub {
requires 'Test2::V0';
requires 'Test::WWW::Mechanize::PSGI';
};
3 changes: 3 additions & 0 deletions lib/PJP/M/Index/Module.pm
Original file line number Diff line number Diff line change
@@ -122,6 +122,9 @@ sub _generate {
debugf("Japanese Description: %s, %s", $name, $desc);
$row->{abstract} = $desc;
}
else {
$row->{abstract} = undef;
}

$row->{repository} = $repository;

2 changes: 1 addition & 1 deletion lib/PJP/M/PodFile.pm
Original file line number Diff line number Diff line change
@@ -87,7 +87,7 @@ sub get_latest {
{}, $search_package )
};
unless (@versions) {
infof("Any versions not found in database: %s", $search_package);
debugf("Any versions not found in database: %s", $search_package);
return undef;
}

21 changes: 4 additions & 17 deletions lib/PJP/M/TOC.pm
Original file line number Diff line number Diff line change
@@ -8,22 +8,9 @@ use File::stat;
use Log::Minimal;
use Pod::Functions;
use HTML::Entities qw/encode_entities/;
use PJP::M::BuiltinVariable;

sub render {
my ($class, $c) = @_;
$c // die;

return mark_raw($c->cache->file_cache
(
"toc:4", 'toc.txt', sub {
infof("regen toc");
my $ret = $class->_render();
return $ret;
}
));
}

sub _render {
sub render_core {
my ($class) = @_;

open my $fh, '<:utf8', 'toc.txt' or die "Cannot open toc.txt: $!";
@@ -96,7 +83,7 @@ my %func_kind2jp = (
);

sub render_function {
my ($class, $c) = @_;
my ($class) = @_;
my $out = '';
foreach my $type (@Pod::Functions::Type_Order) {
$out .= sprintf qq{<h2>%s</h2>\n}, $func_kind2jp{$type} || $Pod::Functions::Type_Description{$type} || $type;
@@ -138,7 +125,7 @@ my %SKIP_NAME = (
my %ENG_NAME;

sub render_variable {
my ($class, $c) = @_;
my ($class) = @_;
my $out = '';
my $pod;
open my $fh, '<:utf8', 'toc-var.txt' or die "Cannot open toc-var.txt: $!";
5 changes: 4 additions & 1 deletion lib/PJP/Web/Dispatcher.pm
Original file line number Diff line number Diff line change
@@ -70,7 +70,10 @@ get '/category/:name/:name2' => sub {
get '/index/core' => sub {
my $c = shift;

my $toc = PJP::M::TOC->render($c);
my $toc = $c->cache->get_or_set('index/core', sub {
mark_raw(PJP::M::TOC->render_core());
});

return $c->render('index/core.tt', {
header_title => 'Perlのコアドキュメントの翻訳一覧',
description => '翻訳されたPerlのコアドキュメントの一覧',
18 changes: 0 additions & 18 deletions t/01_root.t

This file was deleted.

13 changes: 0 additions & 13 deletions t/02_mech.t

This file was deleted.

15 changes: 0 additions & 15 deletions t/03_toc.t

This file was deleted.

15 changes: 0 additions & 15 deletions t/04_toc_functions.t

This file was deleted.

56 changes: 0 additions & 56 deletions t/05_pod.t

This file was deleted.

15 changes: 0 additions & 15 deletions t/06_index_modules.t

This file was deleted.

21 changes: 0 additions & 21 deletions t/07_pod_html.t

This file was deleted.

39 changes: 39 additions & 0 deletions t/M/Index/Module.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,39 @@
use v5.38;
use utf8;
use Test2::V0;

use PJP::M::Index::Module;
use PJP;
use Data::Dumper;

my $c = PJP->bootstrap;

subtest 'generate' => sub {
my @out = PJP::M::Index::Module->generate($c);

for my $out (@out) {
my $name = $out->{name};
my $ret = is $out, {
name => D,
abstract => E, # 本当は D にしたいが一部こけてる
repository => 'translation', # 現在、translation しかない
latest_version => E,
versions => array {
all_items {
name => $name,
version => D,
repository => 'translation',
abstract => E,
distvname => D,
};
etc;
},
}, $name;

unless ($ret) {
note Dumper($out);
}
}
};

done_testing;
88 changes: 88 additions & 0 deletions t/M/Pod.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,88 @@
use v5.38;
use utf8;
use Test2::V0;

use PJP::M::Pod;
use PJP;

my $c = PJP->bootstrap;

my $pod = <<'...';
foo
bar
__END__
=head1 NAME
B<OK> - あれです
=head1 SYNOPSIS
This is a sample pod
=head1 注意
=head1 GETTING HELP
(ヘルプを見る)
perldoc プログラムは、Perl と共に配布されている全ての文書を読むための プログラムです。 http://www.perl.org/ では、さらなる文書、チュートリアル、コミュニティ サポポートがオンラインで得られます。
=head1 理解されるフォーマット
L<"SYNOPSIS">
L<"注意">
...

subtest 'pod2html' => sub {

subtest 'PODを期待通りparseして、HTML化できているか' => sub {
my $html = PJP::M::Pod->pod2html(\$pod);
# 目次
like $html, qr{<li><a href="\#pod27880-24847">注意</a></li>};
like $html, qr{<li><a href="\#GETTING32HELP">ヘルプを見る</a></li>};

# 見出し
like $html, qr{<h1 id="pod27880-24847">注意<a href="\#27880-24847" class="toc_link">&\#182;</a></h1>};
like $html, qr{<h1 id="GETTING32HELP">ヘルプを見る<a href="\#GETTING32HELP" class="toc_link">&\#182;</a></h1>};

todo 'pod2html', sub {
fail 'GETTING32HELP のhrefが目次と見出しで重複しているので調整した方が良さそう';
};
};

subtest 'HTMLタグが閉じられてるか' => sub {
my $html = PJP::M::Pod->pod2html("@{[$c->assets_dir]}translation/docs/perl/5.12.1/perl.pod");

todo 'pod2html', sub {
fail 'HTMLタグが閉じられているかのテストが失敗している';
};

# my $testee = $html;
# for my $tag (qw/div pre p h1 h2 code b a ul li nobr i/) {
# my ($open, $close) = (0, 0);
# $testee =~ s/<$tag[^>]*>/$open++/gei;
# $testee =~ s!</$tag[^>]*>!$close++!gei;
# ok $open > 0, "$tag があり、";
# ok $open == $close, '開始タグと終了タグの数が一致している';
# }
};
};

subtest 'parse_name_section' => sub {
my ($pkg, $desc) = PJP::M::Pod->parse_name_section(\$pod);
is $pkg, 'OK';
is $desc, 'あれです';

subtest 'wt.pod' => sub {
my $path = "@{[$c->assets_dir]}translation/docs/modules/HTTP-WebTest-2.04/bin/wt.pod";
my ($pkg, $desc) = PJP::M::Pod->parse_name_section($path);
is $pkg, 'wt';
is $desc, '1つもしくは複数のウェブページのテスト';
};
};

done_testing;

36 changes: 36 additions & 0 deletions t/M/TOC.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,36 @@
use v5.38;
use Test2::V0;

use PJP::M::TOC;
use PJP;

my $c = PJP->bootstrap;

subtest 'render_core - perl本体のドキュメントの目次' => sub {
my $out = PJP::M::TOC->render_core();
ok $out;
note $out;
todo '目次の内容を確認する' => sub {
fail;
};
};

subtest 'render_function - 組み込み関数の目次' => sub {
my $out = PJP::M::TOC->render_function();
ok $out;
note $out;
todo '目次の内容を確認する' => sub {
fail;
};
};

subtest 'render_variable - 組み込み変数の目次' => sub {
my $out = PJP::M::TOC->render_variable();
ok $out;
note $out;
todo '目次の内容を確認する' => sub {
fail;
};
};

done_testing;
22 changes: 0 additions & 22 deletions t/Util.pm

This file was deleted.

346 changes: 346 additions & 0 deletions t/endpoints.t
Original file line number Diff line number Diff line change
@@ -0,0 +1,346 @@
=pod
=encoding utf8
=head1 PURPOSE
perldoc.jpの各エンドポイントのテストをします。
このエンドポイントのテストが丁寧に書かれていれば、
内部のリファクタリングがしやすくなるので、
可能な限り丁寧に書きたいです。
必須
* status code
* title
必要に応じて
* コンテンツ
翻訳ページでオリジナルの英文が表示されているかどうかなど
壊れていると信頼を失いそうなものはできるだけテストする
* リンク
リンクが壊れていないかどうかなど。$mech->page_links_ok; でテストしたい
=cut

use v5.38;
use utf8;
use Test2::V0;

use Test::WWW::Mechanize::PSGI;
use Plack::Util;

my $app = Plack::Util::load_psgi 'app.psgi';
my $mech = Test::WWW::Mechanize::PSGI->new(app => $app);

subtest 'GET /' => sub {
$mech->get('/');
is $mech->status, 200, 'status is 200';
is $mech->title, 'perldoc.jp';
};

subtest 'GET /about' => sub {
$mech->get('/about');
is $mech->status, 200, 'status is 200';
is $mech->title, 'perldoc.jpについて - perldoc.jp';
};

subtest 'GET /translators' => sub {
$mech->get('/translators');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlドキュメントの翻訳者一覧 - perldoc.jp';
};

# TODO: カテゴリは現在コメントアウトされて、利用されてなさそうなので該当コードを削除してよさそう
# subtest 'GET /category/:name/:name2' => sub {
# }

subtest 'GET /index/core' => sub {
$mech->get('/index/core');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlのコアドキュメントの翻訳一覧 - perldoc.jp';
};

subtest 'GET /index/function' => sub {
$mech->get('/index/function');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlの組み込み関数の翻訳一覧 - perldoc.jp';
};

subtest 'GET /index/variable' => sub {
$mech->get('/index/variable');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlの組み込み変数の翻訳一覧 - perldoc.jp';
};

subtest 'GET /index/module' => sub {
$mech->get('/index/module');
is $mech->status, 200, 'status is 200';
is $mech->title, '翻訳されたPerlモジュールの一覧 - perldoc.jp';
};

subtest 'GET /index/article' => sub {
$mech->get('/index/article');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlに関係するその他の翻訳の一覧 - perldoc.jp';
};

subtest 'GET /pod/*' => sub {
subtest '指定モジュールの翻訳が存在すれば、その翻訳にリダイレクトされる' => sub {
$mech->get('/pod/Acme::Bleach');

is $mech->status, 200, 'status is 200';
like $mech->title, qr/^Acme::Bleach/;
$mech->base_like(qr{/docs/modules/Acme-Bleach-\d.\d\d/Bleach.pod});
};

subtest '指定モジュールの翻訳が存在しなければ、404が返る' => sub {
$mech->get('/pod/DoesNotExist');
is $mech->status, 404, 'status is 404';
};
};

subtest 'GET /func/*' => sub {
subtest '組み込み関数の翻訳が存在すれば、その翻訳が表示される' => sub {
$mech->get('/func/chomp');

is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlの組み込み関数 chomp の翻訳 - perldoc.jp';
};

subtest '存在しない組み込み関数の場合、404が返る' => sub {
$mech->get('/func/DoesNotExist');
is $mech->status, 404, 'status is 404';
};

subtest '組み込み関数の翻訳が存在しない場合、404を返しつつ、翻訳がない旨を伝える' => sub {
my $name = 'chomp';

my $c = PJP->bootstrap;
my $row = $c->dbh->single(func => { name => $name });

$c->dbh->do(q{DELETE FROM func WHERE name=?}, {}, $name);
$mech->get("/func/$name");

is $mech->status, 404, 'status is 404';
is $mech->title, "'$name' は まだ翻訳されていません。 - perldoc.jp";

$c->dbh->insert(func => $row); # restore
};
};

subtest 'GET /variable/*' => sub {
subtest '組み込み変数の翻訳が存在すれば、その翻訳が表示される' => sub {
$mech->get('/variable/$_');

is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlの組み込み変数 $_ の翻訳 - perldoc.jp';
};

subtest '存在しない組み込み変数の場合、404が返る' => sub {
$mech->get('/variable/DoesNotExist');
is $mech->status, 404, 'status is 404';
};

subtest '組み込み変数の翻訳が存在しない場合、404を返しつつ、翻訳がない旨を伝える' => sub {
my $name = '$_';

my $c = PJP->bootstrap;
my $row = $c->dbh->single(var => { name => $name });

$c->dbh->do(q{DELETE FROM var WHERE name=?}, {}, $name);
$mech->get('/variable/$_');

is $mech->status, 404, 'status is 404';
is $mech->title, "'$name' は まだ翻訳されていません。 - perldoc.jp";

$c->dbh->insert(var => $row); # restore
};
};

subtest '/docs/modules/{distvname}{trailingslash}' => sub {
subtest '指定モジュールの翻訳が存在すれば、その翻訳が表示される' => sub {
$mech->get('/docs/modules/Acme-Bleach-1.12/Bleach.pod');

is $mech->status, 200, 'status is 200';
like $mech->title, qr/^Acme::Bleach/;
};

subtest '指定モジュールの翻訳が存在しなければ、404が返る' => sub {
$mech->get('/docs/modules/DoesNotExist-1.12/DoesNotExist.pod');
is $mech->status, 404, 'status is 404';
};
};


# 生のソースを表示
subtest '/docs/(modules|perl|articles)/*.(html|pod).pod' => sub {
$mech->get('/docs/modules/Acme-Bleach-1.12/Bleach.pod.pod');

is $mech->status, 200, 'status is 200';
ok $mech->header_like('Content-Type', qr{^text/plain; charset=}), 'Content-Type is text/plain';
$mech->text_contains('Acme::Bleach'), 'content contains Acme::Bleach';
};

subtest '/docs/(modules|perl)/*.pod/diff' => sub {
$mech->get('/docs/perl/5.38.0/perl.pod/diff?target=perl%2F5.36.0%2Fperl.pod');

is $mech->status, 200, 'status is 200';
is $mech->title, 'perl/5.38.0/perl.pod と perl/5.36.0/perl.pod の翻訳の差分 - perldoc.jp';
};

subtest '/docs/(articles)/*.html' => sub {
subtest 'コメントでlinktoと埋め込まれていたら、そのページにリダイレクトする' => sub {
$mech->get('/docs/articles/qntm.org/files/perl/perl.html');

ok $mech->base_is('http://qntm.org/files/perl/perl_jp.html');
};

subtest 'コメントでlinktoと埋め込まれてなければ、記事翻訳を表示する' => sub {
$mech->get('/docs/articles/www.perl.com/pub/2005/06/02/catalyst.html');

is $mech->status, 200, 'status is 200';
is $mech->title, 'Catalyst - Perl.com - www.perl.com - perldoc.jp';
};

subtest '翻訳が存在しなければ、404が返る' => sub {
$mech->get('/docs/articles/foo.html');

is $mech->status, 404, 'status is 404';
};
};

subtest '/docs/(articles)/*.md' => sub {
subtest '記事翻訳があれば、その翻訳を表示' => sub {
$mech->get('/docs/articles/github.com/Perl/PPCs/ppcs/ppc0004-defer-block.md');

is $mech->status, 200, 'status is 200';
is $mech->title, 'Perl/PPCs/ppcs/ppc0004 defer block - github.com - perldoc.jp';
};

subtest '記事翻訳がなければ、404が返る' => sub {
$mech->get('/docs/articles/foo.md');

is $mech->status, 404, 'status is 404';
};
};

subtest '/docs/perl/*.pod' => sub {
subtest 'perlの翻訳の場合、バージョンの指定がなければ、最新の翻訳が表示される' => sub {
$mech->get('/docs/perl/perl.pod');
is $mech->status, 200, 'status is 200';
is $mech->title, 'perl - Perl 5 言語インタプリタ - perldoc.jp';
};

subtest '翻訳がなければ、404が返る' => sub {
$mech->get('/docs/perl/DoesNotExist.pod');
is $mech->status, 404, 'status is 404';
};
};

subtest '/docs/(modules|perl|articles)/*.pod' => sub {
subtest 'perlの翻訳の場合' => sub {
$mech->get('/docs/perl/5.38.0/perl.pod');
is $mech->status, 200, 'status is 200';
is $mech->title, 'perl - Perl 5 言語インタプリタ - perldoc.jp';
};
subtest 'moduleの翻訳の場合' => sub {
$mech->get('/docs/modules/Acme-Bleach-1.12/Bleach.pod');
is $mech->status, 200, 'status is 200';
like $mech->title, qr/^Acme::Bleach/;
};
subtest 'articleの翻訳の場合' => sub {
todo 'articleの翻訳で、podのケースがない' => sub {
pass;
};
};
subtest '翻訳がなければ、404が返る' => sub {
$mech->get('/docs/perl/5.38.0/DoesNotExist.pod');
is $mech->status, 404, 'status is 404';
};
};

subtest 'perldoc.jp/$VALUE のように指定したら、よしなにリダイレクトする' => sub {

subtest '/perl* - 先頭にperlがついていれば、perlの翻訳ページへリダイレクトする' => sub {
subtest '/perlは、/docs/perl/$LATEST/perl.pod にリダイレクトされる' => sub {
$mech->get('/perl');
is $mech->status, 200, 'status is 200';
is $mech->title, 'perl - Perl 5 言語インタプリタ - perldoc.jp';

$mech->base_like(qr{/docs/perl/[^/]+/perl.pod$});
};

subtest '/perlintroは、/docs/perl/$LATEST/perlntro.pod にリダイレクトされる' => sub {
$mech->get('/perlintro');
is $mech->status, 200, 'status is 200';
is $mech->title, 'perlintro - Perl の概要 - perldoc.jp';

$mech->base_like(qr{/docs/perl/[^/]+/perlintro.pod$});
};
};

subtest '/(function) - 組み込み関数があれば、その翻訳ページへリダイレクトする' => sub {
subtest '/chomp は、/func/chomp にリダイレクトされる' => sub {
$mech->get('/chomp');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlの組み込み関数 chomp の翻訳 - perldoc.jp';

$mech->base_like(qr{/func/chomp$});
};

subtest '/abs は、/func/abs にリダイレクトされる' => sub {
$mech->get('/abs');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlの組み込み関数 abs の翻訳 - perldoc.jp';

$mech->base_like(qr{/func/abs$});
};
};

subtest '/$@%.+ - $@%のいずれかで始まる場合、組み込み変数の翻訳ページへリダイレクトする' => sub {
subtest '/$_ は、/variable/$_ にリダイレクトされる' => sub {
$mech->get('/$_');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlの組み込み変数 $_ の翻訳 - perldoc.jp';

$mech->base_like(qr{/variable/%24_$}); # $_ はURLエンコードされ、%24_ になる
};

subtest '/$! は、/variable/$! にリダイレクトされる' => sub {
$mech->get('/$!');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlの組み込み変数 $! の翻訳 - perldoc.jp';

$mech->base_like(qr{/variable/%24%21$}); # $! はURLエンコードされ、%24%21 になる
};

subtest '/%ENV は、/variable/%ENV にリダイレクトされる' => sub {
$mech->get('/%ENV');
is $mech->status, 200, 'status is 200';
is $mech->title, 'Perlの組み込み変数 %ENV の翻訳 - perldoc.jp';

$mech->base_like(qr{/variable/%25ENV$}); # %ENV はURLエンコードされ、%25ENV になる
};
};

subtest '/{name} - いずれにも該当しなかった場合、最新ドキュメントか組み込み関数のページへリダイレクトする' => sub {
subtest '/Acme::Bleach は、/docs/modules/Acme-Bleach-1.12/Bleach.pod にリダイレクトされる' => sub {
$mech->get('/Acme::Bleach');
is $mech->status, 200, 'status is 200';
like $mech->title, qr/^Acme::Bleach/;

$mech->base_like(qr{/docs/modules/Acme-Bleach-1.12/Bleach.pod$});
};

subtest '/fuga は、/func/fuga にリダイレクトされる' => sub {
$mech->get('/fuga');
is $mech->status, 404, 'status is 404';
is $mech->title, "'fuga' は Perl の組み込み関数ではありません。 - perldoc.jp";

$mech->base_like(qr{/func/fuga$});
$mech->text_contains("'fuga' は Perl の組み込み関数ではありません。");
};
};
};

done_testing;
11 changes: 1 addition & 10 deletions toc.txt
Original file line number Diff line number Diff line change
@@ -11,20 +11,14 @@
perlreftut - Perlのリファレンスの短いインストラクション
perldsc - Perl のデータ構造クックブック
perllol - Perl で配列の配列を操作する

perlrequick - Perl 正規表現のクイックスタート
perlretut - Perl の正規表現のチュートリアル

perlootut - Perl の初心者向けオブジェクト指向チュートリアル

perlperf - Perl の性能と最適化のテクニック

perlstyle - Perl スタイルガイド

perlcheat - perl チートシート
perltrap - 不注意による Perl の罠
perldebtut - デバッグのチュートリアル

perlfaq - Perl に関するよくある質問
perlfaq1 - Perl に関する一般的な質問
perlfaq2 - Perl の入手と学習
@@ -61,13 +55,10 @@
perlobj - Perl のオブジェクト
perltie - オブジェクトクラスを単純な変数に隠す方法
perldbmfilter - Perl DBM フィルタ
#
perlipc - Perl のプロセス間通信 (シグナル, fifo, パイプ, 安全な副プロセス, ソケット, セマフォ)
perlfork - Perl の fork エミュレーション
perlnumber - Perl での数値と数値操作の意味論

perlthrtut - Perl におけるスレッドのチュートリアル

perlport - 移植性のある Perl を書く
perllocale - Perl のロケール操作 (国際化と地域化)
perluniintro - Perl Unicode の手引き
@@ -110,7 +101,7 @@

perlapi - perl public API の自動生成ドキュメント
# perlintern - Perl internal functions (autogenerated)
perliol - IO 層の Perl 実装への C API
perliol - IO 層の Perl 実装への C API
perlapio - perl の抽象入出力インターフェース

perlhack - Perl をハックする方法

0 comments on commit 91942bb

Please sign in to comment.