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

package App::Devbot;

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

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,
  ));

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

  $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;
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/;
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
445eb545 PG	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");
bb1da1df MG	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.