正規表現ベースのHTML::FillInForm::Lite

HTML::FillInFormを正規表現ベースで再実装したHTML::FillInForm::LiteってのがCPANにリリースされてます。

なかなか爽快ですね。HTML::FillInFormはHTML::Parserを利用しているので無駄な部分が多かったのがデメリットだったわけで。

ドキュメントには2倍近く高速になると書いてたので一応ベンチを取ってみました。

use Benchmark qw(cmpthese timethese :hireswallclock);

use HTML::FillInForm;
use HTML::FillInForm::Lite;

my $str = q{
    <form>
    <input type="text" name="text_data1" value="" >
    <input type="text" name="text_data2" value="" >
    <input type="text" name="text_data3" value="" >
    <input type="text" name="text_data4" value="" >
    <input type="text" name="text_data5" value="" >
    <input type="password" name="pass_data1" value="" >
    <input type="password" name="pass_data2" value="" >
    <select name="select_data">
        <option value="1">a</option>
        <option value="2">b</option>
        <option value="3">c</option>
        <option value="4">d</option>
        <option value="5">e</option>
    </select>
    <input type="radio" name="radio_data" value="0">a
    <input type="radio" name="radio_data" value="1">b
    <input type="radio" name="radio_data" value="2">c
    <input type="radio" name="radio_data" value="3">d
    <input type="radio" name="radio_data" value="4">e
    <input type="radio" name="radio_data" value="5">f
    <textarea name="textarea_data">
    </textarea>
    <input type="submit">
    </form>
};

my $fdat = {
    text_data1 => 'foo',
    text_data2 => 'bar',
    text_pass1 => 'pas',
    select_data => '1',
    radio_data => '0',
    textarea_data => 'BBBBBB',
};

sub fill_lite {
    my $output = HTML::FillInForm::Lite->new->fill(
        \$str,$fdat
    );
}

sub fill {
    my $output = HTML::FillInForm->new->fill(
        scalarref => \$str,
        fdat      => $fdat,
    );
}

cmpthese(1000,{
    'fill'      => \&fill,
    'fill_lite' => \&fill_lite,
});

__END__

            Rate      fill fill_lite
fill       820/s        --      -27%
fill_lite 1122/s       37%        --

たしかに結構早くなってますね。元HTMLデータやオプションの渡し方によってベンチに若干の変化はありますが、大体このくらいです。これはいいですね。

ただ少し気になったのが「<option value="1">a」という書き方だと突っ込んでくれないところですかね。ちゃんと「<option value="1">a</option>」と書かないと駄目みたい。

ぜひぜひ使いたい所なのですが、現状HTML::FillInForm自体が広く使われてしまっているのでそれらを全部HTML::FillInForm::Liteに置き換えていくのは正直不可能です。

Catalyst::Plugin::FillInForm、Template::Plugin::FillInForm、CGI::Application::Plugin::FillInForm、などなどHTML::FillInFormを前提に作られているのはそりゃもう沢山あります。

な　の　で、

HTML::FillInFormを置き換えられないのならHTML::FillInFormを書き換えちゃえばいいのです。

とは言ってもHTML/FillInForm.pmを直接書き換えるわけじゃーありません。packageを侵食してしまえばいいのです。

ってことでざーっと実装してみました。

その名もHTML::FillInForm::Lite::Overwrite

package HTML::FillInForm::Lite::Overwrite;

use strict;
use warnings;

use HTML::FillInForm;
use HTML::FillInForm::Lite;

our $VERSION = '0.01';

our $KNOWN_KEYS = {
    scalarref      =>  1,
    arrayref       =>  1,
    fdat           =>  1,
    fobject        =>  1,
    file           =>  1,
    target         =>  1,
    fill_password  =>  1,
    ignore_fields  =>  1,
    disable_fields =>  1,
};

if ( my $known_keys = HTML::FillInForm->can('_known_keys') ) {
    $KNOWN_KEYS = $known_keys->();
}

package # (^o^)
    HTML::FillInForm;

no warnings 'redefine';

sub new {
    shift;
}

sub fill {
    my $proto = shift;
    my ($type) = @_;
    my ($src,$q,%option);
    
    if ( ref $type ) {
        ($src,$q,%option) = @_;
    }
    else {
        if ( $KNOWN_KEYS->{$type} ) {
            # old syntax
            %option = @_;
            $src = delete $option{arrayref}  if $option{arrayref};
            $src = delete $option{scalarref} if $option{scalarref};
            $src = delete $option{file}      if $option{file};
            $q = [];
            foreach my $fkeys ( qw/ fdat fobject / ) {
                if ( my $fdata = delete $option{$fkeys} ) {
                    push @$q , ref $fdata eq 'ARRAY' ? @$fdata : $fdata;
                }
            }
        }
    }
    
    $option{fill_password} = 1 unless defined $option{fill_password};
    
    return HTML::FillInForm::Lite->fill($src,$q,%option);
}

1;

fill_passwordオプションが本家のそれとは逆の意味なのでデフォルト1にするという処理が入ってます。

んでまーベンチ計りなおしてみると、

use Benchmark qw(cmpthese timethese :hireswallclock);

use HTML::FillInForm::Lite::Overwrite;

my $str = q{
    <form>
    <input type="text" name="text_data1" value="" >
    <input type="text" name="text_data2" value="" >
    <input type="text" name="text_data3" value="" >
    <input type="text" name="text_data4" value="" >
    <input type="text" name="text_data5" value="" >
    <input type="password" name="pass_data1" value="" >
    <input type="password" name="pass_data2" value="" >
    <select name="select_data">
        <option value="1">a</option>
        <option value="2">b</option>
        <option value="3">c</option>
        <option value="4">d</option>
        <option value="5">e</option>
    </select>
    <input type="radio" name="radio_data" value="0">a
    <input type="radio" name="radio_data" value="1">b
    <input type="radio" name="radio_data" value="2">c
    <input type="radio" name="radio_data" value="3">d
    <input type="radio" name="radio_data" value="4">e
    <input type="radio" name="radio_data" value="5">f
    <textarea name="textarea_data">
    </textarea>
    <input type="submit">
    </form>
};

my $fdat = {
    text_data1 => 'foo',
    text_data2 => 'bar',
    text_pass1 => 'pas',
    select_data => '1',
    radio_data => '0',
    textarea_data => 'BBBBBB',
};

sub fill_lite {
    my $output = HTML::FillInForm::Lite->new->fill(
        \$str,$fdat
    );
}

sub fill {
    my $output = HTML::FillInForm->new->fill(
        scalarref => \$str,
        fdat      => $fdat,
    );
}

cmpthese(1000,{
    'fill'      => \&fill,
    'fill_lite' => \&fill_lite,
});

__END__

            Rate      fill fill_lite
fill      1015/s        --       -8%
fill_lite 1104/s        9%        --

という結果になり、ほぼ同じ値になりますた。

急ぎで適当に作ったのでまだテストとか無い状態でございますです。

ってことでとりあえずあとでCodeReposにうｐっときます。リンクは↓

http://coderepos.org/share/browser/lang/perl/HTML-FillInForm-Lite-Overwrite

追記

CGI::Ex::Fillなんてのがあったのか - Unknown::Programming