#! /usr/bin/perl -w ## ---------------------------------------------------------------------------- # t/filter_chain.t # ----------------------------------------------------------------------------- # Mastering programmed by YAMASHINA Hio # # Copyright 2006 YAMASHINA Hio # ----------------------------------------------------------------------------- # $Id: filter_chain.t 4093 2007-03-08 07:27:08Z hio $ # ----------------------------------------------------------------------------- use strict; use warnings; use Test::More; use Test::Exception; use File::Spec; our $TL; check_fork(); plan tests => 5; &setup; &test_001; sub check_fork { my $pid = eval{ fork(); }; $@ and plan skip_all => "fork required"; if( $pid ) { waitpid($pid, 0); return; # success. }elsif( !defined($pid) ) { plan skip_all => "fork failed: $!"; }else { # child; exit(0); } } # my $pid = my_fork(my $stdout); sub my_fork { my $r = pipe(my$stdout_r,my$stdout_w); $r or die "pipe: $!"; my $pid = fork(); if( !defined($pid) ) { die "fork failed: $!"; }elsif( $pid ) { # parent. $_[0] = $stdout_r; close($stdout_w); return $pid; }else { # child. open(STDIN, "<", "/dev/null") or die "reset STDIN failed: $!"; if( $^O eq 'MSWin32' ) { # dup handle not work correctly on win32? *STDOUT = $stdout_w; *STDERR = $stdout_w; }else { open(STDOUT, ">&", $stdout_w) or die "reset STDOUT failed: $!"; open(STDERR, ">&", $stdout_w) or die "reset STDERR failed: $!"; close($stdout_w); } close($stdout_r); return $pid; } } sub run_cgi(&;$) { my $code = shift; my $param = shift || {}; my $pid = my_fork(my $stdout); defined($pid) or die "open failed: $!"; if( !$pid ) { # child. $ENV{GATEWAY_INTERFACE} = 'RUN/0.1'; $ENV{REQUEST_URI} = '/'; $ENV{REQUEST_METHOD} = 'GET'; $ENV{QUERY_STRING} = join('&', map{"$_=$param->{$_}"}keys %$param); eval { require Tripletail; Tripletail->import(File::Spec->devnull); $SIG{__DIE__} = sub{ print "Content-Type: text/plain\r\n\r\ndied: ".shift; exit; }; $TL->startCgi(-main=>sub{ &$code; }); exit 0; }; exit 1; } my $out = join('', <$stdout>); my $kid = waitpid($pid, 0); $kid==$pid or die "catch another process (pid:$kid), expected $pid"; my $sig = $?&127; my $core = $?&128 ? 1 : 0; my $ret = $?>>8; $?==0 or die "fail with $ret (sig:$sig, core:$core)"; $out =~ s/(.*?\r?\n)?\r?\n//; $out; } sub _make_filter { my $name = shift; my $sub = shift; $INC{"Tripletail/Filter/$name.pm"} = $0; my $pkg = "Tripletail::Filter::$name"; no strict 'refs'; push(@{$pkg.'::ISA'}, qw(Tripletail::Filter)); *{$pkg.'::print'} = $sub; } sub setup { _make_filter(WrapBrackets => sub{ my $pkg = shift; my $content = shift; "[$content]"; }); _make_filter(WrapBraces => sub{ my $pkg = shift; my $content = shift; "{$content}"; }); } sub _set_filter($;$) { my $filter = shift; my $priority = shift; $filter = "Tripletail::Filter::$filter"; if( $priority ) { $TL->setContentFilter( [$filter, $priority] ); }else { $TL->setContentFilter( $filter ); } } sub test_001 { is(run_cgi(sub{ _set_filter(TEXT=>''); $TL->print("AAA"); }), "AAA", "TEXT filter"); is(run_cgi(sub{ _set_filter(TEXT=>''); _set_filter(TEXT=>500); $TL->print("AAA"); }), "Content-Type: text/plain; charset=Shift_JIS\r\n\r\nAAA", "twice TEXT filter makes headers double"); is(run_cgi(sub{ _set_filter(WrapBrackets=>undef); $TL->print("AAA"); }), "[AAA][]", "wrap with brackets"); is(run_cgi(sub{ _set_filter(WrapBraces =>undef); $TL->print("AAA"); }), "{AAA}{}", "wrap with braces"); is(run_cgi(sub{ _set_filter(WrapBrackets=> 500); # before std filter. _set_filter(WrapBraces =>1500); # after std filter. $TL->print("BBB"); $TL->print("CCC"); }), "[BBB]}{[CCC]}{[]\r\n}\r\n", "wrap with both brackets and braces"); # first `{' is prepended to headers. } # ----------------------------------------------------------------------------- # End of File. # -----------------------------------------------------------------------------