2008-08-02 Jun Morimoto <morimoto@mrmt.net>
* use FindBin
+ * moved logging functions to Keitairc::Log package
+ * make Keitairc::ClientInfo tidy
2008-07-19 Jun Morimoto <morimoto@mrmt.net>
#!/usr/bin/perl
# -*- mode: perl; coding: utf-8 -*-
# keitairc
-# $Id: keitairc,v 1.65 2008-08-02 13:31:07 morimoto Exp $
+# $Id: keitairc,v 1.66 2008-08-02 15:02:15 morimoto Exp $
# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/keitairc,v $
#
# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
use Keitairc::ClientInfo;
use Keitairc::SessionManager;
use Keitairc::Plugins;
+use Keitairc::Log;
use strict;
use warnings;
my $uri = $request->uri();
my $ci = new Keitairc::ClientInfo($request);
- ::log_debug("dispatch: $uri");
+ Keitairc::Log::log_debug("dispatch: $uri");
{
# chop off $cf->web_root()
my $content = $request->decoded_content();
my ($password) = ($content =~ /^password=(.*)/);
- ::log_debug("password [$password]");
- ::log_debug("web_password [" . $cf->web_password() . "]");
+ Keitairc::Log::log_debug("password [$password]");
+ Keitairc::Log::log_debug("web_password [" . $cf->web_password() . "]");
if($cf->web_password() eq $password){
- my $s = $sm->add($ci->{header}->{user_agent}, $ci->serial_key());
+ my $s = $sm->add($ci->user_agent(), $ci->serial_key());
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
if(length $docomo_foma_icc){
if(my $s = $sm->verify({serial_key => $docomo_foma_icc,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
if($docomo_foma_icc eq $cf->docomo_foma_icc()){
my $s = $sm->add($ci->user_agent(), $docomo_foma_icc);
- ::log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from docomo_foma_icc");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
my $request = shift;
my $ci = new Keitairc::ClientInfo($request);
if($ci->is_docomo()){
- my $docomo_imodeid = $ci->{header}->{x_dcmguid};
+ my $docomo_imodeid = $ci->docomo_imodeid();
if(length $docomo_imodeid){
if(my $s = $sm->verify({serial_key => $docomo_imodeid,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$s->{id}/index from docomo_imodeid");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from docomo_imodeid");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
if($docomo_imodeid eq $cf->docomo_imodeid()){
my $s = $sm->add($ci->user_agent(), $docomo_imodeid);
- ::log_debug("redirect to /$s->{id}/index from docomo_imodeid");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from docomo_imodeid");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
if(defined($session_id) && length($session_id)){
if($sm->verify({session_id => $session_id,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$session_id/index from cookie");
+ Keitairc::Log::log_debug("redirect to /$session_id/index from cookie");
my $view = new Keitairc::View($cf, $ci, $session_id);
return $view->redirect("/$session_id/index");
}
}
if($ci->is_ezweb()){
- my $subscriber_id = $ci->{header}->{x_up_subno};
+ my $subscriber_id = $ci->au_subscriber_id();
if(length $subscriber_id){
if(my $s = $sm->verify({serial_key => $subscriber_id,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$s->{id}/index from subscriber_id");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from subscriber_id");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
if($subscriber_id eq $cf->au_subscriber_id()){
my $s = $sm->add($ci->user_agent(), $subscriber_id);
- ::log_debug("redirect to /$s->{id}/index from au_subscriber_id");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from au_subscriber_id");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
if(length $serial_key){
if(my $s = $sm->verify({serial_key => $serial_key,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$s->{id}/index from softbank serial_key");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from softbank serial_key");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
if($serial_key eq $cf->softbank_serial_key()){
my $s = $sm->add($ci->user_agent(), $serial_key);
- ::log_debug("redirect to /$s->{id}/index from softbank_serial_key");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from softbank_serial_key");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
}
if($ci->is_emobile()){
- my $userid = $ci->{header}->{x_em_uid};
+ my $userid = $ci->emobile_userid();
if(length $userid){
if(my $s = $sm->verify({serial_key => $userid,
user_agent => $ci->user_agent()})){
- ::log_debug("redirect to /$s->{id}/index from userid");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from userid");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
if($userid eq $cf->emobile_userid()){
my $s = $sm->add($ci->user_agent(), $userid);
- ::log_debug("redirect to /$s->{id}/index from emobile_userid");
+ Keitairc::Log::log_debug("redirect to /$s->{id}/index from emobile_userid");
my $view = new Keitairc::View($cf, $ci, $s->{id});
return $view->redirect("/$s->{id}/index");
}
return Encode::encode($cf->web_charset(), $buf);
}
-################################################################
-sub log{
- my $m = shift;
- warn "keitairc: $m\n";
-}
-
-sub log_die{
- my $m = shift;
- die "keitairc: $m\n";
-}
-
-sub log_debug{
- my $m = shift;
- if($cf->debug()){
- warn "keitairc(debug): $m\n";
- }
-}
-
__END__
# -*- mode: perl; coding: utf-8 -*-
# Keitairc::ClientInfo
-# $Id: ClientInfo.pm,v 1.6 2008-06-29 09:20:49 morimoto Exp $
+# $Id: ClientInfo.pm,v 1.7 2008-08-02 15:02:15 morimoto Exp $
# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/ClientInfo.pm,v $
#
# Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
################################################################
sub is_ezweb{
my $me = shift;
+ # old au phones (WAP1.0 era) does not match with this regexp,
+ # we don't care
$me->{header}->{user_agent} =~ /^KDDI-/;
}
################################################################
sub is_ipod{
my $me = shift;
+ # we treat iPod touch as iPhone
$me->{header}->{user_agent} =~ /(iPod|iPhone)/;
}
################################################################
sub is_emobile{
my $me = shift;
- $me->is_emobile_mobilebrowser() + $me->is_emobile_openbrowser();
+ $me->is_emobile_mobilebrowser() || $me->is_emobile_openbrowser();
}
################################################################
################################################################
sub is_mobile{
my $me = shift;
- $me->is_ezweb() + $me->is_docomo()
- + $me->is_softbank() + $me->is_emobile_mobilebrowser();
+ $me->is_ezweb() || $me->is_docomo() ||
+ $me->is_softbank() || $me->is_emobile_mobilebrowser();
}
################################################################
}
################################################################
-sub subscribe_id{
+# http://www.nttdocomo.co.jp/service/imode/make/content/ip/#imodeid
+sub docomo_imodeid{
+ my $me = shift;
+ $me->{header}->{x_dcmguid};
+}
+
+################################################################
+sub au_subscribe_id{
my $me = shift;
$me->{header}->{x_up_subno};
}
################################################################
-sub userid{
+sub emobile_userid{
my $me = shift;
$me->{header}->{x_em_uid};
}
return $me->softbank_serial();
}
if($me->is_ezweb()){
- return $me->subscribe_id();
+ return $me->au_subscribe_id();
}
if($me->is_emobile()){
- return $me->userid();
+ return $me->emobile_userid();
}
}
# -*- mode: perl; coding: utf-8 -*-
# Keitairc::Config
-# $Id: Config.pm,v 1.17 2008-07-19 08:43:51 morimoto Exp $
+# $Id: Config.pm,v 1.18 2008-08-02 15:02:15 morimoto Exp $
# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/Config.pm,v $
#
# Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
if(defined $argv[0]){
unless(-r $argv[0]){
- ::log("Can't read $argv[0]");
+ Keitairc::Log::log("Can't read $argv[0]");
exit 1;
}
$me->file($argv[0]);
if(defined $me->show_newmsgonly()){
- ::log('show_newmsgonly has obsoleted from keitairc 2.0');
+ Keitairc::Log::log('show_newmsgonly has obsoleted from keitairc 2.0');
}
if(defined $me->web_username()){
- ::log('web_username has obsoleted from keitairc 2.0');
+ Keitairc::Log::log('web_username has obsoleted from keitairc 2.0');
}
if(defined $me->use_cookie()){
- ::log('use_cookie has obsoleted from keitairc 2.0');
+ Keitairc::Log::log('use_cookie has obsoleted from keitairc 2.0');
}
if(defined $me->au_pcsv()){
- ::log('au_pcsv has obsoleted from keitairc 2.0');
+ Keitairc::Log::log('au_pcsv has obsoleted from keitairc 2.0');
}
unless(length $me->irc_nick()){
- ::log_die('irc_nick does not specified');
+ Keitairc::Log::log_die('irc_nick does not specified');
}
unless(length $me->irc_username()){
- ::log_die('irc_username does not specified');
+ Keitairc::Log::log_die('irc_username does not specified');
}
unless(length $me->irc_server()){
- ::log_die('irc_server does not specified');
+ Keitairc::Log::log_die('irc_server does not specified');
}
unless(length $me->web_port()){
- ::log_die('web_port does not specified');
+ Keitairc::Log::log_die('web_port does not specified');
}
unless(length $me->web_host()){
- ::log_die('web_host does not specified');
+ Keitairc::Log::log_die('web_host does not specified');
}
unless(length $me->web_password()){
- ::log_die('web_password does not specified');
+ Keitairc::Log::log_die('web_password does not specified');
}
$me;
my $file = shift;
if(-r $file){
$me->SUPER::file($file);
- ::log("Loaded configuration file: $file");
+ Keitairc::Log::log("Loaded configuration file: $file");
return;
}
- ::log("$file does not exist");
+ Keitairc::Log::log("$file does not exist");
}
1;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# Keitairc::Log
+# $Id: Log.pm,v 1.1 2008-08-02 15:02:16 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/Log.pm,v $
+#
+# Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+
+package Keitairc::Log;
+use strict;
+use warnings;
+
+sub log{
+ my $m = shift;
+ warn "keitairc: $m\n";
+}
+
+sub log_die{
+ my $m = shift;
+ die "keitairc: $m\n";
+}
+
+no strict;
+sub log_debug{
+ my $m = shift;
+ if(defined $cf){
+ unless($cf->debug()){
+ return;
+ }
+ }
+ warn "keitairc(debug): $m\n";
+}
+
+1;
# -*- mode: perl; coding: utf-8 -*-
# Keitairc::Plugins
-# $Id: Plugins.pm,v 1.5 2008-06-29 09:20:49 morimoto Exp $
+# $Id: Plugins.pm,v 1.6 2008-08-02 15:02:16 morimoto Exp $
# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/Plugins.pm,v $
#
# Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
my $e = eval join('', <P>);
close(P);
if($@ || !defined($e)){
- ::log_die("Error in plugin $dir/$file\n" . $@);
+ Keitairc::Log::log_die("Error in plugin $dir/$file\n" . $@);
next;
}
unless($plugin->{name} =~ /^[a-z][a-z0-9_]+/){
- ::log_die("Illegal plugin name $plugin->{name}");
+ Keitairc::Log::log_die("Illegal plugin name $plugin->{name}");
next;
}
if(defined $plugins->{$plugin->{name}}){
- ::log_die("Plugin $plugin->{name} has already loaded");
+ Keitairc::Log::log_die("Plugin $plugin->{name} has already loaded");
next;
}
$plugins->{$plugin->{name}}->{action_imprementation} =
$plugin->{action_imprementation};
$plugins->{$plugin->{name}}->{order} = $order++;
- ::log("Loaded plugin $plugin->{name} from $dir/$file");
+ Keitairc::Log::log("Loaded plugin $plugin->{name} from $dir/$file");
}
}
closedir(F);
# -*- mode: perl; coding: utf-8 -*-
# Keitairc::SessionManager
-# $Id: SessionManager.pm,v 1.6 2008-06-29 09:20:49 morimoto Exp $
+# $Id: SessionManager.pm,v 1.7 2008-08-02 15:02:16 morimoto Exp $
# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/SessionManager.pm,v $
#
# Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
my $user_agent = $me->normalize_user_agent($arg->{user_agent});
my $s;
- # ::log_debug("sm->verify: sid [$arg->{session_id}] serial_key [$arg->{serial_key}] user_agent [$arg->{user_agent}]");
+ # Keitairc::Log::log_debug("sm->verify: sid [$arg->{session_id}] serial_key [$arg->{serial_key}] user_agent [$arg->{user_agent}]");
if(defined $arg->{serial_key}){
if($s = $me->search_by_serial_key($arg->{serial_key}, $user_agent)){
$s->{user_agent} = $user_agent;
if(defined $serial_key){
$s->{serial_key} = $serial_key;
+ }else{
+ $s->{serial_key} = undef;
}
$s->{last_access_time} = time;
- ::log_debug("new session: " .
- "id[$s->{id}]" .
- "ua[$s->{user_agent}] " .
- "time[$s->{last_access_time}] " .
- "serial_key[$s->{serial_key}] " .
- "ttl[$s->{ttl}]");
+ Keitairc::Log::log_debug(
+ dh('new session', $s,
+ qw(id user_agent last_access_time serial_key ttl)));
$s;
}
################################################################
+# dh: dump hash
+sub dh{
+ my $title = shift;
+ my $obj = shift;
+ my @args = @_;
+ my @buf;
+ for my $arg (@args){
+ if(defined $obj->{$arg}){
+ push @buf, sprintf('%s[%s]', $arg, $obj->{$arg});
+ }
+ }
+
+ $title . ': ' . join(', ', @buf);
+}
+
+################################################################
# TTLが過ぎたセッションを抹消
# $sm->garbage_collect();
sub garbage_collect{
if(($me->{sessions}->{$id}->{last_access_time} +
$me->{sessions}->{$id}->{ttl}) < time){
delete $me->{sessions}->{$id};
- ::log_debug("deleted session: id[$id]");
+ Keitairc::Log::log_debug("deleted session: id[$id]");
}
}
}
my $me = shift;
my $user_agent = shift;
- # ::log_debug("normalize_user_agent: user_agent[$user_agent]");
+ # Keitairc::Log::log_debug("normalize_user_agent: user_agent[$user_agent]");
# NTT DoCoMoのFOMA端末製造番号 (15桁のユニークな英数字) および
# FOMAカード製造番号 (20桁のユニークな英数字) を除去
$user_agent =~ s|/SN[0-9A-Z]+|/|;
}
- # ::log_debug("normalize_user_agent: user_agent[$user_agent]");
+ # Keitairc::Log::log_debug("normalize_user_agent: user_agent[$user_agent]");
$user_agent;
}
# -*- mode: perl; coding: utf-8 -*-
# Keitairc::View
-# $Id: View.pm,v 1.15 2008-07-19 08:43:51 morimoto Exp $
+# $Id: View.pm,v 1.16 2008-08-02 15:02:16 morimoto Exp $
# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/lib/Keitairc/View.pm,v $
#
# Copyright (c) 2008 Jun Morimoto <morimoto@mrmt.net>
$path = sprintf('%s%s', $me->{Config}->web_root(), $path);
}
- ::log_debug("path [$path]");
+ Keitairc::Log::log_debug("path [$path]");
my $response = HTTP::Response->new(302);
$response->push_header('Location', $path);
OSDN Git Service
