]>
Commit | Line | Data |
---|---|---|
bb1da1df MG |
1 | package App::Devbot 0.001002; |
2 | use v5.14; | |
3 | use warnings; | |
4 | ||
5 | use POE; | |
6 | use POE::Component::IRC::State; | |
7 | use POE::Component::IRC::Plugin::AutoJoin; | |
8 | use POE::Component::IRC::Plugin::NickServID; | |
9 | ||
10 | use File::Slurp qw/append_file/; | |
11 | use IRC::Utils qw/parse_user/; | |
12 | ||
13 | use Getopt::Long; | |
14 | use POSIX qw/strftime/; | |
15 | ||
16 | ################################################## | |
17 | ||
18 | our $VERSION; | |
19 | ||
20 | my $nick='devbot'; | |
21 | my $password; | |
22 | my $server='irc.oftc.net'; | |
23 | my $port=6697; | |
24 | my $ssl=1; | |
25 | my @channels; | |
26 | my $trace=0; | |
27 | ||
28 | my $log=1; | |
29 | my $store_files=0; | |
30 | ||
31 | GetOptions ( | |
32 | "nick=s" => \$nick, | |
33 | "password=s" => \$password, | |
34 | "server=s" => \$server, | |
35 | "port=i" => \$port, | |
36 | "ssl!" => \$ssl, | |
37 | "channel=s" => \@channels, | |
38 | "log!" => \$log, | |
39 | "store-files!" => \$store_files, | |
40 | "trace!" => \$trace, | |
41 | ); | |
42 | ||
43 | my $irc; | |
44 | ||
45 | sub mode_char { | |
46 | my ($channel, $nick)=@_; | |
47 | return '~' if $irc->is_channel_owner($channel, $nick); | |
48 | return '&' if $irc->is_channel_admin($channel, $nick); | |
49 | return '@' if $irc->is_channel_operator($channel, $nick); | |
50 | return '%' if $irc->is_channel_halfop($channel, $nick); | |
51 | return '+' if $irc->has_channel_voice($channel, $nick); | |
52 | return ' ' | |
53 | } | |
54 | ||
55 | sub log_event{ | |
56 | return unless $log; | |
57 | my ($channel, @strings) = @_; | |
58 | my $file=strftime '%F', localtime; | |
59 | mkdir 'logs'; | |
60 | mkdir "logs/$channel"; | |
61 | append_file "logs/$channel/$file.txt", strftime ('%T ', localtime), @strings, "\n"; | |
62 | } | |
63 | ||
64 | sub bot_start{ | |
65 | $irc->plugin_add (NickServID => POE::Component::IRC::Plugin::NickServID->new(Password => $password)) if defined $password; | |
66 | $irc->plugin_add (AutoJoin => POE::Component::IRC::Plugin::AutoJoin->new( | |
67 | Channels => \@channels, | |
68 | RejoinOnKick => 1, | |
69 | Rejoin_delay => 10, | |
70 | Retry_when_banned => 60, | |
71 | )); | |
72 | ||
73 | $irc->yield(register => "all"); | |
74 | $irc->yield( | |
75 | connect => { | |
76 | Nick => $nick, | |
77 | Username => 'devbot', | |
78 | Ircname => "devbot $VERSION", | |
79 | Server => $server, | |
80 | Port => $port, | |
81 | UseSSL => $ssl, | |
82 | } | |
83 | ); | |
84 | } | |
85 | ||
86 | sub on_public{ | |
87 | my ($fulluser, $channels, $message)=@_[ARG0, ARG1, ARG2]; | |
88 | my $nick=parse_user $fulluser; | |
89 | ||
90 | for (@$channels) { | |
91 | my $mode_char=mode_char $_, $nick; | |
92 | log_event $_, "<$mode_char$nick> $message"; | |
93 | } | |
94 | } | |
95 | ||
96 | sub on_ctcp_action{ | |
97 | my ($fulluser, $channels, $message)=@_[ARG0, ARG1, ARG2]; | |
98 | my $nick=parse_user $fulluser; | |
99 | ||
100 | log_event $_, "* $nick $message" for @$channels; | |
101 | } | |
102 | ||
103 | sub on_join{ | |
104 | my ($fulluser, $channel)=@_[ARG0, ARG1]; | |
105 | my ($nick, $user, $host)=parse_user $fulluser; | |
106 | ||
107 | log_event $channel, "-!- $nick [$user\@$host] has joined $channel"; | |
108 | } | |
109 | ||
110 | sub on_part{ | |
111 | my ($fulluser, $channel, $message)=@_[ARG0, ARG1, ARG2]; | |
112 | my ($nick, $user, $host)=parse_user $fulluser; | |
113 | ||
114 | log_event $channel, "-!- $nick [$user\@$host] has left $channel [$message]"; | |
115 | } | |
116 | ||
117 | sub on_kick{ | |
118 | my ($fulluser, $channel, $target, $message)=@_[ARG0, ARG1, ARG2, ARG3]; | |
119 | my $nick=parse_user $fulluser; | |
120 | ||
121 | log_event $channel, "-!- $target was kicked from $channel by $nick [$message]"; | |
122 | } | |
123 | ||
124 | sub on_mode{ | |
125 | my ($fulluser, $channel, @args)=@_[ARG0 .. $#_]; | |
126 | my $nick=parse_user $fulluser; | |
127 | my $mode=join ' ', @args; | |
128 | ||
129 | log_event $channel, "-!- mode/$channel [$mode] by $nick"; | |
130 | } | |
131 | ||
132 | sub on_topic{ | |
133 | my ($fulluser, $channel, $topic)=@_[ARG0, ARG1, ARG2]; | |
134 | my $nick=parse_user $fulluser; | |
135 | ||
136 | log_event $channel, "-!- $nick changed the topic of $channel to: $topic" if $topic; | |
137 | log_event $channel, "-!- Topic unset by $nick on $channel" unless $topic; | |
138 | } | |
139 | ||
140 | sub on_nick{ | |
141 | my ($fulluser, $nick, $channels)=@_[ARG0, ARG1, ARG2]; | |
142 | my $oldnick=parse_user $fulluser; | |
143 | ||
144 | log_event $_, "-!- $oldnick is now known as $nick" for @$channels; | |
145 | } | |
146 | ||
147 | sub on_quit{ | |
148 | my ($fulluser, $message, $channels)=@_[ARG0, ARG1, ARG2]; | |
149 | my ($nick, $user, $host)=parse_user $fulluser; | |
150 | ||
151 | log_event $_, "-!- $nick [$user\@$host] has quit [$message]" for @$channels; | |
152 | } | |
153 | ||
154 | sub on_dcc_request{ | |
155 | return unless $store_files; | |
156 | my ($fulluser, $type, $cookie, $name)=@_[ARG0, ARG1, ARG3, ARG4]; | |
157 | my $nick=parse_user $fulluser; | |
158 | return unless $type eq 'SEND'; | |
159 | return unless $irc->nick_channels($nick); | |
160 | return if $name =~ m,/,; | |
161 | ||
162 | mkdir 'files'; | |
163 | $irc->yield(dcc_accept => $cookie, "files/$name"); | |
164 | } | |
165 | ||
166 | sub run{ | |
167 | $irc=POE::Component::IRC::State->spawn(); | |
168 | ||
169 | POE::Session->create( | |
170 | inline_states => { | |
171 | _start => \&bot_start, | |
172 | irc_public => \&on_public, | |
173 | irc_ctcp_action => \&on_ctcp_action, | |
174 | irc_join => \&on_join, | |
175 | irc_part => \&on_part, | |
176 | irc_kick => \&on_kick, | |
177 | irc_mode => \&on_mode, | |
178 | irc_topic => \&on_topic, | |
179 | irc_nick => \&on_nick, | |
180 | irc_quit => \&on_quit, | |
181 | irc_dcc_request => \&on_dcc_request | |
182 | }, | |
183 | options => { | |
184 | trace => $trace | |
185 | } | |
186 | ); | |
187 | ||
188 | $poe_kernel->run(); | |
189 | } | |
190 | ||
191 | 1; | |
192 | ||
193 | __END__ | |
194 | ||
195 | =head1 NAME | |
196 | ||
197 | App::Devbot - IRC bot which helps development | |
198 | ||
199 | =head1 SYNOPSIS | |
200 | ||
201 | use App::Devbot; | |
202 | App::Devbot->run; | |
203 | ||
204 | =head1 DESCRIPTION | |
205 | ||
206 | App::Devbot is an IRC bot which helps developers collaborate. | |
207 | ||
208 | Right now, it only does channel logging and file storage. It might do more in the future. | |
209 | ||
210 | =head1 OPTIONS | |
211 | ||
212 | =over | |
213 | ||
214 | =item B<--nick> I<nickname> | |
215 | ||
216 | The nickname of devbot. Defaults to devbot. | |
217 | ||
218 | =item B<--password> I<password> | |
219 | ||
220 | If supplied, identify to NickServ with this password | |
221 | ||
222 | =item B<--server> I<hostname> | |
223 | ||
224 | The server to connect to. Defaults to irc.oftc.net. | |
225 | ||
226 | =item B<--port> I<port> | |
227 | ||
228 | The port to connect to. Defaults to 6697. | |
229 | ||
230 | =item B<--ssl>, B<--no-ssl> | |
231 | ||
232 | B<--ssl> enables connecting to the server with SSL, B<--no-ssl> disables this. Defaults to B<--ssl>. | |
233 | ||
234 | =item B<--channel> I<channel> | |
235 | ||
236 | Makes devbot connect to I<channel>. Can be supplied multiple times for multiple channels. Has no default value. | |
237 | ||
238 | =item B<--log>, B<--no-log> | |
239 | ||
240 | B<--log> enables logging events to 'logs/I<CHANNEL>/I<DATE>.txt'. B<--no-log> disables logging. Defaults to B<--log>. | |
241 | ||
242 | =item B<--store-files>, B<--no-store-files> | |
243 | ||
244 | B<--store-files> enables storing files received via DCC to 'files/I<FILENAME>'. Files are only accepted if the sender and devbot share a channel. B<Only use when all channel users are trusted>. B<--no-store-files> disables storing files. Defaults to <--no-store-files>. | |
245 | ||
246 | =item B<--trace>, B<--no-trace> | |
247 | ||
248 | B<--trace> enables POE::Component::IRC::State tracing. Useful for debugging. B<--no-trace> disables tracing. Defaults to B<--no-trace>. | |
249 | ||
250 | =back | |
251 | ||
252 | =head1 CAVEATS | |
253 | ||
254 | As stated above, the B<--store-files> option should only be used on private channels where every user is trusted. | |
255 | ||
256 | =head1 AUTHOR | |
257 | ||
258 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
259 | ||
260 | =head1 COPYRIGHT AND LICENSE | |
261 | ||
262 | Copyright (C) 2013 by Marius Gavrilescu | |
263 | ||
264 | This library is free software; you can redistribute it and/or modify | |
265 | it under the same terms as Perl itself, either Perl version 5.14.2 or, | |
266 | at your option, any later version of Perl 5 you may have available. |