]>
Commit | Line | Data |
---|---|---|
8dc70d07 MG |
1 | package App::FonBot::Plugin::IRC; |
2 | ||
4e1612f3 | 3 | our $VERSION = '0.000_5'; |
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 | |
962dff7b MG |
75 | given($cmd){ |
76 | when(/^myid$/i){ | |
77 | $self->{irc}->yield(privmsg => $nick, $from); | |
78 | } | |
8dc70d07 | 79 | |
962dff7b MG |
80 | when(/^login$/i) { |
81 | my ($user, $pass) = @args; | |
8dc70d07 | 82 | |
962dff7b | 83 | eval { pwcheck $user, $pass }; |
8dc70d07 | 84 | |
962dff7b MG |
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 | } | |
8dc70d07 | 94 | |
962dff7b MG |
95 | when(/^logout$/i){ |
96 | delete $self->{nick_to_username}{$from}; | |
97 | } | |
8dc70d07 | 98 | |
962dff7b MG |
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 | } | |
8dc70d07 | 105 | } |
8dc70d07 | 106 | |
962dff7b MG |
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 | } | |
8dc70d07 MG |
130 | } |
131 | ||
132 | sub irc_public{ | |
962dff7b | 133 | # Do nothing |
8dc70d07 MG |
134 | } |
135 | ||
136 | sub irc_001{ | |
962dff7b | 137 | # Do nothing |
8dc70d07 MG |
138 | } |
139 | ||
140 | sub send_message{ | |
962dff7b MG |
141 | my ($self, $address, $content)=@_[OBJECT, ARG0, ARG1]; |
142 | $self->{irc}->yield(privmsg => $address, $_) for map {unpack '(A400)*'} split "\n", $content | |
8dc70d07 MG |
143 | } |
144 | ||
145 | sub shutdown{ | |
962dff7b | 146 | $_[KERNEL]->alias_remove($_) for $_[KERNEL]->alias_list; |
8dc70d07 MG |
147 | } |
148 | ||
149 | sub _start { ... } | |
150 | ||
151 | 1 |