[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;

our $VERSION = '0.001002';

use DB_File;

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

use constant +{
	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 {
	my $class = shift;
	my $self = {
		filename => 'factoids.db',
		@_
	};

	my %db;
	$self->{dbobj} = tie %db, DB_File => $self->{filename} if defined $self->{filename};
	$self->{db} = \%db;
	bless $self, $class
}

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

sub infobot_add {
	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 {
	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{
	my ($self, $irc, $to, $nick, $message, $addressed) = @_;

	local $_= $message;

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

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

sub PCI_unregister{ 1 }

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