lib/App/Devbot.pm

   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 use Regexp::Common qw /net/;
  19
  20 ##################################################
  21
  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
  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");
  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.