HTTP::MobileAgent を例にした method の追加についてメモ

ちょっと面白い話題だったので、メモ。

CodeZine：Perlで作るモバイルサイトのコツ：第5回（モバイル, XHTML, Perl）

■HTTP::MobileAgentによる対応端末の判別
use HTTP::MobileAgent;

my $agent = HTTP::MobileAgent->new;

if ($agent->is_docomo){
    if ($agent->is_foma){
        # XHTML対応
    }
}
elsif ($agent->is_ezweb){
    if ($agent->is_win){
        # XHTML対応
    }
}
elsif ($agent->is_softbank){
    if ($agent->is_type_w || $agent->is_type_3gc){
        # XHTML対応
    }
}
　多少長い判別となってしまいましたので用途に合わせて関数化してもよいでしょう。各キャリアのXHTMLの仕様については公式ページをご参照ください。

初心者向けの記事だからこそ、小飼氏が氏が指摘するように、Damian 氏おすすめの、より可読性が高い方法*1で書いた方が良いと思うんだけどなぁ・・・。

404 Blog Not Found:perl - 勝手に添削 - 条件分岐

よりおしゃれな方法として、HTTP::MobileAgentのサブクラスを作るという方法もあります。
{
    package MyMobileAgent;
    use base 'HTTP::MobileAgent';
    sub new {
        my $class = shift;
        my $self = HTTP::MobileAgent->new(@_);
        my $id = $self + 0;
        my $pkg = __PACKAGE__ . "::" .  $id;
        no strict 'refs';
        @{$pkg."::ISA"} = (ref $self, __PACKAGE__);
        bless $self, $pkg;
    }
    sub is_xhtml{
        my $self = shift;
        return 1 if $self->is_docomo and $self->is_foma;
        return 1 if $self->is_ezweb  and $self->is_win;
        if ($self->is_softbank){
            return 1 if $self->is_type_w or $self->is_type_3gc;
        }
        return 0;
    }
}
my $ma  = MyMobileAgent->new;
my $ext = $ma->is_xhtml ? 'xhtml' : 'html';
ここでnew()を以上のように定義しているのは、HTTP::MobileAgentのnew()の設計が少し特殊で、そのままでは継承可能となるように設計されていないからで、newがないと
Can't locate object method "parse" via package "MyMobileAgent::NonMobile" at lib/HTTP/MobileAgent.pm line 40
と怒られてしまいます。そこでまずHTTP::MobileAgent->new()でインスタンスをこさえて上で、それをblessしなおしているわけです。このテクニックは覚えておいて損はないでしょう。
上の方法ではうまく行かないとの指摘がmiyagawa君より。手元ではうまく動いていたように見えたのだが、当方のtestに問題があった。とりあえず"singleton class"でnewする方法に差し替え。TB(予定)も参照のこと。

Damian 氏おすすめの方法は、ちょっと脇に置いといて・・・HTTP::MobileAgent に is_xhtml という method を追加する方法に注目。
影響範囲がサブクラス内に限定されるので、既に HTTP::MobileAgent を利用している既存コードに影響が出ない点が良さげだと思う。

subtech - Bulknews::Subtech - MobileAgent

ここでnew()を以上のように定義しているのは、HTTP::MobileAgentのnew()の設計が少し特殊で、そのままでは継承可能となるように設計されていないからで

それには理由があって、USER_AGENT の文字列をみて適切なサブクラスに bless する Factory になっているから。そのインスタンスをもってきて自前のクラスに bless したら、動くわけがない。

subtech - Bulknews::Subtech - MobileAgent

継承をつかってきちんと動かしたければ、MyMobileAgent のサブクラスを動的につくって @ISA に DoCoMo を差し込むようにハックしなければダメ。無理やりかけばこうなるか。
package MyMobileAgent;

my $i;
sub new {
    my $class = shift;
    my $self = HTTP::MobileAgent->new(@_);
    my $pkg = __PACKAGE__ . "::". $i++;
    no strict 'refs';
    @{$pkg."::ISA"} = (ref $self, __PACKAGE__);
    bless $self, $pkg;
}

subtech - Bulknews::Subtech - MobileAgent

そもそも後から機能追加するのに継承を使うというのはイケていない。すべての呼び出しを HTTP::MobileAgent から MyMobileAgent に変えなければならないし、is_xhtml 以外の機能をつけるときに拡張性がない。こういうのはメソッド追加するプラグインでやるのが定石。
package HTTP::MobileAgent::Plugin::XHTML;
use strict;

sub import {
    my $class = shift;
    *HTTP::MobileAgent::is_xhtml = sub { ... }
}

1;
これで、 use HTTP::MobileAgent::Plugin::XHTML; すれば大元のクラスにメソッドが追加できる。

確かに、全てを変更する必要性がある場合は、この方法が優れている。
問題を、今回の場合に限定するならば、is_xhtml メソッドは、そもそも存在していないので、全てを変更した方が使い勝手が良いとも思う。
ただ、既に存在するメソッドを変更する場合とか、既に巨大なソースコードが存在してて追うのが怠いとか、影響範囲を限定したい場合も多々あり、そう言った場合は、サブクラスを作る方法が良い。

404 Blog Not Found:perl - 継承を使いたいワケ

こういうのはメソッド追加するプラグインでやるのが定石。
package HTTP::MobileAgent::Plugin::XHTML;
use strict;

sub import {
    my $class = shift;
    *HTTP::MobileAgent::is_xhtml = sub { ... }
}

1;
これであれば、何もこう書かなくても、
sub HTTP::MobileAgent::is_xhtml { ... }
でも行ける。しかし、本当のところこれは出来れば避けたい。なぜかというと、もしHTTP::MobileAgent::is_xhtml()があらかじめ存在していたら、既存のそれが上書きされてしまうから。use warnings 'redefine'が効いていれば、上書きの際には警告こそ出してくれるが、PerlではWarningが出るだけだ。このあたりは、静的言語のファンならうなずく所。
やはりクラスはなるべく継承可能な形で書いておきたい。このあたりはGisle Aasのモジュール、特にHTML::Parserあたりが参考になる。
「この程度でクラスをこさえるなんて」という声もあるのだが、折角動的言語を使っているのだから、クラスは最低限のものをこさえたい。そのためにも、継承はなるべくサポートして欲しい。

個人的結論。影響範囲を考慮して、状況にあわせて選択した方が良い。

404 Blog Not Found:perl - 継承を使いたいワケ

別のやり方としては、拙作Object::Prototypeを使うやり方もある。

use strict;
use warnings;
use lib 'lib';
use HTTP::MobileAgent;
use Object::ProtoType;

my $hm  = HTTP::MobileAgent->new(@ARGV);
my $ma = Object::Prototype->new($hm);
$ma->prototype(is_xhtml => sub {
                   my $self = shift;
                   return 1 if $self->is_docomo and $self->is_foma;
                   return 1 if $self->is_ezweb  and $self->is_win;
                   if ( $self->is_softbank ) {
                       return 1 if $self->is_type_w or $self->is_type_3gc;
                   }
                   return 0;
               });
my $ext = $ma->is_xhtml ? 'xhtml' : 'html';
warn $ext;
__END__

を！！便利！！JavaScript っぽ。

*1:Perl Best Practices の 31ページ目 Ternaies の項を参照の事