File Coverage

blib/lib/Text/Trac/InlineNode.pm
Criterion Covered Total %
statement 136 138 98.5
branch 35 44 79.5
condition 7 14 50.0
subroutine 28 28 100.0
pod 0 3 0.0
total 206 227 90.7


line stmt bran cond sub pod time code
1             package Text::Trac::InlineNode;
2              
3 9     9   62 use strict;
  9         15  
  9         290  
4 9     9   49 use warnings;
  9         21  
  9         216  
5 9     9   4555 use Tie::IxHash;
  9         39267  
  9         90  
6 9     9   3836 use Text::Trac::Macro;
  9         24  
  9         61  
7 9     9   322 use UNIVERSAL::require;
  9         19  
  9         46  
8 9     9   3891 use Text::Trac::LinkResolver;
  9         25  
  9         113  
9 9     9   4772 use HTML::Entities qw();
  9         52197  
  9         18474  
10              
11             our $VERSION = '0.23';
12              
13             tie my %token_table, 'Tie::IxHash';
14              
15             #my $handler = $token_table{'!?\\[\\d+\\]|(?:\\b|!)r\\d+\\b(?!:\\d)'};
16             #$handler->format_link('test');
17              
18             my $link_scheme = '[\w.+-]+';
19             my $quoted_string = q{'[^']+'|"[^"]+"};
20             my $shref_target_first = '[\w/?!#@]';
21             my $shref_target_middle = '(?:\|(?=[^|\s])|[^|<>\s])';
22             my $shref_target_last = '[a-zA-Z0-9/=]';
23             my $shref = "!?$link_scheme:
24             (?:
25             $quoted_string
26             |$shref_target_first(?:$shref_target_middle*$shref_target_last)?
27             )
28             ";
29              
30             my $macro = '\[\[[\w/+-]+(?:\(.*\))?\]\]';
31              
32             my $lhref_relative_target = '[/.][^\s[\]]*';
33             my $lhref = "!?\\[
34             (?:
35             $link_scheme:
36             (?:$quoted_string|[^\\[\\]\\s]*)
37             |(?:$lhref_relative_target|[^\\[\\]\\s])
38             )
39             (?:
40             \\s+
41             $quoted_string
42             |[^\\]]+
43             )?
44             \\]
45             ";
46              
47             my $rules = join '|', ( map {"($_)"} ( keys %token_table ) );
48             $rules = qr/$rules/x;
49              
50             s/^\!\?// for values %token_table;
51             s/^\\// for values %token_table;
52              
53             sub new {
54 1607     1607 0 9237 my ( $class, $c ) = @_;
55              
56             # external link resolvers
57 1607         2434 my %external_handler;
58 1607         3435 for (@Text::Trac::LinkResolver::handlers) {
59 14463         34376 my $class = 'Text::Trac::LinkResolver::' . ucfirst($_);
60 14463         41047 $class->require;
61 14463         346004 my $handler = $class->new($c);
62 14463 100       51127 $token_table{ $handler->{pattern} } = $handler if defined $handler->{pattern};
63 14463         124362 $external_handler{$_} = $handler;
64             }
65              
66             %token_table = (
67 1607         5353 q{'''''} => 'bolditalic',
68             q{'''} => 'bold',
69             q{''} => 'italic',
70             '!?__' => 'underline',
71             '!?~~' => 'strike',
72             '!?,,' => 'subscript',
73             '!?\^' => 'superscript',
74             '`|\{\{\{|\}\}\}' => 'inline',
75             $macro => 'macro',
76             %token_table,
77             $lhref => 'lhref',
78             $shref => 'shref',
79             );
80              
81 1607         1553103 my $rules = join '|', ( map {"($_)"} ( keys %token_table ) );
  27319         159545  
82 1607         15931 $rules = qr/$rules/x;
83              
84 1607         4806 s/^\!\?// for values %token_table;
85 1607         240464 s/^\\// for values %token_table;
86              
87 1607         234602 my $self = {
88             context => $c,
89             open_tags => [],
90             rules => $rules,
91             external_handler => \%external_handler,
92             };
93 1607         3556 bless $self, $class;
94 1607         41773 return $self;
95             }
96              
97             sub parse {
98 210     210 0 1440 my ( $self, $rest ) = @_;
99 210         407 my $html = '';
100 210         3982 while ( $rest =~ /$self->{rules}/xms ) {
101 123         363 $html .= $self->escape($`) . $self->_replace( $&, $`, $' );
102 123         1278 $rest = $';
103             }
104 210         630 return $html . $self->escape($rest);
105             }
106              
107             sub escape {
108 337     337 0 838 my ( $self, $s ) = @_;
109 337         1057 return HTML::Entities::encode( $s, '<>&"' );
110             }
111              
112             sub _replace {
113 123     123   6605 my ( $self, $match, $pre_match, $post_match ) = @_;
114 123 100       421 if ( $match =~ s/^!// ) {
115 21         70 return $match;
116             }
117             else {
118             TOKEN:
119 102         383 for my $token ( keys %token_table ) {
120 1071 100       32047 if ( $match =~ /$token/x ) {
121 110         721 my $formatter = $token_table{$token};
122 110 100       1091 if ( ref $formatter ) {
123 25         92 for (qw/ log source attachment http /) {
124 84 100       973 next TOKEN if $match =~ /^\[?$_/;
125             }
126 17         109 return $formatter->format_link($match);
127             }
128             else {
129 85         245 my $method = "_${formatter}_formatter";
130 85         426 return $self->$method( $match, $pre_match, $post_match );
131             }
132             }
133             }
134             }
135             }
136              
137             sub _simple_tag_handler {
138 40     40   73 my ( $self, $open_tag, $close_tag ) = @_;
139              
140 40 100       85 if ( $self->_is_open($open_tag) ) {
141 20         58 $self->_close_tag($open_tag);
142 20         97 return $close_tag;
143             }
144             else {
145 20         56 $self->_open_tag($open_tag);
146 20         104 return $open_tag;
147             }
148             }
149              
150             sub _is_open {
151 44     44   82 my ( $self, $tag ) = @_;
152 44         75 return grep { $tag eq $_ } @{ $self->{open_tags} };
  24         86  
  44         119  
153             }
154              
155             sub _open_tag {
156 22     22   43 my ( $self, $tag ) = @_;
157 22         34 push @{ $self->{open_tags} }, $tag;
  22         56  
158             }
159              
160             sub _close_tag {
161 22     22   43 my ( $self, $tag ) = @_;
162              
163 22         32 my $index = 0;
164 22         33 for ( @{ $self->{open_tags} } ) {
  22         50  
165 24 100       67 last if $tag eq $_;
166 2         5 $index++;
167             }
168 22         35 splice @{ $self->{open_tags} }, $index;
  22         52  
169             }
170              
171             sub _bolditalic_formatter {
172 4     4   8 my $self = shift;
173              
174 4         8 my $is_open = $self->_is_open('');
175              
176 4         9 my $tmp;
177 4 100       11 if ($is_open) {
178 2         4 $tmp .= '';
179 2         7 $self->_close_tag('');
180             }
181              
182 4         11 $tmp .= $self->_bold_formatter;
183              
184 4 100       11 unless ($is_open) {
185 2         4 $tmp .= '';
186 2         5 $self->_open_tag('');
187             }
188              
189 4         18 return $tmp;
190             }
191              
192             sub _bold_formatter {
193 16     16   27 my $self = shift;
194 16         34 return $self->_simple_tag_handler( '', '' );
195             }
196              
197             sub _italic_formatter {
198 4     4   6 my $self = shift;
199 4         11 return $self->_simple_tag_handler( '', '' );
200             }
201              
202             sub _underline_formatter {
203 4     4   10 my ( $self, $match, $pre_match, $post_match ) = @_;
204 4 50       14 my $class_underline = $self->{context}->{class} ? q{class="underline"} : '';
205 4         14 return $self->_simple_tag_handler( qq{}, '' );
206             }
207              
208             sub _strike_formatter {
209 4     4   11 my ( $self, $match, $pre_match, $post_match ) = @_;
210 4         11 return $self->_simple_tag_handler( '', '' );
211             }
212              
213             sub _superscript_formatter {
214 4     4   10 my ( $self, $match, $pre_match, $post_match ) = @_;
215 4         10 return $self->_simple_tag_handler( '', '' );
216             }
217              
218             sub _subscript_formatter {
219 4     4   12 my ( $self, $match, $pre_match, $post_match ) = @_;
220 4         11 return $self->_simple_tag_handler( '', '' );
221             }
222              
223             sub _inline_formatter {
224 4     4   12 my ( $self, $match, $pre_match, $post_match ) = @_;
225 4         11 return $self->_simple_tag_handler( '', '' );
226             }
227              
228             sub _shref_formatter {
229 20     20   62 my ( $self, $match ) = @_;
230              
231 20         871 my ( $ns, $target ) = (
232             $match =~ m/($link_scheme):
233             (
234             $quoted_string
235             |$shref_target_first
236             (?:
237             $shref_target_middle*
238             $shref_target_last
239             )?
240             )
241             /x
242             );
243 20         115 return $self->_make_link( $ns, $target, $match, $match );
244             }
245              
246             sub _lhref_formatter {
247 20     20   60 my ( $self, $match ) = @_;
248              
249 20         625 my ( $ns, $target, $label ) = (
250             $match =~ m/\[
251             ($link_scheme):
252             (
253             (?:$quoted_string|[^\]\s]*)
254             |(?:$lhref_relative_target|[^\]\s])
255             )
256             (?:
257             \s+
258             ($quoted_string|[^\]]+)
259             )?
260             \]
261             /x
262             );
263 20 100       83 if ( !$label ) { # e.g. `[http://target]` or `[wiki:target]`
264 8 50       26 if ($target) {
265 8 50       27 if ( $target =~ m!^//! ) {
266 0         0 $label = $ns . ':' . $target;
267             }
268             else {
269 8         19 $label = $target;
270             }
271             }
272             else { # e.g. `[search:]`
273 0         0 $label = $ns;
274             }
275             }
276 20         73 return $self->_make_link( $ns, $target, $match, $label );
277             }
278              
279             sub _make_link {
280 40     40   154 my ( $self, $ns, $target, $match, $label ) = @_;
281 40 100 66     319 if ( defined $target && ( $target =~ m!^//! or $target eq 'mailto' ) ) {
      66        
282 5         26 return $self->_make_ext_link( $ns . ':' . $target, $label );
283             }
284             else {
285 35         70 my $handler;
286 35 50       99 if ( defined $ns ) {
287 35         92 $handler = $self->{external_handler}->{$ns};
288             }
289 35 100       187 return $handler ? $handler->format_link( $match, $target, $label ) : $match;
290             }
291             }
292              
293             sub _make_ext_link {
294 5     5   15 my ( $self, $url, $text, $title ) = @_;
295              
296 5 50       17 my $title_attr = $title ? qq{title="$title"} : '';
297              
298 5   33     26 $title ||= $text;
299              
300 5   50     38 my $local = $self->{context}->{local} || '';
301 5 50       19 my $class_link = $self->{context}->{class} ? q{class="ext-link"} : '';
302 5 50       15 my $class_icon = $self->{context}->{class} ? q{class="icon"} : '';
303 5 50       20 my $span = $self->{context}{span} ? qq{} : '';
304 5 50 33     50 if ( $url !~ /^$local/ or !$local ) {
305 5         53 return qq{$span$text};
306             }
307             }
308              
309             sub _macro_formatter {
310 5     5   14 my ( $self, $match ) = @_;
311              
312 5         35 my ( $name, $args ) = ( $match =~ m!\[\[ ([\w/+-]+) (?:\( (.*) \))? \]\]!x );
313              
314 5 100       39 if ( $name =~ /br/i ) {
315 1         7 return '
';
316             }
317             else {
318 4         31 return Text::Trac::Macro->new->parse( $name, $args, $match );
319             }
320             }
321              
322             package Text::Trac::InlineNode::Initializer;
323              
324             1;