lib/App/FonBot/Plugin/IRC.pm

   1 package App::FonBot::Plugin::IRC;
   2
   3 our $VERSION = '0.000_3';
   4
   5 use v5.14;
   6 use strict;
   7 use warnings;
   8
   9 use Apache2::Authen::Passphrase qw/pwcheck/;
  10 use IRC::Utils qw/parse_user/;
  11 use Log::Log4perl qw//;
  12 use POE;
  13 use POE::Component::IRC qw//;
  14
  15 use Text::ParseWords qw/shellwords/;
  16 use subs qw/shutdown/;
  17
  18 use App::FonBot::Plugin::Common;
  19
  20 ##################################################
  21
  22 my %selves;
  23
  24 sub init{
  25         my ($ns)=@_;
  26
  27         my $self=$ns->new;
  28         $self->{log}->info("initializing $ns");
  29         tie my %nick_to_username, DB_File => "nick_to_username-$ns.db";
  30         $self->{nick_to_username}=\%nick_to_username;
  31         $selves{$ns}=$self
  32 }
  33
  34 sub fini{
  35         my ($ns)=@_;
  36
  37         $selves{$ns}->{log}->info("finishing $ns");
  38         $selves{$ns}->{irc}->yield(shutdown => "finishing $ns") if defined $selves{$ns}->{irc};
  39         untie $selves{$ns}->{nick_to_username};
  40         POE::Kernel->post($selves{$ns}->{session} => 'shutdown');
  41         delete $selves{$ns}
  42 }
  43
  44 ##################################################
  45
  46 sub new{
  47         my ($ns)=@_;
  48
  49         my $self = {
  50                 prefix => {},
  51                 log => Log::Log4perl->get_logger($ns),
  52         };
  53
  54         bless $self, $ns;
  55
  56         $self->{session} = POE::Session->create(
  57                 object_states => [ $self => [ '_start', 'send_message', 'irc_001', 'irc_msg', 'irc_public', 'shutdown' ] ],
  58         );
  59
  60         $self
  61 }
  62
  63 sub irc_msg{
  64         my ($from, $msg, $self)=@_[ARG0,ARG2,OBJECT];
  65         my $nick=parse_user $from;
  66
  67         my $username=$self->{nick_to_username}{$from};
  68         my $address=$_[KERNEL]->alias_list;
  69         $address.=" $nick";
  70
  71         chomp $msg;
  72         my @args=shellwords $msg;
  73         my $cmd=shift @args;
  74
  75         given($cmd){
  76                 when(/^myid$/i){
  77                         $self->{irc}->yield(privmsg => $nick, $from);
  78                 }
  79
  80                 when(/^login$/i) {
  81                         my ($user, $pass) = @args;
  82
  83                         eval { pwcheck $user, $pass };
  84
  85                         if ($@) {
  86                                 $self->{log}->debug("Login for $user failed");
  87                                 $self->{irc}->yield(privmsg => $nick, 'Bad username/password combination');
  88                         } else {
  89                                 $self->{log}->debug("Login for $user succeded");
  90                                 $self->{nick_to_username}{$from} = $user;
  91                                 $self->{irc}->yield(privmsg => $nick, "Logged in as $user");
  92                         }
  93                 }
  94
  95                 when(/^logout$/i){
  96                         delete $self->{nick_to_username}{$from};
  97                 }
  98
  99                 when(/^prefix$/i){
 100                         if (defined $username) {
 101                                 $self->{prefix}{$username} = [@args];
 102                         } else {
 103                                 $self->{irc}->yield(privmsg => $nick, 'You are not logged in. Say "login your_username your_password" (where your_username and your_password are your login credentials) to login.');
 104                         }
 105                 }
 106
 107                 when(/^noprefix$/i){
 108                         if (defined $username) {
 109                                 delete $self->{prefix}{$username}
 110                         } else {
 111                                 $self->{irc}->yield(privmsg => $nick, 'You are not logged in. Say "login your_username your_password" (where your_username and your_password are your login credentials) to login.');
 112                         }
 113                 }
 114
 115                 default {
 116                         if (defined $username) {
 117                                 $ok_user_addresses{"$username $address"}=1;
 118                                 $self->{log}->debug("Command $cmd @args from $username");
 119                                 if (exists $self->{prefix}{$username}) {
 120                                         sendmsg $username, undef, $address, @{$self->{prefix}{$username}}, $cmd, @args;
 121                                 } else {
 122                                         sendmsg $username, undef, $address, $cmd, @args;
 123                                 }
 124                         } else {
 125                                 $self->{irc}->yield(privmsg => $nick, 'You are not logged in. Say "login your_username your_password" (where your_username and your_password are your login credentials) to login.');
 126                         }
 127                 }
 128
 129         }
 130 }
 131
 132 sub irc_public{
 133         # Do nothing
 134 }
 135
 136 sub irc_001{
 137         # Do nothing
 138 }
 139
 140 sub send_message{
 141         my ($self, $address, $content)=@_[OBJECT, ARG0, ARG1];
 142         $self->{irc}->yield(privmsg => $address, $_) for map {unpack '(A400)*'} split "\n", $content
 143 }
 144
 145 sub shutdown{
 146         $_[KERNEL]->alias_remove($_) for $_[KERNEL]->alias_list;
 147 }
 148
 149 sub _start { ... }
 150
 151 1