root/lang/perl/misc/bot-kouen-debyu.pl @ 29074

Revision 8953, 5.6 kB (checked in by drry, 7 years ago)

lang/ruby/path_observer/trunk/lib/path_observer/observe_manager.rb
lang/ruby/path_observer/trunk/lib/path_observer/observer.rb
lang/ruby/path_observer/trunk/README
lang/ruby/date_time-duration/lib/date_time/duration.rb
lang/ruby/osxhotkey/README
lang/lua/bluasxom/lib/List.lua
lang/perl/Catalyst-Controller-AllowDisable?/trunk/lib/Catalyst/Controller/AllowDisable.pm
lang/perl/Catalyst-Controller-AllowDisable?/trunk/Makefile.PL
lang/perl/Catalyst-Controller-AllowDisable?/trunk/README
lang/perl/Catalyst-Helper-Lighty/trunk/LISENCE
lang/perl/Catalyst-Helper-Lighty/trunk/LICENSE
lang/perl/Catalyst-Helper-Lighty/trunk/MANIFEST
lang/perl/Catalyst-Plugin-FormValidator?-Lazy/trunk/lib/Catalyst/Plugin/FormValidator/Lazy.pm
lang/perl/Catalyst-Plugin-Log-Colorful/trunk/lib/Catalyst/Plugin/Log/Colorful.pm
lang/perl/WebService-Simple/trunk/lib/WebService/Simple.pm
lang/perl/WebService-Simple/trunk/lib/WebService/Simple/Response.pm
lang/perl/misc/bot-kouen-debyu.pl
lang/perl/misc/google_code_search.pl
lang/perl/misc/hatena-keyword.pl
lang/perl/Sledge-Plugin-FormValidator?-Lazy/trunk/lib/Sledge/Plugin/FormValidator/Lazy.pm
lang/perl/Net-OAuth-Consumer/trunk/lib/Net/OAuth/Consumer.pm
lang/perl/Net-Twitter-FriendFinder?/trunk/lib/Net/Twitter/FriendFinder/From/TwitterKensaku.pm
lang/perl/Net-Twitter-FriendFinder?/trunk/lib/Net/Twitter/FriendFinder/From/TwitterDiff.pm
lang/perl/Net-Twitter-FriendFinder?/trunk/lib/Net/Twitter/FriendFinder/From/Google.pm
lang/perl/Net-Twitter-FriendFinder?/trunk/lib/Net/Twitter/FriendFinder/From/Twitter.pm
lang/perl/Net-Twitter-FriendFinder?/trunk/lib/Net/Twitter/FriendFinder/From/URL.pm
lang/perl/Net-Twitter-FriendFinder?/trunk/lib/Net/Twitter/FriendFinder.pm
lang/perl/Data-LazyACL/trunk/lib/Data/LazyACL.pm
lang/perl/Data-LazyACL/trunk/README
lang/perl/Iterator-Simple/trunk/lib/Iterator/Simple.pm
lang/perl/WWW-Stickam-API/trunk/lib/WWW/Stickam/API.pm
lang/perl/WWW-Stickam-API/trunk/lib/WWW/Stickam/API/Media/Information.pm
lang/perl/WWW-Stickam-API/trunk/lib/WWW/Stickam/API/Search/User.pm
lang/perl/WWW-Stickam-API/trunk/lib/WWW/Stickam/API/Search/Media.pm
lang/perl/WWW-Stickam-API/trunk/lib/WWW/Stickam/API/Base.pm
lang/perl/WWW-Stickam-API/trunk/lib/WWW/Stickam/API/User/Video.pm
lang/perl/WWW-Stickam-API/trunk/lib/WWW/Stickam/API/User/Profile.pm
lang/perl/WWW-Stickam-API/trunk/lib/WWW/Stickam/API/User/Audio.pm
lang/perl/WWW-Stickam-API/trunk/lib/WWW/Stickam/API/User/Image.pm
lang/perl/Bundle-Porn/trunk/lib/Bundle/Porn.pm
lang/perl/Bundle-Porn/trunk/Makefile.PL
lang/perl/App-Starter/trunk/lib/App/Starter.pm
lang/perl/App-Starter/trunk/bin/app-starter.pl
lang/perl/App-Starter/trunk/bin/app-starter-catalyst.pl
lang/perl/Chaostr/trunk/lib/Chaostr/ValidateEm/Plugin/String.pm
lang/perl/Chaostr/trunk/lib/Catalyst/Plugin/FormValidateEm.pm
lang/perl/Chaostr/trunk/extlib
lang/perl/Acme-PSON/trunk/lib/Acme/PSON.pm
lang/perl/Acme-DRYCopyPaste/trunk/lib/Acme/DRYCopyPaste.pm
lang/perl/OAuth-Lite/trunk/lib/OAuth/Lite/Util.pm
lang/perl/MozRepl/trunk/lib/MozRepl/Plugin/JSON.pm
lang/perl/FormValidator-LazyWay?/trunk/lib/FormValidator/LazyWay/Plugin.pm
lang/perl/FormValidator-LazyWay?/trunk/lib/FormValidator/LazyWay/Results.pm
lang/perl/FormValidator-LazyWay?/trunk/lib/FormValidator/LazyWay.pm:

  • SYNOPSIS
Line 
1#!/usr/bin/perl
2
3
4use strict;
5use warnings;
6use POE qw(Sugar::Args Component::IRC);
7use Class::Inspector;
8use IO::All;
9use Getopt::Long;
10use DateTime;
11use List::MoreUtils;
12
13my $channel  = '#test';
14my $datafile = '/tmp/kouen.dat';
15my $nick     = 'kouen_mama';
16my $server   = 'localhost';
17my $port     = 6667;
18my $interval = 5;
19
20my $CMD_START = "公園デビューします";
21my $CMD_OTOMODACHI = "公園のお友達は誰";
22
23my $conf = {
24    status => 'sleep'
25};
26
27my $result
28    = GetOptions (
29        "channel=s"  => \$channel,
30        "datafile=s" => \$datafile,
31        "nick=s"     => \$nick,
32        "server=s"   => \$server,
33        "port=i"     => \$port,
34        "interval=i" => \$interval,
35    );
36
37
38POE::Component::IRC->spawn(
39    alias  => 'bot',
40    nick   => $nick,
41    server => $server,
42    port   => $port,
43);
44
45POE::Session->create(
46    package_states => [ main => Class::Inspector->methods('main') ],
47    args           => \@ARGV,
48);
49
50POE::Kernel->sig(INT => sub { POE::Kernel->stop });
51POE::Kernel->run;
52
53
54sub _start {
55    my $poe = sweet_args;
56    $poe->kernel->post(bot => register => 'all');
57    $poe->kernel->post(bot => connect  => {});
58}
59sub irc_001 {
60    my $poe = sweet_args;
61    $poe->kernel->post($poe->sender => join => $channel);
62}
63sub irc_public {
64    my $poe      = sweet_args;
65    my ($who )  = split('!' , $poe->args->[0] );
66    my $what     = $poe->args->[2] ;
67
68
69    # 公園デビュー開始最低条件
70    if( $CMD_START eq $what && $conf->{status} eq 'sleep' ) {
71
72        my $io = io( $datafile );
73        my @_otomodachis = ();
74
75        my $str_otomodaches = '';
76        while( my $line = $io->getline ) {
77            chomp $line;
78            my $name = $line;
79            $str_otomodaches .= ' ' . $name ;
80            push ( @_otomodachis , $name );
81        }
82
83
84        if( scalar @_otomodachis == 0 || List::MoreUtils::none { $who eq $_ } @_otomodachis ) {
85            $conf->{status} = 'introducing';
86            $conf->{til}    = time + (60* $interval );
87            $conf->{otomodachis} = \@_otomodachis;
88            $conf->{new_otomodachi} = $who ;
89            $poe->kernel->post( $poe->sender => notice => $channel =>  $who . 'さんが公園デビューをするよ!お友達集まって!' . $str_otomodaches );
90        }
91        else {
92            # 既にデビューしてるよ。
93            $poe->kernel->post( $poe->sender => notice => $channel =>  $who . 'さんはすでに公園デビューしたお友達だよねー' );
94        }
95    }
96    if( $conf->{status} eq 'introducing' ) {
97        # 終わり処理
98        if( $conf->{til} < time ) {
99            $poe->kernel->post( $poe->sender => notice => $channel => $conf->{new_otomodachi} . 'さんがデビューできたよ!みんな仲良くしようね。' );
100
101            # 登録処理、初期化処理
102            io($datafile)->append($conf->{new_otomodachi} . "\n");
103            $conf = { status => 'sleep' };
104        }
105        else {
106
107            # 自分で発言
108            if( $conf->{new_otomodachi} eq $who ) {
109                    $poe->kernel->post( $poe->sender => notice => $channel => $conf->{new_otomodachi} . 'さん、その調子!いい感じだわ。' );
110            }
111            # お友達が発言
112            else {
113                my $reg =  $conf->{new_otomodachi} ;
114                # TODO RANDOM
115                # 愛情のある発言
116                if( $what =~ /$reg/ ) {
117                    $poe->kernel->post( $poe->sender => notice => $channel => 'そうそう仲良くしようね。'. $who . 'さん偉いねー。' );
118                }
119                # 愛情のない発言
120                else {
121                    $poe->kernel->post( $poe->sender => notice => $channel => $who . 'さん、' . $conf->{new_otomodachi} .'ちゃんに話しかけてあげてね。' );
122                }
123            }
124
125        }
126
127    }
128
129}
130
131
1321;
133
134=head1 NAME
135
136bot-kouen-debyu.pl - IRC公園デビューボット
137
138=head1 DESCRIPTION
139
140公園デビューを愛情をもって見守るボット。お友達の皆さんも、デビューの人には仲良くしてあげてくださいね。
141
142=head1 SYNOPSIS
143
144 perl bot-kouen-debyu.pl --interval=5 --server='irc.freenode.net' --channel='#CodeRepos' --nick='kouen_mama' --datafile='/tmp/bot-kouen.dat'
145
146=head1 機能
147
148=head2 「公園デビューします!」機能
149
150公園デビューします!と、デビューがまだの人が発言すると、ボットさんが、愛情をもって見守り始めます。
151具体的には、5分間の間、他の人が「@デビューしている人のnick 」をつけて発言しないと、怒ります。また、デビューしている人が発言すると、愛情を持って応援して上げます。 5分経ったら、デビュー終了処理をします。(イベントの発生は発言なので、実際には5分たった後に初めて発言した人の時に終了処理をします。)
152
153=head1 TODO
154
155=head2 公園デビューした時のログを確認できる、「公園デビュー走馬灯 @nick」コマンド(仮案)
156
157=head2 公園デビューやり直し機能。
158
159発言数が少なかったり、お友達があまりその時にいなかった時は、公園デビュー失敗にする
160
161=head2 例外処理
162
163何もしてない。途中で抜けたときとか。
164
165=head1 作成動機
166
167初めての部屋で発言しようとするとき、公園デビューを見守ってくれる、ママが欲しいと思ったから。また、DISられたい、添削されたい、修正されたいから。
168
169 19:41 (shunirr) さっきjoinしたから今まさにドキドキしてる
170 19:42 (Yappo) 公園デビューてきなものか
171
172=head1 AUTHOR
173
174 Yet Another Newbie tomyhero
175
176=cut
Note: See TracBrowser for help on using the browser.