lib/POE/Component/IRC/Plugin/Seen.pm

   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, $$rmessage, $$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