blog.nomadscafe.jp

CatalystをデバッグOnで起動したときに最初の方にでてくる

.-------------------------------------------------------------------+----------.
| Class                                                             | Type     |
+-------------------------------------------------------------------+----------+
| Traba::Model::DBISweet                                            | class    |
| Traba::Model::Trackbacks                                          | class    |
| Traba::Model::URLBL                                               | instance |
| Traba::View::RSS                                                  | instance |
| Traba::View::TT                                                   | instance |
'-------------------------------------------------------------------+----------'

これの右側のTypeがあるんだけど、この欄のclassかinstanceになるかは、Catalystの起動時のsetup_componentsで判定される。
判定に使われるのは、COMPONENTというクラスメソッド。ちなみに、上は暦トラバのもの。

Catalyst::Componentにはそれが実装されてる。中身的には、configをまとめてコンストラクタのnewを呼び出すというコード。

sub COMPONENT {
    my ( $self, $c ) = @_;
    # Temporary fix, some components does not pass context to constructor
    my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
    if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) {
        return $new;
    }
    else {
        if ( my $new = $self->new( $c, $arguments ) ) {
            return $new;
        }
        else {
            my $class = ref $self || $self;
            my $new = { %{ $self->config }, %{$arguments} };
            return bless $new, $class;
        }
    }
}

ということで、Catalyst::ComponentをベースとするModel/Viewは（おかしい事をしないかぎり)必ずinstanceになる。

package Traba::Model::URLBL;

use strict;
use warnings;
use base 'Catalyst::Model';
use NEXT;
use Net::DNS::Resolver;
use URI;

sub new {
    my($class, $c, $config) = @_;
    my $self = $class->NEXT::new($c,$config);
    $config->{urlbl_dns} ||= [qw/sc.surbl.org bsb.spamlookup.net rbl.bulkfeeds.jp/];
    $self->config($config);
    return $self;
}

sub is_blocked {
    my($self, $url) = @_;
    my $uri = URI->new($url);
    my $domain = $uri->host;
    $domain =~ s/^www\.//;
    my $res   = Net::DNS::Resolver->new;
    for my $dns (@{$self->config->{urlbl_dns}}){
	    my $q = $res->search("$domain.$dns");
        return 1 if $q && $q->answer;
    }
    return;
}
1;