いっちょ Apache のフィルタモジュール講座でも書いてみるか

と思ったら知ってることはすべて（しかもそれ以上）mod_perl のドキュメント（⇒mod_perl: Input and Output Filters）に網羅されていました。orz。

Perl に疎くてもフィルタモジュールを書く人なら目を通しておいて損はないです。つかこのレベルのドキュメントが httpd のドキュメントにも欲しかった。

ちなみにさらりと読んで「mod_perl だとレスポンスコンテンツ等にストリーム指向アクセスできるんか」とぬか喜びしたら行ストリーミングをしてくれるわけではなくて，ちょっとがっかり。どういうことかというと，Stream oriented Output Filters のくだりにも書いてありますが，read() や handler の呼び出しが行の途中でぶったぎられている可能性があるということです。だから自分でバッファリングしなきゃいけない。

例題として mod_trimxml - daily dayflower の mod_perl 版を書いてみます。

package MyApacheMod::Filter::TrimXML;

use strict;
use warnings;

use base qw( Apache2::Filter );

use Apache2::Const -compile => qw( OK );
use Apache2::RequestRec;
use APR::Table;

use constant BUFFER_LEN => 8000;

sub builtin_rule {
    my ($r) = @_;

    my $agent = $r->headers_in->get('User-Agent');
    return 0 if ! $agent;

    return 0 if $agent =~ m' Opera 'ixmso;

    return ($agent =~ m' MSIE \s+ [2-6] 'xmso);
}

sub handler : FilterRequestHandler {
    my $f = shift;

    if (! $f->ctx) {
        $f->ctx({});

        if (builtin_rule($f->r)) {
            $f->r->headers_out->unset('Content-Length');
            $f->ctx->{leftover} = q{};
        }
        else {
            $f->ctx->{done} = 1;
        }
    }

    my $ctx = $f->ctx;

    while ($f->read(my $buffer, BUFFER_LEN)) {
        if ($ctx->{done}) {
            $f->print($buffer);
            next;
        }

        $ctx->{leftover} .= $buffer;
        my $leftover = $ctx->{leftover};

        if ($leftover =~ s{ \A \s* <\?xml \s+ [^>]* \?> \s+ }{}xmso) {
            $f->print($leftover);
            $ctx->{leftover} = q{};
            $ctx->{done}     = 1;
        }
        elsif ($leftover =~ m' \A \s* (\S{4}) 'xmso) {
            if ($1 ne '<?xml') {
                $f->print($leftover);
                $ctx->{leftover} = q{};
                $ctx->{done}     = 1;
            }
        }
    }

    if (! $ctx->{done} && $f->seen_eos) {
        my $leftover = $ctx->{leftover};
        if ($leftover =~ s{ \A \s* <\?xml \s+ [^>]* \?> \s* }{}xmso) {
            ;
        }
        $f->print($leftover);
        $ctx->{leftover} = q{};
        $ctx->{done}     = 1;
    }

    return Apache2::Const::OK;   
}

1;

いくつか省略している機能があるとはいえ，このサイズで収まるとは。やっぱりストリーム指向インタフェースは素敵。buckets and brigades をちまちまいじるのは面倒ですし。