line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package POE::Component::IRC::Plugin::MegaHAL; |
2
|
|
|
|
|
|
|
BEGIN { |
3
|
2
|
|
|
2
|
|
479424
|
$POE::Component::IRC::Plugin::MegaHAL::AUTHORITY = 'cpan:HINRIK'; |
4
|
|
|
|
|
|
|
} |
5
|
|
|
|
|
|
|
{ |
6
|
|
|
|
|
|
|
$POE::Component::IRC::Plugin::MegaHAL::VERSION = '0.46'; |
7
|
|
|
|
|
|
|
} |
8
|
|
|
|
|
|
|
|
9
|
2
|
|
|
2
|
|
22
|
use strict; |
|
2
|
|
|
|
|
6
|
|
|
2
|
|
|
|
|
86
|
|
10
|
2
|
|
|
2
|
|
14
|
use warnings FATAL => 'all'; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
267
|
|
11
|
2
|
|
|
2
|
|
13
|
use Carp; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
195
|
|
12
|
2
|
|
|
2
|
|
1231
|
use Encode qw(decode_utf8 encode_utf8 is_utf8); |
|
2
|
|
|
|
|
12867
|
|
|
2
|
|
|
|
|
205
|
|
13
|
2
|
|
|
2
|
|
1041
|
use IRC::Utils qw(lc_irc matches_mask_array decode_irc strip_color strip_formatting); |
|
2
|
|
|
|
|
9540
|
|
|
2
|
|
|
|
|
258
|
|
14
|
2
|
|
|
2
|
|
18
|
use List::Util qw(first); |
|
2
|
|
|
|
|
5
|
|
|
2
|
|
|
|
|
269
|
|
15
|
2
|
|
|
2
|
|
1113
|
use POE; |
|
2
|
|
|
|
|
54101
|
|
|
2
|
|
|
|
|
18
|
|
16
|
2
|
|
|
2
|
|
117383
|
use POE::Component::AI::MegaHAL; |
|
2
|
|
|
|
|
84334
|
|
|
2
|
|
|
|
|
76
|
|
17
|
2
|
|
|
2
|
|
1200
|
use POE::Component::IRC::Plugin qw(PCI_EAT_NONE); |
|
2
|
|
|
|
|
500
|
|
|
2
|
|
|
|
|
5599
|
|
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
sub new { |
20
|
1
|
|
|
1
|
1
|
7613
|
my ($package, %args) = @_; |
21
|
1
|
|
|
|
|
3
|
my $self = bless \%args, $package; |
22
|
|
|
|
|
|
|
|
23
|
1
|
50
|
|
|
|
17
|
if (ref $self->{MegaHAL} eq 'POE::Component::AI::MegaHAL') { |
24
|
0
|
|
|
|
|
0
|
$self->{keep_alive} = 1; |
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
else { |
27
|
1
|
|
|
|
|
11
|
$self->{MegaHAL} = POE::Component::AI::MegaHAL->spawn( |
28
|
1
|
50
|
|
|
|
4
|
($self->{MegaHAL_args} ? %{ $self->{MegaHAL_args} } : () ), |
29
|
|
|
|
|
|
|
); |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
1
|
50
|
33
|
|
|
8952
|
$self->{Method} = 'notice' if !defined $self->{Method} || $self->{Method} !~ /privmsg|notice/; |
33
|
1
|
|
|
|
|
17
|
$self->{abusers} = { }; |
34
|
1
|
50
|
|
|
|
73
|
$self->{Abuse_interval} = 60 if !defined $self->{Abuse_interval}; |
35
|
|
|
|
|
|
|
|
36
|
1
|
|
|
|
|
43
|
return $self; |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub PCI_register { |
40
|
1
|
|
|
1
|
0
|
1458
|
my ($self, $irc) = @_; |
41
|
|
|
|
|
|
|
|
42
|
1
|
50
|
|
|
|
43
|
if (!$irc->isa('POE::Component::IRC::State')) { |
43
|
0
|
|
|
|
|
0
|
die __PACKAGE__ . " requires PoCo::IRC::State or a subclass thereof\n"; |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
1
|
|
|
|
|
10
|
$self->{irc} = $irc; |
47
|
1
|
|
|
|
|
32
|
POE::Session->create( |
48
|
|
|
|
|
|
|
object_states => [ |
49
|
|
|
|
|
|
|
$self => [qw( |
50
|
|
|
|
|
|
|
_start |
51
|
|
|
|
|
|
|
_sig_DIE |
52
|
|
|
|
|
|
|
_save |
53
|
|
|
|
|
|
|
_megahal_reply |
54
|
|
|
|
|
|
|
_megahal_greeting |
55
|
|
|
|
|
|
|
_megahal_saved |
56
|
|
|
|
|
|
|
_greet_handler |
57
|
|
|
|
|
|
|
_msg_handler |
58
|
|
|
|
|
|
|
)], |
59
|
|
|
|
|
|
|
], |
60
|
|
|
|
|
|
|
); |
61
|
|
|
|
|
|
|
|
62
|
1
|
|
|
|
|
257
|
$irc->plugin_register($self, 'SERVER', qw(isupport ctcp_action join public)); |
63
|
1
|
|
|
|
|
74
|
return 1; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub PCI_unregister { |
67
|
1
|
|
|
1
|
0
|
2966
|
my ($self, $irc) = @_; |
68
|
|
|
|
|
|
|
|
69
|
1
|
50
|
|
|
|
88
|
$irc->yield(part => $self->{Own_channel}) if $self->{Own_channel}; |
70
|
1
|
|
|
|
|
4
|
delete $self->{irc}; |
71
|
1
|
|
|
|
|
12
|
$poe_kernel->post($self->{session_id}, '_save'); |
72
|
|
|
|
|
|
|
|
73
|
1
|
|
|
|
|
92
|
return 1; |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub _save { |
77
|
1
|
|
|
1
|
|
366
|
my ($kernel, $self) = @_[KERNEL, OBJECT]; |
78
|
|
|
|
|
|
|
|
79
|
1
|
|
|
|
|
21
|
$kernel->post( |
80
|
|
|
|
|
|
|
$self->{MegaHAL}->session_id(), |
81
|
|
|
|
|
|
|
'_cleanup', |
82
|
|
|
|
|
|
|
{ event => '_megahal_saved' }, |
83
|
|
|
|
|
|
|
); |
84
|
1
|
|
|
|
|
179
|
return; |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub _start { |
88
|
1
|
|
|
1
|
|
703
|
my ($kernel, $self, $session) = @_[KERNEL, OBJECT, SESSION]; |
89
|
1
|
|
|
|
|
21
|
$kernel->sig(DIE => '_sig_DIE'); |
90
|
1
|
|
|
|
|
65
|
$self->{session_id} = $session->ID(); |
91
|
1
|
|
|
|
|
170
|
$kernel->refcount_increment($self->{session_id}, __PACKAGE__); |
92
|
1
|
|
|
|
|
72
|
return; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
sub _sig_DIE { |
96
|
0
|
|
|
0
|
|
0
|
my ($kernel, $self, $ex) = @_[KERNEL, OBJECT, ARG1]; |
97
|
0
|
|
|
|
|
0
|
chomp $ex->{error_str}; |
98
|
0
|
|
|
|
|
0
|
warn "Error: Event $ex->{event} in $ex->{dest_session} raised exception:\n"; |
99
|
0
|
|
|
|
|
0
|
warn " $ex->{error_str}\n"; |
100
|
0
|
|
|
|
|
0
|
$kernel->sig_handled(); |
101
|
0
|
|
|
|
|
0
|
return; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
sub _megahal_reply { |
105
|
0
|
|
|
0
|
|
0
|
my ($self, $info) = @_[OBJECT, ARG0]; |
106
|
0
|
|
|
|
|
0
|
my $reply = $self->_normalize_megahal($info->{reply}); |
107
|
0
|
|
|
|
|
0
|
$reply = encode_utf8($reply); |
108
|
|
|
|
|
|
|
|
109
|
0
|
0
|
|
|
|
0
|
if ($reply =~ s/^\x01 //) { |
110
|
0
|
|
|
|
|
0
|
$self->{irc}->yield('ctcp', $info->{_target}, "ACTION $reply"); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
else { |
113
|
0
|
|
|
|
|
0
|
$self->{irc}->yield($self->{Method}, $info->{_target}, $reply); |
114
|
|
|
|
|
|
|
} |
115
|
0
|
|
|
|
|
0
|
return; |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub _megahal_greeting { |
119
|
0
|
|
|
0
|
|
0
|
my ($self, $info) = @_[OBJECT, ARG0]; |
120
|
0
|
|
|
|
|
0
|
my $reply = $self->_normalize_megahal($info->{reply}); |
121
|
0
|
|
|
|
|
0
|
$reply = encode_utf8($reply); |
122
|
|
|
|
|
|
|
|
123
|
0
|
0
|
|
|
|
0
|
if ($reply =~ s/^\x01 //) { |
124
|
0
|
|
|
|
|
0
|
$self->{irc}->yield('ctcp', $info->{_target}, "ACTION $reply"); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
else { |
127
|
0
|
|
|
|
|
0
|
$reply = "$info->{_nick}: $reply"; |
128
|
0
|
|
|
|
|
0
|
$self->{irc}->yield($self->{Method}, $info->{_target}, $reply); |
129
|
|
|
|
|
|
|
} |
130
|
0
|
|
|
|
|
0
|
return; |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
|
|
|
|
|
|
sub _megahal_saved { |
134
|
1
|
|
|
1
|
|
2416273
|
my ($kernel, $self) = @_[KERNEL, OBJECT]; |
135
|
|
|
|
|
|
|
|
136
|
1
|
50
|
|
|
|
8
|
if (!$self->{keep_alive}) { |
137
|
1
|
|
|
|
|
9
|
$poe_kernel->post($self->{MegaHAL}->session_id(), 'shutdown'); |
138
|
|
|
|
|
|
|
} |
139
|
1
|
|
|
|
|
93
|
delete $self->{MegaHAL}; |
140
|
1
|
|
|
|
|
5
|
$poe_kernel->refcount_decrement($self->{session_id}, __PACKAGE__); |
141
|
1
|
|
|
|
|
30
|
return; |
142
|
|
|
|
|
|
|
} |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub _ignoring_channel { |
145
|
0
|
|
|
0
|
|
|
my ($self, $chan) = @_; |
146
|
|
|
|
|
|
|
|
147
|
0
|
0
|
0
|
|
|
|
return if $self->{Own_channel} && $self->_is_own_channel($chan); |
148
|
|
|
|
|
|
|
|
149
|
0
|
0
|
|
|
|
|
if ($self->{Channels}) { |
150
|
|
|
|
|
|
|
return 1 if !first { |
151
|
0
|
|
|
0
|
|
|
my $c = $chan; |
152
|
0
|
0
|
|
|
|
|
$c = decode_irc($c) if is_utf8($_); |
153
|
0
|
|
|
|
|
|
$_ eq $c |
154
|
0
|
0
|
|
|
|
|
} @{ $self->{Channels} }; |
|
0
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
} |
156
|
0
|
|
|
|
|
|
return; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub _ignoring_user { |
160
|
0
|
|
|
0
|
|
|
my ($self, $user) = @_; |
161
|
|
|
|
|
|
|
|
162
|
0
|
0
|
|
|
|
|
if ($self->{Ignore_masks}) { |
163
|
0
|
|
|
|
|
|
my $mapping = $self->{irc}->isupport('CASEMAPPING'); |
164
|
0
|
0
|
|
|
|
|
return 1 if keys %{ matches_mask_array($self->{Ignore_masks}, [$user], $mapping) }; |
|
0
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
|
167
|
0
|
|
|
|
|
|
return; |
168
|
|
|
|
|
|
|
} |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
sub _ignoring_abuser { |
171
|
0
|
|
|
0
|
|
|
my ($self, $user, $chan) = @_; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# abuse protection |
174
|
0
|
|
|
|
|
|
my $key = "$user $chan"; |
175
|
0
|
|
|
|
|
|
my $last_time = delete $self->{abusers}->{$key}; |
176
|
0
|
|
|
|
|
|
$self->{abusers}->{$key} = time; |
177
|
|
|
|
|
|
|
|
178
|
0
|
0
|
0
|
|
|
|
return 1 if $last_time && (time - $last_time < $self->{Abuse_interval}); |
179
|
0
|
|
|
|
|
|
return; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub _msg_handler { |
183
|
0
|
|
|
0
|
|
|
my ($self, $kernel, $type, $user, $chan, $what) = @_[OBJECT, KERNEL, ARG0..$#_]; |
184
|
0
|
|
|
|
|
|
my $nick = $self->{irc}->nick_name(); |
185
|
|
|
|
|
|
|
|
186
|
0
|
0
|
|
|
|
|
return if $self->_ignoring_channel($chan); |
187
|
0
|
0
|
|
|
|
|
return if $self->_ignoring_user($user); |
188
|
0
|
|
|
|
|
|
$what = _normalize_irc($what); |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
# should we reply? |
191
|
0
|
|
|
|
|
|
my $event = '_no_reply'; |
192
|
0
|
0
|
0
|
|
|
|
if ($self->{Own_channel} && $self->_is_own_channel($chan) |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
193
|
|
|
|
|
|
|
|| $type eq 'public' && $what =~ s/^\s*\Q$nick\E[:,;.!?~]?\s//i |
194
|
|
|
|
|
|
|
|| $self->{Talkative} && $what =~ /\Q$nick/i) |
195
|
|
|
|
|
|
|
{ |
196
|
0
|
|
|
|
|
|
$event = '_megahal_reply'; |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
0
|
0
|
0
|
|
|
|
if ($event eq '_megahal_reply' && $self->_ignoring_abuser($user, $chan)) { |
200
|
0
|
|
|
|
|
|
$event = '_no_reply'; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
0
|
0
|
|
|
|
|
if ($self->{Ignore_regexes}) { |
204
|
0
|
|
|
|
|
|
for my $regex (@{ $self->{Ignore_regexes} }) { |
|
0
|
|
|
|
|
|
|
205
|
0
|
0
|
|
|
|
|
return if $what =~ $regex; |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
$kernel->post($self->{MegaHAL}->session_id() => do_reply => { |
210
|
|
|
|
|
|
|
event => $event, |
211
|
|
|
|
|
|
|
text => $what, |
212
|
|
|
|
|
|
|
_target => $chan, |
213
|
|
|
|
|
|
|
}); |
214
|
|
|
|
|
|
|
|
215
|
0
|
|
|
|
|
|
return; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
sub _is_own_channel { |
219
|
0
|
|
|
0
|
|
|
my $self = shift; |
220
|
0
|
|
|
|
|
|
my $chan = lc_irc(shift); |
221
|
0
|
|
|
|
|
|
my $own = lc_irc($self->{Own_channel}); |
222
|
|
|
|
|
|
|
|
223
|
0
|
0
|
|
|
|
|
$chan = decode_irc($chan) if is_utf8($own); |
224
|
0
|
0
|
|
|
|
|
return 1 if $chan eq $own; |
225
|
0
|
|
|
|
|
|
return; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub _greet_handler { |
229
|
0
|
|
|
0
|
|
|
my ($self, $kernel, $user, $chan) = @_[OBJECT, KERNEL, ARG0, ARG1]; |
230
|
|
|
|
|
|
|
|
231
|
0
|
0
|
|
|
|
|
return if $self->_ignoring_user($user, $chan); |
232
|
0
|
0
|
0
|
|
|
|
return if !$self->{Own_channel} || !$self->_is_own_channel($chan); |
233
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
$kernel->post($self->{MegaHAL}->session_id() => initial_greeting => { |
235
|
|
|
|
|
|
|
event => '_megahal_greeting', |
236
|
|
|
|
|
|
|
_target => $chan, |
237
|
|
|
|
|
|
|
_nick => (split /!/, $user)[0], |
238
|
|
|
|
|
|
|
}); |
239
|
|
|
|
|
|
|
|
240
|
0
|
|
|
|
|
|
return; |
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub _normalize_megahal { |
244
|
0
|
|
|
0
|
|
|
my ($self, $line) = @_; |
245
|
|
|
|
|
|
|
|
246
|
0
|
|
|
|
|
|
$line = decode_utf8($line); |
247
|
0
|
0
|
|
|
|
|
if ($self->{English}) { |
248
|
0
|
|
|
|
|
|
$line =~ s{\bi\b}{I}g; |
249
|
0
|
|
|
|
|
|
$line =~ s{(?<=\w)$}{.}; |
250
|
|
|
|
|
|
|
} |
251
|
0
|
|
|
|
|
|
return $line; |
252
|
|
|
|
|
|
|
} |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
sub _normalize_irc { |
255
|
0
|
|
|
0
|
|
|
my ($line) = @_; |
256
|
|
|
|
|
|
|
|
257
|
0
|
|
|
|
|
|
$line = decode_irc($line); |
258
|
0
|
|
|
|
|
|
$line = strip_color($line); |
259
|
0
|
|
|
|
|
|
$line = strip_formatting($line); |
260
|
0
|
|
|
|
|
|
return $line; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
sub brain { |
264
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
265
|
0
|
|
|
|
|
|
return $self->{MegaHAL}; |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
sub transplant { |
269
|
0
|
|
|
0
|
1
|
|
my ($self, $brain) = @_; |
270
|
|
|
|
|
|
|
|
271
|
0
|
0
|
|
|
|
|
if (ref $brain ne 'POE::Component::AI::MegaHAL') { |
272
|
0
|
|
|
|
|
|
croak 'Argument must be a POE::Component::AI::MegaHAL instance'; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
my $old_brain = $self->{MegaHAL}; |
276
|
0
|
0
|
|
|
|
|
$poe_kernel->post($self->{MegaHAL}->session_id(), 'shutdown') if !$self->{keep_alive}; |
277
|
0
|
|
|
|
|
|
$self->{MegaHAL} = $brain; |
278
|
0
|
|
|
|
|
|
$self->{keep_alive} = 1; |
279
|
0
|
|
|
|
|
|
return $old_brain; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub S_isupport { |
283
|
0
|
|
|
0
|
0
|
|
my ($self, $irc) = splice @_, 0, 2; |
284
|
0
|
0
|
|
|
|
|
$irc->yield(join => $self->{Own_channel}) if $self->{Own_channel}; |
285
|
0
|
|
|
|
|
|
return PCI_EAT_NONE; |
286
|
|
|
|
|
|
|
} |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
sub S_ctcp_action { |
289
|
0
|
|
|
0
|
0
|
|
my ($self, $irc) = splice @_, 0, 2; |
290
|
0
|
|
|
|
|
|
my $user = ${ $_[0] }; |
|
0
|
|
|
|
|
|
|
291
|
0
|
|
|
|
|
|
my $chan = ${ $_[1] }->[0]; |
|
0
|
|
|
|
|
|
|
292
|
0
|
|
|
|
|
|
my $what = ${ $_[2] }; |
|
0
|
|
|
|
|
|
|
293
|
0
|
0
|
|
|
|
|
my $chantypes = join('', @{ $irc->isupport('CHANTYPES') || ['#', '&']}); |
|
0
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
|
295
|
0
|
0
|
|
|
|
|
return PCI_EAT_NONE if $chan !~ /^[$chantypes]/; |
296
|
|
|
|
|
|
|
|
297
|
0
|
|
|
|
|
|
$poe_kernel->post( |
298
|
|
|
|
|
|
|
$self->{session_id}, |
299
|
|
|
|
|
|
|
'_msg_handler', |
300
|
|
|
|
|
|
|
'action', |
301
|
|
|
|
|
|
|
$user, |
302
|
|
|
|
|
|
|
$chan, |
303
|
|
|
|
|
|
|
"\x01 $what", |
304
|
|
|
|
|
|
|
); |
305
|
|
|
|
|
|
|
|
306
|
0
|
|
|
|
|
|
return PCI_EAT_NONE; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
sub S_public { |
310
|
0
|
|
|
0
|
0
|
|
my ($self, $irc) = splice @_, 0, 2; |
311
|
0
|
|
|
|
|
|
my $user = ${ $_[0] }; |
|
0
|
|
|
|
|
|
|
312
|
0
|
|
|
|
|
|
my $chan = ${ $_[1] }->[0]; |
|
0
|
|
|
|
|
|
|
313
|
0
|
|
|
|
|
|
my $what = ${ $_[2] }; |
|
0
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
|
315
|
0
|
|
|
|
|
|
$poe_kernel->post($self->{session_id} => _msg_handler => 'public', $user, $chan, $what); |
316
|
0
|
|
|
|
|
|
return PCI_EAT_NONE; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
sub S_join { |
320
|
0
|
|
|
0
|
0
|
|
my ($self, $irc) = splice @_, 0, 2; |
321
|
0
|
|
|
|
|
|
my $user = ${ $_[0] }; |
|
0
|
|
|
|
|
|
|
322
|
0
|
|
|
|
|
|
my $chan = ${ $_[1] }; |
|
0
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
|
324
|
0
|
0
|
|
|
|
|
return PCI_EAT_NONE if (split /!/, $user)[0] eq $irc->nick_name(); |
325
|
0
|
|
|
|
|
|
$poe_kernel->post($self->{session_id} => _greet_handler => $user, $chan); |
326
|
0
|
|
|
|
|
|
return PCI_EAT_NONE; |
327
|
|
|
|
|
|
|
} |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
1; |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
=encoding utf8 |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=head1 NAME |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
POE::Component::IRC::Plugin::MegaHAL - A PoCo-IRC plugin which provides access to a MegaHAL conversation simulator. |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=head1 SYNOPSIS |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
To quickly get an IRC bot with this plugin up and running, you can use |
340
|
|
|
|
|
|
|
L: |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
$ pocoirc -s irc.perl.org -j '#bots' -a MegaHAL |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
Or use it in your code: |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
use POE::Component::IRC::Plugin::MegaHAL; |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
$irc->plugin_add('MegaHAL', POE::Component::IRC::Plugin::MegaHAL->new( |
349
|
|
|
|
|
|
|
Own_channel => '#bot_chan', |
350
|
|
|
|
|
|
|
English => 1, |
351
|
|
|
|
|
|
|
Ignore_regexes => [ qr{^\s*\w+://\S+\s*$} ], # ignore URL-only lines |
352
|
|
|
|
|
|
|
)); |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
=head1 DESCRIPTION |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
POE::Component::IRC::Plugin::MegaHAL is a |
357
|
|
|
|
|
|
|
L plugin. It provides "intelligence" |
358
|
|
|
|
|
|
|
through the use of L. |
359
|
|
|
|
|
|
|
It will talk back when addressed by channel members (and possibly in other |
360
|
|
|
|
|
|
|
situations, see L|/"new">). An example: |
361
|
|
|
|
|
|
|
|
362
|
|
|
|
|
|
|
--> megahal_bot joins #channel |
363
|
|
|
|
|
|
|
oh hi there |
364
|
|
|
|
|
|
|
hello there |
365
|
|
|
|
|
|
|
megahal_bot: hi |
366
|
|
|
|
|
|
|
oh hi there |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
It will occasionally send CTCP ACTIONS (/me) too, if the reply in question |
369
|
|
|
|
|
|
|
happens to be based on an earlier CTCP ACTION from someone. |
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
All NOTICEs are ignored, so if your other bots only issue NOTICEs like |
372
|
|
|
|
|
|
|
they should, they will be ignored automatically. |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
Before using, you should read the documentation for |
375
|
|
|
|
|
|
|
L and by extension, |
376
|
|
|
|
|
|
|
L, so you have an idea of what to pass as the |
377
|
|
|
|
|
|
|
B<'MegaHAL_args'> parameter to L|/"new">. |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
This plugin requires the IRC component to be |
380
|
|
|
|
|
|
|
L or a subclass thereof. |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
=head1 METHODS |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
=head2 C |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
Takes the following optional arguments: |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
B<'MegaHAL'>, a reference to an existing |
389
|
|
|
|
|
|
|
L object you have |
390
|
|
|
|
|
|
|
lying around. Useful if you want to use it with multiple IRC components. |
391
|
|
|
|
|
|
|
If this argument is not provided, the plugin will construct its own object. |
392
|
|
|
|
|
|
|
|
393
|
|
|
|
|
|
|
B<'MegaHAL_args'>, a hash reference containing arguments to pass to the |
394
|
|
|
|
|
|
|
constructor of a new L |
395
|
|
|
|
|
|
|
object. |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
B<'Channels'>, an array reference of channel names. If this is provided, the |
398
|
|
|
|
|
|
|
bot will only listen/respond in the specified channels, rather than all |
399
|
|
|
|
|
|
|
channels. |
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
B<'Own_channel'>, a channel where it will reply to all messages, as well as |
402
|
|
|
|
|
|
|
greet everyone who joins. The plugin will take care of joining the channel. |
403
|
|
|
|
|
|
|
It will part from it when the plugin is removed from the pipeline. Defaults |
404
|
|
|
|
|
|
|
to none. |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
B<'Abuse_interval'>, default is 60 (seconds), which means that user X in |
407
|
|
|
|
|
|
|
channel Y has to wait that long before addressing the bot in the same channel |
408
|
|
|
|
|
|
|
if he wants to get a reply. Setting this to 0 effectively turns off abuse |
409
|
|
|
|
|
|
|
protection. |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
B<'Talkative'>, when set to a true value, the bot will respond whenever |
412
|
|
|
|
|
|
|
someone mentions its name (in a PRIVMSG or CTCP ACTION (/me)). If false, it |
413
|
|
|
|
|
|
|
will only respond when addressed directly with a PRIVMSG. Default is false. |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
B<'Ignore_masks'>, an array reference of IRC masks (e.g. "purl!*@*") to |
416
|
|
|
|
|
|
|
ignore. |
417
|
|
|
|
|
|
|
|
418
|
|
|
|
|
|
|
B<'Ignore_regexes'>, an array reference of regex objects. If a message |
419
|
|
|
|
|
|
|
matches any of them, it will be ignored. Handy for ignoring messages with |
420
|
|
|
|
|
|
|
URLs in them. |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
B<'Method'>, how you want messages to be delivered. Valid options are |
423
|
|
|
|
|
|
|
'notice' (the default) and 'privmsg'. |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
B<'English'>, when set to a true value, some English-language corrections |
426
|
|
|
|
|
|
|
will be applied to the bot's output. Currently it will capitalizes the word |
427
|
|
|
|
|
|
|
'I' and make sure paragraphs end with '.' where appropriate. Defaults to |
428
|
|
|
|
|
|
|
false. |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
Returns a plugin object suitable for feeding to |
431
|
|
|
|
|
|
|
L's plugin_add() method. |
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
=head2 C |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
Takes no arguments. Returns the underlying |
436
|
|
|
|
|
|
|
L object being used |
437
|
|
|
|
|
|
|
by the plugin. |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
=head2 C |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
Replaces the brain with the supplied |
442
|
|
|
|
|
|
|
L instance. Shuts |
443
|
|
|
|
|
|
|
down the old brain if it was instantiated by the plugin itself. |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
=head1 AUTHOR |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
Hinrik Ern SigurEsson, hinrik.sig@gmail.com |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
=head1 KUDOS |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
Those go to Chris C Williams and his friend GumbyBRAIN. |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=cut |