Bump version and update Changes
[app-fonbot-daemon.git] / lib / App / FonBot / Plugin / IRC.pm
CommitLineData
8dc70d07
MG
1package App::FonBot::Plugin::IRC;
2
b8d4a547 3our $VERSION = '0.001';
8dc70d07
MG
4
5use v5.14;
6use strict;
7use warnings;
8
9use Apache2::Authen::Passphrase qw/pwcheck/;
10use IRC::Utils qw/parse_user/;
11use Log::Log4perl qw//;
12use POE;
13use POE::Component::IRC qw//;
14
15use Text::ParseWords qw/shellwords/;
16use subs qw/shutdown/;
17
18use App::FonBot::Plugin::Common;
19
20##################################################
21
22my %selves;
23
24sub init{
962dff7b 25 my ($ns)=@_;
8dc70d07 26
962dff7b
MG
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
8dc70d07
MG
32}
33
34sub fini{
962dff7b 35 my ($ns)=@_;
8dc70d07 36
962dff7b
MG
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}
8dc70d07
MG
42}
43
44##################################################
45
46sub new{
962dff7b 47 my ($ns)=@_;
8dc70d07 48
962dff7b
MG
49 my $self = {
50 prefix => {},
51 log => Log::Log4perl->get_logger($ns),
52 };
8dc70d07 53
962dff7b 54 bless $self, $ns;
8dc70d07 55
962dff7b
MG
56 $self->{session} = POE::Session->create(
57 object_states => [ $self => [ '_start', 'send_message', 'irc_001', 'irc_msg', 'irc_public', 'shutdown' ] ],
58 );
8dc70d07 59
962dff7b 60 $self
8dc70d07
MG
61}
62
63sub irc_msg{
962dff7b
MG
64 my ($from, $msg, $self)=@_[ARG0,ARG2,OBJECT];
65 my $nick=parse_user $from;
8dc70d07 66
962dff7b
MG
67 my $username=$self->{nick_to_username}{$from};
68 my $address=$_[KERNEL]->alias_list;
69 $address.=" $nick";
8dc70d07 70
962dff7b
MG
71 chomp $msg;
72 my @args=shellwords $msg;
73 my $cmd=shift @args;
8dc70d07 74
a7504653
MG
75 local $_ = $cmd;
76 if (/^myid$/i){
77 $self->{irc}->yield(privmsg => $nick, $from);
78 } elsif (/^login$/i) {
79 my ($user, $pass) = @args;
80
81 eval { pwcheck $user, $pass };
82
83 if ($@) {
84 $self->{log}->debug("Login for $user failed");
85 $self->{irc}->yield(privmsg => $nick, 'Bad username/password combination');
86 } else {
87 $self->{log}->debug("Login for $user succeded");
88 $self->{nick_to_username}{$from} = $user;
89 $self->{irc}->yield(privmsg => $nick, "Logged in as $user");
962dff7b 90 }
a7504653
MG
91 } elsif (/^logout$/i){
92 delete $self->{nick_to_username}{$from};
93 } elsif (/^prefix$/i){
94 if (defined $username) {
95 $self->{prefix}{$username} = [@args];
96 } else {
97 $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.');
8dc70d07 98 }
a7504653
MG
99 } elsif (/^noprefix$/i){
100 if (defined $username) {
101 delete $self->{prefix}{$username}
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.');
962dff7b 104 }
a7504653
MG
105 } else {
106 if (defined $username) {
107 $ok_user_addresses{"$username $address"}=1;
108 $self->{log}->debug("Command $cmd @args from $username");
109 if (exists $self->{prefix}{$username}) {
110 sendmsg $username, undef, $address, @{$self->{prefix}{$username}}, $cmd, @args;
962dff7b 111 } else {
a7504653 112 sendmsg $username, undef, $address, $cmd, @args;
962dff7b 113 }
a7504653
MG
114 } else {
115 $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.');
962dff7b 116 }
962dff7b 117 }
8dc70d07
MG
118}
119
120sub irc_public{
962dff7b 121 # Do nothing
8dc70d07
MG
122}
123
124sub irc_001{
962dff7b 125 # Do nothing
8dc70d07
MG
126}
127
128sub send_message{
962dff7b
MG
129 my ($self, $address, $content)=@_[OBJECT, ARG0, ARG1];
130 $self->{irc}->yield(privmsg => $address, $_) for map {unpack '(A400)*'} split "\n", $content
8dc70d07
MG
131}
132
133sub shutdown{
962dff7b 134 $_[KERNEL]->alias_remove($_) for $_[KERNEL]->alias_list;
8dc70d07
MG
135}
136
137sub _start { ... }
138
1391
This page took 0.019508 seconds and 4 git commands to generate.