| 1 | package POE::Component::IRC::Plugin::Seen; |
| 2 | |
| 3 | our $VERSION = 0.001001; |
| 4 | |
| 5 | use v5.14; |
| 6 | use strict; |
| 7 | use warnings; |
| 8 | |
| 9 | use DB_File; |
| 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__ |
| 91 | |
| 92 | =head1 NAME |
| 93 | |
| 94 | POE::Component::IRC::Plugin::Seen - PoCo-IRC plugin that remembers seeing people |
| 95 | |
| 96 | =head1 SYNOPSIS |
| 97 | |
| 98 | use POE::Component::IRC::Plugin::Seen; |
| 99 | |
| 100 | my $irc = POE::Component::IRC->spawn; |
| 101 | $irc->plugin_add(Seen => POE::Component::IRC::Plugin::Seen->new(filename => 'mycache.db')); |
| 102 | |
| 103 | =head1 DESCRIPTION |
| 104 | |
| 105 | POE::Component::IRC::Plugin::Seen is a PoCo-IRC plugin that remembers what each person around it did last. |
| 106 | |
| 107 | When somebody sends him a private message of the form 'seen NICKNAME' or somebody says 'botnick: seen NICKNAME' in a channel with the bot, the plugin answers with the last action NICKNAME did. |
| 108 | |
| 109 | =head1 METHODS |
| 110 | |
| 111 | =over |
| 112 | |
| 113 | =item B<new>([I<filename> => value]) |
| 114 | |
| 115 | Creates a new plugin object suitable for L<POE::Component::IRC>'s C<plugin_add> method. |
| 116 | |
| 117 | Takes one optional argument, C<filename>, the name of the file to store the plugin's state in. If C<undef> or not given, it keeps the state in memory. |
| 118 | |
| 119 | =back |
| 120 | |
| 121 | =head1 SEE ALSO |
| 122 | |
| 123 | L<POE::Component::IRC::Plugin> |
| 124 | |
| 125 | =head1 AUTHOR |
| 126 | |
| 127 | Marius Gavrilescu C<< <marius@ieval.ro> >> |
| 128 | |
| 129 | =head1 COPYRIGHT AND LICENSE |
| 130 | |
| 131 | Copyright (C) 2013,2014 by Marius Gavrilescu |
| 132 | |
| 133 | This library is free software; you can redistribute it and/or modify |
| 134 | it under the same terms as Perl itself, either Perl version 5.14.2 or, |
| 135 | at your option, any later version of Perl 5 you may have available. |
| 136 | |
| 137 | |
| 138 | =cut |