line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package POE::Component::IRC::Plugin::Infobot; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
25175
|
use 5.014000; |
|
1
|
|
|
|
|
4
|
|
4
|
1
|
|
|
1
|
|
6
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
5
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
29
|
|
6
|
1
|
|
|
1
|
|
5
|
use re '/s'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
81
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
our $VERSION = '0.001003'; |
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
511
|
use DB_File; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
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 (/^ (.+)$/i) { |
59
|
|
|
|
|
|
|
$irc->yield(ctcp => $to => "ACTION $1") |
60
|
|
|
|
|
|
|
} elsif (/^ (.*)$/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__ |