Changeset 13013

Show
Ignore:
Timestamp:
06/01/08 23:00:19 (5 years ago)
Author:
tokuhirom
Message:

merge MooseX::Plaggerize branch!

Location:
lang/perl/mobirc/trunk
Files:
3 added
1 removed
34 modified
1 moved

Legend:

Unmodified
Added
Removed

  • lang/perl/mobirc/trunk/CONCEPT

    r12896 r13013  
    1111- 1.00 マデニヤルコト 
    1212-- MooseX::Plaggerize べーすニ移行 
     13--- run_hook_first を移動させる 
     14--- run_hook_filter を移動させる 
     15--- App::Mobirc::Plugin::Component::XMPP を復活させる 
    1316-- C からよばれる Template はすべて validate() をつかう 
     17-- DocRoot の完全分離 
     18-- HTMLFilter::StickyTime => StickyTime. 
     19-- and preload StickyTime plugin. 
     20-- HTTPD::* => Web::* 
     21-- hirose31's Groups => Hook. 
     22-- validate_hook を、もうちょいなんとかかっこよく実装したい。 
     23 

  • lang/perl/mobirc/trunk/Makefile.PL

    r12903 r13013  
    77# moooooose 
    88requires 'Moose'               => '0.48'; 
     9requires 'MooseX::Plaggerize'  => '0.03'; 
    910 
    1011# http-engine 

  • lang/perl/mobirc/trunk/config.yaml.sample

    r7461 r13013  
    1010 
    1111plugin: 
    12   - module: App::Mobirc::Plugin::HTMLFilter::DoCoMoCSS 
    13   - module: App::Mobirc::Plugin::IRCCommand::TiarraLog 
    14   - module: App::Mobirc::Plugin::Authorizer::Cookie 
     12  - module: HTMLFilter::DoCoMoCSS 
     13  - module: IRCCommand::TiarraLog 
     14  - module: Authorizer::Cookie 
    1515    config: 
    1616      password: 1152 
    17   - module: App::Mobirc::Plugin::Authorizer::BasicAuth 
     17  - module: Authorizer::BasicAuth 
    1818    config: 
    1919      username: netwatcher 
    2020      password: 0721 
    21   # - module: App::Mobirc::Plugin::Authorizer::EZSubscriberID 
     21  # - module: Authorizer::EZSubscriberID 
    2222  #   config: 
    2323  #     au_subscriber_id: 25253252_oe.ezweb.ne.jp 
    24   - module: App::Mobirc::Plugin::HTMLFilter::ConvertPictograms 
    25   - module: App::Mobirc::Plugin::MessageBodyFilter::Clickable 
     24  - module: HTMLFilter::ConvertPictograms 
     25  - module: MessageBodyFilter::Clickable 
    2626    config: 
    2727      au_pcsv: 0 
    … …  
    3030      # accept_schemes: [mailto, tel] 
    3131      # redirector: http://www.google.com/url?sa=D&q= 
    32   - module: App::Mobirc::Plugin::MessageBodyFilter::IRCColor 
     32  - module: MessageBodyFilter::IRCColor 
    3333    config: 
    3434      # no_decorate: 0 
    3535 
    36   - module: App::Mobirc::Plugin::Component::IRCClient 
     36  - module: Component::IRCClient 
    3737    config: 
    38  
    3938      server: 127.0.0.1 
    4039      port: 252322 
    … …  
    5554          - jagayama 
    5655 
    57   # - module: App::Mobirc::Plugin::DocRoot 
     56  # - module: DocRoot 
    5857  #   config: 
    5958  #     root: /foo/ 

  • lang/perl/mobirc/trunk/lib/App/Mobirc.pm

    r12896 r13013  
    11package App::Mobirc; 
    22use Moose; 
    3 with 'App::Mobirc::Role::Pluggable', 'App::Mobirc::Role::Context'; 
     3with 'App::Mobirc::Role::Context', 'MooseX::Plaggerize', 'MooseX::Plaggerize::PluginLoader'; 
    44use 5.00800; 
    55use Scalar::Util qw/blessed/; 
    … …  
    3333 
    3434    my $self = $next->( $class, config => $config ); 
    35     $self->load_plugins; 
     35 
     36    $self->_load_plugins(); 
    3637 
    3738    return $self; 
    3839}; 
     40 
     41sub _load_plugins { 
     42    my $self = shift; 
     43    for my $plugin (@{ $self->config->{plugin} }) { 
     44        $plugin->{module} =~ s/^App::Mobirc::Plugin:://; 
     45        $self->load_plugin( $plugin ); 
     46    } 
     47} 
    3948 
    4049sub run { 
    … …  
    4251    die "this is instance method" unless blessed $self; 
    4352 
    44     for my $code (@{$self->get_hook_codes('run_component')}) { 
    45         $code->($self); 
    46     } 
     53    $self->run_hook('run_component'); 
    4754 
    4855    App::Mobirc::HTTPD->init($self->config); 
    … …  
    8996 
    9097register hook 
    91  
    92 =item get_hook_codes 
    93  
    94 get hook codes 
    95  
    96 =item add_channel 
    97  
    98 register channel object 
    99  
    100 =item channels 
    101  
    102 get a channel objects. 
    103  
    104 =item get_channel 
    105  
    106 get a channel 
    107  
    108 =item delete_channel 
    109  
    110 delete channel 
    11198 
    11299=back 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/HTTPD/C.pm

    r12654 r13013  
    2121    my ( $c, $out ) = @_; 
    2222 
    23     $out = _html_filter($c, $out); 
     23    ($c, $out) = context->run_hook_filter('html_filter', $c, $out); 
    2424    my $content = encode( $c->req->mobile_agent->encoding, $out); 
    2525 
    … …  
    3939    $c->res->body( $content ); 
    4040 
    41     for my $code (@{context->get_hook_codes('response_filter')}) { 
    42         $code->($c); 
    43     } 
     41    context->run_hook('response_filter', $c); 
    4442} 
    4543 
    46 sub _html_filter { 
    47     my $c = shift; 
    48     my $content = shift; 
    49  
    50     for my $code (@{context->get_hook_codes('html_filter')}) { 
    51         $content = $code->($c, $content); 
    52     } 
    53  
    54     $content; 
    55 } 
    56  
    57  
    58441; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/HTTPD/C/Mobile.pm

    r12885 r13013  
    122122            recent_mode         => $c->req->params->{recent_mode}, 
    123123            message             => $c->req->params->{'msg'} || '', 
    124             channel_page_option => [ 
    125                 map { $_->( $channel, $c ) } 
    126                   @{ context->get_hook_codes('channel_page_option') } 
    127             ], 
     124            channel_page_option => context->run_hook('channel_page_option', $channel, $c), 
    128125            irc_nick            => irc_nick, 
    129126        } 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/HTTPD/Handler.pm

    r12867 r13013  
    1212my $dve = Data::Visitor::Encode->new; 
    1313 
     14sub context () { App::Mobirc->context } ## no critic 
     15 
    1416sub handler { 
    1517    my $c = shift; 
    1618 
    17     for my $code (@{App::Mobirc->context->get_hook_codes('request_filter')}) { 
    18         $code->($c); 
    19     } 
     19    context->run_hook('request_filter', $c); 
    2020 
    2121    if (authorize($c)) { 
    … …  
    2424            $c->res->set_http_response($response); 
    2525        } 
    26         for my $code (@{App::Mobirc->context->get_hook_codes('response_filter')}) { 
    27             $code->($c); 
    28         } 
     26        context->run_hook('response_filter', $c); 
    2927    } else { 
    3028        $c->res->status(401); 
    … …  
    3533sub authorize { 
    3634    my $c = shift; 
    37     for my $code (@{App::Mobirc->context->get_hook_codes('authorize')}) { 
    38         if ($code->($c)) { 
    39             DEBUG "AUTHORIZATION SUCCEEDED"; 
    40             return 1; # authorization succeeded. 
    41         } 
     35 
     36    if (context->run_hook_first('authorize', $c)) { 
     37        DEBUG "AUTHORIZATION SUCCEEDED"; 
     38        return 1; # authorization succeeded. 
     39    } else { 
     40        return 0; # authorization failed 
    4241    } 
    43     return 0; # authorization failed 
    4442} 
    4543 
    … …  
    5149    unless ($rule) { 
    5250        # hook by plugins 
    53         for my $code (@{App::Mobirc->context->get_hook_codes('httpd')}) { 
    54             my $finished = $code->($c, $c->req->uri->path); 
    55             if ($finished) { 
    56                 # XXX we should use html filter? 
    57                 return; 
    58             } 
     51        if (context->run_hook_first( 'httpd', ( $c, $c->req->uri->path ) ) ) { 
     52            # XXX we should use html filter? 
     53            return; 
    5954        } 
    6055 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/HTTPD/Template/IRCMessage.pm

    r12887 r13013  
    5858            my $g = {}; 
    5959            for my $p ( @{ App::Mobirc->context->config->{plugin} || [] } ) { 
    60                 if ( $p->{module} eq 'App::Mobirc::Plugin::Component::IRCClient' ) { 
     60                if ( $p->{module} =~ 'Component::IRCClient' ) { 
    6161                    $g = $p->{config}->{groups} if exists $p->{config}->{groups}; 
    6262                    last; 
    … …  
    9393    my ( $self, $class, $body ) = validate_pos( @_, OBJECT, SCALAR, SCALAR ); 
    9494 
    95     my $c = App::Mobirc->context; 
    96     my $codes = $c->get_hook_codes('message_body_filter') || []; 
    97  
    9895    $body = encode_entities($body, q{<>&"'}); 
    99     for my $filter ( @{ $codes } ) { 
    100         $body = $filter->($body); 
    101     } 
     96    ($body, ) = App::Mobirc->context->run_hook_filter('message_body_filter', $body); 
    10297 
    10398    span { attr { class => $class } 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Model/Channel.pm

    r12644 r13013  
    102102    my ($self, $command) = @_; 
    103103 
    104     for my $code (@{$self->{global_context}->get_hook_codes('process_command')}) { 
    105         my $ret = $code->($self->{global_context}, $command, $self); 
    106         last if $ret; 
    107     } 
     104    $self->{global_context}->run_hook_first('process_command', $command, $self); 
    108105} 
    109106 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/Authorizer/BasicAuth.pm

    r5980 r13013  
    11package App::Mobirc::Plugin::Authorizer::BasicAuth; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44use Carp; 
    55use App::Mobirc::Util; 
    66 
    7 sub register { 
    8     my ($class, $global_context, $conf) = @_; 
    9  
    10     $global_context->register_hook( 
    11         'authorize' => sub { my $c = shift;  _authorize($c, $conf) }, 
    12     ); 
    13 } 
    14  
    15 sub _authorize { 
    16     my ( $c, $conf ) = @_; 
     7hook authorize => sub { 
     8    my ( $self, $global_context, $c, $conf ) = @_; 
    179 
    1810    DEBUG "Basic Auth..."; 
    … …  
    3022        return false; 
    3123    } 
    32 } 
     24}; 
    3325 
    34261; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/Authorizer/Cookie.pm

    r12642 r13013  
    11package App::Mobirc::Plugin::Authorizer::Cookie; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44use App::Mobirc::Util; 
    55use Carp; 
    … …  
    77use Digest::MD5 (); 
    88use Encode; 
     9use App::Mobirc::Validator; 
    910 
    10 our $SALT = 'CSS Nite'; 
     11has password => ( 
     12    is       => 'ro', 
     13    isa      => 'Str', 
     14    required => 1, 
     15); 
    1116 
    12 sub register { 
    13     my ($class, $global_context, $conf) = @_; 
     17has expires => ( 
     18    is      => 'ro', 
     19    isa     => 'Str', 
     20    default => '+7d', 
     21); 
    1422 
    15     $global_context->register_hook( 
    16         'authorize' => sub { my $c = shift;  _authorize($c, $conf) }, 
    17     ); 
    18     $global_context->register_hook( 
    19         'response_filter' => sub { my ($c, ) = @_;  _set_cookie($c, $conf) }, 
    20     ); 
    21 } 
     23hook authorize => sub { 
     24    my ( $self, $global_context, $c, ) = validate_hook('authorize', @_); 
    2225 
    23 # comfort 
    24 sub _calc_digest { 
    25     my ($password, ) = @_; 
    26  
    27     return Digest::MD5::md5_hex( "$password,$SALT" ); 
    28 } 
    29  
    30 sub _authorize { 
    31     my ( $c, $conf ) = @_; 
    32  
    33     my $cookie_str = $c->{req}->header('Cookie'); 
     26    my $cookie_str = $c->req->header('Cookie'); 
    3427    unless ($cookie_str) { 
    3528        DEBUG "cookie header is empty"; 
    … …  
    3730    } 
    3831 
    39     my %cookie = CGI::Cookie->parse($cookie_str); 
    40     if ( $cookie{mobirc_key} && $cookie{mobirc_key}->value eq _calc_digest($conf->{password}) ) 
    41     { 
     32    my %cookie = CGI::Cookie->parse($cookie_str); # TODO: use HTTP::Engine::Request's stuff! 
     33    if ( $cookie{mobirc_key} && $cookie{mobirc_key}->value eq _calc_digest($self->password) ) { 
    4234        DEBUG "cookie auth succeeded"; 
    4335        return true; 
    … …  
    4739        return false; 
    4840    } 
    49 } 
     41}; 
    5042 
    51 sub _set_cookie { 
    52     my ($c, $conf) = @_; 
    53  
    54     my $password = $conf->{password} or croak "conf->{password} missing"; 
     43hook response_filter => sub { 
     44    my ($self, $global_context, $c) = validate_hook('response_filter', @_); 
    5545 
    5646    $c->res->cookies->{mobirc_key} = CGI::Cookie->new( 
    5747        -name    => 'mobirc_key', 
    58         -value   => _calc_digest($password), 
    59         -expires => $conf->{expires} || '+7d', 
     48        -value   => _calc_digest($self->password), 
     49        -expires => $self->expires, 
    6050    ); 
     51}; 
     52 
     53our $SALT = 'CSS Nite';  
     54sub _calc_digest { 
     55    my ($password, ) = @_; 
     56    return Digest::MD5::md5_hex( "$password,$SALT" ); 
    6157} 
    6258 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/Authorizer/DoCoMoGUID.pm

    r12868 r13013  
    11package App::Mobirc::Plugin::Authorizer::DoCoMoGUID; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44use Carp; 
    55use App::Mobirc::Util; 
     6use HTML::StickyQuery::DoCoMoGUID; 
    67 
    7 use HTML::StickyQuery::DoCoMoGUID; 
    8 sub register { 
    9     my ($class, $global_context, $conf) = @_; 
     8has docomo_guid => ( 
     9    is       => 'ro', 
     10    isa      => 'Str', 
     11    required => 1, 
     12); 
    1013 
    11     $global_context->register_hook( 
    12         'authorize' => sub { my $c = shift;  _authorize($c, $conf) } 
    13     ); 
    14     $global_context->register_hook( 
    15         'html_filter' => \&_html_filter_docomo_guid, 
    16     ); 
    17 } 
     14hook authorize => sub { 
     15    my ( $self, $global_context, $c, ) = @_; 
    1816 
    19 sub _authorize { 
    20     my ( $c, $conf ) = @_; 
    21  
    22     DEBUG __PACKAGE__; 
    23  
    24     unless ($conf->{docomo_guid}) { 
    25         croak "missing docomo_guid"; 
    26     } 
    27  
    28     my $subno = $c->{req}->header('x-dcmguid'); 
    29     if ( $subno && $subno eq $conf->{docomo_guid} ) { 
     17    my $subno = $c->req->header('x-dcmguid'); 
     18    if ( $subno && $subno eq $self->docomo_guid ) { 
    3019        DEBUG "SUCESS AT DocomoGUID"; 
    3120        return true; 
    … …  
    3322        return false; 
    3423    } 
    35 } 
     24}; 
    3625 
    37 sub _html_filter_docomo_guid { 
    38     my ($c, $content) = @_; 
     26hook 'html_filter' => sub { 
     27    my ($self, $global_context, $c, $content) = @_; 
    3928 
    4029    DEBUG "Filter DoCoMoGUID"; 
    4130    return $content unless $c->req->mobile_agent->is_docomo; 
    42  
    43     return HTML::StickyQuery::DoCoMoGUID->new()->sticky( scalarref => \$content, ); 
    44 } 
     31    return ($c, HTML::StickyQuery::DoCoMoGUID->new()->sticky( scalarref => \$content, )); 
     32}; 
    4533 
    46341; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/Authorizer/EZSubscriberID.pm

    r5980 r13013  
    11package App::Mobirc::Plugin::Authorizer::EZSubscriberID; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44use Carp; 
    55use App::Mobirc::Util; 
    66 
    7 sub register { 
    8     my ($class, $global_context, $conf) = @_; 
     7has 'au_subscriber_id' => ( 
     8    is       => 'ro', 
     9    isa      => 'Str', 
     10    required => 1, 
     11); 
    912 
    10     $global_context->register_hook( 
    11         'authorize' => sub { my $c = shift;  _authorize($c, $conf) }, 
    12     ); 
    13 } 
     13hook authorize => sub { 
     14    my ( $self, $global_context, $c, ) = @_; 
    1415 
    15 sub _authorize { 
    16     my ( $c, $conf ) = @_; 
    17  
    18     DEBUG __PACKAGE__; 
    19  
    20     unless ($conf->{au_subscriber_id}) { 
    21         croak "missing au_subscriber_id"; 
    22     } 
    23  
    24     my $subno = $c->{req}->header('x-up-subno'); 
    25     if ( $subno && $subno eq $conf->{au_subscriber_id} ) { 
     16    my $subno = $c->req->header('x-up-subno'); 
     17    if ( $subno && $subno eq $self->au_subscriber_id ) { 
    2618        DEBUG "SUCESS AT EZSubscriberID"; 
    2719        return true; 
    … …  
    2921        return false; 
    3022    } 
    31 } 
     23}; 
    3224 
    33251; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/Authorizer/SoftBankID.pm

    r5980 r13013  
    11package App::Mobirc::Plugin::Authorizer::SoftBankID; 
    2 # vim:expandtab: 
    32use strict; 
    4 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    54use Carp; 
    65use App::Mobirc::Util; 
    76 
    8 sub register { 
    9     my ($class, $global_context, $conf) = @_; 
     7has jphone_uid => ( 
     8    is       => 'ro', 
     9    isa      => 'Str', 
     10    required => 1, 
     11); 
    1012 
    11     $global_context->register_hook( 
    12         'authorize' => sub { my $c = shift;  _authorize($c, $conf) }, 
    13     ); 
    14 } 
     13hook authorize => sub { 
     14    my ( $self, $global_context, $c ) = @_; 
    1515 
    16 sub _authorize { 
    17     my ( $c, $conf ) = @_; 
    18  
    19     unless ($conf->{jphone_uid}) { 
    20         croak "missing jphone_uid; specify your x-jphone-uid string."; 
    21     } 
    22  
    23     my $uid = $c->{req}->header('x-jphone-uid'); 
    24     if ( $uid && $uid eq $conf->{jphone_uid} ) { 
     16    my $uid = $c->req->header('x-jphone-uid'); 
     17    if ( $uid && $uid eq $self->jphone_uid ) { 
    2518        return true; 
    2619    } else { 
    2720        return false; 
    2821    } 
    29 } 
     22}; 
    3023 
    31241; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/Component/IRCClient.pm

    r12148 r13013  
    11package App::Mobirc::Plugin::Component::IRCClient; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44 
    55use POE; 
    … …  
    1313use App::Mobirc::Util; 
    1414 
    15 sub register { 
    16     my ($class, $global_context, $conf) = @_; 
    17  
    18     DEBUG "register ircclient component"; 
    19     $conf->{ping_delay}       ||= 30; 
    20     $conf->{reconnect_delay}  ||= 10; 
    21  
    22     $global_context->register_hook( 
    23         'run_component' => sub { _init($conf, shift) }, 
    24     ); 
    25     $global_context->register_hook( 
    26         'process_command' => sub { my ($global_context, $command, $channel) = @_;  _process_command($conf, $global_context, $command, $channel) }, 
    27     ); 
    28 } 
    29  
    30 sub _process_command { 
    31     my ($conf, $global_context, $command, $channel) = @_; 
    32  
    33     my $irc_incode = $conf->{incode}; 
    34     if ($command && $channel->name =~ /^[#*%]/) { 
    35         if ($command =~ m{^/}) { 
     15has ping_delay => ( 
     16    is      => 'ro', 
     17    isa     => 'Int', 
     18    default => 30, 
     19); 
     20 
     21has reconnect_delay => ( 
     22    is      => 'ro', 
     23    isa     => 'Int', 
     24    default => 10, 
     25); 
     26 
     27has incode => ( 
     28    is      => 'ro', 
     29    isa     => 'Str', 
     30    default => 'UTF-8', 
     31); 
     32 
     33has nick => ( 
     34    is       => 'ro', 
     35    isa      => 'Str', 
     36    required => 1, 
     37); 
     38 
     39has username => ( 
     40    is      => 'ro', 
     41    isa     => 'Str', 
     42    default => 'mobirc user', 
     43); 
     44 
     45has groups => ( 
     46    is  => 'ro', 
     47    isa => 'HashRef', 
     48); 
     49 
     50has desc => ( 
     51    is      => 'ro', 
     52    isa     => 'Str', 
     53    default => '', 
     54); 
     55 
     56has server => ( 
     57    is       => 'ro', 
     58    isa      => 'Str', 
     59    required => 1, 
     60); 
     61 
     62has port => ( 
     63    is       => 'ro', 
     64    isa      => 'Int', 
     65    required => 1, 
     66); 
     67 
     68has password => ( 
     69    is  => 'ro', 
     70    isa => 'Str', 
     71); 
     72 
     73hook process_command => sub { 
     74    my ( $self, $global_context, $command, $channel ) = @_; 
     75 
     76    my $irc_incode = $self->incode; 
     77    if ( $command && $channel->name =~ /^[#*%]/ ) { 
     78        if ( $command =~ m{^/} ) { 
    3679            DEBUG "SENDING COMMAND"; 
    3780            $command =~ s!^/!!g; 
    … …  
    4184              $command; 
    4285 
    43             $poe_kernel->post('mobirc_irc', @args); 
    44         } else { 
     86            $poe_kernel->post( 'mobirc_irc', @args ); 
     87        } 
     88        else { 
    4589            DEBUG "NORMAL PRIVMSG"; 
    4690 
    4791            $poe_kernel->post( 'mobirc_irc', 
    4892                privmsg => encode( $irc_incode, $channel->name ) => 
    49                 encode( $irc_incode, $command ) ); 
     93                  encode( $irc_incode, $command ) ); 
    5094 
    5195            DEBUG "Sending command $command"; 
     96 
    5297            # FIXME: httpd $B4X78$J$$7o(B 
    53             if ($global_context->config->{httpd}->{echo} eq true) { 
     98            if ( $global_context->config->{httpd}->{echo} eq true ) { 
    5499                $channel->add_message( 
    55100                    App::Mobirc::Model::Message->new( 
    56101                        who => decode( 
    57102                            $irc_incode, 
    58                             $poe_kernel->alias_resolve('irc_session')->get_heap->{irc}->nick_name 
     103                            $poe_kernel->alias_resolve('irc_session') 
     104                              ->get_heap->{irc}->nick_name 
    59105                        ), 
    60106                        body  => $command, 
    … …  
    67113    } 
    68114    return false; 
    69 } 
    70  
    71 sub _init { 
    72     my ($config, $global_context) = @_; 
     115}; 
     116 
     117hook 'run_component' => sub { 
     118    my ( $self, $global_context ) = @_; 
    73119 
    74120    DEBUG "initialize ircclient"; 
     121 
    75122    # irc component 
    76123    my $irc = POE::Component::IRC->spawn( 
    77124        Alias    => 'mobirc_irc', 
    78         Nick     => $config->{nick}, 
    79         Username => $config->{username}, 
    80         Ircname  => $config->{desc}, 
    81         Server   => $config->{server}, 
    82         Port     => $config->{port}, 
    83         Password => $config->{password} 
     125        Nick     => $self->nick, 
     126        Username => $self->username, 
     127        Ircname  => $self->desc, 
     128        Server   => $self->server, 
     129        Port     => $self->port, 
     130        Password => $self->password, 
    84131    ); 
    85132 
    … …  
    88135            seen_traffic   => false, 
    89136            disconnect_msg => true, 
    90             config         => $config, 
     137            config         => $self, 
    91138            irc            => $irc, 
    92139            global_context => $global_context, 
    93140        }, 
    94141        inline_states => { 
    95             _start           => \&on_irc_start, 
    96             _default         => \&on_irc_default, 
    97  
    98             irc_001          => \&on_irc_001, 
    99             irc_join         => \&on_irc_join, 
    100             irc_part         => \&on_irc_part, 
    101             irc_public       => \&on_irc_public, 
    102             irc_notice       => \&on_irc_notice, 
    103             irc_topic        => \&on_irc_topic, 
    104             irc_332          => \&on_irc_topicraw, 
    105             irc_ctcp_action  => \&on_irc_ctcp_action, 
    106             irc_kick         => \&on_irc_kick, 
    107             irc_snotice      => \&on_irc_snotice, 
    108  
    109             autoping         => \&do_autoping, 
    110             connect          => \&do_connect, 
     142            _start   => \&on_irc_start, 
     143            _default => \&on_irc_default, 
     144 
     145            irc_001         => \&on_irc_001, 
     146            irc_join        => \&on_irc_join, 
     147            irc_part        => \&on_irc_part, 
     148            irc_public      => \&on_irc_public, 
     149            irc_notice      => \&on_irc_notice, 
     150            irc_topic       => \&on_irc_topic, 
     151            irc_332         => \&on_irc_topicraw, 
     152            irc_ctcp_action => \&on_irc_ctcp_action, 
     153            irc_kick        => \&on_irc_kick, 
     154            irc_snotice     => \&on_irc_snotice, 
     155 
     156            autoping => \&do_autoping, 
     157            connect  => \&do_connect, 
    111158 
    112159            irc_disconnected => \&on_irc_reconnect, 
    … …  
    117164 
    118165    $global_context->add_channel( 
    119         App::Mobirc::Model::Channel->new($global_context, U('*server*')) 
    120     ); 
    121 } 
     166        App::Mobirc::Model::Channel->new( $global_context, U('*server*') ) ); 
     167}; 
    122168 
    123169# ------------------------------------------------------------------------- 
    … …  
    144190    DEBUG "CONNECTED"; 
    145191 
    146     my $channel = $poe->heap->{global_context}->get_channel(decode( 'utf8', '*server*' )); 
     192    my $channel = 
     193      $poe->heap->{global_context}->get_channel( decode( 'utf8', '*server*' ) ); 
    147194    $channel->add_message( 
    148195        App::Mobirc::Model::Message->new( 
    149196            who   => undef, 
    150             body  => decode('utf8', 'Connected to irc server!'), 
     197            body  => decode( 'utf8', 'Connected to irc server!' ), 
    151198            class => 'connect', 
    152199        ) 
    … …  
    162209    DEBUG "JOIN"; 
    163210 
    164     my ($who, $channel_name) = _get_args($poe); 
     211    my ( $who, $channel_name ) = _get_args($poe); 
    165212 
    166213    $who =~ s/!.*//; 
    … …  
    173220    my $channel = $poe->heap->{global_context}->get_channel($channel_name); 
    174221    unless ($channel) { 
    175         $channel = App::Mobirc::Model::Channel->new( 
    176             $poe->heap->{global_context}, 
    177             $channel_name, 
    178         ); 
    179         $poe->heap->{global_context}->add_channel( $channel ); 
     222        $channel = 
     223          App::Mobirc::Model::Channel->new( $poe->heap->{global_context}, 
     224            $channel_name, ); 
     225        $poe->heap->{global_context}->add_channel($channel); 
    180226    } 
    181227 
    … …  
    197243    my $poe = sweet_args; 
    198244 
    199     my ($who, $channel_name, $msg) = _get_args($poe); 
     245    my ( $who, $channel_name, $msg ) = _get_args($poe); 
    200246 
    201247    $who =~ s/!.*//; 
    … …  
    233279    DEBUG "IRC PUBLIC"; 
    234280 
    235     my ($who, $channel_name, $msg) = _get_args($poe); 
     281    my ( $who, $channel_name, $msg ) = _get_args($poe); 
    236282 
    237283    $who =~ s/!.*//; 
    … …  
    249295    ); 
    250296    my $irc = $poe->heap->{irc}; 
     297 
    251298    if ( $who eq $irc->nick_name ) { 
    252299        DEBUG "CLEAR UNREAD"; 
    … …  
    261308    my $poe = sweet_args; 
    262309 
    263     my ($who, $channel_name, $msg) = _get_args($poe); 
     310    my ( $who, $channel_name, $msg ) = _get_args($poe); 
    264311 
    265312    DEBUG "IRC NOTICE $who $channel_name $msg"; 
    266313 
    267     for my $code (@{ $poe->heap->{global_context}->get_hook_codes('on_irc_notice') }) { 
    268         my $finished = $code->($poe, $who, $channel_name, $msg); 
    269         return if $finished; 
     314    if ( $poe->heap->{global_context} 
     315        ->run_hook_first( 'on_irc_notice', $poe, $who, $channel_name, $msg ) ) 
     316    { 
     317        return; 
    270318    } 
    271319 
    … …  
    289337    my $poe = sweet_args; 
    290338 
    291     my ($who, $channel_name, $topic) = _get_args($poe); 
     339    my ( $who, $channel_name, $topic ) = _get_args($poe); 
    292340 
    293341    $who =~ s/!.*//; 
    … …  
    306354    ); 
    307355 
    308     $poe->heap->{seen_traffic}                  = true; 
    309     $poe->heap->{disconnect_msg}                = true; 
     356    $poe->heap->{seen_traffic}   = true; 
     357    $poe->heap->{disconnect_msg} = true; 
    310358} 
    311359 
    … …  
    313361    my $poe = sweet_args; 
    314362 
    315     my ($x, $y, $dat) = _get_args($poe); 
     363    my ( $x, $y, $dat ) = _get_args($poe); 
    316364 
    317365    my ( $channel, $topic ) = @{$dat}; 
    … …  
    319367    DEBUG "SET TOPIC RAW: $channel => $topic"; 
    320368 
    321     $poe->heap->{global_context}->get_channel(normalize_channel_name($channel))->topic($topic); 
    322     $poe->heap->{seen_traffic}                  = true; 
    323     $poe->heap->{disconnect_msg}                = true; 
     369    $poe->heap->{global_context} 
     370      ->get_channel( normalize_channel_name($channel) )->topic($topic); 
     371    $poe->heap->{seen_traffic}   = true; 
     372    $poe->heap->{disconnect_msg} = true; 
    324373} 
    325374 
    … …  
    327376    my $poe = sweet_args; 
    328377 
    329     my ($who, $channel_name, $msg) = _get_args($poe); 
     378    my ( $who, $channel_name, $msg ) = _get_args($poe); 
    330379 
    331380    $who =~ s/!.*//; 
    … …  
    333382 
    334383    my $channel = $poe->heap->{global_context}->get_channel($channel_name); 
    335     my $body = sprintf(decode('utf8', "* %s %s"), $who, $msg); 
     384    my $body = sprintf( decode( 'utf8', "* %s %s" ), $who, $msg ); 
    336385    $channel->add_message( 
    337386        App::Mobirc::Model::Message->new( 
    … …  
    351400    DEBUG "DNBKICK"; 
    352401 
    353     my ($kicker, $channel_name, $kickee, $msg) = _get_args($poe); 
     402    my ( $kicker, $channel_name, $kickee, $msg ) = _get_args($poe); 
    354403    $msg ||= 'Flooder'; 
    355404 
    … …  
    377426    my $poe = sweet_args; 
    378427 
    379     $poe->kernel->post( mobirc_irc => time ) unless $poe->heap->{seen_traffic}; 
     428    $poe->kernel->post( mobirc_irc => time ) 
     429      unless $poe->heap->{seen_traffic}; 
    380430    $poe->heap->{seen_traffic} = false; 
    381431    $poe->kernel->delay( autoping => $poe->heap->{config}->{ping_delay} ); 
    … …  
    385435    my $poe = sweet_args; 
    386436 
    387     my ($message, ) = _get_args($poe); 
     437    my ( $message, ) = _get_args($poe); 
    388438 
    389439    DEBUG "getting snotice : $message"; 
    390440 
    391     my $channel = $poe->heap->{global_context}->get_channel(U('*server*' )); 
     441    my $channel = $poe->heap->{global_context}->get_channel( U('*server*') ); 
    392442    $channel->add_message( 
    393443        App::Mobirc::Model::Message->new( 
    … …  
    404454    DEBUG "!RECONNECT! " . $poe->heap->{disconnect_msg}; 
    405455    if ( $poe->heap->{disconnect_msg} ) { 
    406         my $channel = $poe->heap->{global_context}->get_channel(decode( 'utf8', '*server*' )); 
     456        my $channel = 
     457          $poe->heap->{global_context} 
     458          ->get_channel( decode( 'utf8', '*server*' ) ); 
    407459        $channel->add_message( 
    408460            App::Mobirc::Model::Message->new( 
    409                 who   => undef, 
    410                 body  => decode( 'utf8', 'Disconnected from irc server, trying to reconnect...'), 
     461                who  => undef, 
     462                body => decode( 
     463                    'utf8', 
     464                    'Disconnected from irc server, trying to reconnect...' 
     465                ), 
    411466                class => 'reconnect', 
    412467            ) 
    … …  
    422477 
    423478    my @ret; 
    424     for my $elem (@{$poe->args}) { 
    425         if ( ref $elem && ref $elem eq 'ARRAY') { 
    426             push @ret, [map { decode($poe->heap->{config}->{incode}, $_) } @$elem]; 
    427         } else { 
    428             push @ret, decode($poe->heap->{config}->{incode}, $elem); 
     479    for my $elem ( @{ $poe->args } ) { 
     480        if ( ref $elem && ref $elem eq 'ARRAY' ) { 
     481            push @ret, 
     482              [ map { decode( $poe->heap->{config}->{incode}, $_ ) } @$elem ]; 
     483        } 
     484        else { 
     485            push @ret, decode( $poe->heap->{config}->{incode}, $elem ); 
    429486        } 
    430487    } 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/Component/Twitter.pm

    r12148 r13013  
    11package App::Mobirc::Plugin::Component::Twitter; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44use POE::Component::Client::Twitter; 
    55use App::Mobirc::Model::Channel; 
    … …  
    99use Encode; 
    1010 
    11 sub register { 
    12     my ($class, $global_context, $conf) = @_; 
     11has channel => ( 
     12    is => 'ro', 
     13    isa => 'Str', 
     14    default => U('#twitter'), 
     15); 
    1316 
    14     DEBUG "register twitter client component"; 
    15     $global_context->register_hook( 
    16         'run_component' => sub { _init($conf, shift) }, 
    17     ); 
    18     $global_context->register_hook( 
    19         'process_command' => sub { my ($global_context, $command, $channel) = @_;  _process_command($conf, $global_context, $command, $channel) }, 
    20     ); 
     17has 'alias' => ( 
     18    is      => 'ro', 
     19    isa     => 'Str', 
     20    default => 'twitter', 
     21); 
    2122 
    22     $conf->{channel} ||= U '#twitter'; 
    23     $conf->{alias} ||= 'twitter'; 
    24     $conf->{screenname} ||= $conf->{username}; 
    25     $conf->{friend_timeline_interval} ||= 60; 
    26 } 
     23has screenname => ( 
     24    is      => 'ro', 
     25    isa     => 'Str', 
     26    lazy    => 1, 
     27    default => { shift->username }, 
     28); 
    2729 
    28 sub _process_command { 
    29     my ($conf, $global_context, $command, $channel) = @_; 
     30has username => ( 
     31    is       => 'ro', 
     32    isa      => 'Str', 
     33    required => 1, 
     34); 
    3035 
    31     if ($conf->{channel} eq $channel->name) { 
    32         $poe_kernel->post( $conf->{alias}, 'update', encode('utf-8', $command) ); 
     36has password => ( 
     37    is       => 'ro', 
     38    isa      => 'Str', 
     39    required => 1, 
     40); 
     41 
     42has friend_timeline_interval => ( 
     43    is      => 'ro', 
     44    isa     => 'Int', 
     45    default => 60, 
     46); 
     47 
     48hook 'process_command' => sub { 
     49    my ($self, $global_context, $command, $channel) = @_; 
     50 
     51    if ($self->channel eq $channel->name) { 
     52        $poe_kernel->post( $self->alias, 'update', encode('utf-8', $command) ); 
    3353        $channel->add_message( 
    3454            App::Mobirc::Model::Message->new( 
    35                 who => $conf->{screenname}, 
     55                who   => $self->screenname, 
    3656                body  => $command, 
    3757                class => 'public', 
    … …  
    4161    } 
    4262    return false; 
    43 } 
     63}; 
    4464 
    45 sub _init { 
    46     my ( $conf, $global_context ) = @_; 
     65hook 'run_component' => sub { 
     66    my ( $sself $global_context ) = @_; 
    4767 
    48     my $twitter = POE::Component::Client::Twitter->spawn( %{ $conf } ); 
    49  
    50     $global_context->add_channel( 
    51         App::Mobirc::Model::Channel->new( $global_context, $conf->{channel}, ), 
    52     ); 
     68    my $twitter = POE::Component::Client::Twitter->spawn( %{ $self } ); 
    5369 
    5470    POE::Session->create( 
    … …  
    6278                my $poe = sweet_args; 
    6379                $twitter->yield('friend_timeline'); 
    64                 $poe->kernel->delay( 'delay_friend_timeline' => $conf->{friend_timeline_interval} ); 
     80                $poe->kernel->delay( 'delay_friend_timeline' => $self->friend_timeline_interval ); 
    6581            }, 
    6682            'twitter.friend_timeline_success' => sub { 
    6783                my $poe = sweet_args; 
    6884                my $ret = $poe->args->[0] || []; 
    69                 my $channel = $global_context->get_channel( $conf->{channel} ); 
     85                my $channel = $global_context->get_channel( $self->channel ); 
    7086                DEBUG "twitter friend timeline SUCCESSS!!"; 
    7187                DEBUG "got lines: " . scalar(@$ret); 
    … …  
    7692                    DEBUG "GOT STATUS IS: $body($who)"; 
    7793 
    78                     next if $conf->{screenname} eq $who; 
     94                    next if $self->screenname eq $who; 
    7995 
    8096                    $channel->add_message( 
    … …  
    89105        } 
    90106    ); 
    91 } 
     107}; 
    92108 
    931091; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/DocRoot.pm

    r12811 r13013  
    11package App::Mobirc::Plugin::DocRoot; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44use App::Mobirc::Util; 
    55use XML::LibXML; 
    66use Encode; 
     7use Params::Validate ':all'; 
    78 
    8 sub register { 
    9     my ($class, $global_context, $conf) = @_; 
     9has root => ( 
     10    is       => 'ro', 
     11    isa      => 'Str', 
     12    required => 1, 
     13); 
    1014 
    11     DEBUG "Rewrite Document Root"; 
     15hook request_filter => sub { 
     16    my ($self, $global_context, $c) = validate_pos(@_, 
     17        { isa => __PACKAGE__ }, 
     18        { isa => 'App::Mobirc' }, 
     19        { isa => 'HTTP::Engine::Context' }, 
     20    ); 
    1221 
    13     $global_context->register_hook( 
    14         request_filter => sub { _request_filter($conf, @_) }, 
    15     ); 
    16     $global_context->register_hook( 
    17         response_filter => sub { _response_filter($conf, @_) }, 
    18     ); 
    19     $global_context->register_hook( 
    20         'html_filter' => sub { _html_filter_docroot($_[0], $_[1], $conf) }, 
    21     ); 
    22 } 
    23  
    24 sub _request_filter { 
    25     my ($conf, $c) = @_; 
    26  
    27     my $root = $conf->{root}; 
     22    my $root = $self->root; 
    2823    $root =~ s!/$!!; 
    2924 
    3025    my $path = $c->req->uri->path; 
    31     DEBUG "BEFORE : " . $c->req->uri; 
    3226    $path =~ s!^$root!!; 
    3327    $c->req->uri->path($path); 
    34     DEBUG "AFTER  : " . $c->req->uri; 
    35 } 
     28}; 
    3629 
    37 sub _response_filter { 
    38     my ($conf, $c) = @_; 
     30hook response_filter => sub { 
     31    my ($self, $global_context, $c) = @_; 
    3932 
    4033    if ($c->res->redirect) { 
    4134        DEBUG "REWRITE REDIRECT : " . $c->res->redirect; 
    4235 
    43         my $root = $conf->{root}; 
     36        my $root = $self->root; 
    4437        $root =~ s!/$!!; 
    4538        $c->res->redirect( $root . $c->res->redirect ); 
    … …  
    4740        DEBUG "FINISHED: " . $c->res->redirect; 
    4841    } 
    49 } 
     42}; 
    5043 
    51 sub _html_filter_docroot { 
    52     my ($c, $content, $conf) = @_; 
     44hook html_filter => sub { 
     45    my ($self, $global_context, $c, $content, ) = @_; 
    5346 
    5447    DEBUG "FILTER DOCROOT"; 
    5548    DEBUG "CONTENT IS UTF* : " . Encode::is_utf8($content); 
    5649 
    57     my $root = $conf->{root}; 
     50    my $root = $self->root; 
    5851    $root =~ s!/$!!; 
    5952 
    … …  
    8982    $html =~ s{<!DOCTYPE[^>]*>\s*}{}; 
    9083 
    91     decode($doc->encoding || "UTF-8", $html); 
    92 } 
     84    return ($c, decode($doc->encoding || "UTF-8", $html)); 
     85}; 
    9386 
    94871; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/GPS.pm

    r12863 r13013  
    11package App::Mobirc::Plugin::GPS; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44use HTTP::MobileAgent; 
    55use HTTP::MobileAgent::Plugin::Locator; 
    … …  
    1111use UNIVERSAL::require; 
    1212use String::TT ':all'; 
     13use Encode::JP::Mobile; 
    1314 
    14 sub register { 
    15     my ($class, $global_context, $conf) = @_; 
     15has inv_geocoder => ( 
     16    is      => 'ro', 
     17    isa     => 'Str', 
     18    default => 'Null', 
     19); 
    1620 
    17     $global_context->register_hook( 
    18         channel_page_option => sub { 
    19             my ($channel, $global_context) = @_; 
     21hook channel_page_option => sub { 
     22    my ( $self, $global_context, $channel ) = @_; 
    2023 
    21             my $time = time(); 
    22             return tt qq{<a href="/channel/[% channel.name | uri %]/gps?time=[% time | html %]">gps</a>}; 
    23         }, 
    24     ); 
     24    my $time = time(); 
     25    return tt qq{<a href="/channel/[% channel.name | uri %]/gps">gps</a>}; 
     26}; 
    2527 
    26     $global_context->register_hook( 
    27         httpd => sub { 
    28             my ($c, $uri) = @_; 
     28hook httpd => sub { 
     29    my ( $self, $global_context, $c, $uri ) = @_; 
    2930 
    30             if ($uri =~ m{^/channel/([^/]+)/gps$}) { 
    31                 my $channel_name = $1; 
     31    if ( $uri =~ m{^/channel/([^/]+)/gps$} ) { 
     32        my $channel_name = $1; 
    3233 
    33                 my $config = App::Mobirc->context->config; 
    34                 my $path = File::Spec->catfile($config->{global}->{assets_dir}, 'plugin', 'GPS', 'measure.tt2'); 
     34        my $config = App::Mobirc->context->config; 
     35        my $path   = File::Spec->catfile( $config->{global}->{assets_dir}, 
     36            'plugin', 'GPS', 'measure.tt2' ); 
    3537 
    36                 local %ENV; 
    37                 if (my $devcap_multimedia = $c->req->header('X-UP-DEVCAP-MULTIMEDIA')) { 
    38                     $ENV{HTTP_X_UP_DEVCAP_MULTIMEDIA} = $devcap_multimedia; 
    39                 } 
     38        local %ENV; 
     39        if ( my $devcap_multimedia = $c->req->header('X-UP-DEVCAP-MULTIMEDIA') ) 
     40        { 
     41            $ENV{HTTP_X_UP_DEVCAP_MULTIMEDIA} = $devcap_multimedia; 
     42        } 
    4043 
    41                 my $tt = Template->new(ABSOLUTE => 1); 
    42                 $tt->process( 
    43                     $path, 
    44                     { 
    45                         request      => $c->request, 
    46                         req          => $c->req, 
    47                         channel_name => $channel_name, 
    48                         mobile_agent => $c->req->mobile_agent, 
    49                         docroot      => $config->{httpd}->{root}, 
    50                         port         => $config->{httpd}->{port}, 
    51                     }, 
    52                     \my $out 
    53                 ) or warn $tt->error; 
     44        my $tt = Template->new( ABSOLUTE => 1 ); 
     45        $tt->process( 
     46            $path, 
     47            { 
     48                request      => $c->request, 
     49                req          => $c->req, 
     50                channel_name => $channel_name, 
     51                mobile_agent => $c->req->mobile_agent, 
     52                docroot      => $config->{httpd}->{root}, 
     53                port         => $config->{httpd}->{port}, 
     54            }, 
     55            \my $out 
     56        ) or warn $tt->error; 
    5457 
    55                 $c->res->content_type(encode('utf8', 'text/html; charset=Shift_JIS')); 
    56                 $c->res->body($out); 
    57                 return 1; 
    58             } else { 
    59                 return 0; 
    60             } 
    61         }, 
    62     ); 
     58        $c->res->content_type( 
     59            encode( 'utf8', 'text/html; charset=Shift_JIS' ) ); 
     60        $c->res->body($out); 
     61        return 1; 
     62    } 
     63    else { 
     64        return 0; 
     65    } 
     66}; 
    6367 
    64     $global_context->register_hook( 
    65         httpd => sub { 
    66             my ($c, $uri) = @_; 
     68hook httpd => sub { 
     69    my ($self, $global_context, $c, $uri) = @_; 
    6770 
    68             if ($uri =~ m{^/channel/([^/]+)/gps_do$}) { 
    69                 my $channel_name = uri_unescape $1; 
    70                 my $inv_geocoder = $conf->{inv_geocoder} || 'EkiData'; 
     71    if ($uri =~ m{^/channel/([^/]+)/gps_do$}) { 
     72        my $channel_name = uri_unescape $1; 
     73        my $inv_geocoder = $self->inv_geocoder; 
    7174 
    72                 my $point = $c->req->mobile_agent->get_location( $c->req->query_params ); 
     75        my $point = $c->req->mobile_agent->get_location( $c->req->query_params ); 
    7376 
    74                 "App::Mobirc::Plugin::GPS::InvGeocoder::$inv_geocoder"->use or die $@; 
    75                 my $msg = "App::Mobirc::Plugin::GPS::InvGeocoder::$inv_geocoder"->inv_geocoder($point); 
    76                    $msg = uri_escape encode($c->req->mobile_agent->encoding, $msg); 
     77        "App::Mobirc::Plugin::GPS::InvGeocoder::$inv_geocoder"->use or die $@; 
     78        my $msg = "App::Mobirc::Plugin::GPS::InvGeocoder::$inv_geocoder"->inv_geocoder($point); 
     79           $msg = uri_escape encode($c->req->mobile_agent->encoding, $msg); 
    7780 
    78                 my $time = time(); 
    79                 my $redirect = tt "/channels/[% channel_name | uri %]?msg=L:[% msg %]&t=[% time | uri %]"; 
    80                 $c->res->redirect($redirect); 
    81                 return 1; 
    82             } else { 
    83                 return 0; 
    84             } 
    85         }, 
    86     ); 
    87 } 
     81        my $redirect = tt "/channels/[% channel_name | uri %]?msg=L:[% msg %]"; 
     82        $c->res->redirect($redirect); 
     83        return 1; 
     84    } else { 
     85        return 0; 
     86    } 
     87}; 
    8888 
    89891; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/HTMLFilter/CompressHTML.pm

    r6129 r13013  
    22# vim:expandtab: 
    33use strict; 
    4 use warnings; 
     4use MooseX::Plaggerize::Plugin; 
    55use App::Mobirc::Util; 
    66 
    7 sub register { 
    8     my ($class, $global_context) = @_; 
    9  
    10     $global_context->register_hook( 
    11         'html_filter' => \&_html_filter_compress 
    12     ); 
    13 } 
    14  
    15 sub _html_filter_compress { 
    16     my ($c, $content) = @_; 
     7hook html_filter => sub { 
     8    my ($self, $global_context, $c, $content) = @_; 
    179 
    1810    my $bsize = length $content; 
    … …  
    3022    DEBUG "Compress before->$bsize after->$asize $rate% packets->$packets"; 
    3123 
    32     return $content; 
    33 } 
    34  
    35  
     24    return ( $c, $content); 
     25}; 
    3626 
    37271; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/HTMLFilter/ConvertPictograms.pm

    r12585 r13013  
    11package App::Mobirc::Plugin::HTMLFilter::ConvertPictograms; 
    22use strict; 
    3 use warnings; 
    4 use HTML::Entities::ConvertPictogramMobileJp; 
     3use MooseX::Plaggerize::Plugin; 
     4use HTML::Entities::ConvertPictogramMobileJp qw(convert_pictogram_entities); 
     5use Params::Validate ':all'; 
    56 
    6 sub register { 
    7     my ($class, $global_context) = @_; 
     7hook html_filter => sub { 
     8    my ($self, $global_context, $c, $content) = validate_pos(@_, 
     9        { isa => __PACKAGE__ }, 
     10        { isa => 'App::Mobirc' }, 
     11        { isa => 'HTTP::Engine::Context' }, 
     12        { type => SCALAR }, 
     13    ); 
    814 
    9     $global_context->register_hook( 
    10         'html_filter' => \&_html_convert_pictograms 
     15    return ( 
     16        $c, 
     17        convert_pictogram_entities( 
     18            mobile_agent => $c->req->mobile_agent, 
     19            html         => $content, 
     20        ) 
    1121    ); 
    12 } 
    13  
    14 sub _html_convert_pictograms { 
    15     my ($c, $content) = @_; 
    16  
    17     convert_pictogram_entities( 
    18         mobile_agent => $c->req->mobile_agent, 
    19         html         => $content, 
    20     ); 
    21 } 
     22}; 
    2223 
    23241; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/HTMLFilter/DoCoMoCSS.pm

    r12866 r13013  
    11package App::Mobirc::Plugin::HTMLFilter::DoCoMoCSS; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44use CSS::Tiny; 
    55use XML::LibXML; 
    … …  
    88use Encode; 
    99 
    10 sub register { 
    11     my ($class, $global_context) = @_; 
    12  
    13     DEBUG "Register DoCoMoCSS"; 
    14  
    15     $global_context->register_hook( 
    16         'html_filter' => \&_html_filter_docomocss, 
    17     ); 
    18 } 
    19  
    20 # based from HTML::DoCoMoCSS 
    21 sub _html_filter_docomocss { 
    22     my $c = shift; 
    23     my $content = shift; 
     10# some code copied from HTML::DoCoMoCSS 
     11hook 'html_filter' => sub { 
     12    my ($self, $global_context, $c, $content) = @_; 
    2413 
    2514    DEBUG "FILTER DOCOMO CSS"; 
    26     return $content unless $c->req->mobile_agent->is_docomo; 
     15    return ($c, $content) unless $c->req->mobile_agent->is_docomo; 
    2716 
    2817    # escape Numeric character reference. 
    … …  
    5241    $content =~ s{(<a[^>]+)/>}{$1></a>}gi; 
    5342 
    54     return $pict_unescape->(); 
    55 } 
     43    return ($c, $pict_unescape->()); 
     44}; 
    5645 
    57461; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/HTMLFilter/StickyTime.pm

    r12884 r13013  
    11package App::Mobirc::Plugin::HTMLFilter::StickyTime; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44use App::Mobirc::Util; 
    55use HTML::StickyQuery; 
    66 
    7 sub register { 
    8     my ($class, $global_context) = @_; 
    9  
    10     $global_context->register_hook( 
    11         'html_filter' => \&_html_filter 
    12     ); 
    13     $global_context->register_hook( 
    14         response_filter => sub { _response_filter(@_) }, 
    15     ); 
    16 } 
    17  
    18 sub _response_filter { 
    19     my ($c, ) = @_; 
     7hook response_filter => sub { 
     8    my ($self, $global_context, $c) = @_; 
    209 
    2110    if ($c->res->redirect) { 
    … …  
    2413        return $c->res->redirect( $uri->as_string ); 
    2514    } 
    26 } 
     15}; 
    2716 
    28  
    29 sub _html_filter { 
    30     my ($c, $content) = @_; 
     17hook html_filter => sub { 
     18    my ($self, $global_context, $c, $content) = @_; 
    3119 
    3220    my $sticky = HTML::StickyQuery->new(); 
    33     return $sticky->sticky( 
    34         scalarref => \$content, 
    35         param     => { t => time() }, 
     21 
     22    return ( 
     23        $c, 
     24        $sticky->sticky( 
     25            scalarref => \$content, 
     26            param     => { t => time() }, 
     27        ) 
    3628    ); 
    37 } 
    38  
    39  
     29}; 
    4030 
    41311; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/IRCCommand/TiarraLog.pm

    r5980 r13013  
    1 # vim:expandtab: 
    21package App::Mobirc::Plugin::IRCCommand::TiarraLog; 
    32use strict; 
    4 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    54use Encode; 
    65use App::Mobirc::Util; 
    76 
    8 sub register { 
    9     my ($class, $global_context, $conf) = @_; 
     7has sysmsg_prefix => ( 
     8    is      => 'ro', 
     9    isa     => 'Str', 
     10    default => 'tiarra', 
     11); 
    1012 
    11     $global_context->register_hook( 
    12         'on_irc_notice' => sub { _process(@_, $conf) }, 
    13     ); 
    14  
    15     $conf->{sysmsg_prefix} ||= q{tiarra}; 
    16 } 
    17  
    18 sub _process { 
    19     my ($poe, $who, $channel, $msg, $conf) = @_; 
    20  
     13hook on_irc_notice => sub { 
     14    my ($self, $global_context, $poe, $who, $channel, $msg) = @_; 
    2115 
    2216    # Tiarra Log::Recent Parser 
    23     if ($who && $who eq $conf->{sysmsg_prefix}) { 
     17    if ($who && $who eq $self->sysmsg_prefix) { 
    2418        # header: %H:%M:%S 
    2519        # header: %H:%M 
    … …  
    8478 
    8579    return false; 
    86 } 
     80}; 
    8781 
    88821; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/MessageBodyFilter/Clickable.pm

    r6757 r13013  
    22# vim:expandtab: 
    33use strict; 
    4 use warnings; 
     4use MooseX::Plaggerize::Plugin; 
    55use URI::Find; 
    66use URI::Escape; 
    … …  
    99@URI::tel::ISA = qw( URI ); 
    1010 
    11 sub register { 
    12     my ($class, $global_context, $conf) = @_; 
     11has accept_schemes => ( 
     12    is  => 'ro', 
     13    isa => 'ArrayRef', 
     14); 
    1315 
    14     $global_context->register_hook( 
    15         'message_body_filter' => sub { my $body = shift;  process($body, $conf) }, 
    16     ); 
    17 } 
     16has http_link_string => ( 
     17    is  => 'ro', 
     18    isa => 'Str', 
     19); 
    1820 
    19 sub process { 
    20     my ( $text, $conf ) = @_; 
     21has redirector => ( 
     22    is  => 'ro', 
     23    isa => 'Str', 
     24); 
    2125 
    22     my $as = $conf->{accept_schemes}; 
     26has au_pcsv => ( 
     27    is  => 'ro', 
     28    isa => 'Bool', 
     29); 
     30 
     31has pocket_hatena => ( 
     32    is  => 'ro', 
     33    isa => 'Bool', 
     34); 
     35 
     36has google_gwt => ( 
     37    is  => 'ro', 
     38    isa => 'Bool', 
     39); 
     40 
     41hook message_body_filter => sub { 
     42    my ( $self, $global_context, $text ) = @_; 
     43 
     44    my $as = $self->accept_schemes; 
    2345 
    2446    my $link_string_table = {}; 
    … …  
    4264        sub { 
    4365            my ( $uri, $orig_uri ) = @_; 
    44             if ($conf->{accept_schemes} && 
     66            if ($self->accept_schemes && 
    4567                !(grep { $_ eq $uri->scheme } @$as)) { 
    4668                return $orig_uri; 
    4769            } 
    48             return (__PACKAGE__->can("process_" . $uri->scheme) || 
    49                     \&process_default)->($conf, $uri, $orig_uri, $link_string_table); 
     70            return ($self->can("process_" . $uri->scheme) || \&process_default)->($self, $uri, $orig_uri, $link_string_table); 
    5071        } 
    5172    )->find( \$text ); 
    5273 
    5374    return $text; 
    54 } 
     75}; 
    5576 
    5677sub process_http { 
    57     my ( $conf, $uri, $orig_uri ) = @_; 
     78    my ( $self, $uri, $orig_uri ) = @_; 
    5879    my $out = ""; 
    5980    my $link_string = $orig_uri; 
    6081 
    61     if ( $conf->{http_link_string} ) { 
    62         $link_string =$conf->{http_link_string}; 
     82    if ( $self->http_link_string ) { 
     83        $link_string =$self->http_link_string; 
    6384        $link_string =~ s{\$(\w+)}{ 
    6485            $uri->$1; 
    … …  
    6990    my $encoded_uri = encode_entities($uri, q(<>&")); 
    7091 
    71     if ( $conf->{redirector} ) { 
     92    if ( $self->redirector ) { 
    7293        $out = 
    7394        sprintf( 
    7495            '<a href="%s%s" rel="nofollow" class="url">%s</a>', 
    75             encode_entities($conf->{redirector}, q(<>&")), 
     96            encode_entities($self->redirector, q(<>&")), 
    7697            $encoded_uri, 
    7798            $link_string ); 
    … …  
    79100        $out = qq{<a href="$encoded_uri" rel="nofollow" class="url">$link_string</a>}; 
    80101    } 
    81     if ( $conf->{au_pcsv} ) { 
     102    if ( $self->au_pcsv ) { 
    82103        $out .= qq{<a href="device:pcsiteviewer?url=$encoded_uri" rel="nofollow" class="au_pcsv">[PCSV]</a>}; 
    83104    } 
    84     if ( $conf->{pocket_hatena} ) { 
     105    if ( $self->pocket_hatena ) { 
    85106        $out .= 
    86107        sprintf( 
    … …  
    88109            uri_escape($uri) ); 
    89110    } 
    90     if ( $conf->{google_gwt} ) { 
     111    if ( $self->google_gwt ) { 
    91112        $out .= 
    92113        sprintf( 
    … …  
    98119 
    99120sub process_default { 
    100     my ( $conf, $uri, $orig_uri, $link_string_table ) = @_; 
     121    my ( $self, $uri, $orig_uri, $link_string_table ) = @_; 
    101122 
    102123    my $link_string = $orig_uri; 

  • lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/MessageBodyFilter/IRCColor.pm

    r5980 r13013  
    11package App::Mobirc::Plugin::MessageBodyFilter::IRCColor; 
    22use strict; 
    3 use warnings; 
     3use MooseX::Plaggerize::Plugin; 
    44 
    5 sub register { 
    6     my ($class, $global_context, $conf) = @_; 
     5has no_decorate => ( 
     6    is      => 'ro', 
     7    isa     => 'Bool', 
     8    default => 0, 
     9); 
    710 
    8     $global_context->register_hook( 
    9         'message_body_filter' => sub { my $body = shift;  process($body, $conf) }, 
    10     ); 
    11 } 
     11hook message_body_filter => sub { 
     12    my ( $self, $global_context, $text ) = @_; 
    1213 
    13 sub process { 
    14     my ( $text, $conf ) = @_; 
    15  
    16     return _decorate_irc_color($text, $conf->{no_decorate} || 0); 
    17 } 
     14    return _decorate_irc_color($text, $self->no_decorate); 
     15}; 
    1816 
    1917sub _decorate_irc_color { 
    … …  
    2119 
    2220    if ( $src !~ /[\x02\x03\x0f\x16\x1f]/ ) { 
    23  
    2421        # skip without colorcode 
    2522        return $src; 

  • lang/perl/mobirc/trunk/t/HTTPD/Template/IRCMessage.t

    r12638 r13013  
    1414        plugin => [ 
    1515            { 
    16                 module => 'App::Mobirc::Plugin::Component::IRCClient', 
    17                 config => 
    18                   { groups => { initialJ => [qw(jknaoya jkondo jagayam)] }, }, 
     16                module => 'Component::IRCClient', 
     17                config => { 
     18                    groups => { initialJ => [qw(jknaoya jkondo jagayam)] }, 
     19                    nick   => 'foo', 
     20                    port   => 3333, 
     21                    server => '127.0.0.1', 
     22                }, 
    1923            }, 
    2024        ] 

  • lang/perl/mobirc/trunk/t/Plugins/Component/IRCClient.t

    r5980 r13013  
    1616 
    1717my $config = { 
    18     plugin => [ 
    19         { 
    20             module => 'App::Mobirc::Plugin::Component::IRCClient', 
    21             config => { 
    22                 nick     => 'testee', 
    23                 port     => $PORT, 
    24                 incode   => 'utf8', 
    25                 username => 'test man', 
    26                 desc     => 'hoge', 
    27                 server   => 'localhost', 
    28             }, 
    29         } 
    30     ], 
    3118    httpd => { 
    3219        port  => 88888, 
    … …  
    3825 
    3926my $global_context = App::Mobirc->new($config); 
    40 $_->($global_context) for @{$global_context->get_hook_codes('run_component')}; 
     27$global_context->load_plugin( 
     28    { 
     29        module => 'Component::IRCClient', 
     30        config => { 
     31            nick     => 'testee', 
     32            port     => $PORT, 
     33            incode   => 'utf8', 
     34            username => 'test man', 
     35            desc     => 'hoge', 
     36            server   => 'localhost', 
     37        }, 
     38    } 
     39); 
     40$global_context->run_hook('run_component'); 
    4141POE::Session->create( 
    4242    package_states => [ 

  • lang/perl/mobirc/trunk/t/Plugins/DocRoot.t

    r7817 r13013  
    22use warnings; 
    33use utf8; 
    4 use App::Mobirc::Plugin::DocRoot; 
     4use App::Mobirc; 
    55use Encode; 
    66use Test::Base; 
     7 
     8my $global_context = App::Mobirc->new( 
     9    { 
     10        httpd  => { port     => 3333, title => 'mobirc', lines => 40 }, 
     11        global => { keywords => [qw/foo/] } 
     12    } 
     13); 
     14$global_context->load_plugin( {module => 'DocRoot', config => {root => '/foo/'}} ); 
    715 
    816filters { 
    … …  
    1220sub convert { 
    1321    my $src = shift; 
     22    my $c = undef; 
    1423    ok Encode::is_utf8($src); 
    15     my $dst = App::Mobirc::Plugin::DocRoot::_html_filter_docroot(undef, $src, {root => '/foo/'}); 
    16     ok Encode::is_utf8($dst); 
    17     $dst; 
     24    my ($cdst, $htmldst, ) = $global_context->run_hook_filter( 'html_filter', $c, $src ); 
     25    ok Encode::is_utf8($htmldst); 
     26    $htmldst; 
    1827} 
    1928 

  • lang/perl/mobirc/trunk/t/Plugins/Filter/clickable.t

    r6757 r13013  
    22use warnings; 
    33use Test::Base; 
    4 use App::Mobirc::Plugin::MessageBodyFilter::Clickable; 
     4use App::Mobirc; 
    55 
    66plan tests => 1*blocks; 
    … …  
    1212sub clickable { 
    1313    my $x = shift; 
    14     App::Mobirc::Plugin::MessageBodyFilter::Clickable::process( $x->{text}, $x->{conf} ); 
     14    my $global_context = App::Mobirc->new( 
     15        { 
     16            httpd  => { port     => 3333, title => 'mobirc', lines => 40 }, 
     17            global => { keywords => [qw/foo/] } 
     18        } 
     19    ); 
     20    $global_context->load_plugin( { module => 'MessageBodyFilter::Clickable', config => $x->{conf} } ); 
     21    my ($res, ) = $global_context->run_hook_filter('message_body_filter', $x->{text}); 
     22    $res; 
    1523} 
    1624 
    … …  
    7987text: http://d.hatena.ne.jp/ 
    8088conf: 
    81   pocket_hatena: true 
     89  pocket_hatena: 1 
    8290--- expected: <a href="http://d.hatena.ne.jp/" rel="nofollow" class="url">http://d.hatena.ne.jp/</a><a href="http://mgw.hatena.ne.jp/?url=http%3A%2F%2Fd.hatena.ne.jp%2F;noimage=0;split=1" rel="nofollow" class="pocket_hatena">[ph]</a> 
    8391 
    … …  
    8694text: http://d.hatena.ne.jp/ 
    8795conf: 
    88   au_pcsv: true 
     96  au_pcsv: 1 
    8997--- expected: <a href="http://d.hatena.ne.jp/" rel="nofollow" class="url">http://d.hatena.ne.jp/</a><a href="device:pcsiteviewer?url=http://d.hatena.ne.jp/" rel="nofollow" class="au_pcsv">[PCSV]</a> 
    9098 
    … …  
    93101text: http://www.google.co.jp/search?hl=ja&q=foo 
    94102conf: 
    95   au_pcsv: true 
     103  au_pcsv: 1 
    96104--- expected: <a href="http://www.google.co.jp/search?hl=ja&amp;q=foo" rel="nofollow" class="url">http://www.google.co.jp/search?hl=ja&amp;q=foo</a><a href="device:pcsiteviewer?url=http://www.google.co.jp/search?hl=ja&amp;q=foo" rel="nofollow" class="au_pcsv">[PCSV]</a> 
    97105 
    … …  
    100108text: http://d.hatena.ne.jp/ 
    101109conf: 
    102   google_gwt: true 
     110  google_gwt: 1 
    103111--- expected: <a href="http://d.hatena.ne.jp/" rel="nofollow" class="url">http://d.hatena.ne.jp/</a><a href="http://www.google.co.jp/gwt/n?u=http%3A%2F%2Fd.hatena.ne.jp%2F;_gwt_noimg=0" rel="nofollow" class="google_gwt">[gwt]</a> 
    104112 

  • lang/perl/mobirc/trunk/t/Plugins/Filter/decorate-irc-color.t

    r6797 r13013  
    22use warnings; 
    33use Data::Dumper; 
    4 use App::Mobirc::Plugin::MessageBodyFilter::IRCColor; 
     4use App::Mobirc; 
    55 
    66use Test::Base; 
    77eval q{ use String::IRC }; 
    88plan skip_all => "String::IRC is not installed." if $@; 
     9 
     10my $global_context = App::Mobirc->new( 
     11    { 
     12        httpd  => { port     => 3333, title => 'mobirc', lines => 40 }, 
     13        global => { keywords => [qw/foo/] } 
     14    } 
     15); 
     16$global_context->load_plugin( { module => 'MessageBodyFilter::IRCColor', config => { no_decorate => 0} } ); 
    917 
    1018filters { 
    … …  
    1422sub decorate_irc_color { 
    1523    my $x = shift; 
    16     App::Mobirc::Plugin::MessageBodyFilter::IRCColor::process( $x, {} ); 
     24    ($x,) = $global_context->run_hook_filter('message_body_filter', $x); 
     25    return $x; 
    1726} 
    1827 

  • lang/perl/mobirc/trunk/t/Plugins/Filter/no-decorate-irc-color.t

    r6130 r13013  
    11use strict; 
    22use warnings; 
    3 use Data::Dumper; 
    4 use App::Mobirc::Plugin::MessageBodyFilter::IRCColor; 
     3use App::Mobirc; 
    54 
    65use Test::Base; 
    76eval q{ use String::IRC }; 
    87plan skip_all => "String::IRC is not installed." if $@; 
     8 
     9my $global_context = App::Mobirc->new( 
     10    { 
     11        httpd  => { port     => 3333, title => 'mobirc', lines => 40 }, 
     12        global => { keywords => [qw/foo/] } 
     13    } 
     14); 
     15$global_context->load_plugin( { module => 'MessageBodyFilter::IRCColor', config => { no_decorate => 1} } ); 
    916 
    1017filters { 
    … …  
    1421sub decorate_irc_color { 
    1522    my $x = shift; 
    16     App::Mobirc::Plugin::MessageBodyFilter::IRCColor::process( $x, {no_decorate => 1} ); 
     23    ($x,) = $global_context->run_hook_filter('message_body_filter', $x); 
     24    return $x; 
    1725} 
    1826 

  • lang/perl/mobirc/trunk/t/Plugins/HTMLFilter/CompressHTML.t

    r6134 r13013  
    33use App::Mobirc::Plugin::HTMLFilter::CompressHTML; 
    44use Test::Base; 
     5use App::Mobirc; 
     6 
     7my $global_context = App::Mobirc->new( 
     8    { 
     9        httpd  => { port     => 3333, title => 'mobirc', lines => 40 }, 
     10        global => { keywords => [qw/foo/] } 
     11    } 
     12); 
     13$global_context->load_plugin( 'HTMLFilter::CompressHTML' ); 
    514 
    615filters { 
    … …  
    817}; 
    918 
     19run_is input => 'expected'; 
     20 
    1021sub compress { 
    11     App::Mobirc::Plugin::HTMLFilter::CompressHTML::_html_filter_compress(undef, shift); 
     22    my $html = shift; 
     23    my $c = undef; 
     24    ($c, $html) = $global_context->run_hook_filter('html_filter', $c, $html); 
     25    $html; 
    1226} 
    1327 

  • lang/perl/mobirc/trunk/t/Plugins/HTMLFilter/ConvertPictograms.t

    r12636 r13013  
    11use strict; 
    22use warnings; 
    3 use App::Mobirc::Plugin::HTMLFilter::ConvertPictograms; 
     3use App::Mobirc; 
    44use HTTP::MobileAgent; 
     5use HTTP::Engine::Context; 
    56use Test::Base; 
    67 
    7 { 
    8     package DummyContext; 
    9     sub new { 
    10         my ($class, $agent) = @_; 
    11         bless { agent => $agent }, $class; 
     8my $global_context = App::Mobirc->new( 
     9    { 
     10        httpd  => { port     => 3333, title => 'mobirc', lines => 40 }, 
     11        global => { keywords => [qw/foo/] } 
    1212    } 
    13     sub req { 
    14         my $self = shift; 
    15         bless { %$self }, 'DummyContext'; 
    16     } 
    17     sub mobile_agent { shift->{agent} } 
    18 } 
     13); 
     14$global_context->load_plugin( 'HTMLFilter::ConvertPictograms' ); 
    1915 
    2016filters { 
    … …  
    2420sub convert { 
    2521    my $x = shift; 
    26     my $agent = HTTP::MobileAgent->new($x->{ua}); 
    27     App::Mobirc::Plugin::HTMLFilter::ConvertPictograms::_html_convert_pictograms( 
    28         DummyContext->new($agent), $x->{src} ); 
     22    my $c = HTTP::Engine::Context->new; 
     23    $c->req->user_agent( $x->{ua} ); 
     24    ($c, $x->{src}) = $global_context->run_hook_filter( 'html_filter', $c, $x->{src} ); 
     25    return $x->{src}; 
    2926} 
    3027 

  • lang/perl/mobirc/trunk/t/Plugins/HTMLFilter/DoCoMoCSS.t

    r12886 r13013  
    11use strict; 
    22use warnings; 
    3 use Test::More tests => 3; 
     3use Test::More tests => 1; 
    44use HTTP::MobileAgent; 
    55use App::Mobirc; 
    … …  
    1111my $global_context = App::Mobirc->new( 
    1212    { 
    13         httpd  => { port     => 3333, title => 'mobirc', lines => 40 }, 
     13        httpd  => { port     => 3333, }, 
    1414        global => { keywords => [qw/foo/] } 
    1515    } 
    1616); 
    17 App::Mobirc::Plugin::HTMLFilter::DoCoMoCSS->register( 
    18     $global_context 
    19 ); 
    20 is scalar(@{$global_context->get_hook_codes('html_filter')}), 1; 
    21 my $code = $global_context->get_hook_codes('html_filter')->[0]; 
    22 is ref($code), 'CODE'; 
     17$global_context->load_plugin('HTMLFilter::DoCoMoCSS'); 
    2318 
    24 my $src = <<'...'; 
     19my $got = <<'...'; 
    2520<style type="text/css"> 
    2621    a { 
    … …  
    3025<a href="/">foo</a> 
    3126... 
     27($c, $got) = $global_context->run_hook_filter('html_filter', $c, $got); 
    3228 
    33 my $dst = <<'...'; 
     29my $expected = <<'...'; 
    3430<?xml version="1.0"?> 
    3531<a href="/" style="color:red;">foo</a> 
    3632... 
    3733 
    38 is $code->($c, $src), $dst; 
     34is $got, $expected; 
    3935 
     36 

  • lang/perl/mobirc/trunk/t/Plugins/HTMLFilter/StickyTime.t

    r12649 r13013  
    33use App::Mobirc::Plugin::HTMLFilter::StickyTime; 
    44use Test::Base; 
     5use App::Mobirc; 
     6 
     7my $global_context = App::Mobirc->new( 
     8    { 
     9        httpd  => { port     => 3333, title => 'mobirc', lines => 40 }, 
     10        global => { keywords => [qw/foo/] } 
     11    } 
     12); 
     13$global_context->load_plugin( 'HTMLFilter::StickyTime' ); 
    514 
    615plan tests => 1*blocks; 
    716 
    817filters { 
    9     input => [qw/compress/], 
     18    input => [qw/sticky/], 
    1019    expected => [qw/eval/], 
    1120}; 
    … …  
    1625}; 
    1726 
    18 sub compress { 
    19     App::Mobirc::Plugin::HTMLFilter::StickyTime::_html_filter(undef, shift); 
     27sub sticky { 
     28    my $html = shift; 
     29    my $c = undef; 
     30    ($c, $html) = $global_context->run_hook_filter('html_filter', $c, $html); 
     31    return $html; 
    2032} 
    2133