X-Git-Url: http://git.ieval.ro/?a=blobdiff_plain;f=lib%2FPOE%2FComponent%2FIRC%2FPlugin%2FInfobot.pm;h=7fb2b31267bcfaf3469985b5499afe9e52dfe557;hb=35c98648a47fe8e7d52af8aae8e6ec77e4d52257;hp=1ca4e7a096c7f987a84a8878a3fb3ef741cfd790;hpb=30023d128d2cf9f2d3eb54e21b9d56779478caa3;p=poe-component-irc-plugin-infobot.git diff --git a/lib/POE/Component/IRC/Plugin/Infobot.pm b/lib/POE/Component/IRC/Plugin/Infobot.pm index 1ca4e7a..7fb2b31 100644 --- a/lib/POE/Component/IRC/Plugin/Infobot.pm +++ b/lib/POE/Component/IRC/Plugin/Infobot.pm @@ -3,134 +3,137 @@ package POE::Component::IRC::Plugin::Infobot; use 5.014000; use strict; use warnings; +use re '/s'; -our $VERSION = 0.001; +our $VERSION = '0.001003'; 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'], +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 { - 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 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], @_ + 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_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 { - 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, $_) +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 (/^ (.+)$/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) } - } 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") - } + 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) = @_; +sub runcmd{ ## no critic (ProhibitManyArgs) + my ($self, $irc, $to, $nick, $message, $addressed) = @_; - local $_= $message; + 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 - } + 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 { - my ($self, $irc) = @_; - $irc->plugin_register($self, SERVER => qw/public msg/); - 1 +sub PCI_register { ## no critic (Capitalization) + my ($self, $irc) = @_; + $irc->plugin_register($self, SERVER => qw/public msg/); + 1 } -sub PCI_unregister{ 1 } +sub PCI_unregister{ 1 } ## no critic (Capitalization) -sub S_public { - my ($self, $irc, $rfullname, $rchannels, $rmessage) = @_; - my $nick = parse_user $$rfullname; +sub S_public { ## no critic (Capitalization) + my ($self, $irc, $rfullname, $rchannels, $rmessage) = @_; + my $nick = parse_user $$rfullname; - for my $channel (@$$rchannels) { - local $_ = $$rmessage; + for my $channel (@$$rchannels) { + local $_ = $$rmessage; - my $addressed=0; - my $mynick=$irc->nick_name; - if (/^$mynick [,:]\s+/x) { - $addressed=1; - s/^$mynick [,:]\s+//x; - } + my $addressed=0; + my $mynick=$irc->nick_name; + if (/^$mynick [,:]\s+/x) { + $addressed=1; + s/^$mynick [,:]\s+//x; + } - runcmd $self, $irc, $channel, $nick, $_, $addressed - } + runcmd $self, $irc, $channel, $nick, $_, $addressed + } - PCI_EAT_NONE + PCI_EAT_NONE } -sub S_msg{ - my ($self, $irc, $rfullname, $rtargets, $rmessage) = @_; - my $nick = parse_user $$rfullname; +sub S_msg{ ## no critic (Capitalization) + my ($self, $irc, $rfullname, $rtargets, $rmessage) = @_; + my $nick = parse_user $$rfullname; - runcmd $self, $irc, $nick, $nick, $$rmessage, 1; + runcmd $self, $irc, $nick, $nick, $$rmessage, 1; - PCI_EAT_NONE + PCI_EAT_NONE } 1; __END__ +=encoding utf-8 + =head1 NAME POE::Component::IRC::Plugin::Infobot - Add infobot features to an PoCo-IRC @@ -210,7 +213,7 @@ Marius Gavrilescu, Emarius@ieval.roE =head1 COPYRIGHT AND LICENSE -Copyright (C) 2013 by Marius Gavrilescu +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,