+2008-08-03 Jun Morimoto <morimoto@mrmt.net>
+
+ * added t/test_suites, Makefile.PL, MANIFEST
+
2008-08-02 Jun Morimoto <morimoto@mrmt.net>
* use FindBin
--- /dev/null
+MANIFEST
+COPYING
+README
+AUTHORS
+ChangeLog
+keitairc
+t/00_required_modules.t
+t/02_ClientInfo.t
+t/02_Config.t
+t/02_IrcBuffer.t
+t/02_IrcCallback.t
+t/02_Plugins.t
+t/02_SessionManager.t
+t/02_View.t
+t/02_Log.t
+lib/Keitairc/Log.pm
+lib/Keitairc/ClientInfo.pm
+lib/Keitairc/Config.pm
+lib/Keitairc/IrcBuffer.pm
+lib/Keitairc/IrcCallback.pm
+lib/Keitairc/Plugins.pm
+lib/Keitairc/SessionManager.pm
+lib/Keitairc/View.pm
+lib/plugins/00all
+lib/plugins/00index
+lib/plugins/00location
+lib/plugins/00location_receiver
+lib/plugins/00nick
+lib/plugins/00postme
+lib/plugins/00recent
+lib/plugins/00topic
+lib/plugins/00unread
+lib/plugins/10url
+lib/plugins/11url_session
+lib/plugins/20mail
+lib/plugins/20phone
+lib/plugins/30prefectures
+lib/plugins/31distinct
+lib/plugins/32address
+lib/plugins/99keyword
+lib/public/favicon.ico
+lib/public/robots.txt
+lib/templates/404.html
+lib/templates/address.html
+lib/templates/all.html
+lib/templates/index.html
+lib/templates/location.html
+lib/templates/location_receiver.html
+lib/templates/login_icc.html
+lib/templates/login_imodeid.html
+lib/templates/mail.html
+lib/templates/nick.html
+lib/templates/phone.html
+lib/templates/postme.eml
+lib/templates/postme.html
+lib/templates/recent.html
+lib/templates/robots.txt
+lib/templates/root.html
+lib/templates/topic.html
+lib/templates/unread.html
+lib/templates/url.html
+lib/templates/url_session.html
--- /dev/null
+# -*-perl-*-
+# $Id: Makefile.PL,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/Makefile.PL,v $
+
+use 5.8.0;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'keitairc',
+)
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 00_required_modules.t,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/00_required_modules.t,v $
+# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+use strict;
+use warnings;
+use Test::More tests => 9;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+# check required modules
+use_ok('AppConfig');
+use_ok('Encode');
+use_ok('POE');
+use_ok('POE::Filter::HTTPD');
+use_ok('POE::Component::IRC');
+use_ok('POE::Component::Server::TCP');
+use_ok('URI::Escape');
+use_ok('HTML::Template');
+use_ok('HTTP::Response');
+exit;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 02_ClientInfo.t,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_ClientInfo.t,v $
+# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+use strict;
+use warnings;
+use Test::More tests => 52;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use HTTP::Headers;
+use HTTP::Request;
+
+BEGIN {
+ use_ok('Keitairc::ClientInfo');
+}
+
+# au
+{
+ my $header = new HTTP::Headers;
+ my $subscriber_id = '05098765432101_gd.ezweb.ne.jp';
+ $header->header(
+ 'user-agent' => 'KDDI-SN3B UP.Browser/6.2.0.13.1.5 (GUI) MMP/2.0',
+ 'x-up-subno' => $subscriber_id,
+ 'x-up-devcap-cc' => '1',
+ 'x-up-devcap-qvga' => '1',
+ 'accept' => 'application/x-kddi-ezmusic,application/x-kddi-playlist,application/x-kmcs-form-data,application/x-kddi-karrange,application/x-pobox,application/x-tar,application/x-up-download,application/x-www-form-urlencoded,application/x-kcf-license,application/x-kddi-htmlmail,application/x-kddi-drm,application/vnd.KDDI-vpimlist,application/vnd.KDDI-setsynctime,application/vnd.KDDI-verror,application/vnd.syncml+wbxml,text/x-vmessage,image/bci,text/x-vcalendar,text/vcard,application/x-kddi-kcf,application/x-kddi-auc,text/x-vnote,application/x-kddi-mcx,text/x-vcard, application/octet-stream,application/vnd.phonecom.mmc-xml,application/vnd.uplanet.bearer-choice-wbxml,application/vnd.wap.wmlc;type=4365,application/vnd.wap.xhtml+xml,application/xhtml+xml;profile="http://www.wapforum.org/xhtml",image/bmp,image/gif,image/jpeg,image/png,image/vnd.wap.wbmp,image/x-up-wpng,multipart/mixed,multipart/related,text/css,text/html,text/plain,text/vnd.wap.wml;type=4365,application/x-shockwave-flash,audio/vnd.qcelp,application/x-smaf,application/vnd.yamaha.hv-script,application/x-mpeg,video/3gpp2,audio/3gpp2,video/3gpp,audio/3gpp,text/x-hdml,*/*',
+ 'x-up-devcap-max-pdu' => '131072',
+ 'x-up-devcap-screenpixels' => '240,368',
+ 'accept-language' => 'ja-jp',
+ 'x-up-devcap-iscolor' => '1',
+ 'x-up-devcap-screendepth' => '16,RGB565',
+ 'accept-charset' => 'shift_jis,*',
+ 'x-up-devcap-multimedia' => 'A300961123302120',
+ 'via' => '1.1 wb48proxy03.ezweb.ne.jp',
+ 'x-up-devcap-screenchars' => '28,20',
+ 'x-up-devcap-softkeysize' => '6',
+ 'x-up-devcap-titlebar' => '0'
+ );
+
+ my $request = new HTTP::Request('GET', 'http://example.com', $header);
+ my $ci = new Keitairc::ClientInfo($request);
+ ok($ci, 'new Keitairc::ClientInfo (au)');
+ ok($ci->user_agent(), 'au user_agent()');
+ ok($ci->is_mobile(), 'au is_mobile()');
+ ok($ci->is_ezweb(), 'au is_ezweb()');
+ ok(!$ci->is_docomo(), 'au is_docomo()');
+ ok(!$ci->is_ipod(), 'au is_ipod()');
+ ok(!$ci->is_softbank(), 'au is_softbank()');
+ ok(!$ci->is_emobile(), 'au is_emobile()');
+ ok(!$ci->is_emobile_mobilebrowser(), 'au is_emobile_mobilebrowser()');
+ ok(!$ci->is_emobile_openbrowser(), 'au is_emobile_openbrowser()');
+ ok(!$ci->softbank_serial(), 'au softbank_serial()');
+ ok(!$ci->docomo_foma_icc(), 'au docomo_foma_icc()');
+ ok(!$ci->docomo_imodeid(), 'au docomo_imodeid()');
+ ok($ci->au_subscriber_id() eq $subscriber_id, 'au au_subscriber_id()');
+ ok(!$ci->emobile_userid(), 'au emobile_userid()');
+ ok($ci->serial_key() eq $subscriber_id, 'au serial_key()');
+ ok($ci->cookie_available(), 'au cookie_available()');
+}
+
+# NTT DoCoMo FOMA
+{
+ my $icc = 'icc9876543210234567890F';
+ my $ua = 'DoCoMo/2.0 P703imyu(c100;TB;W30H15;ser123498761234567;icc9876543210234567890F)';
+ my $imodeid = '1234567';
+ my $header = new HTTP::Headers;
+ $header->header(
+ 'user-agent' => $ua,
+ 'x_dcmguid' => $imodeid,
+ );
+
+ my $request = new HTTP::Request('GET', 'http://example.com', $header);
+ my $ci = new Keitairc::ClientInfo($request);
+ ok($ci, 'new Keitairc::ClientInfo (NTT DoCoMo FOMA)');
+ ok($ci->user_agent(), 'NTT DoCoMo FOMA user_agent()');
+ ok($ci->is_mobile(), 'NTT DoCoMo FOMA is_mobile()');
+ ok(!$ci->is_ezweb(), 'NTT DoCoMo FOMA is_ezweb()');
+ ok($ci->is_docomo(), 'NTT DoCoMo FOMA is_docomo()');
+ ok(!$ci->is_ipod(), 'NTT DoCoMo FOMA is_ipod()');
+ ok(!$ci->is_softbank(), 'NTT DoCoMo FOMA is_softbank()');
+ ok(!$ci->is_emobile(), 'NTT DoCoMo FOMA is_emobile()');
+ ok(!$ci->is_emobile_mobilebrowser(), 'NTT DoCoMo FOMA is_emobile_mobilebrowser()');
+ ok(!$ci->is_emobile_openbrowser(), 'NTT DoCoMo FOMA is_emobile_openbrowser()');
+ ok(!$ci->softbank_serial(), 'NTT DoCoMo FOMA softbank_serial()');
+ ok($ci->docomo_foma_icc() eq $icc, 'NTT DoCoMo FOMA docomo_foma_icc()');
+ ok($ci->docomo_imodeid() eq $imodeid, 'NTT DoCoMo FOMA docomo_imodeid()');
+ ok(!$ci->au_subscriber_id(), 'NTT DoCoMo FOMA au_subscriber_id()');
+ ok(!$ci->emobile_userid(), 'NTT DoCoMo FOMA emobile_userid()');
+ ok(!$ci->serial_key(), 'NTT DoCoMo FOMA serial_key()');
+ ok(!$ci->cookie_available(), 'NTT DoCoMo FOMA cookie_available()');
+}
+
+# Softbank
+{
+ my $ua = 'SoftBank/1.0/913SH/SHJ001/SN123456789012345 Browser/NetFront/3.4 Profile/MIDP-2.0 Configuration/CLDC-1.1';
+ my $serial = 'SN123456789012345';
+ my $header = new HTTP::Headers;
+ $header->header(
+ 'user-agent' => $ua,
+ );
+
+ my $request = new HTTP::Request('GET', 'http://example.com', $header);
+ my $ci = new Keitairc::ClientInfo($request);
+ ok($ci, 'new Keitairc::ClientInfo (SoftBank)');
+ ok($ci->user_agent(), 'SoftBank user_agent()');
+ ok($ci->is_mobile(), 'SoftBank is_mobile()');
+ ok(!$ci->is_ezweb(), 'SoftBank is_ezweb()');
+ ok(!$ci->is_docomo(), 'SoftBank is_docomo()');
+ ok(!$ci->is_ipod(), 'SoftBank is_ipod()');
+ ok($ci->is_softbank(), 'SoftBank is_softbank()');
+ ok(!$ci->is_emobile(), 'SoftBank is_emobile()');
+ ok(!$ci->is_emobile_mobilebrowser(), 'SoftBank is_emobile_mobilebrowser()');
+ ok(!$ci->is_emobile_openbrowser(), 'SoftBank is_emobile_openbrowser()');
+ ok($ci->softbank_serial() eq $serial, 'SoftBank softbank_serial()');
+ ok(!$ci->docomo_foma_icc(), 'SoftBank docomo_foma_icc()');
+ ok(!$ci->docomo_imodeid(), 'SoftBank docomo_imodeid()');
+ ok(!$ci->au_subscriber_id(), 'SoftBank au_subscriber_id()');
+ ok(!$ci->emobile_userid(), 'SoftBank emobile_userid()');
+ ok($ci->serial_key() eq $serial, 'SoftBank serial_key()');
+ ok($ci->cookie_available(), 'SoftBank cookie_available()');
+}
+
+# TODO: test emobile
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 02_Config.t,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Config.t,v $
+# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+use strict;
+use warnings;
+use Test::More tests => 33;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+BEGIN {
+ use_ok('Keitairc::Config');
+}
+
+use Cwd;
+use Keitairc::Log;
+
+my $version = '10.1';
+my @argv = ("$FindBin::Bin/../etc/dot.keitairc");
+my $c = new Keitairc::Config($version, @argv);
+isa_ok($c, 'AppConfig');
+ok($c->version() eq $version, 'version');
+ok($c->irc_desc() eq 'Andre Limmoenman', 'irc_desc');
+ok($c->irc_port() == 6667, 'irc_port');
+ok($c->irc_nick() eq 'adr', 'irc_nick');
+ok($c->irc_username() eq 'andre', 'irc_username');
+ok($c->irc_server() eq 'irc.example.com', 'irc_server');
+ok($c->irc_password() eq 'javel', 'irc_password');
+ok($c->irc_charset() eq 'iso-2022-jp-1', 'irc_charset');
+ok($c->web_host() eq 'your-keitairc-server.example.com', 'web_host');
+ok($c->web_port() == 8080, 'web_port');
+ok($c->web_password() eq '1234', 'web_password');
+ok($c->web_title() eq 'keitairc', 'web_title');
+ok($c->web_lines() == 100, 'web_lines');
+ok($c->web_root() eq '/', 'web_root');
+ok($c->web_charset() eq 'shiftjis', 'web_charset');
+ok($c->ping_delay() == 30, 'ping_delay');
+ok($c->reconnect_delay() == 10, 'reconnect_delay');
+ok($c->cookie_ttl() == 86400 * 3, 'cookie_ttl');
+ok($c->session_ttl() == 60 * 30, 'session_ttl');
+ok($c->pid_dir() eq '/var/run', 'pid_dir');
+ok($c->pid_file() eq 'keitairc.pid', 'pid_file');
+ok($c->plugin_dir() eq getcwd() . '/lib/plugins:/usr/share/keitairc/lib/plugins', 'plugin_dir');
+ok($c->template_dir() eq getcwd() . '/lib/templates:/usr/share/keitairc/lib/templates', 'template_dir');
+ok($c->public_dir() eq getcwd() . '/lib/public:/usr/share/keitairc/lib/public', 'public_dir');
+ok($c->reverse_message(), 'reverse_message');
+ok($c->reverse_recent(), 'reverse_recent');
+ok($c->reverse_unread(), 'reverse_unread');
+ok($c->show_joinleave(), 'show_joinleave');
+ok($c->fontsize() eq '+0', 'fontsize');
+ok($c->mobile_fontsize() == -1, 'mobile_fontsize');
+ok(!$c->debug(), 'debug');
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 02_IrcBuffer.t,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_IrcBuffer.t,v $
+# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+use strict;
+use warnings;
+use Test::More tests => 1;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+BEGIN{
+ use_ok('Keitairc::IrcBuffer');
+}
+
+# TODO: write some test
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 02_IrcCallback.t,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_IrcCallback.t,v $
+# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+use strict;
+use warnings;
+use Test::More tests => 1;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+BEGIN {
+ use_ok('Keitairc::IrcCallback');
+}
+
+# TODO: write some test
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 02_Log.t,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Log.t,v $
+# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+use strict;
+use warnings;
+use Test::More tests => 1;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+BEGIN {
+ use_ok('Keitairc::Log');
+}
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 02_Plugins.t,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Plugins.t,v $
+# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+use strict;
+use warnings;
+use Test::More tests => 5;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+BEGIN {
+ use_ok('Keitairc::Plugins');
+}
+
+use Keitairc::Config;
+use Keitairc::Log;
+
+my $cf = new Keitairc::Config('0.0',
+ (
+ '-web_host', 'example.com',
+ '-irc_nick', 'foo',
+ '-irc_username', 'foo',
+ '-irc_server', 'example.com',
+ '-web_password', 'foo',
+ '-plugin_dir', "$FindBin::Bin/02_Plugins"
+ ));
+my $pl = new Keitairc::Plugins({config => $cf});
+ok($pl, 'new Keitairc::Plugins');
+
+ok(array_eq($pl->list_plugins(),
+ qw/unread index topic recent mail foo bar/),
+ 'list_plugins()');
+ok(array_eq($pl->list_replace_plugins(),
+ qw/mail foo bar/),
+ 'list_replace_plugins()');
+ok(array_eq($pl->list_action_plugins(),
+ qw/unread index topic recent mail foo bar/),
+ 'list_action_plugins()');
+
+sub array_eq{
+ if(@_ % 2){
+ return 0;
+ }
+
+ for(my($a, $b) = (0, @_/2); $a < @_/2; $a++, $b++){
+ return 0 unless $_[$a] eq $_[$b];
+ }
+ 1;
+}
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 00unread,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Plugins/00unread,v $
+
+# WARNING: This file is a part of Keitairc::Plugins test suite, not
+# actual working code.
+
+$plugin = {
+ name => 'unread',
+ action_imprementation => sub {
+ my ($request, $name, $session_id, $param_string) = @_;
+ my $cid = $param_string;
+ my $channel = $::ib->cid2name($cid);
+
+ ::send_message($request, $channel);
+
+ my $buf;
+ if(defined($::ib->cid2name($cid))){
+ if(defined($::ib->buffer($cid))){
+ $buf = ::render_line($::ib->unread($cid), $session_id, $::cf->reverse_unread);
+ }
+ }
+
+ $::ib->message_added(0); # clear check flags
+ $::ib->clear_unread($cid);
+
+ my $ci = new Keitairc::ClientInfo($request);
+ my $view = new Keitairc::View($::cf, $ci);
+ return $view->render('unread.html', {
+ buf => $buf,
+ channel_compact => $::ib->simple_escape(encode($::cf->web_charset(), $::ib->compact_channel_name($cid))),
+ cid => $cid,
+ stamp => time,
+ });
+ }
+};
+
+1;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 01index,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Plugins/01index,v $
+
+# WARNING: This file is a part of Keitairc::Plugins test suite, not
+# actual working code.
+
+$plugin = {
+ name => 'index',
+ action_imprementation => sub {
+ my ($request, $name, $session_id, $param_string) = @_;
+
+ ::send_message($request);
+
+ my $unread_channels = 0;
+ my $accesskey = 1;
+
+ my $format_mtime = sub{
+ use encoding 'utf8';
+ my $mtime = shift;
+ return if($mtime <= 0);
+ my $timediff = time - $mtime;
+ if($timediff < 60){
+ return $timediff . '秒';
+ }
+ if($timediff < 3600){
+ return int($timediff/60) . '分';
+ }
+ if($timediff < 86400){
+ return int($timediff/3600) . '時間';
+ }
+ if($timediff < 86400 * 30){
+ return int($timediff/86400) . '日';
+ }
+ if($timediff < 86400 * 365){
+ return int($timediff/86400/30) . 'ヶ月';
+ }
+ return int($timediff/86400/365) . '年';
+ no encoding 'utf8';
+ };
+
+ my @loop;
+ for my $cid ($::ib->channels()){
+ my $p = {};
+ my $channel = $::ib->cid2name($cid);
+ my $cname = $::ib->simple_escape(encode($::cf->web_charset(), $::ib->compact_channel_name($cid)));
+ if($accesskey < 10){
+ $p->{link} =
+ sprintf('<a accesskey="%1d" href="all/%d">[%1d] %s</a>',
+ $accesskey,
+ $cid,
+ $accesskey,
+ $cname);
+ }else{
+ $p->{link} =
+ sprintf('<a href="all/%d"> %s</a>',
+ $cid, $cname);
+ }
+ $accesskey++;
+
+ # 未読行数
+ if($::ib->unread_lines($cid)){
+ $p->{unread} =
+ sprintf(' <a href="unread/%d">%s</a>',
+ $cid,
+ $::ib->unread_lines($cid));
+ $unread_channels++;
+ }
+
+ $p->{mtime} = Encode::encode($::cf->web_charset(), $format_mtime->($::ib->mtime($cid)));
+ push @loop, $p;
+ }
+
+ my $ci = new Keitairc::ClientInfo($request);
+ my $view = new Keitairc::View($::cf, $ci);
+ return $view->render('index.html',
+ {
+ loop => \@loop,
+ unread => $unread_channels,
+ });
+ }
+};
+
+1;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 02topic,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Plugins/02topic,v $
+
+# WARNING: This file is a part of Keitairc::Plugins test suite, not
+# actual working code.
+
+$plugin = {
+ name => 'topic',
+ action_imprementation => sub {
+ use encoding 'utf8';
+ my ($request, $name, $session_id, $param_string) = @_;
+ my $buf;
+
+ for my $cid ($::ib->channels()){
+ my $channel = $::ib->cid2name($cid);
+ $buf .= sprintf(' <a href="all/%d">%s</a><br />',
+ $cid,
+ $::ib->simple_escape($::ib->compact_channel_name($cid)));
+ my $topic = $::ib->simple_escape(Encode::decode($::cf->irc_charset(), $::ib->topic($cid)));
+ if(!defined($topic) || !length($topic)){
+ $topic = '(ﾄﾋﾟｯｸ未設定)';
+ }
+ $buf .= $topic;
+ $buf .= "<br />\n";
+ }
+
+ $buf = Encode::encode($::cf->web_charset(), $buf);
+ my $ci = new Keitairc::ClientInfo($request);
+ my $view = new Keitairc::View($::cf, $ci);
+ return $view->render('topic.html', { buf => $buf });
+ no encoding 'utf8';
+ }
+};
+
+1;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 03recent,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Plugins/03recent,v $
+
+# WARNING: This file is a part of Keitairc::Plugins test suite, not
+# actual working code.
+
+$plugin = {
+ name => 'recent',
+ action_imprementation => sub {
+ my ($request, $name, $session_id, $param_string) = @_;
+ my $buf;
+
+ for my $cid ($::ib->channels()){
+ my $channel = $::ib->cid2name($cid);
+ if($::ib->unread_lines($cid)){
+ my $name = $::ib->cid2name($cid);
+ Encode::from_to($name, $::cf->irc_charset(), $::cf->web_charset());
+ $buf .= sprintf(' <a href="all/%d">%s</a><br />', $cid, $name);
+ $buf .= ::render_line($::ib->unread($cid), $session_id, $::cf->reverse_recent);
+ $buf .= "<hr />\n";
+ $::ib->clear_unread($cid);
+ }
+ }
+
+ my $ci = new Keitairc::ClientInfo($request);
+ my $view = new Keitairc::View($::cf, $ci);
+ return $view->render('recent.html', { buf => $buf });
+ }
+};
+
+1;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 20mail,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Plugins/20mail,v $
+
+# WARNING: This file is a part of Keitairc::Plugins test suite, not
+# actual working code.
+
+$plugin = {
+ name => 'mail',
+
+ message_replace_regexp => '\b(\w[\w.+=-]*\@[\w.-]+[\w]\.[\w]{2,4})\b',
+ message_replace_imprementation => sub {
+ my ($session_id, $param) = @_;
+ sprintf('<a href="%s%s/mail/%s">%s</a>',
+ $::cf->web_root(), $session_id, $param, $param);
+ },
+
+ action_imprementation => sub {
+ my ($request, $name, $session_id, $param_string) = @_;
+ my $ci = new Keitairc::ClientInfo($request);
+ my $view = new Keitairc::View($::cf, $ci);
+ return $view->render('mail.html', {
+ session_id => $session_id,
+ mail => $param_string,
+ });
+ }
+};
+
+1;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 21foo,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Plugins/21foo,v $
+
+# WARNING: This file is a part of Keitairc::Plugins test suite, not
+# actual working code.
+
+$plugin = {
+ name => 'foo',
+
+ message_replace_regexp => '\b(\w[\w.+=-]*\@[\w.-]+[\w]\.[\w]{2,4})\b',
+ message_replace_imprementation => sub {
+ my ($session_id, $param) = @_;
+ sprintf('<a href="%s%s/mail/%s">%s</a>',
+ $::cf->web_root(), $session_id, $param, $param);
+ },
+
+ action_imprementation => sub {
+ my ($request, $name, $session_id, $param_string) = @_;
+ my $ci = new Keitairc::ClientInfo($request);
+ my $view = new Keitairc::View($::cf, $ci);
+ return $view->render('mail.html', {
+ session_id => $session_id,
+ mail => $param_string,
+ });
+ }
+};
+
+1;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 22bar,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_Plugins/22bar,v $
+
+# WARNING: This file is a part of Keitairc::Plugins test suite, not
+# actual working code.
+
+$plugin = {
+ name => 'bar',
+
+ message_replace_regexp => '\b(\w[\w.+=-]*\@[\w.-]+[\w]\.[\w]{2,4})\b',
+ message_replace_imprementation => sub {
+ my ($session_id, $param) = @_;
+ sprintf('<a href="%s%s/mail/%s">%s</a>',
+ $::cf->web_root(), $session_id, $param, $param);
+ },
+
+ action_imprementation => sub {
+ my ($request, $name, $session_id, $param_string) = @_;
+ my $ci = new Keitairc::ClientInfo($request);
+ my $view = new Keitairc::View($::cf, $ci);
+ return $view->render('mail.html', {
+ session_id => $session_id,
+ mail => $param_string,
+ });
+ }
+};
+
+1;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 02_SessionManager.t,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_SessionManager.t,v $
+# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+use strict;
+use warnings;
+use Data::Dumper;
+use Test::More tests => 31;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+BEGIN{
+ use_ok('Keitairc::SessionManager');
+}
+
+# every serial strings are fictitious
+my $foma_ua = 'DoCoMo/2.0 P703imyu(c100;TB;W30H15)';
+my $foma_ua_icc = 'DoCoMo/2.0 P703imyu(c100;TB;W30H15;ser123498761234567;icc9876543210234567890F)';
+my $foma_icc = 'icc9876543210234567890F';
+
+my $softbank_ua_serial = 'SoftBank/1.0/913SH/SHJ001/SN123456789012345 Browser/NetFront/3.4 Profile/MIDP-2.0 Configuration/CLDC-1.1';
+my $softbank_serial = 'SN123456789012345';
+my $softbank_ua = 'SoftBank/1.0/913SH/SHJ001/ Browser/NetFront/3.4 Profile/MIDP-2.0 Configuration/CLDC-1.1';
+
+use Keitairc::Log;
+
+{
+ # create new session manager
+ my $sm = new Keitairc::SessionManager;
+ ok($sm, 'SessionManager created');
+}
+
+{
+ # create new session manager /w default_ttl
+ my $sm = new Keitairc::SessionManager({default_ttl => 3});
+ ok($sm->{default_ttl} == 3, 'SessionManager created with default ttl');
+}
+
+my $sm = new Keitairc::SessionManager;
+my $s1;
+
+{
+ # add new session to session manager (NTT DoCoMo FOMA)
+ my $s = $sm->add($foma_ua);
+ ok($s, 'new session added');
+ ok($s->{last_access_time}, 'session has last_access_time');
+ ok(! defined $s->{serial_key}, 'session does not have serial_key');
+ ok($s->{user_agent} eq $foma_ua, 'session has user agent');
+ ok($s->{ttl}, 'session has ttl');
+ ok($s->{id} =~ /S[a-zA-Z]{10}/, 'session has valid session_id');
+ $s1 = $s->{id};
+}
+
+my $s2;
+my $timestamp2;
+
+{
+ # add new session to session manager (NTT DoCoMo FOMA /w ser/icc)
+ my $s = $sm->add($foma_ua_icc, $foma_icc);
+ ok($s, 'new session added');
+ ok($s->{last_access_time}, 'session has last_access_time');
+ ok($s->{serial_key} eq $foma_icc, 'session has serial_key');
+ ok($s->{user_agent} eq $foma_ua, 'session has user agent (serial removed)');
+ ok($s->{ttl}, 'session has ttl');
+ ok($s->{id} =~ /S[a-zA-Z]{10}/, 'session has valid session_id');
+ $s2 = $s->{id};
+ $timestamp2 = $s->{last_access_time};
+}
+
+my $s3;
+
+{
+ # add new session to session manager (SoftBank)
+ my $s = $sm->add($softbank_ua_serial, $softbank_serial);
+ ok($s, 'new session added');
+ ok($s->{last_access_time}, 'session has last_access_time');
+ ok($s->{serial_key} eq $softbank_serial, 'session has serial_key');
+ ok($s->{user_agent} eq $softbank_ua, 'session has user agent (serial removed)');
+ ok($s->{ttl}, 'session has ttl');
+ ok($s->{id} =~ /S[a-zA-Z]{10}/, 'session has valid session_id');
+ $s3 = $s->{id};
+}
+
+my $sid1;
+my $sid2;
+my $sid3;
+
+{
+ my $s;
+ $s = $sm->search_by_session_id($s1, $foma_ua);
+ ok($s, 'search_by_session_id');
+ $sid1 = $s->{id};
+ $s = $sm->search_by_session_id($s2, $foma_ua);
+ ok($s, 'search_by_session_id');
+ $sid2 = $s->{id};
+ $s = $sm->search_by_session_id($s3, $softbank_ua);
+ ok($s, 'search_by_session_id');
+ $sid3 = $s->{id};
+}
+
+{
+ my $s;
+ $s = $sm->search_by_serial_key($foma_icc, $foma_ua);
+ ok($s->{id} eq $sid2, 'search_by_serial_key');
+ $s = $sm->search_by_serial_key($softbank_serial, $softbank_ua);
+ ok($s->{id} eq $sid3, 'search_by_serial_key');
+}
+
+{
+ my $s;
+ $s = $sm->delete($sid1);
+ $s = $sm->search_by_session_id($sid1, $foma_ua);
+ ok(! defined $s, 'deleted session has vanished');
+}
+
+{
+ my $s;
+ sleep(1); # timestamp should be incremented
+ $s = $sm->verify({session_id => $sid2, user_agent => $foma_ua});
+ ok($s, 'verify()');
+ ok($timestamp2 < $s->{last_access_time}, 'verify() refreshed timestamp');
+
+ $s = $sm->verify({session_id => $sid2, user_agent => $softbank_ua});
+ ok(! defined $s, 'verify() reasonably failed');
+
+ $s = $sm->verify({session_id => $sid1, user_agent => $foma_ua});
+ ok(! defined $s, 'verify() reasonably failed');
+}
+
+exit;
--- /dev/null
+# -*- mode: perl; coding: utf-8 -*-
+# $Id: 02_View.t,v 1.1 2008-08-02 18:35:54 morimoto Exp $
+# $Source: /home/ishikawa/work/keitairc/tmp/keitairc/t/02_View.t,v $
+# Copyright (c) 2003-2008 Jun Morimoto <morimoto@mrmt.net>
+# This program is covered by the GNU General Public License 2
+use strict;
+use warnings;
+use Test::More tests => 1;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+BEGIN {
+ use_ok('Keitairc::View');
+}
+
+# TODO: write some test
OSDN Git Service
