]>
Commit | Line | Data |
---|---|---|
1 | package App::FonBot::Plugin::IRC; | |
2 | ||
3 | our $VERSION = '0.001'; | |
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 | 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"); | |
90 | } | |
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.'); | |
98 | } | |
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.'); | |
104 | } | |
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; | |
111 | } else { | |
112 | sendmsg $username, undef, $address, $cmd, @args; | |
113 | } | |
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.'); | |
116 | } | |
117 | } | |
118 | } | |
119 | ||
120 | sub irc_public{ | |
121 | # Do nothing | |
122 | } | |
123 | ||
124 | sub irc_001{ | |
125 | # Do nothing | |
126 | } | |
127 | ||
128 | sub send_message{ | |
129 | my ($self, $address, $content)=@_[OBJECT, ARG0, ARG1]; | |
130 | $self->{irc}->yield(privmsg => $address, $_) for map {unpack '(A400)*'} split "\n", $content | |
131 | } | |
132 | ||
133 | sub shutdown{ | |
134 | $_[KERNEL]->alias_remove($_) for $_[KERNEL]->alias_list; | |
135 | } | |
136 | ||
137 | sub _start { ... } | |
138 | ||
139 | 1 |