line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package IRC::Bot; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
27934
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
36
|
|
4
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
46
|
|
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
#use diagnostics; # For development |
7
|
1
|
|
|
|
|
160
|
use vars qw($VERSION @ISA @EXPORT $log $seen $auth $help $quote $whois |
8
|
1
|
|
|
1
|
|
6
|
$qact $qactdel $quser $qtext $qchannel $delcheck); |
|
1
|
|
|
|
|
6
|
|
9
|
1
|
|
|
1
|
|
4
|
use Carp; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
82
|
|
10
|
1
|
|
|
1
|
|
4370
|
use POE; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
use POE::Component::IRC; |
12
|
|
|
|
|
|
|
use POSIX qw( setsid ); |
13
|
|
|
|
|
|
|
use IRC::Bot::Log; |
14
|
|
|
|
|
|
|
use IRC::Bot::Seen; |
15
|
|
|
|
|
|
|
use IRC::Bot::Auth; |
16
|
|
|
|
|
|
|
use IRC::Bot::Help; |
17
|
|
|
|
|
|
|
use IRC::Bot::Quote; |
18
|
|
|
|
|
|
|
use constant NICK => 'bot'; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
require Exporter; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
@ISA = qw(Exporter AutoLoader); |
23
|
|
|
|
|
|
|
@EXPORT = qw(); |
24
|
|
|
|
|
|
|
$VERSION = '0.07'; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
# Set us up the bomb |
27
|
|
|
|
|
|
|
sub new { |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $class = shift; |
30
|
|
|
|
|
|
|
my %args = @_; |
31
|
|
|
|
|
|
|
return bless \%args, $class; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# Run the bot |
36
|
|
|
|
|
|
|
sub run { |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
my $self = shift; |
39
|
|
|
|
|
|
|
if ($self->{'LogPath'} eq '') { |
40
|
|
|
|
|
|
|
$self->{'LogPath'} = $ENV{'HOME'} . "/"; |
41
|
|
|
|
|
|
|
} |
42
|
|
|
|
|
|
|
$log = IRC::Bot::Log->new( 'Path' => $self->{'LogPath'} ); |
43
|
|
|
|
|
|
|
$seen = IRC::Bot::Seen->new(); |
44
|
|
|
|
|
|
|
$auth = IRC::Bot::Auth->new(); |
45
|
|
|
|
|
|
|
$help = IRC::Bot::Help->new(); |
46
|
|
|
|
|
|
|
$quote = IRC::Bot::Quote->new(); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
POE::Component::IRC->new(NICK) |
49
|
|
|
|
|
|
|
|| croak "Cannot create new P::C::I object!\n"; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
POE::Session->create( |
52
|
|
|
|
|
|
|
object_states => [ |
53
|
|
|
|
|
|
|
$self => { |
54
|
|
|
|
|
|
|
_start => "bot_start", |
55
|
|
|
|
|
|
|
irc_001 => "on_connect", |
56
|
|
|
|
|
|
|
irc_disconnected => "on_disco", |
57
|
|
|
|
|
|
|
irc_public => "on_public", |
58
|
|
|
|
|
|
|
irc_msg => "on_msg", |
59
|
|
|
|
|
|
|
irc_quit => "on_quit", |
60
|
|
|
|
|
|
|
irc_join => "on_join", |
61
|
|
|
|
|
|
|
irc_part => "on_part", |
62
|
|
|
|
|
|
|
irc_mode => "on_mode", |
63
|
|
|
|
|
|
|
irc_kick => "on_kick", |
64
|
|
|
|
|
|
|
irc_notice => "on_notice", |
65
|
|
|
|
|
|
|
irc_ctcp_ping => "on_ping", |
66
|
|
|
|
|
|
|
irc_ctcp_version => "on_ver", |
67
|
|
|
|
|
|
|
irc_ctcp_finger => "on_finger", |
68
|
|
|
|
|
|
|
irc_ctcp_page => "on_page", |
69
|
|
|
|
|
|
|
irc_ctcp_time => "on_time", |
70
|
|
|
|
|
|
|
irc_ctcp_action => "on_action", |
71
|
|
|
|
|
|
|
irc_nick => "on_nick", |
72
|
|
|
|
|
|
|
keepalive => "keepalive", |
73
|
|
|
|
|
|
|
irc_433 => "on_nick_taken", |
74
|
|
|
|
|
|
|
irc_353 => "on_names", |
75
|
|
|
|
|
|
|
irc_dcc_request => "on_dcc_req", |
76
|
|
|
|
|
|
|
irc_dcc_error => "on_dcc_err", |
77
|
|
|
|
|
|
|
irc_dcc_done => "on_dcc_done", |
78
|
|
|
|
|
|
|
irc_dcc_start => "on_dcc_start", |
79
|
|
|
|
|
|
|
irc_dcc_chat => "on_dcc_chat", |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
} |
82
|
|
|
|
|
|
|
] |
83
|
|
|
|
|
|
|
); |
84
|
|
|
|
|
|
|
$poe_kernel->run(); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
# Start the bot things up |
88
|
|
|
|
|
|
|
sub bot_start { |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
my ( $self, $kernel, $session ) = @_[ OBJECT, KERNEL, SESSION ]; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
my $ts = scalar(localtime); |
93
|
|
|
|
|
|
|
$log->serv_log("[$ts] Starting Up..."); |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
$kernel->post( NICK, 'register', 'all' ); |
96
|
|
|
|
|
|
|
$kernel->post( |
97
|
|
|
|
|
|
|
NICK, |
98
|
|
|
|
|
|
|
'connect', |
99
|
|
|
|
|
|
|
{ |
100
|
|
|
|
|
|
|
Debug => $self->{'Debug'}, |
101
|
|
|
|
|
|
|
Nick => $self->{'Nick'}, |
102
|
|
|
|
|
|
|
Server => $self->{'Server'}, |
103
|
|
|
|
|
|
|
Port => $self->{'Port'}, |
104
|
|
|
|
|
|
|
Username => $self->{'Username'}, |
105
|
|
|
|
|
|
|
Password => $self->{'Password'}, |
106
|
|
|
|
|
|
|
Ircname => $self->{'Ircname'}, |
107
|
|
|
|
|
|
|
NSPass => $self->{'NSPass'} |
108
|
|
|
|
|
|
|
} |
109
|
|
|
|
|
|
|
); |
110
|
|
|
|
|
|
|
$kernel->delay( 'reconnect', 20 ); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
# Handle connect event |
114
|
|
|
|
|
|
|
# Join specified channels |
115
|
|
|
|
|
|
|
sub on_connect { |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
my ( $self, $kernel ) = @_[ OBJECT, KERNEL ]; |
118
|
|
|
|
|
|
|
$kernel->post( NICK, 'mode', $self->{'Nick'}, '+B' ); |
119
|
|
|
|
|
|
|
if ($self->{'NSPass'}) { |
120
|
|
|
|
|
|
|
my $msg = "identify " . $self->{'NSPass'}; |
121
|
|
|
|
|
|
|
$self->botspeak( $kernel, 'NickServ', $msg ); |
122
|
|
|
|
|
|
|
} |
123
|
|
|
|
|
|
|
foreach my $chan ( @{ $self->{'Channels'} } ) { |
124
|
|
|
|
|
|
|
$kernel->post( NICK, 'join', $chan ); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# Someone pinged us, handle it. |
129
|
|
|
|
|
|
|
sub on_ping { |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; |
132
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
133
|
|
|
|
|
|
|
$kernel->post( NICK, 'ctcpreply', $nick, "PING", "PONG" ); |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
# Someone changed their nick, handle it. |
138
|
|
|
|
|
|
|
sub on_nick { |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $nnick ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; |
141
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
142
|
|
|
|
|
|
|
$seen->log_seen( $nick, "Changing nick to $nnick" ); |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
} |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# Handle CTCP Version |
147
|
|
|
|
|
|
|
sub on_ver { |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; |
150
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
151
|
|
|
|
|
|
|
$kernel->post( NICK, 'ctcpreply', $nick, "VERSION", "Ima Bot" ); |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
# Handle CTCP Finger |
156
|
|
|
|
|
|
|
sub on_finger { |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; |
159
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
160
|
|
|
|
|
|
|
$kernel->post( NICK, 'ctcpreply', $nick, "FINGER", "Ima Bot" ); |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# Handle CTCP Page |
165
|
|
|
|
|
|
|
sub on_page { |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; |
168
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
169
|
|
|
|
|
|
|
$kernel->post( NICK, 'ctcpreply', $nick, "PAGE", "Ima Bot" ); |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
} |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# Handle CTCP Time |
174
|
|
|
|
|
|
|
sub on_time { |
175
|
|
|
|
|
|
|
|
176
|
|
|
|
|
|
|
my ( $self, $kernel, $who ) = @_[ OBJECT, KERNEL, ARG0 ]; |
177
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
178
|
|
|
|
|
|
|
my $ts = scalar(localtime); |
179
|
|
|
|
|
|
|
$kernel->post( NICK, 'ctcpreply', $nick, "TIME", $ts ); |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# Log actions |
184
|
|
|
|
|
|
|
sub on_action { |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $where, $msg ) = |
187
|
|
|
|
|
|
|
@_[ OBJECT, KERNEL, ARG0, ARG1, ARG2 ]; |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
190
|
|
|
|
|
|
|
my $channel = $where->[0]; |
191
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
192
|
|
|
|
|
|
|
$log->chan_log("[$channel $time] Action: *$nick $msg"); |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
} |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
# Handle mode changes |
197
|
|
|
|
|
|
|
sub on_mode { |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $where, $mode, $nicks ) = |
200
|
|
|
|
|
|
|
@_[ OBJECT, KERNEL, ARG0, ARG1, ARG2, ARG3 ]; |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
203
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
204
|
|
|
|
|
|
|
if ($self->{'Nick'} eq $where) { |
205
|
|
|
|
|
|
|
$log->bot_log("[$where $time] MODE: $mode"); |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
else { |
208
|
|
|
|
|
|
|
if ($nicks) { |
209
|
|
|
|
|
|
|
$log->chan_log("[$where $time] MODE: $mode $nicks by: $nick"); |
210
|
|
|
|
|
|
|
} |
211
|
|
|
|
|
|
|
else { |
212
|
|
|
|
|
|
|
$log->chan_log("[$where $time] MODE: $mode $where by: $nick"); |
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# Handle notices |
219
|
|
|
|
|
|
|
sub on_notice { |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $msg ) = @_[ OBJECT, KERNEL, ARG0, ARG2 ]; |
222
|
|
|
|
|
|
|
|
223
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
224
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
225
|
|
|
|
|
|
|
$log->bot_log("[$self->{'Nick'} $time] NOTICE: $nick: $msg"); |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# Handle kicks |
230
|
|
|
|
|
|
|
sub on_kick { |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $chan, $kickee, $msg ) = |
233
|
|
|
|
|
|
|
@_[ OBJECT, KERNEL, ARG0, ARG1, ARG2, ARG3 ]; |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
236
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
237
|
|
|
|
|
|
|
$log->chan_log("[$chan $time] KICK: $nick: $kickee ($msg)"); |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
} |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# Handle someone quitting. |
242
|
|
|
|
|
|
|
sub on_quit { |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $msg ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; |
245
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
246
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
247
|
|
|
|
|
|
|
$log->serv_log("[$self->{'Nick'} $time] QUIT: $nick: $msg"); |
248
|
|
|
|
|
|
|
$seen->log_seen( $nick, "Quit: $msg" ); |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
# Handle join event |
253
|
|
|
|
|
|
|
sub on_join { |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $where ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; |
256
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
257
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
258
|
|
|
|
|
|
|
$log->chan_log("[$where $time] JOIN: $nick"); |
259
|
|
|
|
|
|
|
$seen->log_seen( $nick, "Joining $where" ); |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
# Handle part event |
264
|
|
|
|
|
|
|
sub on_part { |
265
|
|
|
|
|
|
|
|
266
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $where ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; |
267
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
268
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
269
|
|
|
|
|
|
|
$log->chan_log("[$where $time] PART: $nick"); |
270
|
|
|
|
|
|
|
$seen->log_seen( $nick, "Parting $where" ); |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
# Changes nick if current nick is taken |
275
|
|
|
|
|
|
|
sub on_nick_taken { |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
my ( $self, $kernel ) = @_[ OBJECT, KERNEL ]; |
278
|
|
|
|
|
|
|
my $nick = $self->{'Nick'}; |
279
|
|
|
|
|
|
|
my $rnick = int( rand(999) ); |
280
|
|
|
|
|
|
|
$kernel->post( NICK, 'nick', "$nick$rnick" ); |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
# Communicate with channel/nick |
285
|
|
|
|
|
|
|
sub botspeak { |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
my ( $self, $kernel, $channel, $msg ) = @_; |
288
|
|
|
|
|
|
|
$kernel->post( NICK, 'privmsg', $channel, $msg ); |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
# Borrowed this code from another bot |
293
|
|
|
|
|
|
|
# Can't for the life of me remember which one |
294
|
|
|
|
|
|
|
# Please, let me know if it was you, so I can |
295
|
|
|
|
|
|
|
# give props!! |
296
|
|
|
|
|
|
|
sub keepalive { |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
my ( $self, $kernel, $heap ) = @_[ OBJECT, KERNEL, HEAP ]; |
299
|
|
|
|
|
|
|
$heap->{'keepalive_time'} += 180; |
300
|
|
|
|
|
|
|
$kernel->alarm( 'keepalive' => $heap->{'keepalive_time'} ); |
301
|
|
|
|
|
|
|
$kernel->post( NICK, 'sl', 'PING ' . time() ); |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
# Handle public events |
306
|
|
|
|
|
|
|
sub on_public { |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $where, $msg ) = |
309
|
|
|
|
|
|
|
@_[ OBJECT, KERNEL, ARG0 .. $#_ ]; |
310
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
311
|
|
|
|
|
|
|
my $channel = $where->[0]; |
312
|
|
|
|
|
|
|
my $pubmsg = $msg; |
313
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
314
|
|
|
|
|
|
|
$log->chan_log("[$channel $time] <$nick> $msg"); |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
if ( $msg =~ m/^!help$/i ) { |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
my %pubHelp = $help->pub_help(); |
319
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, "Here is the help you requested:" ); |
320
|
|
|
|
|
|
|
foreach my $keys ( keys %pubHelp ) { |
321
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, $pubHelp{$keys} ); |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
elsif ( $msg =~ m/^!ping$/i ) { |
326
|
|
|
|
|
|
|
|
327
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, "Pong!" ); |
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
} |
330
|
|
|
|
|
|
|
elsif ( $msg =~ m/^!uptime$/i ) { |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
my $time = sprintf( "%d Days, %02d:%02d:%02d", |
333
|
|
|
|
|
|
|
( gmtime( time() - $^T ) )[ 7, 2, 1, 0 ] ); |
334
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, "I've been up for $time" ); |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
} |
337
|
|
|
|
|
|
|
elsif ( $msg =~ m/^!seen/i ) { |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
340
|
|
|
|
|
|
|
my $name = $arg[1]; |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
if ($name) { |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
my $fseen = $seen->get_seen($name) || undef; |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
if ( $name eq $nick ) { |
347
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, |
348
|
|
|
|
|
|
|
"Looking for yourself, $nick?" ); |
349
|
|
|
|
|
|
|
} |
350
|
|
|
|
|
|
|
elsif ( $name eq $self->{'Nick'} ) { |
351
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, "I'm right here, foo!" ); |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
elsif ( defined $fseen ) { |
354
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, $fseen ); |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
else { |
357
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, |
358
|
|
|
|
|
|
|
"Sorry, $nick, I haven't seen $name." ); |
359
|
|
|
|
|
|
|
} |
360
|
|
|
|
|
|
|
} |
361
|
|
|
|
|
|
|
else { |
362
|
|
|
|
|
|
|
my $seen = $help->pub_help('seen'); |
363
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, |
364
|
|
|
|
|
|
|
"Hey $nick, it's like this: $seen" ); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
elsif ( $msg =~ m/^!quote/i ) { |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
370
|
|
|
|
|
|
|
my $name = $arg[1]; |
371
|
|
|
|
|
|
|
my $there = $arg[2]; |
372
|
|
|
|
|
|
|
$qchannel = $channel; |
373
|
|
|
|
|
|
|
if ($name) { |
374
|
|
|
|
|
|
|
if ( $msg =~ m/^!quote\s+(\w+)\s+([^"]*)\s+"([^"]*)"/i ) { |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
$qact = $1; |
377
|
|
|
|
|
|
|
$quser = $2; |
378
|
|
|
|
|
|
|
$qtext = $3; |
379
|
|
|
|
|
|
|
my $res; |
380
|
|
|
|
|
|
|
if ($qact eq "add" ) { |
381
|
|
|
|
|
|
|
$res = $quote->quote_set( $quser, $qtext ); |
382
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, $res ); |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
elsif ( $msg =~ m/^!quote\s+(\w+)\s+([^"]*)$/i ) { |
386
|
|
|
|
|
|
|
$qactdel = $1; |
387
|
|
|
|
|
|
|
$quser = $2; |
388
|
|
|
|
|
|
|
$delcheck = 1; |
389
|
|
|
|
|
|
|
my $res; |
390
|
|
|
|
|
|
|
if ($qactdel eq "del") { |
391
|
|
|
|
|
|
|
$res = $quote->quote_forget( $quser ); |
392
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, $res ); |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
} |
395
|
|
|
|
|
|
|
else { |
396
|
|
|
|
|
|
|
my $said; |
397
|
|
|
|
|
|
|
if ($there) { |
398
|
|
|
|
|
|
|
$said = $quote->quote_query( $there ); |
399
|
|
|
|
|
|
|
} |
400
|
|
|
|
|
|
|
else { |
401
|
|
|
|
|
|
|
$said = $quote->quote_query( $name ); |
402
|
|
|
|
|
|
|
} |
403
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, $said ); |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
} |
406
|
|
|
|
|
|
|
else { |
407
|
|
|
|
|
|
|
my $rhelp = $help->pub_help('quote'); |
408
|
|
|
|
|
|
|
$self->botspeak( $kernel, $channel, $rhelp ); |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
# Handle privmsg communication. |
414
|
|
|
|
|
|
|
sub on_msg { |
415
|
|
|
|
|
|
|
|
416
|
|
|
|
|
|
|
my ( $self, $kernel, $who, $nicks, $msg ) = |
417
|
|
|
|
|
|
|
@_[ OBJECT, KERNEL, ARG0, ARG1, ARG2 ]; |
418
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
419
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
420
|
|
|
|
|
|
|
$log->bot_log("[$self->{'Nick'} $time] <$nick> $msg"); |
421
|
|
|
|
|
|
|
$self->botspeak( $kernel, $nick, |
422
|
|
|
|
|
|
|
"Please use DCC CHAT to communicate with me :)" ) |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
} |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
# Handle dcc request, accept and move on. |
427
|
|
|
|
|
|
|
sub on_dcc_req { |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
my ( $self, $kernel, $type, $who, $id ) = |
430
|
|
|
|
|
|
|
@_[ OBJECT, KERNEL, ARG0, ARG1, ARG3 ]; |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_accept', $id ); |
433
|
|
|
|
|
|
|
|
434
|
|
|
|
|
|
|
} |
435
|
|
|
|
|
|
|
|
436
|
|
|
|
|
|
|
# Start up the DCC session, or welcome back |
437
|
|
|
|
|
|
|
sub on_dcc_start { |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
my ( $self, $kernel, $id, $who, $type ) = |
440
|
|
|
|
|
|
|
@_[ OBJECT, KERNEL, ARG0, ARG1, ARG2 ]; |
441
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
442
|
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
if ( $type eq 'CHAT' ) { |
444
|
|
|
|
|
|
|
my $check = $auth->is_auth($nick); |
445
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
if ( $check != 1 ) { |
447
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "Please Login" ); |
448
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "(.login user pass)" ); |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
else { |
451
|
|
|
|
|
|
|
$auth->get_ses($nick); |
452
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "Welcome Back, $nick" ); |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
} |
456
|
|
|
|
|
|
|
else { |
457
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_close', $id ); |
458
|
|
|
|
|
|
|
} |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
} |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
# Handle a dcc_chat session, parse for commands |
463
|
|
|
|
|
|
|
# Act accordingly. |
464
|
|
|
|
|
|
|
# LOTS OF STUFF GOING ON HERE |
465
|
|
|
|
|
|
|
# Main command parser/dispatcher |
466
|
|
|
|
|
|
|
sub on_dcc_chat { |
467
|
|
|
|
|
|
|
|
468
|
|
|
|
|
|
|
my ( $self, $kernel, $id, $who, $msg ) = |
469
|
|
|
|
|
|
|
@_[ OBJECT, KERNEL, ARG0, ARG1, ARG3 ]; |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
472
|
|
|
|
|
|
|
my $check = $auth->is_auth($nick); |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
if ( $msg =~ m/^.login/i ) { |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
477
|
|
|
|
|
|
|
my $user = $arg[1]; |
478
|
|
|
|
|
|
|
my $pass = $arg[2]; |
479
|
|
|
|
|
|
|
my $time = sprintf( "%02d:%02d", ( localtime( time() ) )[ 2, 1 ] ); |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
if ( $user eq $self->{'Admin'} && $pass eq $self->{'Apass'} ) { |
482
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "Welcome, $nick!" ); |
483
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, |
484
|
|
|
|
|
|
|
"All commands are prefixed with a period(.)" ); |
485
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "See \cB.help\cB" ); |
486
|
|
|
|
|
|
|
$log->bot_log("[$self->{'Nick'} $time] $nick logged in with $user"); |
487
|
|
|
|
|
|
|
$auth->auth_set($nick); |
488
|
|
|
|
|
|
|
} |
489
|
|
|
|
|
|
|
else { |
490
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "Incorrect Login Info!" ); |
491
|
|
|
|
|
|
|
$log->bot_log("$nick tried to login with $user"); |
492
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_close', $id ); |
493
|
|
|
|
|
|
|
} |
494
|
|
|
|
|
|
|
} |
495
|
|
|
|
|
|
|
elsif ( $check != 0 ) { |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
if ( $msg =~ m/^.say/i ) { |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
500
|
|
|
|
|
|
|
my $chan = $arg[1]; |
501
|
|
|
|
|
|
|
$msg =~ s/$arg[1]//; |
502
|
|
|
|
|
|
|
$msg =~ s/.say\s*//; |
503
|
|
|
|
|
|
|
$msg =~ s/\n+//; |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
if ( $chan || $arg[2] ) { |
506
|
|
|
|
|
|
|
$self->botspeak( $kernel, $chan, $msg ); |
507
|
|
|
|
|
|
|
} |
508
|
|
|
|
|
|
|
else { |
509
|
|
|
|
|
|
|
my $say = $help->ask_help('say'); |
510
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $say ); |
511
|
|
|
|
|
|
|
} |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.logout$/i ) { |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "Bye Bye" ); |
516
|
|
|
|
|
|
|
$auth->de_auth($nick); |
517
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_close', $id ); |
518
|
|
|
|
|
|
|
|
519
|
|
|
|
|
|
|
} |
520
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.join/i ) { |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
523
|
|
|
|
|
|
|
my $chan = $arg[1]; |
524
|
|
|
|
|
|
|
|
525
|
|
|
|
|
|
|
if ($chan) { |
526
|
|
|
|
|
|
|
$kernel->post( NICK, 'join', $chan ); |
527
|
|
|
|
|
|
|
} |
528
|
|
|
|
|
|
|
else { |
529
|
|
|
|
|
|
|
my $join = $help->ask_help('join'); |
530
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $join ); |
531
|
|
|
|
|
|
|
} |
532
|
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.part/i ) { |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
536
|
|
|
|
|
|
|
my $chan = $arg[1]; |
537
|
|
|
|
|
|
|
|
538
|
|
|
|
|
|
|
if ($chan) { |
539
|
|
|
|
|
|
|
$kernel->post( NICK, 'part', $chan ); |
540
|
|
|
|
|
|
|
} |
541
|
|
|
|
|
|
|
else { |
542
|
|
|
|
|
|
|
my $part = $help->ask_help('part'); |
543
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $part ); |
544
|
|
|
|
|
|
|
} |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.help/i ) { |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
549
|
|
|
|
|
|
|
my $command = $arg[1]; |
550
|
|
|
|
|
|
|
|
551
|
|
|
|
|
|
|
if ($command) { |
552
|
|
|
|
|
|
|
if ( $command eq 'all' ) { |
553
|
|
|
|
|
|
|
my %help = $help->ask_help(); |
554
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, |
555
|
|
|
|
|
|
|
"Available Topics Are:" ); |
556
|
|
|
|
|
|
|
foreach my $keys ( keys %help ) { |
557
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "\cB$keys" ); |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, |
560
|
|
|
|
|
|
|
"Type .help for more info" ); |
561
|
|
|
|
|
|
|
} |
562
|
|
|
|
|
|
|
else { |
563
|
|
|
|
|
|
|
my $ans = $help->ask_help($command); |
564
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $ans ); |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
else { |
568
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, |
569
|
|
|
|
|
|
|
"Try .help all or .help for more help." ); |
570
|
|
|
|
|
|
|
} |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.quit/i ) { |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
575
|
|
|
|
|
|
|
my $mesg = $arg[1]; |
576
|
|
|
|
|
|
|
$msg =~ s/.quit\s*//; |
577
|
|
|
|
|
|
|
$msg =~ s/\n+//; |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
if ($mesg) { |
580
|
|
|
|
|
|
|
$kernel->call( NICK, 'quit', $msg ); |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
else { |
583
|
|
|
|
|
|
|
$kernel->call( NICK, 'quit', "IRC::BOT" ); |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.clear\s+\w$/i || $msg =~ m/^.clear$/i ) { |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
589
|
|
|
|
|
|
|
my $file = $arg[1]; |
590
|
|
|
|
|
|
|
my $clear = $log->clear_log($file); |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
if ( $clear != 0 ) { |
593
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "Cleared $file" ); |
594
|
|
|
|
|
|
|
} |
595
|
|
|
|
|
|
|
else { |
596
|
|
|
|
|
|
|
my $clear = $help->ask_help('clear'); |
597
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $clear ); |
598
|
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.kick/i ) { |
601
|
|
|
|
|
|
|
|
602
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
603
|
|
|
|
|
|
|
my $channel = $arg[1]; |
604
|
|
|
|
|
|
|
my $user = $arg[2]; |
605
|
|
|
|
|
|
|
my $mesg = $arg[3]; |
606
|
|
|
|
|
|
|
if ( $channel || $user || $mesg ) { |
607
|
|
|
|
|
|
|
$kernel->post( NICK, 'kick', $channel, $user, $mesg ); |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
else { |
610
|
|
|
|
|
|
|
my $kick = $help->get_help('kick'); |
611
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $kick ); |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
} |
614
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.op/i ) { |
615
|
|
|
|
|
|
|
|
616
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
617
|
|
|
|
|
|
|
my $channel = $arg[1]; |
618
|
|
|
|
|
|
|
my $user = $arg[2]; |
619
|
|
|
|
|
|
|
if ( $channel || $user ) { |
620
|
|
|
|
|
|
|
$kernel->post( NICK, 'mode', $channel, '+o', $user ); |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
else { |
623
|
|
|
|
|
|
|
my $op = $help->ask_help('op'); |
624
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $op ); |
625
|
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
} |
627
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.deop/i ) { |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
630
|
|
|
|
|
|
|
my $channel = $arg[1]; |
631
|
|
|
|
|
|
|
my $user = $arg[2]; |
632
|
|
|
|
|
|
|
if ( $channel || $user ) { |
633
|
|
|
|
|
|
|
$kernel->post( NICK, 'mode', $channel, '-o', $user ); |
634
|
|
|
|
|
|
|
} |
635
|
|
|
|
|
|
|
else { |
636
|
|
|
|
|
|
|
my $deop = $help->ask_help('deop'); |
637
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $deop ); |
638
|
|
|
|
|
|
|
} |
639
|
|
|
|
|
|
|
} |
640
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.ban/i ) { |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
643
|
|
|
|
|
|
|
my $channel = $arg[1]; |
644
|
|
|
|
|
|
|
my $host = $arg[2]; |
645
|
|
|
|
|
|
|
if ( $channel || $host ) { |
646
|
|
|
|
|
|
|
$kernel->post( NICK, 'mode', $channel, '+b', $host ); |
647
|
|
|
|
|
|
|
} |
648
|
|
|
|
|
|
|
else { |
649
|
|
|
|
|
|
|
my $ban = $help->ask_help('ban'); |
650
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $ban ); |
651
|
|
|
|
|
|
|
} |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
} |
654
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.unban/i ) { |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
657
|
|
|
|
|
|
|
my $channel = $arg[1]; |
658
|
|
|
|
|
|
|
my $host = $arg[2]; |
659
|
|
|
|
|
|
|
if ( $channel || $host ) { |
660
|
|
|
|
|
|
|
$kernel->post( NICK, 'mode', $channel, '-b', $host ); |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
else { |
663
|
|
|
|
|
|
|
my $unban = $help->ask_help('unban'); |
664
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $unban ); |
665
|
|
|
|
|
|
|
} |
666
|
|
|
|
|
|
|
} |
667
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.hop/i ) { |
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
670
|
|
|
|
|
|
|
my $channel = $arg[1]; |
671
|
|
|
|
|
|
|
my $user = $arg[2]; |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
if ( $channel || $user ) { |
674
|
|
|
|
|
|
|
$kernel->post( NICK, 'mode', $channel, '+h', $user ); |
675
|
|
|
|
|
|
|
} |
676
|
|
|
|
|
|
|
else { |
677
|
|
|
|
|
|
|
my $hop = $help->ask_help('hop'); |
678
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $hop ); |
679
|
|
|
|
|
|
|
} |
680
|
|
|
|
|
|
|
} |
681
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.dehop/i ) { |
682
|
|
|
|
|
|
|
|
683
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
684
|
|
|
|
|
|
|
my $channel = $arg[1]; |
685
|
|
|
|
|
|
|
my $user = $arg[2]; |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
if ( $channel || $user ) { |
688
|
|
|
|
|
|
|
$kernel->post( NICK, 'mode', $channel, '-h', $user ); |
689
|
|
|
|
|
|
|
} |
690
|
|
|
|
|
|
|
else { |
691
|
|
|
|
|
|
|
my $dehop = $help->ask_help('dehop'); |
692
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $dehop ); |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.voice/i ) { |
696
|
|
|
|
|
|
|
|
697
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
698
|
|
|
|
|
|
|
my $channel = $arg[1]; |
699
|
|
|
|
|
|
|
my $user = $arg[2]; |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
if ( $channel || $user ) { |
702
|
|
|
|
|
|
|
$kernel->post( NICK, 'mode', $channel, '+v', $user ); |
703
|
|
|
|
|
|
|
} |
704
|
|
|
|
|
|
|
else { |
705
|
|
|
|
|
|
|
my $voice = $help->ask_help('voice'); |
706
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $voice ); |
707
|
|
|
|
|
|
|
} |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
} |
710
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.devoice/i ) { |
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
713
|
|
|
|
|
|
|
my $channel = $arg[1]; |
714
|
|
|
|
|
|
|
my $user = $arg[2]; |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
if ( $channel || $user ) { |
717
|
|
|
|
|
|
|
$kernel->post( NICK, 'mode', $channel, '-v', $user ); |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
else { |
720
|
|
|
|
|
|
|
my $devoice = $help->ask_help('voice'); |
721
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $devoice ); |
722
|
|
|
|
|
|
|
} |
723
|
|
|
|
|
|
|
|
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.nick/i ) { |
726
|
|
|
|
|
|
|
|
727
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
728
|
|
|
|
|
|
|
my $nnick = $arg[1]; |
729
|
|
|
|
|
|
|
if ($nnick) { |
730
|
|
|
|
|
|
|
$kernel->post ( NICK, 'nick', $nnick ); |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
else { |
733
|
|
|
|
|
|
|
my $chnick = $help->ask_help('nick'); |
734
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $chnick); |
735
|
|
|
|
|
|
|
} |
736
|
|
|
|
|
|
|
} |
737
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.identify/i ) { |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
740
|
|
|
|
|
|
|
my $idpass = $arg[1]; |
741
|
|
|
|
|
|
|
if ($idpass) { |
742
|
|
|
|
|
|
|
$self->botspeak( $kernel, 'NickServ', "identify $idpass" ); |
743
|
|
|
|
|
|
|
} |
744
|
|
|
|
|
|
|
else { |
745
|
|
|
|
|
|
|
my $iden = $help->ask_help('identify'); |
746
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $iden); |
747
|
|
|
|
|
|
|
} |
748
|
|
|
|
|
|
|
|
749
|
|
|
|
|
|
|
} |
750
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.msg\s([^"]*)/i ) { |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
my $user = $1; |
753
|
|
|
|
|
|
|
if ($user) { |
754
|
|
|
|
|
|
|
$self->botspeak( $kernel, $user, "" ); |
755
|
|
|
|
|
|
|
} |
756
|
|
|
|
|
|
|
else { |
757
|
|
|
|
|
|
|
my $priv = $help->ask_help('msg'); |
758
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $priv); |
759
|
|
|
|
|
|
|
} |
760
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.away/i ) { |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
765
|
|
|
|
|
|
|
my $amsg = $arg[1]; |
766
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
if ($amsg) { |
768
|
|
|
|
|
|
|
$kernel->post( NICK, 'away', $amsg ); |
769
|
|
|
|
|
|
|
} |
770
|
|
|
|
|
|
|
else { |
771
|
|
|
|
|
|
|
my $away = $help->ask_help('away'); |
772
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $away ); |
773
|
|
|
|
|
|
|
} |
774
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
} |
776
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.back$/i ) { |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
$kernel->post( NICK, 'away' ); |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
} |
781
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.uptime$/i ) { |
782
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
my $time = sprintf( "%d Days, %02d:%02d:%02d", |
784
|
|
|
|
|
|
|
( gmtime( time() - $^T ) )[ 7, 2, 1, 0 ] ); |
785
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "I've been up for $time" ); |
786
|
|
|
|
|
|
|
} |
787
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.clearseen$/i ) { |
788
|
|
|
|
|
|
|
|
789
|
|
|
|
|
|
|
$seen->clear_seen(); |
790
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "Seen cache cleared!" ); |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
} |
793
|
|
|
|
|
|
|
elsif ( $msg =~ m/^.topic/i ) { |
794
|
|
|
|
|
|
|
my @arg = split ( / /, $msg ); |
795
|
|
|
|
|
|
|
my $chan = $arg[1]; |
796
|
|
|
|
|
|
|
$msg =~ s/\.topic\s+//; |
797
|
|
|
|
|
|
|
$msg =~ s/$chan//; |
798
|
|
|
|
|
|
|
$msg =~ s/\n+//; |
799
|
|
|
|
|
|
|
if ($msg) { |
800
|
|
|
|
|
|
|
$kernel->post( NICK, 'topic', $chan, $msg ); |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
else { |
803
|
|
|
|
|
|
|
my $topic = $help->ask_help('topic'); |
804
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, $topic ); |
805
|
|
|
|
|
|
|
} |
806
|
|
|
|
|
|
|
} |
807
|
|
|
|
|
|
|
else { |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, |
810
|
|
|
|
|
|
|
"\cB.help\cB is what you need" ); |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
else { |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_chat', $id, "Unauthorized!" ); |
816
|
|
|
|
|
|
|
$kernel->post( NICK, 'dcc_close', $id ); |
817
|
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
# Got an error, attempt to close session. |
821
|
|
|
|
|
|
|
# Doesn't appear to be working, I need to question |
822
|
|
|
|
|
|
|
# my implementation, but we'll do that later |
823
|
|
|
|
|
|
|
sub on_dcc_err { |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
my ( $self, $kernel, $id, $who ) = @_[ OBJECT, KERNEL, ARG0, ARG2 ]; |
826
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
827
|
|
|
|
|
|
|
$kernel->post( NICK, 'notice', $nick, "Bot Session Closed" ); |
828
|
|
|
|
|
|
|
$auth->de_auth($nick); |
829
|
|
|
|
|
|
|
|
830
|
|
|
|
|
|
|
} |
831
|
|
|
|
|
|
|
|
832
|
|
|
|
|
|
|
# DCC session is done, close out, kill session. |
833
|
|
|
|
|
|
|
sub on_dcc_done { |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
my ( $self, $kernel, $id, $who ) = @_[ OBJECT, KERNEL, ARG0, ARG1 ]; |
836
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
837
|
|
|
|
|
|
|
$auth->de_auth($nick); |
838
|
|
|
|
|
|
|
|
839
|
|
|
|
|
|
|
} |
840
|
|
|
|
|
|
|
|
841
|
|
|
|
|
|
|
# Got back info from the NAMES command. |
842
|
|
|
|
|
|
|
# Parse and send info to Seen.pm |
843
|
|
|
|
|
|
|
sub on_names { |
844
|
|
|
|
|
|
|
|
845
|
|
|
|
|
|
|
my ( $self, $kernel, $sender, $server, $who ) = |
846
|
|
|
|
|
|
|
@_[ OBJECT, KERNEL, SENDER, ARG0 .. ARG1 ]; |
847
|
|
|
|
|
|
|
|
848
|
|
|
|
|
|
|
$who =~ /([^"]*)\s+:([^"]*)\s+/; |
849
|
|
|
|
|
|
|
my $chan = $1; |
850
|
|
|
|
|
|
|
my $names = $2; |
851
|
|
|
|
|
|
|
$seen->load_current( $names, $chan ); |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
} |
854
|
|
|
|
|
|
|
|
855
|
|
|
|
|
|
|
# Daemonize process |
856
|
|
|
|
|
|
|
# Got this off of perlmonks |
857
|
|
|
|
|
|
|
# Node id: 121604 tailored to my needs |
858
|
|
|
|
|
|
|
# Was trying to avoid more dependencies. |
859
|
|
|
|
|
|
|
sub daemon { |
860
|
|
|
|
|
|
|
|
861
|
|
|
|
|
|
|
my $self = shift; |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
my @fh = ( \*STDIN, \*STDOUT ); |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
my $path; |
866
|
|
|
|
|
|
|
if (!defined($self->{'LogPath'})) { |
867
|
|
|
|
|
|
|
$path = $ENV{'HOME'}; |
868
|
|
|
|
|
|
|
} |
869
|
|
|
|
|
|
|
else { |
870
|
|
|
|
|
|
|
$path = $self->{'LogPath'}; |
871
|
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
open \*STDERR, ">$path/error.log"; |
873
|
|
|
|
|
|
|
select( ( select( \*STDERR ), $| = 1 )[0] ); |
874
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
my $ppid = $$; |
876
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
my $pid = fork && exit 0; |
878
|
|
|
|
|
|
|
|
879
|
|
|
|
|
|
|
!defined $pid && croak "No Fork: ", $!; |
880
|
|
|
|
|
|
|
|
881
|
|
|
|
|
|
|
while ( kill 0, $ppid ) { |
882
|
|
|
|
|
|
|
select undef, undef, undef, .001; |
883
|
|
|
|
|
|
|
} |
884
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
my $session_id = POSIX::setsid(); |
886
|
|
|
|
|
|
|
chdir '/' || croak "Could not cd to /", $!; |
887
|
|
|
|
|
|
|
my $oldmask = umask 00; |
888
|
|
|
|
|
|
|
close $_ || croak $! for @fh; |
889
|
|
|
|
|
|
|
|
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
# Disconnected, clean up a bit |
893
|
|
|
|
|
|
|
sub on_disco { |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
my $self = shift; |
896
|
|
|
|
|
|
|
$auth->de_auth(); |
897
|
|
|
|
|
|
|
exit(0); |
898
|
|
|
|
|
|
|
|
899
|
|
|
|
|
|
|
} |
900
|
|
|
|
|
|
|
|
901
|
|
|
|
|
|
|
1; |
902
|
|
|
|
|
|
|
|
903
|
|
|
|
|
|
|
__END__ |