From 1d8310df0f942ab9cfaf6fad31380b5a1b32c5e5 Mon Sep 17 00:00:00 2001 From: kobaken Date: Wed, 6 Dec 2023 16:16:05 +0900 Subject: [PATCH 1/9] =?UTF-8?q?=E5=85=A8=E3=81=A6=E3=81=AE=E3=82=A8?= =?UTF-8?q?=E3=83=B3=E3=83=89=E3=83=9D=E3=82=A4=E3=83=B3=E3=83=88=E3=81=AE?= =?UTF-8?q?=E3=83=86=E3=82=B9=E3=83=88=E3=82=92=E8=BF=BD=E5=8A=A0?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- cpanfile | 1 + lib/PJP/M/PodFile.pm | 2 +- lib/PJP/M/TOC.pm | 2 +- t/01_endpoints.t | 346 +++++++++++++++++++++++++++++++++++++++++++ t/01_root.t | 18 --- 5 files changed, 349 insertions(+), 20 deletions(-) create mode 100644 t/01_endpoints.t delete mode 100644 t/01_root.t diff --git a/cpanfile b/cpanfile index b246064e..7751aaf1 100644 --- a/cpanfile +++ b/cpanfile @@ -37,5 +37,6 @@ requires 'Router::Simple::Sinatraish'; requires 'Log::Minimal'; on 'test' => sub { + requires 'Test2::V0'; requires 'Test::WWW::Mechanize::PSGI'; }; diff --git a/lib/PJP/M/PodFile.pm b/lib/PJP/M/PodFile.pm index 7a753b86..59f9c72c 100644 --- a/lib/PJP/M/PodFile.pm +++ b/lib/PJP/M/PodFile.pm @@ -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; } diff --git a/lib/PJP/M/TOC.pm b/lib/PJP/M/TOC.pm index 4b022527..dbbe61a3 100644 --- a/lib/PJP/M/TOC.pm +++ b/lib/PJP/M/TOC.pm @@ -16,7 +16,7 @@ sub render { return mark_raw($c->cache->file_cache ( "toc:4", 'toc.txt', sub { - infof("regen toc"); + debugf("regen toc"); my $ret = $class->_render(); return $ret; } diff --git a/t/01_endpoints.t b/t/01_endpoints.t new file mode 100644 index 00000000..64676edb --- /dev/null +++ b/t/01_endpoints.t @@ -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; diff --git a/t/01_root.t b/t/01_root.t deleted file mode 100644 index 30e081a9..00000000 --- a/t/01_root.t +++ /dev/null @@ -1,18 +0,0 @@ -use strict; -use warnings; -use Plack::Test; -use Plack::Util; -use Test::More; - -my $app = Plack::Util::load_psgi 'PJP.psgi'; -test_psgi - app => $app, - client => sub { - my $cb = shift; - my $req = HTTP::Request->new(GET => 'http://localhost/'); - my $res = $cb->($req); - is $res->code, 200; - diag $res->content if $res->code != 200; - }; - -done_testing; From fa8e6bd16bcb02efc5966c18f2ec1e3b66466103 Mon Sep 17 00:00:00 2001 From: kobaken Date: Wed, 6 Dec 2023 17:00:28 +0900 Subject: [PATCH 2/9] =?UTF-8?q?remove=20t/02=5Fmech.t=20/=20t/01=5Fendpoin?= =?UTF-8?q?ts.t=20=E3=81=A7=E7=94=A8=E3=81=AF=E8=B6=B3=E3=82=8A=E3=81=A6?= =?UTF-8?q?=E3=81=84=E3=82=8B=E3=81=AE=E3=81=A7?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- t/02_mech.t | 13 ------------- 1 file changed, 13 deletions(-) delete mode 100644 t/02_mech.t diff --git a/t/02_mech.t b/t/02_mech.t deleted file mode 100644 index ac587003..00000000 --- a/t/02_mech.t +++ /dev/null @@ -1,13 +0,0 @@ -use strict; -use warnings; -use Plack::Test; -use Plack::Util; -use Test::More; -use Test::Requires 'Test::WWW::Mechanize::PSGI'; - -my $app = Plack::Util::load_psgi 'PJP.psgi'; - -my $mech = Test::WWW::Mechanize::PSGI->new(app => $app); -$mech->get_ok('/'); - -done_testing; From 13988fa84b1f60bbbbdb7568dadde5d508dd1bde Mon Sep 17 00:00:00 2001 From: kobaken Date: Wed, 6 Dec 2023 17:04:40 +0900 Subject: [PATCH 3/9] =?UTF-8?q?test=20&=20refactor=20perl=E6=9C=AC?= =?UTF-8?q?=E4=BD=93=E3=83=89=E3=82=AD=E3=83=A5=E3=83=A1=E3=83=B3=E3=83=88?= =?UTF-8?q?=E3=81=AE=E7=9B=AE=E6=AC=A1?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - TOC#renderをrender_coreに改名 - TOC#render_coreがcontextに依存していたが剥がす - cacheは、Dispatcher 側に任す - toc.txtの改行位置をperldoc perlにあわせ調整 - https://perldoc.perl.org/perl - M::TOC に関するテストを集約 --- lib/PJP/M/TOC.pm | 16 +--------------- lib/PJP/Web/Dispatcher.pm | 5 ++++- t/03_toc.t | 15 --------------- t/M/TOC.t | 27 +++++++++++++++++++++++++++ toc.txt | 11 +---------- 5 files changed, 33 insertions(+), 41 deletions(-) delete mode 100644 t/03_toc.t create mode 100644 t/M/TOC.t diff --git a/lib/PJP/M/TOC.pm b/lib/PJP/M/TOC.pm index dbbe61a3..5c9425bc 100644 --- a/lib/PJP/M/TOC.pm +++ b/lib/PJP/M/TOC.pm @@ -9,21 +9,7 @@ use Log::Minimal; use Pod::Functions; use HTML::Entities qw/encode_entities/; -sub render { - my ($class, $c) = @_; - $c // die; - - return mark_raw($c->cache->file_cache - ( - "toc:4", 'toc.txt', sub { - debugf("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: $!"; diff --git a/lib/PJP/Web/Dispatcher.pm b/lib/PJP/Web/Dispatcher.pm index 1fe8cf83..8d0e9690 100644 --- a/lib/PJP/Web/Dispatcher.pm +++ b/lib/PJP/Web/Dispatcher.pm @@ -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のコアドキュメントの一覧', diff --git a/t/03_toc.t b/t/03_toc.t deleted file mode 100644 index 744a2101..00000000 --- a/t/03_toc.t +++ /dev/null @@ -1,15 +0,0 @@ -use strict; -use warnings; -use utf8; -use t::Util; -use Test::More; -use PJP::M::TOC; -use PJP; - -my $c = PJP->bootstrap; -my $out = PJP::M::TOC->render($c); -note $out; -ok $out; - -done_testing; - diff --git a/t/M/TOC.t b/t/M/TOC.t new file mode 100644 index 00000000..cf0caed5 --- /dev/null +++ b/t/M/TOC.t @@ -0,0 +1,27 @@ +use v5.38; +use Test2::V0; + +use PJP::M::TOC; + +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; +# +#}; + +# subtest 'render_variable - 組み込み変数の目次' => sub { +# my $out = PJP::M::TOC->render_variable(); +# ok $out; +# note $out; +# }; + +done_testing; diff --git a/toc.txt b/toc.txt index 20fd5a6e..ca904711 100644 --- a/toc.txt +++ b/toc.txt @@ -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 をハックする方法 From bce7cbf758de1e67a7b038579185a39f4bee4249 Mon Sep 17 00:00:00 2001 From: kobaken Date: Wed, 6 Dec 2023 17:25:48 +0900 Subject: [PATCH 4/9] test TOC#render_function, render_variable --- lib/PJP/M/TOC.pm | 5 +++-- t/04_toc_functions.t | 15 --------------- t/M/TOC.t | 29 +++++++++++++++++++---------- 3 files changed, 22 insertions(+), 27 deletions(-) delete mode 100644 t/04_toc_functions.t diff --git a/lib/PJP/M/TOC.pm b/lib/PJP/M/TOC.pm index 5c9425bc..ab9f0292 100644 --- a/lib/PJP/M/TOC.pm +++ b/lib/PJP/M/TOC.pm @@ -8,6 +8,7 @@ use File::stat; use Log::Minimal; use Pod::Functions; use HTML::Entities qw/encode_entities/; +use PJP::M::BuiltinVariable; sub render_core { my ($class) = @_; @@ -82,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{

%s

\n}, $func_kind2jp{$type} || $Pod::Functions::Type_Description{$type} || $type; @@ -124,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: $!"; diff --git a/t/04_toc_functions.t b/t/04_toc_functions.t deleted file mode 100644 index c5db1a2c..00000000 --- a/t/04_toc_functions.t +++ /dev/null @@ -1,15 +0,0 @@ -use strict; -use warnings; -use utf8; -use t::Util; -use Test::More; -use PJP::M::TOC; -use PJP; - -my $c = PJP->bootstrap; -my $out = PJP::M::TOC->render_function($c); -note $out; -ok $out; - -done_testing; - diff --git a/t/M/TOC.t b/t/M/TOC.t index cf0caed5..97b9b00f 100644 --- a/t/M/TOC.t +++ b/t/M/TOC.t @@ -2,6 +2,9 @@ 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(); @@ -12,16 +15,22 @@ subtest 'render_core - perl本体のドキュメントの目次' => sub { }; }; -#subtest 'render_function - 組み込み関数の目次' => sub { -# my $out = PJP::M::TOC->render_function(); -# ok $out; -# -#}; +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; -# }; +subtest 'render_variable - 組み込み変数の目次' => sub { + my $out = PJP::M::TOC->render_variable(); + ok $out; + note $out; + todo '目次の内容を確認する' => sub { + fail; + }; +}; done_testing; From fe9ecc0e960b137a2a7b346df608d48a0c17f2ee Mon Sep 17 00:00:00 2001 From: kobaken Date: Wed, 6 Dec 2023 19:17:47 +0900 Subject: [PATCH 5/9] fix test: t/M/Pod.t --- t/{05_pod.t => M/Pod.t} | 32 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) rename t/{05_pod.t => M/Pod.t} (50%) diff --git a/t/05_pod.t b/t/M/Pod.t similarity index 50% rename from t/05_pod.t rename to t/M/Pod.t index 82a670f3..ffd9a8a5 100644 --- a/t/05_pod.t +++ b/t/M/Pod.t @@ -1,9 +1,11 @@ -use strict; -use warnings; +use v5.38; use utf8; -use Test::More; +use Test2::V0; + use PJP::M::Pod; -use utf8; +use PJP; + +my $c = PJP->bootstrap; my $pod = <<'...'; foo @@ -34,11 +36,20 @@ L<"注意"> ... -my $html = PJP::M::Pod->pod2html(\$pod); -like $html, qr{

注意

}; -like $html, qr{
  • 注意
    • }; -like $html, qr{

    ヘルプを見る

    }; -like $html, qr{
  • ヘルプを見る
    • }; +subtest 'pod2html' => sub { + my $html = PJP::M::Pod->pod2html(\$pod); + # 目次 + like $html, qr{
  • 注意
    • }; + like $html, qr{
  • ヘルプを見る
    • }; + + # 見出し + like $html, qr{

    注意&\#182;

    }; + like $html, qr{

    ヘルプを見る&\#182;

    }; + + todo 'pod2html', sub { + fail 'GETTING32HELP のhrefが目次と見出しで重複しているので調整した方が良さそう'; + }; +}; subtest 'parse_name_section' => sub { my ($pkg, $desc) = PJP::M::Pod->parse_name_section(\$pod); @@ -46,7 +57,8 @@ subtest 'parse_name_section' => sub { is $desc, 'あれです'; subtest 'wt.pod' => sub { - my ($pkg, $desc) = PJP::M::Pod->parse_name_section('assets/perldoc.jp/docs/modules/HTTP-WebTest-2.04/bin/wt.pod'); + 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, '１つもしくは複数のウェブページのテスト'; }; From d44786e4eeb597ceb86b03c1020df9b37c33ae15 Mon Sep 17 00:00:00 2001 From: kobaken Date: Wed, 6 Dec 2023 20:36:14 +0900 Subject: [PATCH 6/9] test: M::Index::Module#generate --- lib/PJP/M/Index/Module.pm | 3 +++ t/06_index_modules.t | 15 --------------- t/M/Index/Module.t | 39 +++++++++++++++++++++++++++++++++++++++ 3 files changed, 42 insertions(+), 15 deletions(-) delete mode 100644 t/06_index_modules.t create mode 100644 t/M/Index/Module.t diff --git a/lib/PJP/M/Index/Module.pm b/lib/PJP/M/Index/Module.pm index 719ad68a..80712dae 100644 --- a/lib/PJP/M/Index/Module.pm +++ b/lib/PJP/M/Index/Module.pm @@ -122,6 +122,9 @@ sub _generate { debugf("Japanese Description: %s, %s", $name, $desc); $row->{abstract} = $desc; } + else { + $row->{abstract} = undef; + } $row->{repository} = $repository; diff --git a/t/06_index_modules.t b/t/06_index_modules.t deleted file mode 100644 index 1383fe7a..00000000 --- a/t/06_index_modules.t +++ /dev/null @@ -1,15 +0,0 @@ -use strict; -use warnings; -use utf8; -use Test::More; -use PJP::M::Index::Module; -use PJP; -use Log::Minimal; - -my $c = PJP->bootstrap; -my @out = PJP::M::Index::Module->get($c); -note ddf(\@out); -ok scalar(@out); - -done_testing; - diff --git a/t/M/Index/Module.t b/t/M/Index/Module.t new file mode 100644 index 00000000..425f9461 --- /dev/null +++ b/t/M/Index/Module.t @@ -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; From 2a2f53257c7ece9e530bb251c8c54d43641d4639 Mon Sep 17 00:00:00 2001 From: kobaken Date: Wed, 6 Dec 2023 20:50:28 +0900 Subject: [PATCH 7/9] =?UTF-8?q?test=20pod2html=E3=81=A7=E5=A4=89=E6=8F=9B?= =?UTF-8?q?=E3=81=97=E3=81=9FHTML=E3=81=8C=E6=AD=A3=E3=81=97=E3=81=84?= =?UTF-8?q?=E3=81=8B=E7=A2=BA=E8=AA=8D=E3=81=99=E3=82=8B=E3=83=86=E3=82=B9?= =?UTF-8?q?=E3=83=88=E3=82=92=E7=A7=BB=E6=A4=8D=E3=80=82=E3=81=9F=E3=81=A0?= =?UTF-8?q?=E3=81=97=E4=B8=AD=E8=BA=AB=E3=81=AF=E3=81=93=E3=81=91=E3=81=A6?= =?UTF-8?q?=E3=82=8B?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- t/07_pod_html.t | 21 --------------------- t/M/Pod.t | 38 +++++++++++++++++++++++++++++--------- 2 files changed, 29 insertions(+), 30 deletions(-) delete mode 100644 t/07_pod_html.t diff --git a/t/07_pod_html.t b/t/07_pod_html.t deleted file mode 100644 index 5eb91ce2..00000000 --- a/t/07_pod_html.t +++ /dev/null @@ -1,21 +0,0 @@ -use strict; -use warnings; -use utf8; -use Test::More; -use PJP::M::Pod; - -my $html = PJP::M::Pod->pod2html('assets/perldoc.jp/docs/perl/5.12.1/perl.pod'); -ok $html; - -# 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!]*>!$close++!gei; - cmp_ok $open, '>', 0, $tag; - cmp_ok $open, '=', $close; -} - -done_testing; - diff --git a/t/M/Pod.t b/t/M/Pod.t index ffd9a8a5..838396ff 100644 --- a/t/M/Pod.t +++ b/t/M/Pod.t @@ -37,17 +37,37 @@ L<"注意"> ... subtest 'pod2html' => sub { - my $html = PJP::M::Pod->pod2html(\$pod); - # 目次 - like $html, qr{
  • 注意
    • }; - like $html, qr{
  • ヘルプを見る
    • }; - # 見出し - like $html, qr{

    注意&\#182;

    }; - like $html, qr{

    ヘルプを見る&\#182;

    }; + subtest 'PODを期待通りparseして、HTML化できているか' => sub { + my $html = PJP::M::Pod->pod2html(\$pod); + # 目次 + like $html, qr{
  • 注意
    • }; + like $html, qr{
  • ヘルプを見る
    • }; - todo 'pod2html', sub { - fail 'GETTING32HELP のhrefが目次と見出しで重複しているので調整した方が良さそう'; + # 見出し + like $html, qr{

    注意&\#182;

    }; + like $html, qr{

    ヘルプを見る&\#182;

    }; + + 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!]*>!$close++!gei; + # ok $open > 0, "$tag があり、"; + # ok $open == $close, '開始タグと終了タグの数が一致している'; + # } }; }; From 71517322062638f3613661eef55f74ca6edbdaaf Mon Sep 17 00:00:00 2001 From: kobaken Date: Wed, 6 Dec 2023 20:51:05 +0900 Subject: [PATCH 8/9] =?UTF-8?q?Test2=E3=81=A7=E3=81=82=E3=82=8C=E3=81=B0?= =?UTF-8?q?=E3=80=81=E6=97=A5=E6=9C=AC=E8=AA=9E=E3=81=AB=E9=96=A2=E3=81=99?= =?UTF-8?q?=E3=82=8B=E3=83=8F=E3=83=83=E3=82=AF=E3=81=AF=E3=82=82=E3=81=86?= =?UTF-8?q?=E3=81=84=E3=82=89=E3=81=AA=E3=81=84?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- t/Util.pm | 22 ---------------------- 1 file changed, 22 deletions(-) delete mode 100644 t/Util.pm diff --git a/t/Util.pm b/t/Util.pm deleted file mode 100644 index 1e98cf5e..00000000 --- a/t/Util.pm +++ /dev/null @@ -1,22 +0,0 @@ -use strict; -use warnings; -use utf8; - -package t::Util; - -use Test::More; - -{ - # utf8 hack. - binmode Test::More->builder->$_, ":utf8" for qw/output failure_output todo_output/; - no warnings 'redefine'; - my $code = \&Test::Builder::child; - *Test::Builder::child = sub { - my $builder = $code->(@_); - binmode $builder->output, ":utf8"; - binmode $builder->failure_output, ":utf8"; - binmode $builder->todo_output, ":utf8"; - return $builder; - }; -} -1; From 842a5f4d5206b481a4cd6c753b4ad9beabc9a543 Mon Sep 17 00:00:00 2001 From: kobaken Date: Wed, 6 Dec 2023 20:51:36 +0900 Subject: [PATCH 9/9] rename endpoints test --- t/{01_endpoints.t => endpoints.t} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename t/{01_endpoints.t => endpoints.t} (100%) diff --git a/t/01_endpoints.t b/t/endpoints.t similarity index 100% rename from t/01_endpoints.t rename to t/endpoints.t