File Coverage

blib/lib/Net/Async/Matrix/Utils.pm
Criterion Covered Total %
statement 55 55 100.0
branch 19 26 73.0
condition 6 11 54.5
subroutine 11 11 100.0
pod 2 2 100.0
total 93 105 88.5


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2014-2017 -- leonerd@leonerd.org.uk
5              
6             package Net::Async::Matrix::Utils;
7              
8 1     1   47901 use strict;
  1         2  
  1         24  
9 1     1   3 use warnings;
  1         1  
  1         39  
10              
11             our $VERSION = '0.19';
12             $VERSION = eval $VERSION;
13              
14 1     1   3 use Exporter 'import';
  1         1  
  1         38  
15             our @EXPORT_OK = qw(
16             parse_formatted_message
17             build_formatted_message
18             );
19              
20 1     1   502 use String::Tagged 0.11;
  1         5559  
  1         45  
21              
22             # Optionally parse HTML rich-formatted body; but don't get too upset if we
23             # don't have these installed
24 1         2 use constant CAN_PARSE_HTML => eval {
25 1         747 require HTML::TreeBuilder;
26 1         22810 require Convert::Color::HTML;
27 1     1   5 };
  1         1  
28              
29             # Optionally build HTML rich-formatted body; but don't get too upset if we
30             # don't have this installed
31 1         1 use constant CAN_BUILD_HTML => eval {
32 1         417 require String::Tagged::HTML;
33 1         1135 require Convert::Color::HTML;
34 1     1   120125 };
  1         2  
35              
36             =head1 NAME
37              
38             C - support utilities for L
39              
40             =head1 DESCRIPTION
41              
42             =cut
43              
44             =head1 FUNCTIONS
45              
46             =cut
47              
48             =head2 parse_formatted_message
49              
50             $st = parse_formatted_message( $content )
51              
52             Given the content of a C event of C or C
53             type, returns a L instance containing the text of the message
54             with formatting in L style. If the message is not
55             formatted, or the formatting is of a kind not recognised, the plain-text body
56             is returned in an instance with no tags.
57              
58             The following formats are recognised:
59              
60             =over 4
61              
62             =item org.matrix.custom.html
63              
64             This format requires the presence of L to parse; it will be
65             ignored if this module is not available.
66              
67             HTML | String::Tagged::Formatting
68             ------------------+---------------------------
69             , | 'bold'
70             , | 'italic'
71             | 'under'
72             | 'strike'
73             , | 'monospace'
74            
75              
76             =back
77              
78             =cut
79              
80             sub parse_formatted_message
81             {
82 2     2 1 540 my ( $content ) = @_;
83              
84 2         6 for my $format ( $content->{format} ) {
85 2 100       7 last if !$format;
86              
87 1 50       7 return _parse_html_body( $content->{formatted_body} ) if
88             CAN_PARSE_HTML and $format eq "org.matrix.custom.html";
89             }
90              
91 1         9 return String::Tagged->new( $content->{body} );
92             }
93              
94             sub _parse_html_body
95             {
96 1     1   3 my ( $formatted ) = @_;
97              
98 1         10 return _traverse_html( HTML::TreeBuilder->new_from_content( $formatted )
99             ->find_by_tag_name( 'body' )
100             );
101             }
102              
103             sub _traverse_html
104             {
105 8     8   1136 my ( $node ) = @_;
106              
107             # Plain text
108 8 100       20 return String::Tagged->new( $node ) if !ref $node;
109              
110 3         3 my %tags;
111 3         7 for ( $node->tag ) {
112 3 100 66     24 ( $_ eq "b" || $_ eq "strong" ) and $tags{bold}++, last;
113 2 50 33     8 ( $_ eq "i" || $_ eq "em" ) and $tags{italic}++, last;
114              
115 2 50       4 $_ eq "u" and $tags{under}++, last;
116 2 50       5 $_ eq "strike" and $tags{strike}++, last;
117              
118 2 50 33     8 ( $_ eq "tt" || $_ eq "code" ) and $tags{monospace}++, last;
119              
120 2 100       5 if( $_ eq "font" ) {
121 1         3 my %attrs = $node->all_attr;
122              
123             my $fg = defined $attrs{color} ?
124 1 50       10 eval { Convert::Color::HTML->new( $attrs{color} ) } :
  1         10  
125             undef;
126              
127 1 50       1118 $tags{fg} = $fg if defined $fg;
128              
129 1         3 last;
130             }
131             }
132              
133 3         7 my $ret = String::Tagged->new;
134              
135 3         24 $ret .= _traverse_html( $_ ) for $node->content_list;
136              
137 3         125 $ret->apply_tag( 0, length $ret, $_, $tags{$_} ) for keys %tags;
138              
139 3         66 return $ret;
140             }
141              
142             =head2 build_formatted_message
143              
144             $content = build_formatted_message( $str )
145              
146             Given a L instance or plain string, returns a
147             content HASH reference encoding the formatting the message. Plain strings are
148             returned simply as a plain-text body; formatted instances will be output as
149             formatted content if possible:
150              
151             =over 4
152              
153             =item org.matrix.custom.html
154              
155             This format is output for formatted messages if L is
156             available.
157              
158             String::Tagged::Formatting | HTML
159             ---------------------------+--------------------
160             'bold' |
161             'italic' |
162             'under' |
163             'strike' |
164             'monospace' |
165             'fg' |
166              
167             =back
168              
169             =cut
170              
171             sub build_formatted_message
172             {
173 3     3 1 13719 my ( $str ) = @_;
174              
175 3 100       13 return { body => $str } if !ref $str;
176              
177 2 100 100     8 if( $str->tagnames and CAN_BUILD_HTML ) {
178             my $html = String::Tagged::HTML->clone( $str,
179             only_tags => [qw( bold italic under strike monospace fg )],
180             convert_tags => {
181             bold => "strong",
182             italic => "em",
183             under => "u",
184             strike => "strike",
185             monospace => "code",
186 1     1   163 fg => sub { font => { color => $_[1]->as_html->name } },
187             },
188 1         37 );
189              
190             return {
191 1         2081 body => $str->str,
192             format => "org.matrix.custom.html",
193             formatted_body => $html->as_html,
194             };
195             }
196             else {
197 1         12 return { body => $str->str };
198             }
199             }
200              
201             =head1 AUTHOR
202              
203             Paul Evans
204              
205             =cut
206              
207             0x55AA;