[poe-component-irc-plugin-infobot.git] / lib / POE / Component / IRC / Plugin / Infobot.pm

package POE::Component::IRC::Plugin::Infobot;

use 5.014000;
use strict;
use warnings;
use re '/s';

our $VERSION = '0.001003';

use DB_File;

use IRC::Utils qw/parse_user/;
use POE::Component::IRC::Plugin qw/PCI_EAT_NONE/;

use constant +{ ## no critic (Capitalization)
	OK => [ 'sure, %s', 'ok, %s', 'gotcha, %s'],
	A_IS_B => [ '%s is %s', 'I think %s is %s', 'hmmm... %s is %s', 'it has been said that %s is %s', '%s is probably %s', 'rumour has it %s is %s', 'i heard %s was %s', 'somebody said %s is %s', 'i guess %s is %s', 'well, %s is %s', '%s is, like, %s', 'methinks %s is %s'],
	I_DONT_KNOW => [ 'I don\'t know, %s', 'Dunno, %s', 'No idea, %s', '%s: huh?', 'nem tudom, %s', 'anlamıyorum, %s', 'bilmiyorum, %s', 'nu ştiu d\'astea, %s', 'Je ne sais pas, %s', 'Я не знаю, %s'],
};

sub new { ## no critic (RequireArgUnpacking)
	my $class = shift;
	my $self = {
		filename => 'factoids.db',
		@_
	};

	my %db;
	$self->{dbobj} = tie %db, DB_File => $self->{filename} if defined $self->{filename}; ## no critic (ProhibitTie)
	$self->{db} = \%db;
	bless $self, $class
}

sub getstr {
	my $rstrings = shift;
	my @strings = @$rstrings;
	sprintf $strings[int rand $#strings], @_
}

sub infobot_add { ## no critic (ProhibitManyArgs)
	my ($self, $irc, $key, $value, $to, $nick) = @_;
	if (exists $self->{db}->{$key}) {
		$irc->yield(privmsg => $to => "I already had it that way, $nick") if $value eq $self->{db}->{$key};
		$irc->yield(privmsg => $to => "... but $key is $self->{db}->{$key}!") unless $value eq $self->{db}->{$key};
	} else {
		$self->{db}->{$key} = $value;
		$self->{dbobj}->sync if exists $self->{dbobj};
		$irc->yield(privmsg => $to => getstr OK, $nick);
	}
}

sub infobot_query { ## no critic (ProhibitManyArgs)
	my ($self, $irc, $key, $to, $nick, $addressed) = @_;
	if (exists $self->{db}->{$key}) {
		my @answers = split /\s+[|]\s+/, $self->{db}->{$key};
		local $_ = $answers[int rand $#answers];

		if (/^<action> (.+)$/i) {
			$irc->yield(ctcp => $to => "ACTION $1")
		} elsif (/^<reply> (.*)$/i) {
			$irc->yield(privmsg => $to => $1)
		} else {
			$irc->yield(privmsg => $to => getstr A_IS_B, $key, $_)
		}
	} elsif ($addressed) {
		$irc->yield(privmsg => $to => getstr I_DONT_KNOW, $nick)
	}
}

sub infobot_forget {
	my ($self, $irc, $key, $to, $nick) = @_;
	if (exists $self->{db}->{$key}) {
		delete $self->{db}->{$key};
		$self->{dbobj}->sync if exists $self->{dbobj};
		$irc->yield(privmsg => $to => "$nick: I forgot $key")
	} else {
		$irc->yield(privmsg => $to => "I didn't have anything matching $key, $nick")
	}
}

sub runcmd{  ## no critic (ProhibitManyArgs)
	my ($self, $irc, $to, $nick, $message, $addressed) = @_;

	local $_= $message;

	if (/^(.+)\s+is\s+(.*[^?])$/x) {
		infobot_add $self, $irc, $1, $2, $to, $nick if $addressed
	} elsif (/^(.+)[?]$/) {
		infobot_query $self, $irc, $1, $to, $nick, $addressed
	} elsif ($addressed && /^!?forget\s+(.*)$/ || /^!forget\s+(.*)$/) {
		infobot_forget $self, $irc, $1, $to, $nick
	}
}

sub PCI_register { ## no critic (Capitalization)
	my ($self, $irc) = @_;
	$irc->plugin_register($self, SERVER => qw/public msg/);
	1
}

sub PCI_unregister{ 1 } ## no critic (Capitalization)

sub S_public { ## no critic (Capitalization)
	my ($self, $irc, $rfullname, $rchannels, $rmessage) = @_;
	my $nick = parse_user $$rfullname;

	for my $channel (@$$rchannels) {
		local $_ = $$rmessage;

		my $addressed=0;
		my $mynick=$irc->nick_name;
		if (/^$mynick [,:]\s+/x) {
			$addressed=1;
			s/^$mynick [,:]\s+//x;
		}

		runcmd $self, $irc, $channel, $nick, $_, $addressed
	}

	PCI_EAT_NONE
}

sub S_msg{ ## no critic (Capitalization)
	my ($self, $irc, $rfullname, $rtargets, $rmessage) = @_;
	my $nick = parse_user $$rfullname;

	runcmd $self, $irc, $nick, $nick, $$rmessage, 1;

	PCI_EAT_NONE
}

1;
__END__

=encoding utf-8

=head1 NAME

POE::Component::IRC::Plugin::Infobot - Add infobot features to an PoCo-IRC

=head1 SYNOPSIS

  use POE::Component::IRC::Plugin::Infobot;
  $irc->plugin_add(Infobot => POE::Component::Plugin::Infobot->new(filename => '/tmp/stuff.db'))

=head1 DESCRIPTION

POE::Component::IRC::Plugin::Infobot is a PoCo-IRC plugin that makes a PoCo-IRC behave like a simple infobot.

It stores factoids in a DB_File database and lets IRC users add, remove and retreive factoids.

The constructor takes one optional argument, I<filename>, the path to the factoids database. It is 'factoids.db' by default.

=head1 IRC COMMANDS

=over

=item B<add>

Any message of the form "X is Y" which is addressed to the bot or sent in private is an add command. This will not overwrite a previous factoid with the same key.

Example session:

  < mgv> bot: IRC is Internet Relay Chat
  <+bot> OK, mgv
  < mgv> bot: IRC is Internet Relay Chat
  <+bot> I already had it that way, mgv
  < mgv> bot: IRC is Internally-Routed Communication
  <+bot> ... but IRC is Internet Relay Chat!
  < mgv> bot: x is <reply> y!
  <+bot> sure, mgv
  < mgv> bot: whistle is <action> whistles
  <+bot>

=item B<forget>

Any message of the form "forget X" which is addressed to the bot or sent in private is a forget command. This command will erase any previous factoid with this key.

Example session:

  < mgv> bot: forget IRC
  <+bot> mgv: I forgot IRC
  < mgv> bot: forget IRC
  <+bot> I didn't have anything matching IRC, mgv

=item B<query>

Any message ending in a question mark is a query command. If a factoid with that key is found, the plugin will respond. If no such factoid is found AND the message is either addressed to the bot or sent in private, the bot will say that it doesn't know the answer to the question.

If the factoid starts with C<< <reply> >>, everything after the C<< <reply> >> is sent. If it starts with C<< <action> >>, it is sent as a CTCP ACTION. Otherwise, a message of the form C<factoid_key is factoid_value> is sent.

Example session:

  < mgv> IRC?
  <+bot> methinks IRC is Internet Relay Chat
  < mgv> ASD?
  < mgv> bot: ASD?
  <+bot> Dunno, mgv
  < mgv> x?
  <+bot> y!
  < mgv> whistle?
  * bot whistles

=back

=head1 SEE ALSO

L<POE::Component::IRC::Plugin>, L<http://infobot.sourceforge.net/>

=head1 AUTHOR

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

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013-2015 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.


=cut
Commit	Line	Data
	1	package POE::Component::IRC::Plugin::Infobot;
	2
	3	use 5.014000;
	4	use strict;
	5	use warnings;
	6	use re '/s';
	7
	8	our $VERSION = '0.001003';
	9
	10	use DB_File;
	11
	12	use IRC::Utils qw/parse_user/;
	13	use POE::Component::IRC::Plugin qw/PCI_EAT_NONE/;
	14
	15	use constant +{ ## no critic (Capitalization)
	16	OK => [ 'sure, %s', 'ok, %s', 'gotcha, %s'],
	17	A_IS_B => [ '%s is %s', 'I think %s is %s', 'hmmm... %s is %s', 'it has been said that %s is %s', '%s is probably %s', 'rumour has it %s is %s', 'i heard %s was %s', 'somebody said %s is %s', 'i guess %s is %s', 'well, %s is %s', '%s is, like, %s', 'methinks %s is %s'],
	18	I_DONT_KNOW => [ 'I don\'t know, %s', 'Dunno, %s', 'No idea, %s', '%s: huh?', 'nem tudom, %s', 'anlamıyorum, %s', 'bilmiyorum, %s', 'nu ştiu d\'astea, %s', 'Je ne sais pas, %s', 'Я не знаю, %s'],
	19	};
	20
	21	sub new { ## no critic (RequireArgUnpacking)
	22	my $class = shift;
	23	my $self = {
	24	filename => 'factoids.db',
	25	@_
	26	};
	27
	28	my %db;
	29	$self->{dbobj} = tie %db, DB_File => $self->{filename} if defined $self->{filename}; ## no critic (ProhibitTie)
	30	$self->{db} = \%db;
	31	bless $self, $class
	32	}
	33
	34	sub getstr {
	35	my $rstrings = shift;
	36	my @strings = @$rstrings;
	37	sprintf $strings[int rand $#strings], @_
	38	}
	39
	40	sub infobot_add { ## no critic (ProhibitManyArgs)
	41	my ($self, $irc, $key, $value, $to, $nick) = @_;
	42	if (exists $self->{db}->{$key}) {
	43	$irc->yield(privmsg => $to => "I already had it that way, $nick") if $value eq $self->{db}->{$key};
	44	$irc->yield(privmsg => $to => "... but $key is $self->{db}->{$key}!") unless $value eq $self->{db}->{$key};
	45	} else {
	46	$self->{db}->{$key} = $value;
	47	$self->{dbobj}->sync if exists $self->{dbobj};
	48	$irc->yield(privmsg => $to => getstr OK, $nick);
	49	}
	50	}
	51
	52	sub infobot_query { ## no critic (ProhibitManyArgs)
	53	my ($self, $irc, $key, $to, $nick, $addressed) = @_;
	54	if (exists $self->{db}->{$key}) {
	55	my @answers = split /\s+[\|]\s+/, $self->{db}->{$key};
	56	local $_ = $answers[int rand $#answers];
	57
	58	if (/^<action> (.+)$/i) {
	59	$irc->yield(ctcp => $to => "ACTION $1")
	60	} elsif (/^<reply> (.*)$/i) {
	61	$irc->yield(privmsg => $to => $1)
	62	} else {
	63	$irc->yield(privmsg => $to => getstr A_IS_B, $key, $_)
	64	}
	65	} elsif ($addressed) {
	66	$irc->yield(privmsg => $to => getstr I_DONT_KNOW, $nick)
	67	}
	68	}
	69
	70	sub infobot_forget {
	71	my ($self, $irc, $key, $to, $nick) = @_;
	72	if (exists $self->{db}->{$key}) {
	73	delete $self->{db}->{$key};
	74	$self->{dbobj}->sync if exists $self->{dbobj};
	75	$irc->yield(privmsg => $to => "$nick: I forgot $key")
	76	} else {
	77	$irc->yield(privmsg => $to => "I didn't have anything matching $key, $nick")
	78	}
	79	}
	80
	81	sub runcmd{ ## no critic (ProhibitManyArgs)
	82	my ($self, $irc, $to, $nick, $message, $addressed) = @_;
	83
	84	local $_= $message;
	85
	86	if (/^(.+)\s+is\s+(.*[^?])$/x) {
	87	infobot_add $self, $irc, $1, $2, $to, $nick if $addressed
	88	} elsif (/^(.+)[?]$/) {
	89	infobot_query $self, $irc, $1, $to, $nick, $addressed
	90	} elsif ($addressed && /^!?forget\s+(.)$/ \|\| /^!forget\s+(.)$/) {
	91	infobot_forget $self, $irc, $1, $to, $nick
	92	}
	93	}
	94
	95	sub PCI_register { ## no critic (Capitalization)
	96	my ($self, $irc) = @_;
	97	$irc->plugin_register($self, SERVER => qw/public msg/);
	98	1
	99	}
	100
	101	sub PCI_unregister{ 1 } ## no critic (Capitalization)
	102
	103	sub S_public { ## no critic (Capitalization)
	104	my ($self, $irc, $rfullname, $rchannels, $rmessage) = @_;
	105	my $nick = parse_user $$rfullname;
	106
	107	for my $channel (@$$rchannels) {
	108	local $_ = $$rmessage;
	109
	110	my $addressed=0;
	111	my $mynick=$irc->nick_name;
	112	if (/^$mynick [,:]\s+/x) {
	113	$addressed=1;
	114	s/^$mynick [,:]\s+//x;
	115	}
	116
	117	runcmd $self, $irc, $channel, $nick, $_, $addressed
	118	}
	119
	120	PCI_EAT_NONE
	121	}
	122
	123	sub S_msg{ ## no critic (Capitalization)
	124	my ($self, $irc, $rfullname, $rtargets, $rmessage) = @_;
	125	my $nick = parse_user $$rfullname;
	126
	127	runcmd $self, $irc, $nick, $nick, $$rmessage, 1;
	128
	129	PCI_EAT_NONE
	130	}
	131
	132	1;
	133	__END__
	134
	135	=encoding utf-8
	136
	137	=head1 NAME
	138
	139	POE::Component::IRC::Plugin::Infobot - Add infobot features to an PoCo-IRC
	140
	141	=head1 SYNOPSIS
	142
	143	use POE::Component::IRC::Plugin::Infobot;
	144	$irc->plugin_add(Infobot => POE::Component::Plugin::Infobot->new(filename => '/tmp/stuff.db'))
	145
	146	=head1 DESCRIPTION
	147
	148	POE::Component::IRC::Plugin::Infobot is a PoCo-IRC plugin that makes a PoCo-IRC behave like a simple infobot.
	149
	150	It stores factoids in a DB_File database and lets IRC users add, remove and retreive factoids.
	151
	152	The constructor takes one optional argument, I<filename>, the path to the factoids database. It is 'factoids.db' by default.
	153
	154	=head1 IRC COMMANDS
	155
	156	=over
	157
	158	=item B<add>
	159
	160	Any message of the form "X is Y" which is addressed to the bot or sent in private is an add command. This will not overwrite a previous factoid with the same key.
	161
	162	Example session:
	163
	164	< mgv> bot: IRC is Internet Relay Chat
	165	<+bot> OK, mgv
	166	< mgv> bot: IRC is Internet Relay Chat
	167	<+bot> I already had it that way, mgv
	168	< mgv> bot: IRC is Internally-Routed Communication
	169	<+bot> ... but IRC is Internet Relay Chat!
	170	< mgv> bot: x is <reply> y!
	171	<+bot> sure, mgv
	172	< mgv> bot: whistle is <action> whistles
	173	<+bot>
	174
	175	=item B<forget>
	176
	177	Any message of the form "forget X" which is addressed to the bot or sent in private is a forget command. This command will erase any previous factoid with this key.
	178
	179	Example session:
	180
	181	< mgv> bot: forget IRC
	182	<+bot> mgv: I forgot IRC
	183	< mgv> bot: forget IRC
	184	<+bot> I didn't have anything matching IRC, mgv
	185
	186	=item B<query>
	187
	188	Any message ending in a question mark is a query command. If a factoid with that key is found, the plugin will respond. If no such factoid is found AND the message is either addressed to the bot or sent in private, the bot will say that it doesn't know the answer to the question.
	189
	190	If the factoid starts with C<< <reply> >>, everything after the C<< <reply> >> is sent. If it starts with C<< <action> >>, it is sent as a CTCP ACTION. Otherwise, a message of the form C<factoid_key is factoid_value> is sent.
	191
	192	Example session:
	193
	194	< mgv> IRC?
	195	<+bot> methinks IRC is Internet Relay Chat
	196	< mgv> ASD?
	197	< mgv> bot: ASD?
	198	<+bot> Dunno, mgv
	199	< mgv> x?
	200	<+bot> y!
	201	< mgv> whistle?
	202	* bot whistles
	203
	204	=back
	205
	206	=head1 SEE ALSO
	207
	208	L<POE::Component::IRC::Plugin>, L<http://infobot.sourceforge.net/>
	209
	210	=head1 AUTHOR
	211
	212	Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
	213
	214	=head1 COPYRIGHT AND LICENSE
	215
	216	Copyright (C) 2013-2015 by Marius Gavrilescu
	217
	218	This library is free software; you can redistribute it and/or modify
	219	it under the same terms as Perl itself, either Perl version 5.14.2 or,
	220	at your option, any later version of Perl 5 you may have available.
	221
	222
	223	=cut