Index: /lang/perl/App-Benchmark-WAF/trunk/t/cgi/yacafi.t
===================================================================
--- /lang/perl/App-Benchmark-WAF/trunk/t/cgi/yacafi.t (revision 23475)
+++ /lang/perl/App-Benchmark-WAF/trunk/t/cgi/yacafi.t (revision 23475)
@@ -0,0 +1,9 @@
+use strict;
+use App::Benchmark::WAF;
+
+waf_benchmark_diag(
+    type => 'yacafi',
+    mode => 'cgi',
+    path => '/cgi/yacafi/index.cgi',
+
+);
Index: /lang/perl/App-Benchmark-WAF/trunk/t/htdocs/cgi/yacafi/Yacafi.pm
===================================================================
--- /lang/perl/App-Benchmark-WAF/trunk/t/htdocs/cgi/yacafi/Yacafi.pm (revision 23475)
+++ /lang/perl/App-Benchmark-WAF/trunk/t/htdocs/cgi/yacafi/Yacafi.pm (revision 23475)
@@ -0,0 +1,236 @@
+### NO PACK
+package Yacafi;
+use strict;
+use warnings;
+our $VERSION = '0.01';
+
+our $MAX_POST_BODY_SIZE = 1000000;
+our $DEBUG              = 0;
+our $NOT_FOUND_CODE     = \&_not_found;
+our $CURRENT_CLASS      = '';
+### NO PACK END
+
+my $QUERY = undef;
+### NO PACK
+sub import {
+    my($class, %args) = @_;
+    $QUERY = undef;
+    my $caller = caller;
+    $CURRENT_CLASS = $args{current_class} || $caller;
+
+    # create a pack file
+    _pack() if @ARGV && $ARGV[0] eq '--pack';
+
+    # functions export
+    for my $name (qw/ dispatch query controller model view redirect filter /) {
+        no strict 'refs';
+        *{"$caller\::$name"} = \&{$name};
+    }
+    strict->import;
+    warnings->import;
+}
+
+sub _pack {
+    my $yacafi = _read_file($INC{'Yacafi.pm'}); 
+    $yacafi =~ s/### NO PACK\n.+?### NO PACK END\n//sg;
+    $yacafi =~ s/\n__END__\n.+$//s;
+    $yacafi =~ s/\$CURRENT_CLASS/$CURRENT_CLASS/g;
+
+    my $cgi = _read_file((caller(1))[1]);
+    $cgi =~ s/use (?:Yacafi|strict|warnings);//g;
+    $cgi =~ s/\$Yacafi::/\$/g;
+    my $shebang;
+    if ($cgi =~ s/(\#\![^\n]+)//s) {
+        $shebang = $1;
+    }
+    
+    my $pl = qq{$shebang
+### GENERATED BY Yacafi $VERSION
+use strict;
+use warnings;
+package $CURRENT_CLASS;
+my \$MAX_POST_BODY_SIZE = 1000000;
+my \$DEBUG              = 0;
+my \$NOT_FOUND_CODE     = \&_not_found;
+{\n$yacafi\n}
+{\n$cgi\n}\n
+};
+    print $pl;
+    exit;
+}
+
+sub _read_file {
+    my $file = shift;
+    open my $fh, '<', $file or die "$file: $!";
+    do { local $/; <$fh> };
+}
+### NO PACK END
+
+sub dispatch {
+    my $response;
+    eval {
+        my $action = query('action') || 'index';
+        my $func = 'do_' . $action;
+        if (my $code = $CURRENT_CLASS->can($func)) {
+            $response = $code->();
+        } else {
+            $response = $NOT_FOUND_CODE->();
+        }
+    };
+
+    if ($@) {
+        die $@ unless $DEBUG;
+        $response = +{
+            headers => +{},
+            body    => 'Error: ' . $@,
+        };
+    }
+
+    $response ||= +{ headers => +{}, body => '' };
+    $response->{body} ||= '';
+    $response->{headers}->{'Content-Length'} ||= length($response->{body});
+    $response->{headers}->{'Content-Type'} ||= 'text/html';
+
+    # build headers
+    while (my($name, $values) = each %{ $response->{headers} }) {
+        next unless defined $values;
+        for my $value (ref($values) eq 'ARRAY' ? @{ $values } : ( $values )) {
+            printf STDOUT "%s: %s\r\n", $name, $value;
+        }
+    }
+    print STDOUT "\r\n" . $response->{body};
+}
+
+sub query {
+    my $name = shift;
+    unless ($QUERY) {
+        my $input = '';
+        if ($ENV{'REQUEST_METHOD'} eq "POST") {
+            if ($ENV{CONTENT_LENGTH} > $MAX_POST_BODY_SIZE) {
+                die "too long Content-Length";
+            } else {
+                read(STDIN, $input, $ENV{'CONTENT_LENGTH'});
+            }
+        } else {
+            $input = $ENV{QUERY_STRING} || '';
+        }
+
+        for (split /&/, $input) {
+            my ($key, $val) = split /=/, $_;
+            $val =~ tr/+/ /;
+            $val =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("H2", $1)/eg;
+            $QUERY->{$key} = $val;
+        }
+    }
+    $QUERY->{$name};
+}
+
+sub redirect {
+    my($uri, $status) = @_;
+    $status ||= 302;
+    +{
+        headers => +{ Status => $status, Location => $uri },
+        body    => 'redirect to ' . $uri,
+    }
+}
+
+sub controller {
+    my $name = shift;
+    my $func = 'do_' . $name;
+    if (my $code = $CURRENT_CLASS->can($func)) {
+        return $code->(@_);
+    } else {
+        die "controller: $CURRENT_CLASS\::do_$name function is missing...";
+    }
+}
+
+sub model {
+    my $name = shift;
+    my $func = 'model_' . $name;
+    if (my $code = $CURRENT_CLASS->can($func)) {
+        return $code->(@_);
+    } else {
+        die "model: $CURRENT_CLASS\::model_$name function is missing...";
+    }
+}
+
+sub view {
+    my $name = shift;
+    my $func = 'view_' . $name;
+    if (my $code = $CURRENT_CLASS->can($func)) {
+        my $ret = $code->(@_);
+        return $ret if ref($ret);
+        return +{
+            headers => +{},
+            body    => $ret,
+        };
+    } else {
+        die "view: $CURRENT_CLASS\::view_$name function is missing...";
+    }
+    my $ret = _goto_mvc( view => @_ );
+}
+
+
+sub _not_found {
+    +{
+        headers => +{ Status => 404 },
+        body    => 'Not Found',
+    };
+}
+
+my $FILTERS = +{
+    html => sub {
+        my $text = shift;
+        $text =~ s/&/&amp;/g;
+        $text =~ s/</&lt;/g;
+        $text =~ s/>/&gt;/g;
+        $text =~ s/\"/&quot;/g;
+        $text =~ s/'/&#39;/g;
+        $text;
+    },
+};
+
+sub filter {
+    return $FILTERS if @_ == 0;
+    my($text, @filters) = @_;
+    for my $filter (@filters) {
+        next unless exists $FILTERS->{$filter} && ref($FILTERS->{$filter}) eq 'CODE';
+        $text = $FILTERS->{$filter}->($text);
+    }
+    $text;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Yacafi - Yet another CGI application framework interface
+
+=head1 SYNOPSIS
+
+  use Yacafi;
+
+=head1 DESCRIPTION
+
+Yacafi is
+
+=head1 AUTHOR
+
+Kazuhiro Osawa E<lt>yappo <at> shibuya <döt> plE<gt>
+
+=head1 SEE ALSO
+
+=head1 REPOSITORY
+
+  svn co http://svn.coderepos.org/share/lang/perl/Yacafi/trunk Yacafi
+
+Yacafi is Subversion repository is hosted at L<http://coderepos.org/share/>.
+patches and collaborators are welcome.
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Index: /lang/perl/App-Benchmark-WAF/trunk/t/htdocs/cgi/yacafi/index.cgi
===================================================================
--- /lang/perl/App-Benchmark-WAF/trunk/t/htdocs/cgi/yacafi/index.cgi (revision 23475)
+++ /lang/perl/App-Benchmark-WAF/trunk/t/htdocs/cgi/yacafi/index.cgi (revision 23475)
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+use strict;
+use warnings;
+
+use Yacafi;
+
+dispatch;
+
+sub do_index {
+    view 'index';
+}
+
+sub view_index {
+    return {
+        headers => { 'Content-Type' => 'text/html;charset=utf-8' },
+        body    => 'HelloWorld',
+    };
+}
+