| 1 | package App::Devbot; |
| 2 | |
| 3 | use v5.14; |
| 4 | use strict; |
| 5 | use warnings; |
| 6 | our $VERSION = 0.001003; |
| 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. |