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