]>
iEval git - poe-component-irc-plugin-infobot.git/blob - lib/POE/Component/IRC/Plugin/Infobot.pm
1 package POE
:: Component
:: IRC
:: Plugin
:: Infobot
;
8 our $VERSION = '0.001003' ;
12 use IRC
:: Utils qw
/parse_user/ ;
13 use POE
:: Component
:: IRC
:: Plugin qw
/PCI_EAT_NONE/ ;
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 ' ],
21 sub new
{ ## no critic (RequireArgUnpacking)
24 filename
=> 'factoids.db' ,
29 $self ->{ dbobj
} = tie
%db , DB_File
=> $self ->{ filename
} if defined $self ->{ filename
}; ## no critic (ProhibitTie)
36 my @strings = @
$rstrings ;
37 sprintf $strings [ int rand $#strings ], @_
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 };
46 $self ->{ db
}->{ $key } = $value ;
47 $self ->{ dbobj
}-> sync if exists $self ->{ dbobj
};
48 $irc -> yield ( privmsg
=> $to => getstr OK
, $nick );
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 ];
58 if ( /^<action> (.+)$/i ) {
59 $irc -> yield ( ctcp
=> $to => "ACTION $1 " )
60 } elsif ( /^<reply> (.*)$/i ) {
61 $irc -> yield ( privmsg
=> $to => $1 )
63 $irc -> yield ( privmsg
=> $to => getstr A_IS_B
, $key , $_ )
65 } elsif ( $addressed ) {
66 $irc -> yield ( privmsg
=> $to => getstr I_DONT_KNOW
, $nick )
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 " )
77 $irc -> yield ( privmsg
=> $to => "I didn't have anything matching $key , $nick " )
81 sub runcmd
{ ## no critic (ProhibitManyArgs)
82 my ( $self , $irc , $to , $nick , $message , $addressed ) = @_ ;
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
95 sub PCI_register
{ ## no critic (Capitalization)
96 my ( $self , $irc ) = @_ ;
97 $irc -> plugin_register ( $self , SERVER
=> qw
/public msg/ );
101 sub PCI_unregister
{ 1 } ## no critic (Capitalization)
103 sub S_public
{ ## no critic (Capitalization)
104 my ( $self , $irc , $rfullname , $rchannels , $rmessage ) = @_ ;
105 my $nick = parse_user
$ $rfullname ;
107 for my $channel ( @
$ $rchannels ) {
108 local $_ = $ $rmessage ;
111 my $mynick = $irc -> nick_name ;
112 if ( /^$mynick [,:]\s+/x ) {
114 s/^$mynick [,:]\s+//x ;
117 runcmd
$self , $irc , $channel , $nick , $_ , $addressed
123 sub S_msg
{ ## no critic (Capitalization)
124 my ( $self , $irc , $rfullname , $rtargets , $rmessage ) = @_ ;
125 my $nick = parse_user
$ $rfullname ;
127 runcmd
$self , $irc , $nick , $nick , $ $rmessage , 1 ;
139 POE::Component::IRC::Plugin::Infobot - Add infobot features to an PoCo-IRC
143 use POE::Component::IRC::Plugin::Infobot;
144 $irc->plugin_add(Infobot => POE::Component::Plugin::Infobot->new(filename => '/tmp/stuff.db'))
148 POE::Component::IRC::Plugin::Infobot is a PoCo-IRC plugin that makes a PoCo-IRC behave like a simple infobot.
150 It stores factoids in a DB_File database and lets IRC users add, remove and retreive factoids.
152 The constructor takes one optional argument, I<filename>, the path to the factoids database. It is 'factoids.db' by default.
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.
164 < mgv> bot: IRC is Internet Relay Chat
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!
172 < mgv> bot: whistle is <action> whistles
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.
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
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.
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.
195 <+bot> methinks IRC is Internet Relay Chat
208 L<POE::Component::IRC::Plugin>, L<http://infobot.sourceforge.net/>
212 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
214 =head1 COPYRIGHT AND LICENSE
216 Copyright (C) 2013-2015 by Marius Gavrilescu
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.
This page took 0.062382 seconds and 5 git commands to generate.