use strict; use warnings; use Test::More; use Test::Exception; use Config; use Data::Dumper; use lib '.'; use t::test_server; &setup; plan tests => 4 + 4 + 2 + 1 + 8 + 1 + 2 + 10 + 1; &test_01_html; #4. &test_02_mobile_html; #4. &test_03_csv; #2. &test_04_binary; #1. &test_05_input_filter; #8. &test_06_seo_filter; #1. &test_07_seo_input_filter; #2. &test_08_xhtml; #10. &test_09_input_filter_mobile; # 1. exit; # ----------------------------------------------------------------------------- # shortcut. # sub check_requires() { &t::test_server::check_requires; } sub start_server() { &t::test_server::start_server; } sub raw_request(@) { &t::test_server::raw_request; } # ----------------------------------------------------------------------------- # setup. # sub setup { my $failmsg = check_requires(); if( $failmsg ) { plan skip_all => $failmsg; } &start_server; } # ----------------------------------------------------------------------------- # Tripletail::Filter::HTML. # sub test_01_html { { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { $TL->print(q{
}); } }, ); is($res->content, qq{
}, '[html] CCC'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { $TL->print(q{\n}); $TL->print($TL->newTemplate->setTemplate(qq{link\n}) ->expand(URL => $TL->newForm->set('あ' => 'い')->toLink) ->toStr); my $t = $TL->newTemplate->setTemplate(qq{link\n}); $t->node('node')->add(URL => $TL->newForm->set('あ' => 'い')->toLink); $TL->print($t->toStr); $TL->print(q{\n}); $TL->print(q{\n}); } }, ); is($res->content, qq{\nlink\nlink\n\n\n}, '[html] (toLink/toExtLink)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { $TL->print(q{
}); } }, ); is($res->content, qq{
}, '[html] Form output'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $t = $TL->newTemplate->setTemplate(q{
})->extForm; $TL->print($t->toStr); } }, ); is($res->content, qq{
}, '[html] extForm'); } } # ----------------------------------------------------------------------------- # Tripletail::Filter::MobileHTML # sub test_02_mobile_html { { my $res = raw_request( method => 'GET', script => q{ $TL->setContentFilter('Tripletail::Filter::MobileHTML'); $TL->startCgi( -main => \&main, ); sub main { $TL->print(q{link}); } }, ); is $res->content, qq{link}, '[mobile] normal'; } { my $res = raw_request( method => 'GET', script => q{ $TL->setContentFilter('Tripletail::Filter::MobileHTML'); $TL->getContentFilter->addHeader('X-TEST',123); $TL->startCgi( -main => \&main, ); sub main { $TL->print(q{\n}); $TL->print(q{\n}); $TL->print(q{\n}); } }, ); is $res->content, qq{\n\n\n}, '[mobile] toLink/toExtLink'; } { my $res = raw_request( method => 'GET', script => q{ $TL->setContentFilter('Tripletail::Filter::MobileHTML'); $TL->getContentFilter->addHeader('X-TEST',123); $TL->getContentFilter->addHeader('X-TEST',1234); $TL->startCgi( -main => \&main, ); sub main { $TL->print(q{
}); } }, ); is $res->content, qq{
}, '[mobile] Form output'; } { my $res = raw_request( method => 'GET', script => q{ $TL->setContentFilter('Tripletail::Filter::MobileHTML'); $TL->getContentFilter->setHeader('X-TEST',123); $TL->getContentFilter->addHeader('X-TEST',1234); $TL->startCgi( -main => \&main, ); sub main { my $t = $TL->newTemplate->setTemplate(q{
})->extForm; $TL->print($t->toStr); } }, ); is($res->content, qq{
}, '[mobile] extForm'); } } # ----------------------------------------------------------------------------- # Tripletail::Filter::CSV # sub test_03_csv { SKIP: { eval{ require Text::CSV_XS; }; if ($@) { skip 'Text::CSV_XS is unavailable', 1; } my $res = raw_request( method => 'GET', script => q{ $TL->setContentFilter( 'Tripletail::Filter::CSV', charset => 'UTF-8', filename => 'foo.csv', ); $TL->startCgi( -main => \&main, ); sub main { $TL->print(['aaa', 'bb', 'cc,c']); $TL->print('AAA,BB,"CC,C"'."\r\n"); } }, ); is $res->content, qq{aaa,bb,"cc,c"\r\nAAA,BB,"CC,C"\r\n}, '[csv]'; $res = raw_request( method => 'GET', script => q{ $TL->setContentFilter( 'Tripletail::Filter::CSV', charset => 'UTF-8', filename => 'foo.csv', linebreak => "\n", ); $TL->startCgi( -main => \&main, ); sub main { $TL->print(['aaa', 'bb', 'cc,c']); $TL->print('AAA,BB,"CC,C"'."\n"); } }, ); is $res->content, qq{aaa,bb,"cc,c"\nAAA,BB,"CC,C"\n}, '[csv]'; } } # ----------------------------------------------------------------------------- # Tripletail::Filter::Binary # sub test_04_binary { { my $res = raw_request( method => 'GET', script => q{ $TL->setContentFilter('Tripletail::Filter::Binary'); $TL->startCgi( -main => \&main, ); sub main { $TL->print("\x{de}\x{ad}\x{be}\x{ef}"); #" } }, ); is $res->content, "\x{de}\x{ad}\x{be}\x{ef}", '[binary]'; } } # ----------------------------------------------------------------------------- # Tripletail::InputFilter::HTML (default input filter) # sub test_05_input_filter { { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { $TL->print( sprintf('%s-%s', $TL->CGI->getSliceValues(qw[foo bar])), ); } }, env => { QUERY_STRING => 'foo=A%20B&bar=C%20D&CCC=%88%A4', }, ); is $res->content, 'A B-C D', '[input] get'; } { my $res = raw_request( method => 'POST', stdin => 'foo=a%20b&bar=c%20d', ); is $res->content, 'a b-c d', '[input] post'; } { my $res = raw_request( method => 'POST', script => q{ $TL->startCgi( -main => \&main, ); sub main { $TL->print(join ',', $CGI->getKeys); $TL->print('---'); $TL->print(join ',', $CGI->getFileKeys); } }, env => {}, ini => { TL => { trap => 'diewithprint', stacktrace => 'none', }, }, stdin => qq{This is a preamble.\r\n}. qq{\r\n}. qq{--BOUNDARY\r\n}. qq{Content-Disposition: form-data; name="Command"\r\n}. qq{\r\n}. qq{DoUpload\r\n}. qq{--BOUNDARY\r\n}. qq{Content-Disposition: form-data;\r\n}. qq{ name="File";\r\n}. qq{ filename="data.txt"\r\n}. qq{\r\n}. qq{Ged a sheo'l mi fada bhuaip\r\n}. qq{Air long nan crannaibh caola\r\n}. qq{--BOUNDARY--\r\n}. qq{\r\n}. qq{This is a epilogue.}, params => [ 'Content-Type' => 'multipart/form-data; boundary="BOUNDARY"', ], ); is $res->content, 'Command---File', '[input] multipart/form-data [0]'; } { my $res = raw_request( method => 'POST', script => q{ $TL->startCgi( -main => \&main, ); sub main { $TL->print($CGI->getFileName('File')); } }, params => [ 'Content-Type' => 'multipart/form-data; boundary="BOUNDARY"', ], ); is $res->content, 'data.txt', '[input] multipart/form-data [1]'; } { my $res = raw_request( method => 'POST', script => q{ $TL->startCgi( -main => \&main, ); sub main { local $/ = undef; my $fh = $CGI->getFile('File'); $TL->print(<$fh>); } }, params => [ 'Content-Type' => 'multipart/form-data; boundary="BOUNDARY"', ], ); is $res->content, qq{Ged a sheo'l mi fada bhuaip\r\n}. qq{Air long nan crannaibh caola}, '[input] multipart/form-data [2]'; } { my $res = raw_request( method => 'POST', script => q{ $TL->startCgi( -main => \&main, ); sub main { local $/ = undef; my $fh = $CGI->getFile('File', 'UTF-8', 'UTF-16'); $TL->print(<$fh>); } }, params => [ 'Content-Type' => 'multipart/form-data; boundary="BOUNDARY"', ], ); is $res->content, qq{\0G\0e\0d\0 \0a\0 \0s\0h\0e\0o\0'\0l\0 \0m\0i\0 \0f\0a\0d\0a\0 \0b\0h\0u\0a\0i\0p\0\r\0\n}. qq{\0A\0i\0r\0 \0l\0o\0n\0g\0 \0n\0a\0n\0 \0c\0r\0a\0n\0n\0a\0i\0b\0h\0 \0c\0a\0o\0l\0a}, '[input] multipart/form-data [2.5]'; } { my $res = raw_request( method => 'POST', ini => { TL => { 'trap' => 'diewithprint', 'stacktrace' => 'none', 'tempdir' => '.', }, }, script => q{ $TL->startCgi( -main => \&main, ); sub main { local $/ = undef; my $fh = $CGI->getFile('File'); $TL->print(<$fh>); } }, params => [ 'Content-Type' => 'multipart/form-data; boundary="BOUNDARY"', ], ); is $res->content, qq{Ged a sheo'l mi fada bhuaip\r\n}. qq{Air long nan crannaibh caola}, '[input] multipart/form-data [3]'; } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { $TL->setContentFilter('Tripletail::Filter::HTML', charset => 'UTF-8'); $TL->print( sprintf('%s-%s', $TL->CGI->getSliceValues(qw[foo bar])), ); } }, env => { QUERY_STRING => 'foo=%e3%81%84%e3%81%ac&bar=C%20D', }, ini => { 'InputFilter' => { charset => 'UTF-8', }, }, ); # テスト文字は自動判定で文字化けする文字なら何でもよい is $res->content, 'いぬ-C D', '[input] get UTF-8(no CCC)'; } } # ----------------------------------------------------------------------------- # SEO出力 # sub test_06_seo_filter { { my $res = raw_request( method => 'GET', script => q{ $TL->setContentFilter(['Tripletail::Filter::SEO', 1001]); $TL->startCgi( -main => \&main, ); sub main { $TL->getContentFilter(1001)->setOrder(qw(ID Name)); $TL->getContentFilter(1001)->toLink($TL->newForm(KEY => 'VALUE')); $TL->print(q{link}); } }, ); is $res->content, q{link}, '[seo]'; } } # ----------------------------------------------------------------------------- # SEO入力 # sub test_07_seo_input_filter { { my $res = raw_request( method => 'GET', script => q{ $TL->setInputFilter(['Tripletail::InputFilter::SEO', 999]); $TL->startCgi( -main => \&main, ); sub main { $TL->print("--" . $TL->CGI->get('aaa') . "--"); } }, env => { PATH_INFO => '/aaa/SEO', }, ); is $res->content, '--SEO--', '[seo-in]'; } { my $res = raw_request( method => 'GET', script => q{ $TL->setInputFilter(['Tripletail::InputFilter::SEO', 999]); $TL->startCgi( -main => \&main, ); sub main { $TL->print("--" . $TL->CGI->get('aaa') . "--"); } }, env => { PATH_INFO => '/aaa/', }, ); is $res->content, '----', '[seo-in]'; } } # ----------------------------------------------------------------------------- # Tripletail::Filter::HTML + xhtml. # sub test_08_xhtml { { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'html'; my $tmpl = q{
}; $tmpl .= q{}; $tmpl .= q{
}; my $form = { text => 'val' }; my $t = $TL->newTemplate->setTemplate($tmpl)->setForm($form)->extForm; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($t->toStr); } }, ); my $c = $res->content(); $c =~ s{
|
}{}g; is($c, qq{}, '[xhtml] text (html)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'xhtml'; my $tmpl = q{
}; $tmpl .= q{}; $tmpl .= q{
}; my $form = { text => 'val' }; my $t = $TL->newTemplate->setTemplate($tmpl)->setForm($form)->extForm; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($t->toStr); } }, ); my $c = $res->content(); $c =~ s{
|
}{}g; is($c, qq{}, '[xhtml] text (xhtml)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'html'; my $tmpl = q{
}; $tmpl .= q{}; $tmpl .= q{
}; my $form = { radio => 'val' }; my $t = $TL->newTemplate->setTemplate($tmpl)->setForm($form)->extForm; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($t->toStr); } }, ); my $c = $res->content(); $c =~ s{
|
}{}g; is($c, qq{}, '[xhtml] radio (html)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'xhtml'; my $tmpl = q{
}; $tmpl .= q{}; $tmpl .= q{
}; my $form = { radio => 'val' }; my $t = $TL->newTemplate->setTemplate($tmpl)->setForm($form)->extForm; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($t->toStr); } }, ); my $c = $res->content(); $c =~ s{
|
}{}g; is($c, qq{}, '[xhtml] radio (xhtml)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'html'; my $tmpl = q{
}; $tmpl .= q{}; $tmpl .= q{
}; my $form = { chk => 'val' }; my $t = $TL->newTemplate->setTemplate($tmpl)->setForm($form)->extForm; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($t->toStr); } }, ); my $c = $res->content(); $c =~ s{
|
}{}g; is($c, qq{}, '[xhtml] checkbox (html)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'xhtml'; my $tmpl = q{
}; $tmpl .= q{}; $tmpl .= q{
}; my $form = { chk => 'val' }; my $t = $TL->newTemplate->setTemplate($tmpl)->setForm($form)->extForm; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($t->toStr); } }, ); my $c = $res->content(); $c =~ s{
|
}{}g; is($c, qq{}, '[xhtml] checkbox (xhtml)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'html'; my $tmpl = q{
}; $tmpl .= q{}; $tmpl .= q{
}; my $form = { sel => 'val' }; my $t = $TL->newTemplate->setTemplate($tmpl)->setForm($form)->extForm; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($t->toStr); } }, ); my $c = $res->content(); $c =~ s{
|
}{}g; $c =~ s{}{}g; is($c, qq{}, '[xhtml] option (html)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'xhtml'; my $tmpl = q{
}; $tmpl .= q{}; $tmpl .= q{
}; my $form = { sel => 'val' }; my $t = $TL->newTemplate->setTemplate($tmpl)->setForm($form)->extForm; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($t->toStr); } }, ); my $c = $res->content(); $c =~ s{
|
}{}g; $c =~ s{}{}g; is($c, qq{}, '[xhtml] option (xhtml)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'html'; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($TL->newTemplate()->setTemplate("1
<&VAL>")->setAttr(VAL=>'br')->expand(VAL=>"test\nmsg\n")->toStr()); } }, ); my $c = $res->content(); is($c, qq{1
test
\nmsg
\n}, '[xhtml] br (html)'); } { my $res = raw_request( method => 'GET', script => q{ $TL->startCgi( -main => \&main, ); sub main { my $filt = 'xhtml'; $TL->setContentFilter('Tripletail::Filter::HTML',type=>$filt); $TL->print($TL->newTemplate()->setTemplate("1
<&VAL>")->setAttr(VAL=>'br')->expand(VAL=>"test\nmsg\n")->toStr()); } }, ); my $c = $res->content(); is($c, qq{1
test
\nmsg
\n}, '[xhtml] br (xhtml)'); } } # ----------------------------------------------------------------------------- # Tripletail::InputFilter::MobileHTML # sub test_09_input_filter_mobile { { my $res = raw_request( method => 'GET', script => q{ $TL->setInputFilter('Tripletail::InputFilter::MobileHTML'); $TL->startCgi( -main => \&main, ); sub main { $TL->setContentFilter('Tripletail::Filter::HTML', charset => 'UTF-8'); $TL->print( sprintf('%s-%s', $TL->CGI->getSliceValues(qw[foo bar])), ); } }, env => { QUERY_STRING => 'foo=%e3%81%84%e3%81%ac&bar=C%20D', }, ini => { InputFilter => { charset => 'UTF-8', }, }, ); # テスト文字は自動判定で文字化けする文字なら何でもよい is $res->content, 'いぬ-C D', '[input] get UTF-8(no CCC)'; } } # ----------------------------------------------------------------------------- # End of File. # -----------------------------------------------------------------------------