line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package POE::Component::IRC::Qnet; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:HINRIK'; |
3
|
|
|
|
|
|
|
$POE::Component::IRC::Qnet::VERSION = '6.91'; |
4
|
3
|
|
|
3
|
|
88568
|
use strict; |
|
3
|
|
|
|
|
18
|
|
|
3
|
|
|
|
|
99
|
|
5
|
3
|
|
|
3
|
|
15
|
use warnings FATAL => 'all'; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
131
|
|
6
|
3
|
|
|
3
|
|
13
|
use Carp; |
|
3
|
|
|
|
|
11
|
|
|
3
|
|
|
|
|
176
|
|
7
|
3
|
|
|
3
|
|
28
|
use POE; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
18
|
|
8
|
3
|
|
|
3
|
|
1362
|
use POE::Component::IRC::Constants qw(:ALL); |
|
3
|
|
|
|
|
14
|
|
|
3
|
|
|
|
|
659
|
|
9
|
3
|
|
|
3
|
|
20
|
use base qw(POE::Component::IRC); |
|
3
|
|
|
|
|
5
|
|
|
3
|
|
|
|
|
1564
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub _create { |
12
|
1
|
|
|
1
|
|
2
|
my $self = shift; |
13
|
|
|
|
|
|
|
|
14
|
1
|
|
|
|
|
6
|
$self->SUPER::_create(); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# Stuff specific to IRC-Qnet |
17
|
1
|
|
|
|
|
14
|
my @qbot_commands = qw( |
18
|
|
|
|
|
|
|
hello |
19
|
|
|
|
|
|
|
whoami |
20
|
|
|
|
|
|
|
challengeauth |
21
|
|
|
|
|
|
|
showcommands |
22
|
|
|
|
|
|
|
auth |
23
|
|
|
|
|
|
|
challenge |
24
|
|
|
|
|
|
|
help |
25
|
|
|
|
|
|
|
unlock |
26
|
|
|
|
|
|
|
requestpassword |
27
|
|
|
|
|
|
|
reset |
28
|
|
|
|
|
|
|
newpass |
29
|
|
|
|
|
|
|
email |
30
|
|
|
|
|
|
|
authhistory |
31
|
|
|
|
|
|
|
banclear |
32
|
|
|
|
|
|
|
op |
33
|
|
|
|
|
|
|
invite |
34
|
|
|
|
|
|
|
removeuser |
35
|
|
|
|
|
|
|
banlist |
36
|
|
|
|
|
|
|
recover |
37
|
|
|
|
|
|
|
limit |
38
|
|
|
|
|
|
|
unbanall |
39
|
|
|
|
|
|
|
whois |
40
|
|
|
|
|
|
|
version |
41
|
|
|
|
|
|
|
autolimit |
42
|
|
|
|
|
|
|
ban |
43
|
|
|
|
|
|
|
clearchan |
44
|
|
|
|
|
|
|
adduser |
45
|
|
|
|
|
|
|
settopic |
46
|
|
|
|
|
|
|
chanflags |
47
|
|
|
|
|
|
|
deopall |
48
|
|
|
|
|
|
|
requestowner |
49
|
|
|
|
|
|
|
bandel |
50
|
|
|
|
|
|
|
chanlev |
51
|
|
|
|
|
|
|
key |
52
|
|
|
|
|
|
|
welcome |
53
|
|
|
|
|
|
|
voice |
54
|
|
|
|
|
|
|
); |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
|
57
|
1
|
|
|
|
|
29
|
$self->{OBJECT_STATES_HASHREF}->{'qbot_' . $_} = '_qnet_bot_commands' for @qbot_commands; |
58
|
1
|
|
|
|
|
3
|
$self->{server} = 'irc.quakenet.org'; |
59
|
1
|
|
|
|
|
3
|
$self->{QBOT} = 'Q@Cserve.quakenet.org'; |
60
|
|
|
|
|
|
|
|
61
|
1
|
|
|
|
|
3
|
return 1; |
62
|
|
|
|
|
|
|
} |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
sub _qnet_bot_commands { |
65
|
0
|
|
|
0
|
|
|
my ($kernel, $state, $self) = @_[KERNEL,STATE,OBJECT]; |
66
|
0
|
|
|
|
|
|
my $message = join ' ', @_[ARG0 .. $#_]; |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
|
my $pri = $self->{IRC_CMDS}->{'privmsghi'}->[CMD_PRI]; |
69
|
0
|
|
|
|
|
|
my $command = "PRIVMSG "; |
70
|
0
|
|
|
|
|
|
my ($target,$cmd) = split(/_/,$state); |
71
|
0
|
|
|
|
|
|
$command .= join(' :',$self->{uc $target},uc($cmd)); |
72
|
0
|
0
|
|
|
|
|
$command = join(' ',$command,$message) if defined ( $message ); |
73
|
0
|
|
|
|
|
|
$kernel->yield( 'sl_prioritized', $pri, $command ); |
74
|
|
|
|
|
|
|
|
75
|
0
|
|
|
|
|
|
return; |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
sub service_bots { |
79
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
80
|
|
|
|
|
|
|
|
81
|
0
|
|
|
|
|
|
for my $botname ( qw(QBOT) ) { |
82
|
0
|
0
|
|
|
|
|
if ( defined ( $args{$botname} ) ) { |
83
|
0
|
|
|
|
|
|
$self->{$botname} = $args{$botname}; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
0
|
|
|
|
|
|
return 1; |
88
|
|
|
|
|
|
|
} |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
1; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
=encoding utf8 |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=head1 NAME |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
POE::Component::IRC::Qnet - A fully event-driven IRC client module for Quakenet |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
=head1 SYNOPSIS |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
use strict; |
101
|
|
|
|
|
|
|
use warnings; |
102
|
|
|
|
|
|
|
use POE qw(Component::IRC::Qnet); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
my $nickname = 'Flibble' . $$; |
105
|
|
|
|
|
|
|
my $ircname = 'Flibble the Sailor Bot'; |
106
|
|
|
|
|
|
|
my $port = 6667; |
107
|
|
|
|
|
|
|
my $qauth = 'FlibbleBOT'; |
108
|
|
|
|
|
|
|
my $qpass = 'fubar'; |
109
|
|
|
|
|
|
|
my @channels = ( '#Blah', '#Foo', '#Bar' ); |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
# We create a new PoCo-IRC object and component. |
112
|
|
|
|
|
|
|
my $irc = POE::Component::IRC::Qnet->spawn( |
113
|
|
|
|
|
|
|
nick => $nickname, |
114
|
|
|
|
|
|
|
port => $port, |
115
|
|
|
|
|
|
|
ircname => $ircname, |
116
|
|
|
|
|
|
|
) or die "Oh noooo! $!"; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
POE::Session->create( |
119
|
|
|
|
|
|
|
package_states => [ |
120
|
|
|
|
|
|
|
main => [ qw(_default _start irc_001 irc_public) ], |
121
|
|
|
|
|
|
|
], |
122
|
|
|
|
|
|
|
heap => { irc => $irc }, |
123
|
|
|
|
|
|
|
); |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
$poe_kernel->run(); |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub _start { |
128
|
|
|
|
|
|
|
my ($kernel, $heap) = @_[KERNEL, HEAP]; |
129
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
# We get the session ID of the component from the object |
131
|
|
|
|
|
|
|
# and register and connect to the specified server. |
132
|
|
|
|
|
|
|
my $irc_session = $heap->{irc}->session_id(); |
133
|
|
|
|
|
|
|
$kernel->post( $irc_session => register => 'all' ); |
134
|
|
|
|
|
|
|
$kernel->post( $irc_session => connect => { } ); |
135
|
|
|
|
|
|
|
return; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub irc_001 { |
139
|
|
|
|
|
|
|
my ($kernel, $sender) = @_[KERNEL, SENDER]; |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
# Get the component's object at any time by accessing the heap of |
142
|
|
|
|
|
|
|
# the SENDER |
143
|
|
|
|
|
|
|
my $poco_object = $sender->get_heap(); |
144
|
|
|
|
|
|
|
print "Connected to ", $poco_object->server_name(), "\n"; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# Lets authenticate with Quakenet's Q bot |
147
|
|
|
|
|
|
|
$kernel->post( $sender => qbot_auth => $qauth => $qpass ); |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
return; |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub irc_public { |
153
|
|
|
|
|
|
|
my ($kernel, $sender, $who, $where, $what) = @_[KERNEL, SENDER, ARG0 .. ARG2]; |
154
|
|
|
|
|
|
|
my $nick = ( split /!/, $who )[0]; |
155
|
|
|
|
|
|
|
my $channel = $where->[0]; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
if ( my ($rot13) = $what =~ /^rot13 (.+)/ ) { |
158
|
|
|
|
|
|
|
$rot13 =~ tr[a-zA-Z][n-za-mN-ZA-M]; |
159
|
|
|
|
|
|
|
$kernel->post( $sender => privmsg => $channel => "$nick: $rot13" ); |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
return; |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# We registered for all events, this will produce some debug info. |
165
|
|
|
|
|
|
|
sub _default { |
166
|
|
|
|
|
|
|
my ($event, $args) = @_[ARG0 .. $#_]; |
167
|
|
|
|
|
|
|
my @output = ( "$event: " ); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
for my $arg ( @$args ) { |
170
|
|
|
|
|
|
|
if (ref $arg eq 'ARRAY') { |
171
|
|
|
|
|
|
|
push( @output, '[' . join(', ', @$arg ) . ']' ); |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
else { |
174
|
|
|
|
|
|
|
push ( @output, "'$arg'" ); |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
|
print join ' ', @output, "\n"; |
178
|
|
|
|
|
|
|
return 0; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head1 DESCRIPTION |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
POE::Component::IRC::Qnet is an extension to L |
184
|
|
|
|
|
|
|
specifically for use on Quakenet L. See the |
185
|
|
|
|
|
|
|
documentation for L for general usage. |
186
|
|
|
|
|
|
|
This document covers the extensions. |
187
|
|
|
|
|
|
|
|
188
|
|
|
|
|
|
|
The module provides a number of additional commands for communicating with the |
189
|
|
|
|
|
|
|
Quakenet service bot Q. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head1 METHODS |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head2 C |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
The component will query Q its default name on Quakenet. If you |
196
|
|
|
|
|
|
|
wish to override these settings, use this method to configure them. |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
$irc->service_bots(QBOT => 'W@blah.network.net'); |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
In most cases you shouldn't need to mess with these >;o) |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=head1 INPUT |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
The Quakenet service bots accept input as PRIVMSG. This module provides a |
205
|
|
|
|
|
|
|
wrapper around the L "privmsg" command. |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
=head2 C |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
Send commands to the Q bot. Pass additional command parameters as arguments to |
210
|
|
|
|
|
|
|
the event. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
$kernel->post ('my client' => qbot_auth => $q_user => $q_pass); |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
=head1 OUTPUT EVENTS |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
All output from the Quakenet service bots is sent as NOTICEs. |
217
|
|
|
|
|
|
|
Use L|POE::Component::IRC/irc_notice> to trap these. |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=head2 C |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
Has all the same hash keys in C as L, |
222
|
|
|
|
|
|
|
with the addition of B<'account'>, which contains the name of their Q auth account, |
223
|
|
|
|
|
|
|
if they have authed, or a false value if they haven't. |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
=head1 BUGS |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
A few have turned up in the past and they are sure to again. Please use |
228
|
|
|
|
|
|
|
L to report any. Alternatively, email the current maintainer. |
229
|
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
=head1 AUTHOR |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
Chris 'BinGOs' Williams Echris@bingosnet.co.ukE |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
Based on the original POE::Component::IRC by: |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Dennis Taylor, |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=head1 SEE ALSO |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
L |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
L |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
=cut |