File Coverage

blib/lib/App/Alice/Window.pm
Criterion Covered Total %
statement 68 102 66.6
branch 11 28 39.2
condition 0 3 0.0
subroutine 19 25 76.0
pod 1 17 5.8
total 99 175 56.5


line stmt bran cond sub pod time code
1             package App::Alice::Window;
2              
3 4     4   4023 use Encode;
  4         54099  
  4         348  
4 4     4   3593 use utf8;
  4         41  
  4         20  
5 4     4   2138 use App::Alice::MessageBuffer;
  4         14  
  4         174  
6 4     4   40 use Text::MicroTemplate qw/encoded_string/;
  4         9  
  4         318  
7 4     4   3801 use IRC::Formatting::HTML qw/irc_to_html/;
  4         58728  
  4         386  
8 4     4   42 use Any::Moose;
  4         8  
  4         33  
9              
10 4     4   3282 my $url_regex = qr/\b(https?:\/\/(?:[^\s()<>]+|\(([^\s()<>]+|(\([^\s()<>]+\)))*\))+(?:\(([^\s()<>]+|(\([^\s()<>]+\)))*\)|[^\s`!()\[\]{};:'".,<>?«»“”‘’]))/i;
  4         10  
  4         67  
11              
12             has type => (
13             is => 'ro',
14             isa => 'Str',
15             lazy => 1,
16             default => sub {return shift->title =~ /^[#&]/ ? "channel" : "privmsg"}
17             );
18              
19             has is_channel => (
20             is => 'ro',
21             isa => 'Bool',
22             lazy => 1,
23             default => sub {return shift->type eq "channel"}
24             );
25              
26             has assetdir => (
27             is => 'ro',
28             isa => 'Str',
29             required => 1,
30             );
31              
32             has buffer => (
33             is => 'rw',
34             isa => 'App::Alice::MessageBuffer',
35             lazy => 1,
36             default => sub {
37             my $self = shift;
38             App::Alice::MessageBuffer->new(
39             store_class => $self->app->config->message_store,
40             id => $self->id,
41             );
42             },
43             );
44              
45             has title => (
46             is => 'ro',
47             isa => 'Str',
48             required => 1,
49             );
50              
51             has sort_name => (
52             is => 'ro',
53             lazy => 1,
54             default => sub {
55             my $name = $_[0]->title;
56             $name =~ s/^#//;
57             $name;
58             }
59             );
60              
61             has topic => (
62             is => 'rw',
63             isa => 'HashRef[Str|Undef]',
64             default => sub {{
65             string => 'no topic set',
66             author => '',
67             time => time,
68             }}
69             );
70              
71             has id => (
72             is => 'ro',
73             isa => 'Str',
74             lazy => 1,
75             default => sub {
76             return $_[0]->app->_build_window_id($_[0]->title, $_[0]->session);
77             },
78             );
79              
80             has session => (
81             is => 'ro',
82             isa => 'Str',
83             lazy => 1,
84             default => sub {return shift->irc->alias}
85             );
86              
87             has _irc => (
88             is => 'ro',
89             isa => 'App::Alice::IRC',
90             required => 1,
91             weak_ref => 1,
92             );
93              
94             has app => (
95             is => 'ro',
96             isa => 'App::Alice',
97             weak_ref => 1,
98             required => 1,
99             );
100              
101             # move irc arg to _irc, which is wrapped in a method
102             # because infowindow has logic to choose which irc
103             # connection to return
104             sub BUILDARGS {
105 9     9 1 535 my $class = shift;
106 9 50       60 my $args = ref $_[0] ? $_[0] : {@_};
107 9         28 $args->{_irc} = $args->{irc};
108 9         23 delete $args->{irc};
109 9         149 return $args;
110             }
111              
112 34     34 0 248 sub irc { $_[0]->_irc }
113              
114             sub serialized {
115 27     27 0 59 my ($self) = @_;
116             return {
117 27         279 id => $self->id,
118             session => $self->session,
119             title => $self->title,
120             is_channel => $self->is_channel,
121             type => $self->type,
122             hashtag => $self->hashtag,
123             };
124             }
125              
126             sub nick {
127 4     4 0 12 my $self = shift;
128 4 50       18 decode_utf8($self->irc->nick) unless utf8::is_utf8($self->irc->nick);
129             }
130              
131             sub all_nicks {
132 10     10 0 16 my $self = shift;
133              
134 10 100       60 return $self->is_channel ?
135             $self->irc->channel_nicks($self->title)
136             : [ $self->title, $self->nick ];
137             }
138              
139             sub join_action {
140 3     3 0 6 my $self = shift;
141 3         11 my $action = {
142             type => "action",
143             event => "join",
144             nicks => $self->all_nicks,
145             window => $self->serialized,
146             };
147 3         18 $action->{html}{window} = $self->app->render("window", $self);
148 3         10126 $action->{html}{tab} = $self->app->render("tab", $self);
149 3         4626 $action->{html}{select} = $self->app->render("select", $self);
150 3         3528 return $action;
151             }
152              
153             sub nicks_action {
154 0     0 0 0 my $self = shift;
155             return {
156 0         0 type => "action",
157             event => "nicks",
158             nicks => $self->all_nicks,
159             window => $self->serialized,
160             };
161             }
162              
163             sub clear_action {
164 0     0 0 0 my $self = shift;
165             return {
166 0         0 type => "action",
167             event => "clear",
168             window => $self->serialized,
169             };
170             }
171              
172             sub format_event {
173 7     7 0 21 my ($self, $event, $nick, $body) = @_;
174 7         36 my $message = {
175             type => "message",
176             event => $event,
177             nick => $nick,
178             window => $self->serialized,
179             body => $body,
180             msgid => $self->app->next_msgid,
181             timestamp => time,
182             nicks => $self->all_nicks,
183             };
184 7         85 $message->{html} = make_links_clickable(
185             $self->app->render("event", $message)
186             );
187 7         770 $self->buffer->add($message);
188 7         48 return $message;
189             }
190              
191             sub format_message {
192 2     2 0 6 my ($self, $nick, $body) = @_;
193 2 50       17 $body = decode_utf8($body) unless utf8::is_utf8($body);
194              
195 2         108 my $monospace = $self->app->is_monospace_nick($nick);
196             # pass the inverse => italic option if this is NOT monospace
197 2 50       18 my $html = irc_to_html($body, ($monospace ? () : (invert => "italic")));
198              
199 2         258 $html = make_links_clickable($html);
200 2         10 my $own_nick = $self->nick;
201 2 100       39 my $message = {
202             type => "message",
203             event => "say",
204             nick => $nick,
205             avatar => $self->irc->nick_avatar($nick),
206             window => $self->serialized,
207             html => encoded_string($html),
208             self => $own_nick eq $nick,
209             msgid => $self->app->next_msgid,
210             timestamp => time,
211             monospaced => $monospace,
212             consecutive => $nick eq $self->buffer->previous_nick ? 1 : 0,
213             };
214 2 50       11 unless ($message->{self}) {
215 2         12 $message->{highlight} = $self->app->is_highlight($own_nick, $body);
216             }
217 2         12 $message->{html} = $self->app->render("message", $message);
218 2         10692 $self->buffer->add($message);
219 2         17 return $message;
220             }
221              
222             sub format_announcement {
223 0     0 0 0 my ($self, $msg) = @_;
224 0 0 0     0 $msg = decode_utf8($msg) unless utf8::is_utf8($msg)
225             or ref $msg eq "Text::MicroTemplate::EncodedString";
226 0         0 my $message = {
227             type => "message",
228             event => "announce",
229             window => $self->serialized,
230             message => $msg,
231             };
232 0         0 $message->{html} = $self->app->render('announcement', $message);
233 0         0 $message->{message} = "$message->{message}";
234 0         0 $self->reset_previous_nick;
235 0         0 return $message;
236             }
237              
238             sub close_action {
239 2     2 0 5 my $self = shift;
240 2         12 my $action = {
241             type => "action",
242             event => "part",
243             window => $self->serialized,
244             };
245 2         13 return $action;
246             }
247              
248             sub nick_table {
249 0     0 0 0 my ($self, $avatars) = @_;
250 0 0       0 if ($avatars) {
251 0         0 return encoded_string($self->app->render("avatargrid", $self));
252             }
253 0         0 return _format_nick_table($self->all_nicks);
254             }
255              
256             sub make_links_clickable {
257 9     9 0 37503 my $html = shift;
258 9         73 $html =~ s/$url_regex/$1<\/a>/gi;
259 9         31 return $html;
260             }
261              
262             sub _format_nick_table {
263 0     0   0 my $nicks = shift;
264 0 0       0 return "" unless @$nicks;
265 0         0 my $maxlen = 0;
266 0         0 for (@$nicks) {
267 0         0 my $length = length $_;
268 0 0       0 $maxlen = $length if $length > $maxlen;
269             }
270 0         0 my $cols = int(74 / $maxlen + 2);
271 0         0 my (@rows, @row);
272 0         0 for (sort {lc $a cmp lc $b} @$nicks) {
  0         0  
273 0         0 push @row, $_ . " " x ($maxlen - length $_);
274 0 0       0 if (@row >= $cols) {
275 0         0 push @rows, [@row];
276 0         0 @row = ();
277             }
278             }
279 0 0       0 push @rows, [@row] if @row;
280 0         0 return join "\n", map {join " ", @$_} @rows;
  0         0  
281             }
282              
283             sub reset_previous_nick {
284 0     0 0 0 my $self = shift;
285 0         0 $self->buffer->previous_nick("");
286             }
287              
288             sub previous_nick {
289 2     2 0 5 my $self = shift;
290 2         16 return $self->buffer->previous_nick;
291             }
292              
293             sub hashtag {
294 27     27 0 97 my $self = shift;
295 27 100       116 if ($self->type eq "info") {
296 9         100 return "/" . $self->title;
297             }
298 18         263 return "/" . $self->session . "/" . $self->title;
299             }
300              
301             __PACKAGE__->meta->make_immutable;
302             1;