北海道苫小牧市出身の初老PGが書くブログ

永遠のプログラマを夢見る、苫小牧市出身のおじさんのちらしの裏

LWPのリダイレクトを制御

LWP::RobotUA、LWP::Mixi、WWW::Mechanizeなど、LWP::UserAgentのサブクラスは、どんなURLでも勝手にリダイレクトしてしまうのだが、これを制御する方法。答えから言えばredirect_ok の挙動を変えればいいだけなのだが、これがなかなかに面倒くさい。



普通にサブクラスを作ると、利用するクラスを変えた場合にいちいちソースを直さなければならない。また、AUTOLOADを使ってラッパーを作った場合には、ラッパー側のredirect_ok を呼ばせつつ他のメソッドは継承ツリーを検索させなければならないので、ちょいと工夫が必要だ。



まず、サブクラスを作る方法。最初に書いた通り、楽をしたかったので、ここでは動的に作る方法をとっている。入力されたオブジェクトの属するパッケージに対し、〜::_RidirectWatcherと言うサブクラスを作成してインスタンス化している。



sub makeAdapter{
my $class = shift;
my ($Obj, $ref_func) = @_;

croak "ParamException: not a LWP::UserAgent."
if(! UNIVERSAL::isa($Obj, 'LWP::UserAgent'));

croak "ParamException: not a CODE reference."
if(ref($ref_func) ne 'CODE');

#サブクラスの動的生成
my $superclass = ref($Obj);
my $subclass = "${superclass}::_RidirectWatcher";

$Obj->{RiderectWatcherFunction} = $ref_func;
$Obj->{RiderectWatcherSuperClass} = $superclass;

{
no strict 'refs';
@{$subclass . '::ISA'} = ($superclass);
*{$subclass . '::redirect_ok'} = sub {
my $self = shift;
my $original_method = "$Obj->{RiderectWatcherSuperClass}::redirect_ok";
return $Obj->{RiderectWatcherFunction}->(@_)
&& $self->$original_method(@_);
}
}

bless $Obj, $subclass;
}





次に、AUTOLOAD を使う方法。これは会社のperl使いに作ってもらったもの。ラッパーのredirect_okを呼んでもらうために自身でLWP::UserAgentのプロパティを完全に持つことと、AUTOLOAD内で実際にメソッドを行使できるパッケージを検索するところがポイント。



sub makeAdapter{
my $class = shift;
my ($Obj, $ref_func) = @_;

croak "ParamException: not a LWP::UserAgent."
if(! UNIVERSAL::isa($Obj, 'LWP::UserAgent'));

croak "ParamException: not a CODE reference."
if(ref($ref_func) ne 'CODE');

$Obj->{RiderectWatcherFunction} = $ref_func;
$Obj->{RiderectWatcherBaseClass} = ref($Obj);

bless $Obj, $class;
}


sub redirect_ok{
my $self = shift;
my $method = $self->{RiderectWatcherBaseClass} . '::redirect_ok';
return $self->{RiderectWatcherFunction}->(@_)
&& $self->$method(@_);
}


sub AUTOLOAD {
( my $method_name = $AUTOLOAD ) =~ s/.*:://;

my $method =
$_[0]->{RiderectWatcherBaseClass}->can($method_name)
|| $_[0]->{RiderectWatcherBaseClass}->can('AUTOLOAD');

goto $method if $method;
}






どっちにしろ、ハッカー冥利に尽きるここまでしなきゃならんのか的なコードですな。