lib/App/Devbot.pm

   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.