File Coverage

blib/lib/POE/Component/IRC/Plugin/Seen.pm
Criterion Covered Total %
statement 9 11 81.8
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 13 15 86.6


line stmt bran cond sub pod time code
1             package POE::Component::IRC::Plugin::Seen;
2              
3             our $VERSION = 0.001002;
4              
5 1     1   38669 use v5.14;
  1         3  
6 1     1   9 use strict;
  1         2  
  1         44  
7 1     1   8 use warnings;
  1         8  
  1         65  
8              
9 1     1   590 use DB_File;
  0            
  0            
10              
11             use IRC::Utils qw/lc_irc parse_user/;
12             use POE::Component::IRC::Plugin qw/PCI_EAT_NONE PCI_EAT_PLUGIN/;
13              
14             ##################################################
15              
16             sub new{
17             my $class = shift;
18             my $self = { @_ };
19              
20             $self->{dbobj} = tie my %db, DB_File => $self->{filename};
21             $self->{db} = \%db;
22             bless $self, $class
23             }
24              
25             sub log_event {
26             my ($self, $nick, $event) = @_;
27             my $time = localtime;
28             $self->{db}->{$nick} = "$time $event";
29             $self->{dbobj}->sync;
30             PCI_EAT_NONE
31             }
32              
33             sub seen {
34             my ($self, $irc, $nick, $to, $from) = @_;
35             if (exists $self->{db}->{$nick}) {
36             $irc->yield(privmsg => $to => "I last saw $nick $self->{db}->{$nick}")
37             } else {
38             $irc->yield(privmsg => $to => "I haven't seen $nick")
39             }
40             PCI_EAT_PLUGIN
41             }
42              
43             sub PCI_register {
44             my ($self, $irc) = @_;
45             $irc->plugin_register($self, SERVER => qw/ctcp_action join part public msg/);
46             1
47             }
48              
49             sub PCI_unregister { 1 }
50              
51             sub S_ctcp_action {
52             my ($self, $irc, $rfullname, $rchannels, $rmessage) = @_;
53             my $nick = parse_user $$rfullname;
54              
55             log_event $self, $nick => "on $$rchannels->[0] doing: * $$rmessage"
56             }
57              
58             sub S_public {
59             my ($self, $irc, $rfullname, $rchannels, $rmessage) = @_;
60             my $nick = parse_user $$rfullname;
61             my $mynick = $irc->nick_name;
62              
63             seen $self, $irc, $1, $$rchannels->[0], $nick if $$rmessage =~ /^(?:$mynick [,:])?\s*!?seen\s+([^ ]+)/x;
64             log_event $self, $nick => "on $$rchannels->[0] saying $$rmessage"
65             }
66              
67             sub S_join {
68             my ($self, $irc, $rfullname, $rchannel) = @_;
69             my $nick = parse_user $$rfullname;
70              
71             log_event $self, $nick => "joining $$rchannel"
72             }
73              
74             sub S_part {
75             my ($self, $irc, $rfullname, $rchannel, $rmessage) = @_;
76             my $nick = parse_user $$rfullname;
77             my $msg = $$rmessage ? " with message '$$rmessage'" : '';
78              
79             log_event $self, $nick => "parting $$rchannel$msg"
80             }
81              
82             sub S_msg {
83             my ($self, $irc, $rfullname, $rtargets, $rmessage) = @_;
84             my $nick = parse_user $$rfullname;
85              
86             seen $self, $irc, $1, $$rtargets->[0], $nick if $$rmessage =~ /^\s*!?seen\s+([^ ]+)/
87             }
88              
89             1;
90             __END__