From 30023d128d2cf9f2d3eb54e21b9d56779478caa3 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Mon, 19 Aug 2013 17:41:41 +0300 Subject: [PATCH] Initial commit --- Changes | 5 + MANIFEST | 6 + Makefile.PL | 18 ++ README | 32 ++++ lib/POE/Component/IRC/Plugin/Infobot.pm | 220 ++++++++++++++++++++++++ t/POE-Component-IRC-Plugin-Infobot.t | 56 ++++++ 6 files changed, 337 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile.PL create mode 100644 README create mode 100644 lib/POE/Component/IRC/Plugin/Infobot.pm create mode 100644 t/POE-Component-IRC-Plugin-Infobot.t diff --git a/Changes b/Changes new file mode 100644 index 0000000..6c36855 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for Perl extension POE::Component::IRC::Plugin::Infobot. + +0.001 Sat Jul 6 16:05:43 2013 + * Initial release + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..7000280 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,6 @@ +Changes +Makefile.PL +MANIFEST +README +t/POE-Component-IRC-Plugin-Infobot.t +lib/POE/Component/IRC/Plugin/Infobot.pm diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..91055ce --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +use ExtUtils::MakeMaker; + +WriteMakefile( + NAME => 'POE::Component::IRC::Plugin::Infobot', + VERSION_FROM => 'lib/POE/Component/IRC/Plugin/Infobot.pm', + ABSTRACT_FROM => 'lib/POE/Component/IRC/Plugin/Infobot.pm', + AUTHOR => 'Marius Gavrilescu ', + LICENSE => 'perl', + MIN_PERL_VERSION => '5.14.0', + META_ADD => { + dynamic_config => 0, + }, + PREREQ_PM => { + POE::Component::IRC::Plugin => 0, + IRC::Utils => 0.12, + DB_File => 0. + }, +); diff --git a/README b/README new file mode 100644 index 0000000..9881e83 --- /dev/null +++ b/README @@ -0,0 +1,32 @@ +POE-Component-IRC-Plugin-Infobot version 0.001 +============================================== + +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. + +INSTALLATION + +To install this module type the following: + + perl Makefile.PL + make + make test + make install + +DEPENDENCIES + +This module requires these other modules and libraries: + +* IRC::Utils +* POE::Component::IRC + +COPYRIGHT AND LICENCE + +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. diff --git a/lib/POE/Component/IRC/Plugin/Infobot.pm b/lib/POE/Component/IRC/Plugin/Infobot.pm new file mode 100644 index 0000000..1ca4e7a --- /dev/null +++ b/lib/POE/Component/IRC/Plugin/Infobot.pm @@ -0,0 +1,220 @@ +package POE::Component::IRC::Plugin::Infobot; + +use 5.014000; +use strict; +use warnings; + +our $VERSION = 0.001; + +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 (/^ (.+)$/i) { + $irc->yield(ctcp => $to => "ACTION $1") + } elsif (/^ (.*)$/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__ + +=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, the path to the factoids database. It is 'factoids.db' by default. + +=head1 IRC COMMANDS + +=over + +=item B + +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 y! + <+bot> sure, mgv + < mgv> bot: whistle is whistles + <+bot> + +=item B + +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 + +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<< >>, everything after the C<< >> is sent. If it starts with C<< >>, it is sent as a CTCP ACTION. Otherwise, a message of the form C 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, L + +=head1 AUTHOR + +Marius Gavrilescu, Emarius@ieval.roE + +=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 diff --git a/t/POE-Component-IRC-Plugin-Infobot.t b/t/POE-Component-IRC-Plugin-Infobot.t new file mode 100644 index 0000000..90723a9 --- /dev/null +++ b/t/POE-Component-IRC-Plugin-Infobot.t @@ -0,0 +1,56 @@ +#!/usr/bin/perl -wT +use strict; +use warnings; + +use Taint::Util qw/taint/; +use Test::MockObject; +use Test::More tests => 16; + +BEGIN { use_ok('POE::Component::IRC::Plugin::Infobot') }; + +no warnings 'redefine'; +sub POE::Component::IRC::Plugin::Infobot::getstr { + my $rstrings = shift; + sprintf @{$rstrings}[0], @_ +} +use warnings 'redefine'; + +my $last_msg; +my $last_ctcp; + +sub yield { + $last_msg = $_[3] if $_[1] eq 'privmsg'; + $last_ctcp = $_[3] if $_[1] eq 'ctcp'; +} + +my $mockirc = Test::MockObject->new; +$mockirc->mock(yield => \&yield)->set_always(nick_name => 'bot'); + +my $self = POE::Component::IRC::Plugin::Infobot->new(filename => undef); + +sub runtest{ + my ($message, $expect, $comment, $private) = @_; + undef $last_msg; + undef $last_ctcp; + $self->S_public($mockirc, \'mgv!marius@ieval.ro', \([ '#chan' ]), \$message) unless $private; + $self->S_msg($mockirc, \'mgv!marius@ieval.ro', undef, \$message) if $private; + is($last_msg // $last_ctcp, $expect, $comment) +} + +runtest 'bot: a is b', 'sure, mgv', 'add'; +runtest 'bot: a is b', 'I already had it that way, mgv', 'add same factoid twice'; +runtest 'bot: a is c', '... but a is b!', 'redefine factoid'; +runtest 'a?', 'a is b', 'query'; +runtest 'bot: forget a', 'mgv: I forgot a', 'forget'; +runtest 'bot: forget a', 'I didn\'t have anything matching a, mgv', 'forget inexistent factoid'; +runtest 'a?', undef, 'query for inexistent factoid'; +runtest 'bot: a?', 'I don\'t know, mgv', 'addressed query for inexistent factoid'; + +runtest 'bot: b is c', 'sure, mgv', 'add with reply'; +runtest 'b?', 'c', 'check reply'; +runtest 'bot: c is d', 'sure, mgv', 'add with action'; +runtest 'c?', 'ACTION d', 'check action'; + +runtest 'x is y', 'sure, mgv', 'private add', 1; +runtest 'x?', 'x is y', 'private query', 1; +runtest 'forget x', 'mgv: I forgot x', 'private forget', 1; -- 2.39.2