[app-devbot.git] / lib / App / Devbot.pm

package App::Devbot;

use v5.14;
use strict;
use warnings;
our $VERSION = 0.001004;

use POE;
use POE::Component::IRC::State;
use POE::Component::IRC::Plugin::AutoJoin;
use POE::Component::IRC::Plugin::NickServID;

use File::Slurp qw/append_file/;
use IRC::Utils qw/parse_user/;

use Getopt::Long;
use POSIX qw/strftime/;
use Regexp::Common qw /net/;

##################################################

my $nick='devbot';
my $password;
my $server='irc.oftc.net';
my $port=6697;
my $ssl=1;
my @channels;
my $trace=0;

my $log=1;
my $store_files=0;

GetOptions (
  "nick=s" => \$nick,
  "password=s" => \$password,
  "server=s" => \$server,
  "port=i" => \$port,
  "ssl!" => \$ssl,
  "channel=s" => \@channels,
  "log!" => \$log,
  "store-files!" => \$store_files,
  "trace!" => \$trace,
);

my $irc;

sub mode_char {
  my ($channel, $nick)=@_;
  return '~' if $irc->is_channel_owner($channel, $nick);
  return '&' if $irc->is_channel_admin($channel, $nick);
  return '@' if $irc->is_channel_operator($channel, $nick);
  return '%' if $irc->is_channel_halfop($channel, $nick);
  return '+' if $irc->has_channel_voice($channel, $nick);
  return ' '
}

sub log_event{
  return unless $log;
  my ($channel, @strings) = @_;
  my $file=strftime '%F', localtime;
  mkdir 'logs';
  mkdir "logs/$channel";
  append_file "logs/$channel/$file.txt", strftime ('%T ', localtime), @strings, "\n";
}

sub bot_start{
  $irc->plugin_add (NickServID => POE::Component::IRC::Plugin::NickServID->new(Password => $password)) if defined $password;
  $irc->plugin_add (AutoJoin => POE::Component::IRC::Plugin::AutoJoin->new(
	Channels => \@channels,
	RejoinOnKick => 1,
	Rejoin_delay => 10,
	Retry_when_banned => 60,
  ));

  $server = $1 if $server =~ /^($RE{net}{domain})$/;
  $port   = $1 if $port =~ /^([0-9]+)$/;

  $irc->yield(register => "all");
  $irc->yield(
	connect => {
	  Nick     => $nick,
	  Username => 'devbot',
	  Ircname  => "devbot $VERSION",
	  Server   => $server,
	  Port     => $port,
	  UseSSL   => $ssl,
	}
  );
}

sub on_public{
  my ($fulluser, $channels, $message)=@_[ARG0, ARG1, ARG2];
  my $nick=parse_user $fulluser;

  for (@$channels) {
	my $mode_char=mode_char $_, $nick;
	log_event $_, "<$mode_char$nick> $message";
  }
}

sub on_ctcp_action{
  my ($fulluser, $channels, $message)=@_[ARG0, ARG1, ARG2];
  my $nick=parse_user $fulluser;

  log_event $_, "* $nick $message" for @$channels;
}

sub on_join{
  my ($fulluser, $channel)=@_[ARG0, ARG1];
  my ($nick, $user, $host)=parse_user $fulluser;

  log_event $channel, "-!- $nick [$user\@$host] has joined $channel";
}

sub on_part{
  my ($fulluser, $channel, $message)=@_[ARG0, ARG1, ARG2];
  my ($nick, $user, $host)=parse_user $fulluser;

  log_event $channel, "-!- $nick [$user\@$host] has left $channel [$message]";
}

sub on_kick{
  my ($fulluser, $channel, $target, $message)=@_[ARG0, ARG1, ARG2, ARG3];
  my $nick=parse_user $fulluser;

  log_event $channel, "-!- $target was kicked from $channel by $nick [$message]";
}

sub on_mode{
  my ($fulluser, $channel, @args)=@_[ARG0 .. $#_];
  my $nick=parse_user $fulluser;
  my $mode=join ' ', @args;

  log_event $channel, "-!- mode/$channel [$mode] by $nick";
}

sub on_topic{
  my ($fulluser, $channel, $topic)=@_[ARG0, ARG1, ARG2];
  my $nick=parse_user $fulluser;

  log_event $channel, "-!- $nick changed the topic of $channel to: $topic" if $topic;
  log_event $channel, "-!- Topic unset by $nick on $channel" unless $topic;
}

sub on_nick{
  my ($fulluser, $nick, $channels)=@_[ARG0, ARG1, ARG2];
  my $oldnick=parse_user $fulluser;

  log_event $_, "-!- $oldnick is now known as $nick" for @$channels;
}

sub on_quit{
  my ($fulluser, $message, $channels)=@_[ARG0, ARG1, ARG2];
  my ($nick, $user, $host)=parse_user $fulluser;

  log_event $_, "-!- $nick [$user\@$host] has quit [$message]" for @$channels;
}

sub on_dcc_request{
  return unless $store_files;
  my ($fulluser, $type, $cookie, $name)=@_[ARG0, ARG1, ARG3, ARG4];
  my $nick=parse_user $fulluser;
  return unless $type eq 'SEND';
  return unless $irc->nick_channels($nick);
  return if $name =~ m,/,;

  mkdir 'files';
  $irc->yield(dcc_accept => $cookie, "files/$name");
}

sub run{
  $irc=POE::Component::IRC::State->spawn();

  POE::Session->create(
	inline_states => {
	  _start  => \&bot_start,
	  irc_public => \&on_public,
	  irc_ctcp_action => \&on_ctcp_action,
	  irc_join => \&on_join,
	  irc_part => \&on_part,
	  irc_kick => \&on_kick,
	  irc_mode => \&on_mode,
	  irc_topic => \&on_topic,
	  irc_nick => \&on_nick,
	  irc_quit => \&on_quit,
	  irc_dcc_request => \&on_dcc_request
	},
	options => {
	  trace => $trace
	}
  );

  $poe_kernel->run();
}

1;

__END__

=head1 NAME

App::Devbot - IRC bot which helps development

=head1 SYNOPSIS

  use App::Devbot;
  App::Devbot->run;

=head1 DESCRIPTION

App::Devbot is an IRC bot which helps developers collaborate.

Right now, it only does channel logging and file storage. It might do more in the future.

=head1 OPTIONS

=over

=item B<--nick> I<nickname>

The nickname of devbot. Defaults to devbot.

=item B<--password> I<password>

If supplied, identify to NickServ with this password

=item B<--server> I<hostname>

The server to connect to. Defaults to irc.oftc.net.

=item B<--port> I<port>

The port to connect to. Defaults to 6697.

=item B<--ssl>, B<--no-ssl>

B<--ssl> enables connecting to the server with SSL, B<--no-ssl> disables this. Defaults to B<--ssl>.

=item B<--channel> I<channel>

Makes devbot connect to I<channel>. Can be supplied multiple times for multiple channels. Has no default value.

=item B<--log>, B<--no-log>

B<--log> enables logging events to 'logs/I<CHANNEL>/I<DATE>.txt'. B<--no-log> disables logging. Defaults to B<--log>.

=item B<--store-files>, B<--no-store-files>

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>.

=item B<--trace>, B<--no-trace>

B<--trace> enables POE::Component::IRC::State tracing. Useful for debugging. B<--no-trace> disables tracing. Defaults to B<--no-trace>.

=back

=head1 CAVEATS

As stated above, the B<--store-files> option should only be used on private channels where every user is trusted.

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013 by Marius Gavrilescu

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