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