Changeset 8913

Show
Ignore:
Timestamp:
04/05/08 16:45:20 (5 years ago)
Author:
tokuhirom
Message:

Plugin::Parser::* はさしかえたくなることはないだろうということで、Agent::* に parser 系をまるっと書いちゃうことにした。

Location:
lang/perl/HTTP-MobileAttribute/trunk/lib/HTTP
Files:
7 added
1 removed
4 modified

Legend:

Unmodified
Added
Removed
  • lang/perl/HTTP-MobileAttribute/trunk/lib/HTTP/MobileAttribute.pm

    r8889 r8913  
    33use warnings; 
    44our $VERSION = '0.04'; 
    5 use Class::Component; 
    65use HTTP::MobileAttribute::Request; 
    76use HTTP::MobileAttribute::CarrierDetector; 
    8  
    9 __PACKAGE__->load_components(qw/DisableDynamicPlugin Autocall::InjectMethod/); 
     7use UNIVERSAL::require; 
    108 
    119# XXX: This really affects the first time H::MobileAttribute gets loaded 
     
    2119} 
    2220 
    23 our %CARRIER_CLASSES; 
    24 sub load_plugin { 
    25     my $class = shift; 
    26     %CARRIER_CLASSES = (); 
    27     $class->SUPER::load_plugin(@_); 
    28 } 
     21sub carriers { qw/DoCoMo AirHPhone ThirdForce EZweb NonMobile/ } 
     22 
     23BEGIN { 
     24    for (carriers()) { 
     25        "HTTP::MobileAttribute::Agent::$_"->use or die $@; 
     26    } 
     27}; 
    2928 
    3029sub new { 
     
    3837    my $carrier_longname = HTTP::MobileAttribute::CarrierDetector::detect($request->get('User-Agent')); 
    3938 
    40     my $carrier_class = $CARRIER_CLASSES{ $carrier_longname }; 
    41     if (! $carrier_class) { 
    42         $carrier_class = $class->agent_class($carrier_longname); 
    43         for my $type (qw/ components plugins methods hooks /) { 
    44             my $method = "class_component_$type"; 
    45             $carrier_class->$method($class->$method); 
    46         } 
    47         $CARRIER_CLASSES{ $carrier_longname } = $carrier_class; 
    48     } 
    49  
    50     my $self = $carrier_class->SUPER::new({ 
     39    my $self = $class->agent_class($carrier_longname)->new({ 
    5140        request          => $request, 
    5241        carrier_longname => $carrier_longname, 
    5342    }); 
    54  
    55     $self->create_accessors_delayed(); 
    56     $self->parse(); 
    57  
     43    $self->parse; 
    5844    return $self; 
    5945} 
    6046 
    61 for my $accessor (qw/request carrier_longname/) { 
    62     no strict 'refs'; 
    63     *{$accessor} = sub { shift->{$accessor} }; 
    64 } 
    65  
    66 sub user_agent { shift->request->get('User-Agent') } 
    67  
    6847sub agent_class { 'HTTP::MobileAttribute::Agent::' . $_[1] } 
    6948 
    70 my @delayed_accessors; 
     49sub load_plugins { 
     50    my ($class, @plugins) = @_; 
    7151 
    72 sub create_accessors_delayed { 
    73     my ($self, ) = @_; 
    74  
    75     while (my $accessor_info = pop @delayed_accessors) { 
    76         for my $method (@{ $accessor_info->{accessors} }) { 
    77             no strict 'refs'; 
    78             *{"$accessor_info->{package}::$method"} = sub { $_[1]->{$method} }; 
    79             $self->agent_class($accessor_info->{carrier})->register_method( 
    80                 $method => $accessor_info->{package} 
    81             ); 
    82         } 
     52    for my $carrier (carriers()) { 
     53        $class->agent_class($carrier)->load_plugins(@plugins); 
    8354    } 
    8455} 
    8556 
    86 sub register_accessors_delayed { 
    87     my ($self, $accessor_info) = @_; 
    88  
    89     push @delayed_accessors, $accessor_info; 
    90 } 
    91  
    92 package # hide from pause 
    93     HTTP::MobileAttribute::Agent::DoCoMo; 
    94 use base qw/HTTP::MobileAttribute/; 
    95  
    96 package # hide from pause 
    97     HTTP::MobileAttribute::Agent::EZweb; 
    98 use base qw/HTTP::MobileAttribute/; 
    99  
    100 package # hide from pause 
    101     HTTP::MobileAttribute::Agent::ThirdForce; 
    102 use base qw/HTTP::MobileAttribute/; 
    103  
    104 package # hide from pause 
    105     HTTP::MobileAttribute::Agent::AirHPhone; 
    106 use base qw/HTTP::MobileAttribute/; 
    107  
    108 package # hide from pause 
    109     HTTP::MobileAttribute::Agent::NonMobile; 
    110 use base qw/HTTP::MobileAttribute/; 
    11157 
    112581; 
  • lang/perl/HTTP-MobileAttribute/trunk/lib/HTTP/MobileAttribute/Attribute/CarrierMethod.pm

    r8799 r8913  
    88 
    99    if (ref $param) { 
    10         $c->agent_class($param->[0])->register_method( $param->[1] => { plugin => $plugin, method => $method } ); 
     10        return unless $c =~ $param->[0]; 
     11        $c->register_method( $param->[1] => { plugin => $plugin, method => $method } ); 
    1112    } else { 
    12         $c->agent_class($param)->register_method( $method => $plugin ); 
     13        return unless $c =~ $param; 
     14        $c->register_method( $method => $plugin ); 
    1315    } 
    1416} 
  • lang/perl/HTTP-MobileAttribute/trunk/lib/HTTP/MobileAttribute/Plugin.pm

    r8836 r8913  
    44use base qw/Class::Component::Plugin/; 
    55 
    6 __PACKAGE__->mk_classdata('__accessors'); 
    7  
    8 sub new { 
    9     my ($class, $config, $c) = @_; 
    10     my $self = $class->SUPER::new($config, $c); 
    11     if ($self->__accessors) { 
    12         $c->register_accessors_delayed( $self->__accessors); 
    13         $self->__accessors(undef); 
    14     } 
    15     $self; 
    16 } 
    17  
    18 sub accessors { 
    19     my ($class, $carrier, $accessors) = @_; 
    20  
    21     $class->__accessors({carrier => $carrier, accessors => $accessors, package => $class}); 
     6sub class_component_load_attribute_resolver { 
     7    $_[1] eq 'CarrierMethod' ? "HTTP::MobileAttribute::Attribute::CarrierMethod" : undef 
    228} 
    239 
  • lang/perl/HTTP-MobileAttribute/trunk/lib/HTTP/MobileAttribute/Plugin/Core.pm

    r8851 r8913  
    77    my ($class, $config, $c) = @_; 
    88    my $self = $class->SUPER::new($config, $c); 
    9     $c->load_plugins(map({ "Parser::$_" } qw/DoCoMo ThirdForce EZweb NonMobile AirHPhone/)); 
     9    # $c->load_plugins(); 
    1010    $self; 
    1111}