File Coverage

blib/lib/Convos/Controller/Chat.pm
Criterion Covered Total %
statement 15 83 18.0
branch 0 26 0.0
condition 0 10 0.0
subroutine 5 14 35.7
pod 1 1 100.0
total 21 134 15.6


line stmt bran cond sub pod time code
1             package Convos::Controller::Chat;
2              
3             =head1 NAME
4              
5             Convos::Controller::Chat - Mojolicious controller for IRC chat
6              
7             =cut
8              
9 1     1   834 use Mojo::Base 'Mojolicious::Controller';
  1         7281  
  1         6  
10 1     1   317791 use Mojo::JSON 'j';
  1         2  
  1         47  
11 1     1   4 use Mojo::Util qw( html_unescape xml_escape );
  1         1  
  1         38  
12 1     1   371 use Convos::Core::Commands;
  1         2  
  1         35  
13 1     1   4 use Time::HiRes 'time';
  1         1  
  1         8  
14              
15             =head1 METHODS
16              
17             =head2 socket
18              
19             Handle conversation exchange over websocket.
20              
21             =cut
22              
23             sub socket {
24 0     0 1   my $self = shift;
25 0           my $login = $self->session('login');
26 0           my $key = "convos:user:$login:out";
27              
28 0           $self->_schedule_day_changed_event;
29 0           $self->inactivity_timeout(60);
30 0           Scalar::Util::weaken($self);
31              
32             # from browser to backend
33             $self->on(
34             message => sub {
35 0     0     my ($self, $octets) = @_;
36 0           my $dom;
37              
38 0           $self->logf(debug => '[ws] < %s', $octets);
39              
40 0 0         if ($octets eq 'PING') {
41             return $self->redis->execute(
42             PING => sub {
43 0 0         $_[1] ? $self->send('PONG') : $self->finish;
44             }
45 0           );
46             }
47              
48 0           $dom = Mojo::DOM->new($octets)->at('div');
49              
50 0 0 0       if ($dom and $dom->{'id'} and $dom->{'data-network'}) {
      0        
51 0   0       @$dom{qw( network state target uuid )}
52 0           = map { delete $dom->{$_} // '' } qw( data-network data-state data-target id );
53 0           $self->_handle_socket_data($dom);
54             }
55             else {
56 0           $octets = xml_escape $octets;
57 0           $self->_send_400($dom, "Invalid message ($octets)")->finish;
58             }
59             }
60 0           );
61              
62             $self->on(
63             finish => sub {
64 0     0     my $tid;
65 0 0         $self or return;
66 0           delete $self->stash->{redis};
67 0 0         Mojo::IOLoop->remove($tid) if $tid = $self->stash('day_changed_event_tid');
68             }
69 0           );
70              
71             # from backend to browser
72             $self->redis->on(
73             message => $key => sub {
74 0     0     my ($sub, $err, @messages) = @_;
75              
76 0 0         return unless $self;
77 0 0         return $self->finish->logf(warn => '[REDIS] %s', $err) if $err;
78 0           pop @messages; # remove channel name from messages
79              
80 0           $self->logf(debug => '[%s] > %s', $key, $messages[0]);
81             $self->format_conversation(
82 0           sub { j(shift @messages) },
83             sub {
84 0           my ($self, $messages) = @_;
85 0           $self->send_partial("event/$messages->[0]{event}", target => '', %{$messages->[0]});
  0            
86             },
87 0           );
88             }
89 0           );
90             }
91              
92             sub _convos_message {
93 0     0     my ($self, $args, $input, $response) = @_;
94 0           my $login = $self->session('login');
95              
96 0           $self->send_partial(
97             'event/message',
98             highlight => 0,
99             message => $input,
100             nick => $login,
101             network => $args->{network},
102             status => 200,
103             target => '',
104             timestamp => time,
105             uuid => $args->{uuid} . '_',
106             );
107 0           $self->send_partial(
108             'event/message',
109             highlight => 0,
110             message => $response,
111             nick => $args->{network},
112             network => $args->{network},
113             status => 200,
114             target => '',
115             timestamp => time,
116             uuid => $args->{uuid},
117             );
118             }
119              
120             sub _handle_socket_data {
121 0     0     my ($self, $dom) = @_;
122 0           my $cmd = html_unescape $dom->text(0);
123 0           my $login = $self->session('login');
124              
125 0 0         if ($cmd =~ s!^/(\w+)\s*(.*)!!) {
    0          
126 0           my ($action, $arg) = ($1, $2);
127 0           $arg =~ s/\s+$//;
128 0 0         if (my $code = Convos::Core::Commands->can(lc($action))) {
129 0           $cmd = $self->$code($arg, $dom);
130             }
131             else {
132 0           return $self->_send_400($dom, 'Unknown command. Type /help to see available commands.');
133             }
134             }
135             elsif ($dom->{target}) {
136 0           $cmd = "PRIVMSG $dom->{target} :$cmd";
137             }
138             else {
139 0           return;
140             }
141              
142 0 0         if (defined $cmd) {
143 0           my $key = "convos:user:$login:$dom->{network}";
144 0           $cmd = "$dom->{uuid} $cmd";
145 0           $self->logf(debug => '[%s] < %s', $key, $cmd);
146 0           $self->redis->publish($key => $cmd);
147 0 0         if ($dom->{'data-history'}) {
148 0           $self->redis->rpush("user:$login:cmd_history", $dom->text(0));
149 0           $self->redis->ltrim("user:$login:cmd_history", -30, -1);
150             }
151             }
152             }
153              
154             sub _schedule_day_changed_event {
155 0     0     my $self = shift;
156 0           my $t = 86400 - time % 86400;
157              
158 0           Scalar::Util::weaken($self);
159             $self->stash(
160             day_changed_event_tid => Mojo::IOLoop->timer(
161             $t => sub {
162 0 0   0     $self or return;
163 0           $self->send_partial('event/day_changed', timestamp => time + 1,);
164 0           $self->_schedule_day_changed_event;
165             }
166             )
167 0           );
168             }
169              
170             sub _send_400 {
171 0     0     my ($self, $args, $message) = @_;
172              
173 0   0       $self->send_partial(
174             message => $message,
175             network => $args->{'data-network'} || '',
176             status => 400,
177             template => 'event/server_message',
178             timestamp => time,
179             uuid => '',
180             );
181             }
182              
183             =head1 COPYRIGHT
184              
185             See L.
186              
187             =head1 AUTHOR
188              
189             Jan Henning Thorsen
190              
191             Marcus Ramberg
192              
193             =cut
194              
195             1;