Changeset 776

Show
Ignore:
Timestamp:
10/28/07 14:46:57 (6 years ago)
Author:
tokuhirom
Message:

lang/perl/mobirc: updated todo.
lang/perl/mobirc: s/keitairc_irc/mobirc_irc/g
lang/perl/mobirc: content-type is now configurable.
lang/perl/mobirc: split router class
lang/perl/mobirc: use CGI::Cookie
lang/perl/mobirc: [IMPORTANT]change commandline options

Location:
lang/perl/mobirc/trunk/mobirc
Files:
1 added
7 modified

Legend:

Unmodified
Added
Removed

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

    r770 r776  
    44 
    55requires 'CGI'; 
     6requires 'CGI::Cookie'; 
    67requires 'Carp'; 
    78requires 'Encode'; 

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

    r775 r776  
    1515  title: mobirc 
    1616  lines: 40 
     17  cookie_expires: +3d 
    1718  authorizer: 
    1819    - module: Mobirc::HTTPD::Authorizer::Cookie 

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

    r771 r776  
    2323use Mobirc::Util; 
    2424use Mobirc::HTTPD::Controller; 
     25use Mobirc::HTTPD::Router; 
    2526 
    2627our $GLOBAL_CONFIG;                      # TODO: should use HEAP. 
    … …  
    99100    croak 'uri missing' unless $uri; 
    100101 
    101     my ($meth, @args) = route($c, $uri); 
     102    my ($meth, @args) = Mobirc::HTTPD::Router->route($c, $uri); 
    102103 
    103104    if (blessed $meth && $meth->isa('HTTP::Response')) { 
    … …  
    112113} 
    113114 
    114 sub route { 
    115     my ($c, $uri) = @_; 
    116     croak 'uri missing' unless $uri; 
    117  
    118     if ( $uri eq '/' ) { 
    119         return 'index'; 
    120     } 
    121     elsif ( $uri eq '/topics' ) { 
    122         return 'topics'; 
    123     } 
    124     elsif ( $uri eq '/recent' ) { 
    125         return 'recent'; 
    126     } 
    127     elsif ($uri =~ m{^/channels(-recent)?/([^?]+)(?:\?time=\d+)?$}) { 
    128         my $recent_mode = $1 ? true : false; 
    129         my $channel_name = $2; 
    130         return 'show_channel', $recent_mode, uri_unescape($channel_name); 
    131     } else { 
    132         warn "dan the 404 not found: $uri"; 
    133         my $response = HTTP::Response->new(404); 
    134         $response->content("Dan the 404 not found: $uri"); 
    135         return $response; 
    136     } 
    137 } 
    138  
    1391151; 
    140116 

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

    r770 r776  
    44use boolean ':all'; 
    55use Carp; 
     6use CGI::Cookie; 
    67 
    78sub authorize { 
    … …  
    1213    } 
    1314 
    14     my %cookie; 
    15     for ( split( /; */, $c->{req}->header('Cookie') ) ) { 
    16         my ( $name, $value ) = split(/=/); 
    17         $value =~ s/%([0-9A-Fa-f][0-9A-Fa-f])/pack('C', hex($1))/eg; 
    18         $cookie{$name} = $value; 
    19     } 
     15    my %cookie = CGI::Cookie->parse($c->{req}->header('Cookie')); 
    2016 
    21     if (   $cookie{username} eq $conf->{username} 
    22         && $cookie{passwd} eq $conf->{password} ) 
     17    if (   $cookie{username}->value eq $conf->{username} 
     18        && $cookie{passwd}->value eq $conf->{password} ) 
    2319    { 
    2420        return true; 

  • lang/perl/mobirc/trunk/mobirc/lib/Mobirc/HTTPD/Controller.pm

    r770 r776  
    1515use Scalar::Util qw/blessed/; 
    1616use List::Util qw/first/; 
     17use CGI::Cookie; 
    1718 
    1819use Mobirc; 
    … …  
    8889 
    8990    if ($message) { 
    90         $c->{poe}->kernel->post( 'keitairc_irc', privmsg => $channel => $message ); 
     91        $c->{poe}->kernel->post( 'mobirc_irc', privmsg => $channel => $message ); 
    9192 
    9293        add_message( 
    … …  
    166167 
    167168    my $response = HTTP::Response->new(200); 
    168     $response->push_header( 'Content-type', 'text/html; charset=Shift_JIS' ); # TODO: should be configurable 
     169    $response->push_header( 'Content-type' => $c->{config}->{httpd}->{content_type} ); 
    169170    $response->push_header('Content-Length' => length($content) ); 
    170171 
    … …  
    180181    my $c        = shift; 
    181182    my $response = shift; 
    182  
    183     my ( $sec, $min, $hour, $mday, $mon, $year, $wday ) = 
    184       localtime( time + $c->{httpd}->{cookie_ttl} ); 
    185183 
    186184    my ( $user_info, ) = 
    … …  
    190188    croak "Can't get user_info" unless $user_info; 
    191189 
    192     my $expiration = sprintf( 
    193         '%.3s, %.2d-%.3s-%.4s %.2d:%.2d:%.2d', 
    194         qw(Sun Mon Tue Wed Thu Fri Sat) [$wday], 
    195         $mday, 
    196         qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec) [$mon], 
    197         $year + 1900, 
    198         $hour, 
    199         $min, 
    200         $sec 
    201     ); 
    202190    $response->push_header( 
    203         'Set-Cookie', 
    204         sprintf( 
    205             "username=%s; expires=%s; \n", 
    206             $user_info->{username}, $expiration 
     191        'Set-Cookie' => CGI::Cookie->new( 
     192            -name    => 'username', 
     193            -value   => $user_info->{username}, 
     194            -expires => $c->{config}->{httpd}->{cookie_expires} 
    207195        ) 
    208196    ); 
    209197    $response->push_header( 
    210         'Set-Cookie', 
    211         sprintf( 
    212             "passwd=%s; expires=%s; \n", 
    213             $user_info->{password}, $expiration 
     198        'Set-Cookie' => CGI::Cookie->new( 
     199            -name    => 'passwd', 
     200            -value   => $user_info->{username}, 
     201            -expires => $c->{config}->{httpd}->{cookie_expires} 
    214202        ) 
    215203    ); 

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

    r755 r776  
    1818    # irc component 
    1919    POE::Component::IRC->spawn( 
    20         Alias    => 'keitairc_irc', 
     20        Alias    => 'mobirc_irc', 
    2121        Nick     => $config->{irc}->{nick}, 
    2222        Username => $config->{irc}->{username}, 
    … …  
    6767    $poe->kernel->alias_set('irc_session'); 
    6868 
    69     my $irc = $poe->kernel->alias_resolve('keitairc_irc'); 
     69    my $irc = $poe->kernel->alias_resolve('mobirc_irc'); 
    7070    $poe->kernel->post( $irc, register => 'all' ); 
    7171    $poe->kernel->post( $irc, connect  => {} ); 
    … …  
    208208    my $poe = sweet_args; 
    209209 
    210     $poe->kernel->post( keitairc_irc => connect => {} ); 
     210    $poe->kernel->post( mobirc_irc => connect => {} ); 
    211211} 
    212212 
    … …  
    214214    my $poe = sweet_args; 
    215215 
    216     $poe->kernel->post( keitairc_irc => time ) unless $poe->heap->{seen_traffic}; 
     216    $poe->kernel->post( mobirc_irc => time ) unless $poe->heap->{seen_traffic}; 
    217217    $poe->heap->{seen_traffic} = false; 
    218218    $poe->kernel->delay( autoping => $poe->heap->{config}->{ping_delay} ); 

  • lang/perl/mobirc/trunk/mobirc/mobirc

    r770 r776  
    1010use Carp; 
    1111use YAML::Syck; 
     12use Getopt::Long; 
    1213 
    1314use lib File::Spec->catfile( $FindBin::Bin, 'lib'); 
    … …  
    2021$SIG{INT} = sub { die "SIGINT!\n" }; 
    2122 
    22 DEBUG "NOW LOADING"; 
     23my $daemonize_fg = false; 
     24my $conffname = File::Spec->catfile($FindBin::Bin, 'config.yaml'); 
     25my $version = false; 
     26GetOptions( 
     27    'daemonize' => \$daemonize_fg, 
     28    'config=s'  => \$conffname, 
     29    'version'   => \$version, 
     30) or die "Usage: $0 -c config.yaml"; 
     31Getopt::Long::Configure("bundling"); # allows -c -v 
    2332 
    24 my $conffname = File::Spec->catfile($FindBin::Bin, 'config.ini'); 
    25 if ($ARGV[0]) { 
    26     $conffname = $ARGV[0]; 
     33if ($version) { 
     34    print "Mobirc/$Mobirc::VERSION\n"; 
     35    exit; 
    2736} 
     37 
    2838die "file does not exist: $conffname" unless -f $conffname; 
    2939 
    … …  
    3848$config->{httpd}->{root} ||= '/'; 
    3949$config->{global}->{assets_dir} ||= File::Spec->catfile($FindBin::Bin, 'assets'); 
    40 $config->{httpd}->{cookie_ttl} ||= 86400 * 3;    # 3 days 
     50$config->{httpd}->{cookie_expires} ||= '+3d'; 
     51$config->{httpd}->{content_type} ||= 'text/html; charset=Shift_JIS'; 
    4152 
    4253# daemonize 
    43 if ( $config->{global}->{daemonize} ) { 
     54if ( $daemonize_fg ) { 
    4455    daemonize($config->{global}->{pid_fname}); 
    4556} 
    … …  
    7687    use YAML instead of AppConfig 
    7788    dispatcher likes Sledge(HTTPD) 
     89    TT should in the assets dir? 
     90    cool uri 
     91    use TT at dispatch_index 
     92    templates should be configurable 
     93    use poe's heap instead of global variables ;-( 
     94    Makefile.PL 
    7895 
    7996=head1 TODO 
    8097 
    8198    avoid warnings. 
    82     use poe's heap instead of global variables ;-( 
    83     templates should configurable 
    84     use TT at dispatch_index 
    85     TT should in the assets dir? 
    86     cool uri 
    87     Makefile.PL 
    8899 
    89100=head1 supported phones