root/lang/perl/mobirc/trunk/mobirc/lib/Mobirc/IRCClient.pm @ 906

Revision 906, 7.3 kB (checked in by tokuhirom, 6 years ago)

lang/perl/mobirc: oops... $message is already decoded. orz.

Line 
1package Mobirc::IRCClient;
2use strict;
3use warnings;
4
5use POE;
6use POE::Sugar::Args;
7use POE::Component::IRC;
8
9use Encode;
10use Carp;
11
12use Mobirc::Util;
13
14sub init {
15    my ($class, $config) = @_;
16
17    # irc component
18    my $irc = POE::Component::IRC->spawn(
19        Alias    => 'mobirc_irc',
20        Nick     => $config->{irc}->{nick},
21        Username => $config->{irc}->{username},
22        Ircname  => $config->{irc}->{desc},
23        Server   => $config->{irc}->{server},
24        Port     => $config->{irc}->{port},
25        Password => $config->{irc}->{password}
26    );
27
28    POE::Session->create(
29        heap => {
30            seen_traffic   => false,
31            disconnect_msg => true,
32            channel_topic  => {},
33            channel_name   => {},
34            config         => $config,
35            irc            => $irc,
36        },
37        inline_states => {
38            _start           => \&on_irc_start,
39            _default         => \&on_irc_default,
40
41            irc_001          => \&on_irc_001,
42            irc_join         => \&on_irc_join,
43            irc_part         => \&on_irc_part,
44            irc_public       => \&on_irc_public,
45            irc_notice       => \&on_irc_notice,
46            irc_topic        => \&on_irc_topic,
47            irc_332          => \&on_irc_topicraw,
48            irc_ctcp_action  => \&on_irc_ctcp_action,
49            irc_kick         => \&on_irc_kick,
50            irc_snotice      => \&on_irc_snotice,
51
52            autoping         => \&do_autoping,
53            connect          => \&do_connect,
54
55            irc_disconnected => \&on_irc_reconnect,
56            irc_error        => \&on_irc_reconnect,
57            irc_socketerr    => \&on_irc_reconnect,
58        }
59    );
60}
61
62# -------------------------------------------------------------------------
63
64sub on_irc_default {
65    DEBUG "ignore unknown event: $_[ARG0]";
66}
67
68sub on_irc_start {
69    my $poe = sweet_args;
70    DEBUG "START";
71
72    $poe->kernel->alias_set('irc_session');
73
74    DEBUG "input charset is: " . $poe->heap->{config}->{irc}->{incode};
75
76    $poe->heap->{irc}->yield( register => 'all' );
77    $poe->heap->{irc}->yield( connect  => {} );
78}
79
80sub on_irc_001 {
81    my $poe = sweet_args;
82
83    DEBUG "CONNECTED";
84
85    add_message( $poe,
86        decode( 'utf8', '*server*' ),
87        undef, decode('utf8', 'Connected to irc server!'), 'connect' );
88
89    $poe->heap->{disconnect_msg} = true;
90    $poe->heap->{channel_name} = {'*server*' => '*server*'};
91    $poe->kernel->delay( autoping => $poe->heap->{config}->{ping_delay} );
92}
93
94sub on_irc_join {
95    my $poe = sweet_args;
96
97    DEBUG "JOIN";
98
99    my ($who, $channel) = _get_args($poe);
100
101    $who =~ s/!.*//;
102
103    # chop off after the gap (bug workaround of madoka)
104    $channel =~ s/ .*//;
105
106    my $canon_channel = canon_name($channel);
107
108    $poe->heap->{channel_name}->{$canon_channel} = $channel;
109    my $irc = $poe->heap->{irc};
110    unless ( $who eq $irc->nick_name ) {
111        add_message(
112            $poe,
113            $channel,
114            undef,
115            "$who joined",
116            'join',
117        );
118    }
119    $poe->heap->{seen_traffic}   = true;
120    $poe->heap->{disconnect_msg} = true;
121}
122
123sub on_irc_part {
124    my $poe = sweet_args;
125
126    my ($who, $channel, $msg) = _get_args($poe);
127
128    $who =~ s/!.*//;
129
130    # chop off after the gap (bug workaround of POE::Filter::IRC)
131    $channel =~ s/ .*//;
132
133    my $canon_channel = canon_name($channel);
134
135    my $irc = $poe->heap->{irc};
136    if ( $who eq $irc->nick_name ) {
137        delete $poe->heap->{channel_name}->{$canon_channel};
138    }
139    else {
140        my $message = "$who leaves";
141        if ($msg) {
142            $message .= "($msg)";
143        }
144
145        add_message(
146            $poe,
147            $channel,
148            undef,
149            $message,
150            'leave',
151        );
152    }
153    $poe->heap->{seen_traffic}   = true;
154    $poe->heap->{disconnect_msg} = true;
155}
156
157sub on_irc_public {
158    my $poe = sweet_args;
159
160    DEBUG "IRC PUBLIC";
161
162    my ($who, $channel, $msg) = _get_args($poe);
163
164    $who =~ s/!.*//;
165
166    $channel = $channel->[0];
167
168    add_message(
169        $poe, $channel,
170        $who, $msg,
171        'public',
172    );
173
174    $poe->heap->{seen_traffic}   = true;
175    $poe->heap->{disconnect_msg} = true;
176}
177
178sub on_irc_notice {
179    my $poe = sweet_args;
180
181    my ($who, $channel, $msg) = _get_args($poe);
182
183    DEBUG "IRC NOTICE";
184
185    $who =~ s/!.*//;
186    $channel = $channel->[0];
187
188    add_message(
189        $poe, $channel,
190        $who, $msg,
191        'notice',
192    );
193    $poe->heap->{seen_traffic}   = true;
194    $poe->heap->{disconnect_msg} = true;
195}
196
197sub on_irc_topic {
198    my $poe = sweet_args;
199
200    my ($who, $channel, $topic) = _get_args($poe);
201
202    $who =~ s/!.*//;
203
204    DEBUG "SET TOPIC";
205
206    add_message( $poe,
207        $channel,
208        undef, "$who set topic: $topic",
209        'topic',
210        );
211
212    $poe->heap->{channel_topic}->{canon_name($channel)} = $topic;
213
214    $poe->heap->{seen_traffic}                  = true;
215    $poe->heap->{disconnect_msg}                = true;
216}
217
218sub on_irc_topicraw {
219    my $poe = sweet_args;
220
221    DEBUG "SET TOPIC RAW";
222
223    my ($w, $raw) = _get_args($poe);
224
225    my ( $channel, $topic ) = split( / :/, $raw, 2 );
226
227    $poe->heap->{channel_topic}->{ canon_name($channel) } = $topic;
228    $poe->heap->{seen_traffic}                  = true;
229    $poe->heap->{disconnect_msg}                = true;
230}
231
232sub on_irc_ctcp_action {
233    my $poe = sweet_args;
234
235    my ($who, $channel, $msg) = _get_args($poe);
236
237    $who =~ s/!.*//;
238    $channel = $channel->[0];
239    $msg = sprintf( '* %s %s', $who, $msg );
240
241    add_message( $poe, $channel, '', $msg, 'ctcp_action', );
242
243    $poe->heap->{seen_traffic}   = true;
244    $poe->heap->{disconnect_msg} = true;
245}
246
247sub on_irc_kick {
248    my $poe = sweet_args;
249
250    DEBUG "DNBKICK";
251
252    my ($kicker, $channel, $kickee, $msg) = _get_args($poe);
253    $msg ||= 'Flooder';
254
255    $kicker =~ s/!.*//;
256
257    add_message(
258        $poe, $channel, '', "$kicker has kicked $kickee($msg)", 'kick'
259    );
260    $poe->heap->{seen_traffic}   = true;
261    $poe->heap->{disconnect_msg} = true;
262}
263
264sub do_connect {
265    my $poe = sweet_args;
266
267    $poe->heap->{irc}->yield( connect => {} );
268}
269
270sub do_autoping {
271    my $poe = sweet_args;
272
273    $poe->kernel->post( mobirc_irc => time ) unless $poe->heap->{seen_traffic};
274    $poe->heap->{seen_traffic} = false;
275    $poe->kernel->delay( autoping => $poe->heap->{config}->{ping_delay} );
276}
277
278sub on_irc_snotice {
279    my $poe = sweet_args;
280
281    my ($message, ) = _get_args($poe);
282
283    DEBUG "getting snotice : $message";
284
285    add_message(
286        $poe,
287        decode( 'utf8', '*server*' ),
288        undef,
289        $message,
290        'snotice',
291    );
292}
293
294sub on_irc_reconnect {
295    my $poe = sweet_args;
296
297    if ( $poe->heap->{disconnect_msg} ) {
298        add_message(
299            $poe,
300            decode( 'utf8', '*server*' ),
301            undef,
302            decode( 'utf8', 'Disconnected from irc server, trying to reconnect...'),
303            'reconnect',
304        );
305    }
306    $poe->heap->{disconnect_msg} = false;
307    $poe->kernel->delay( connect => $poe->heap->{config}->{reconnect_delay} );
308}
309
310# FIXME: I want more cool implement
311sub _get_args {
312    my $poe = shift;
313
314    my @ret;
315    for my $elem (@{$poe->args}) {
316        if ( ref $elem && ref $elem eq 'ARRAY') {
317            push @ret, [map { decode($poe->heap->{config}->{irc}->{incode}, $_) } @$elem];
318        } else {
319            push @ret, decode($poe->heap->{config}->{irc}->{incode}, $elem);
320        }
321    }
322    return @ret;
323}
324
3251;
Note: See TracBrowser for help on using the browser.