1=encoding utf8 2 3=head1 NAME 4 5POE::Component::IRC::Cookbook::Seen - Implement the 'seen' command 6 7=head1 SYNOPSIS 8 9This little bot tracks the whereabouts of users and allows you to retrieve 10that information on command. 11 12 19:59:51 * seen_bot (n=hinrik@pool-71-164-43-32.chrlwv.east.verizon.net) has joined #test_channel1 13 19:59:55 <foo> bar 14 20:00:16 * seen_bot has quit (Remote closed the connection) 15 20:00:27 * seen_bot (n=hinrik@pool-71-164-43-32.chrlwv.east.verizon.net) has joined #test_channel1 16 20:00:29 <literal> seen_bot: seen seen_bot 17 20:00:29 <seen_bot> literal: I last saw seen_bot at Mon Sep 22 20:00:27 2008 joining #test_channel1 18 20:00:34 <literal> seen_bot: seen foo 19 20:00:40 <seen_bot> literal: I last saw foo at Mon Sep 22 19:59:56 2008 on #test_channel1 saying: bar 20 20:00:45 <literal> seen_bot: seen baz 21 20:00:48 <seen_bot> literal: I haven't seen baz 22 23=head1 DESCRIPTION 24 25 #!/usr/bin/env perl 26 27 use strict; 28 use warnings; 29 use IRC::Utils qw(parse_user lc_irc); 30 use POE; 31 use POE::Component::IRC::State; 32 use POE::Component::IRC::Plugin::AutoJoin; 33 use POE::Component::IRC::Plugin::BotCommand; 34 use Storable; 35 36 use constant { 37 USER_DATE => 0, 38 USER_MSG => 1, 39 DATA_FILE => 'seen', 40 SAVE_INTERVAL => 20 * 60, # save state every 20 mins 41 }; 42 43 my $seen = { }; 44 $seen = retrieve(DATA_FILE) if -s DATA_FILE; 45 46 POE::Session->create( 47 package_states => [ 48 main => [ qw( 49 _start 50 irc_botcmd_seen 51 irc_ctcp_action 52 irc_join 53 irc_part 54 irc_public 55 irc_quit 56 save 57 )] 58 ], 59 ); 60 61 $poe_kernel->run(); 62 63 sub _start { 64 my ($kernel, $heap) = @_[KERNEL, HEAP]; 65 my $irc = POE::Component::IRC::State->spawn( 66 Nick => 'seen_bot', 67 Server => 'irc.freenode.net', 68 ); 69 $heap->{irc} = $irc; 70 71 $irc->plugin_add('AutoJoin', POE::Component::IRC::Plugin::AutoJoin->new( 72 Channels => [ '#test_channel1', '#test_channel2' ] 73 )); 74 75 $irc->plugin_add('BotCommand', POE::Component::IRC::Plugin::BotCommand->new( 76 Commands => { 77 seen => 'Usage: seen <nick>' 78 } 79 )); 80 81 $irc->yield(register => qw(ctcp_action join part public quit botcmd_seen)); 82 $irc->yield('connect'); 83 $kernel->delay_set('save', SAVE_INTERVAL); 84 return; 85 } 86 87 sub save { 88 my $kernel = $_[KERNEL]; 89 warn "storing\n"; 90 store($seen, DATA_FILE) or die "Can't save state"; 91 $kernel->delay_set('save', SAVE_INTERVAL); 92 } 93 94 sub irc_ctcp_action { 95 my $nick = parse_user($_[ARG0]); 96 my $chan = $_[ARG1]->[0]; 97 my $text = $_[ARG2]; 98 99 add_nick($nick, "on $chan doing: * $nick $text"); 100 } 101 102 sub irc_join { 103 my $nick = parse_user($_[ARG0]); 104 my $chan = $_[ARG1]; 105 106 add_nick($nick, "joining $chan"); 107 } 108 109 sub irc_part { 110 my $nick = parse_user($_[ARG0]); 111 my $chan = $_[ARG1]; 112 my $text = $_[ARG2]; 113 114 my $msg = 'parting $chan'; 115 $msg .= " with message '$text'" if defined $text; 116 117 add_nick($nick, $msg); 118 } 119 120 sub irc_public { 121 my $nick = parse_user($_[ARG0]); 122 my $chan = $_[ARG1]->[0]; 123 my $text = $_[ARG2]; 124 125 add_nick($nick, "on $chan saying: $text"); 126 } 127 128 sub irc_quit { 129 my $nick = parse_user($_[ARG0]); 130 my $text = $_[ARG1]; 131 132 my $msg = 'quitting'; 133 $msg .= " with message '$text'" if defined $text; 134 135 add_nick($nick, $msg); 136 } 137 138 sub add_nick { 139 my ($nick, $msg) = @_; 140 $seen->{lc_irc($nick)} = [time, $msg]; 141 } 142 143 sub irc_botcmd_seen { 144 my ($heap, $nick, $channel, $target) = @_[HEAP, ARG0..$#_]; 145 $nick = parse_user($nick); 146 my $irc = $heap->{irc}; 147 148 if ($seen->{lc_irc($target)}) { 149 my $date = localtime $seen->{lc_irc($target)}->[USER_DATE]; 150 my $msg = $seen->{lc_irc($target)}->[USER_MSG]; 151 $irc->yield(privmsg => $channel, "$nick: I last saw $target at $date $msg"); 152 } 153 else { 154 $irc->yield(privmsg => $channel, "$nick: I haven't seen $target"); 155 } 156 } 157 158=head1 AUTHOR 159 160Hinrik E<Ouml>rn SigurE<eth>sson, hinrik.sig@gmail.com 161 162