]>
Commit | Line | Data |
---|---|---|
8dc70d07 MG |
1 | package App::FonBot::Plugin::IRC; |
2 | ||
b8d4a547 | 3 | our $VERSION = '0.001'; |
8dc70d07 MG |
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{ | |
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 | ||
34 | sub 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 | ||
46 | sub 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 | ||
63 | sub 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 | ||
120 | sub irc_public{ | |
962dff7b | 121 | # Do nothing |
8dc70d07 MG |
122 | } |
123 | ||
124 | sub irc_001{ | |
962dff7b | 125 | # Do nothing |
8dc70d07 MG |
126 | } |
127 | ||
128 | sub 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 | ||
133 | sub shutdown{ | |
962dff7b | 134 | $_[KERNEL]->alias_remove($_) for $_[KERNEL]->alias_list; |
8dc70d07 MG |
135 | } |
136 | ||
137 | sub _start { ... } | |
138 | ||
139 | 1 |