File Coverage

blib/lib/Text/HikiDoc.pm
Criterion Covered Total %
statement 395 399 99.0
branch 74 84 88.1
condition 35 48 72.9
subroutine 36 36 100.0
pod 5 5 100.0
total 545 572 95.2


line stmt bran cond sub pod time code
1             #
2             # $Id: HikiDoc.pm,v 1.19 2009/07/17 12:59:59 oneroad Exp $
3             #
4             package Text::HikiDoc;
5              
6 15     15   1262395 use strict;
  15         44  
  15         519  
7 15     15   78 use warnings;
  15         30  
  15         376  
8              
9 15     15   81 use File::Basename;
  15         30  
  15         140285  
10              
11             our $VERSION = '1.021';
12              
13             sub _array_to_hash {
14 146     146   228 my $self = shift;
15 146         359 my $params = shift;
16 146         221 my $defaults = shift;
17              
18 146 100       442 if ( ref $$params[0] eq 'HASH' ) {
19 5         13 %$self = (@$defaults, %{$$params[0]});
  5         63  
20             }
21             else {
22 141         231 my $num = 1;
23 141         310 for my $value (@$params) {
24 131         220 $$defaults[$num] = $value;
25 131         332 $num += 2;
26             }
27              
28 141         1227 %$self = @$defaults;
29             }
30              
31 146         357 return $self;
32             }
33              
34             sub new {
35 14     14 1 55912 my $class = shift;
36 14         51 my @params = @_;
37              
38 14         55 my $self = bless {}, $class;
39              
40 14         83 my @defaults = (
41             string => '',
42             level => 1,
43             empty_element_suffix => ' />',
44             br_mode => 'false',
45             table_border => 'true',
46             );
47              
48 14         88 $self->_array_to_hash(\@params, \@defaults);
49              
50 14         37 $self->{stack} = ();
51 14         38 $self->{plugin_stack} = ();
52 14         158 $self->{enabled_plugin} = ();
53              
54 14         89 return $self;
55             }
56              
57              
58             sub to_html {
59 132     132 1 388893 my $self = shift;
60 132         293 my @params = @_;
61              
62 132         742 my @defaults = (
63             string => $self->{string},
64             level => $self->{level},
65             empty_element_suffix => $self->{empty_element_suffix},
66             br_mode => $self->{br_mode},
67             table_border => $self->{table_border},
68             enabled_plugin => $self->{enabled_plugin},
69             );
70              
71 132         472 $self->_array_to_hash(\@params, \@defaults);
72              
73 132   50     473 my $string = $self->{string} || '';
74              
75 132 50       300 return unless $string;
76              
77 132         280 $string =~ s/\r\n/\n/g;
78 132         240 $string =~ s/\r/\n/g;
79 132         2543 $string =~ s/\n*\z/\n\n/;
80              
81             # escape '&', '<' and '>'
82 132         436 $string = $self->_escape_html($string);
83             # escape some symbols
84 132         423 $string = $self->_escape_meta_char($string);
85             # parse blocks
86 132         409 $string = $self->_block_parser($string);
87             # remove needless new lines
88 132         251 $string =~ s/\n{2,}/\n/g;
89             # restore some html parts
90 132         324 $string = $self->_restore_block($string);
91 132         339 $string = $self->_restore_plugin_block($string);
92             # unescape some symbols
93 132         372 $string = $self->_unescape_meta_char($string);
94             # terminate with a single new line
95 132         3270 $string =~ s/\n*\z/\n/g;
96              
97 132         779 return $string;
98             }
99              
100             sub enable_plugin {
101 7     7 1 1172 my $self = shift;
102 7         20 my @list = @_;
103              
104 7         16 my %tmp;
105 7         37 @{$self->{enabled_plugin}} = map {
  11         957  
106 6         15 eval 'require '.ref($self).'::Plugin::'.$_;
107 11 100       64 if ( $@ ) {
108             ;
109             }
110             else {
111 9         30 $_;
112             }
113 7         24 } sort {$a cmp $b} grep {!$tmp{$_}++} @list;
  11         71  
114 7         24 undef %tmp;
115              
116 7         14 return @{$self->{enabled_plugin}};
  7         40  
117             }
118              
119             #sub enable_all_plugin {
120             # my $self = shift;
121             #
122             ## somethig_to_do();
123             #
124             # return @{$self->{enabled_plugin}};
125             #}
126              
127             #sub disable_plugin {
128             # my $self = shift;
129             # my @list = @_;
130             #
131             # my %tmp;
132             # map {$tmp{$_}++} @{$self->{enabled_plugin}};
133             # map {$tmp{$_}--} @list;
134             # @{$self->{enabled_plugin}} = sort {$a cmp $b} grep {$tmp{$_} > 0} (keys %tmp);
135             # undef %tmp;
136             #
137             # return @{$self->{enabled_plugin}};
138             #}
139             #
140             #sub disable_all_plugin {
141             # my $self = shift;
142             #
143             # @{$self->{enabled_plugin}} = ();
144             #
145             # return @{$self->{enabled_plugin}};
146             #}
147              
148             sub plugin_list {
149 1     1 1 2 my $self = shift;
150              
151 1 50       2 if ( $#{$self->{enabled_plugin}} >= 0 ) {
  1         7  
152 1         2 return @{$self->{enabled_plugin}};
  1         8  
153             }
154             else {
155 0         0 return ();
156             }
157             }
158              
159             sub is_enabled {
160 2     2 1 6 my $self = shift;
161 2         5 my $plugin = shift;
162              
163 2         3 for my $list (@{$self->{enabled_plugin}}) {
  2         7  
164 3 100       19 return 1 if $list eq $plugin;
165             }
166 1         8 return 0;
167             }
168              
169             ##
170             # Block Parser
171             ##
172             sub _block_parser {
173 143     143   198 my $self = shift;
174 143   50     344 my $string = shift || '';
175              
176 143         389 $string = $self->_parse_plugin($string);
177 143         397 $string = $self->_parse_pre($string);
178 143         409 $string = $self->_parse_comment($string);
179 143         397 $string = $self->_parse_header($string);
180 143         369 $string = $self->_parse_hrules($string);
181 143         337 $string = $self->_parse_list($string);
182 143         358 $string = $self->_parse_definition($string);
183 143         380 $string = $self->_parse_blockquote($string);
184 143         388 $string = $self->_parse_table($string);
185 143         361 $string = $self->_parse_paragraph($string);
186 143         664 $string =~ s/^\s+//gm;
187              
188 143         337 return $string;
189             }
190              
191             ##
192             # plugin
193             sub _parse_plugin {
194 143     143   183 my $self = shift;
195 143   50     343 my $string = shift || '';
196              
197 143         199 my $PLUGIN_OPEN = '{{';
198 143         244 my $PLUGIN_CLOSE = '}}';
199              
200 143         177 my $plugin = 'false';
201 143         213 my $plugin_str = '';
202              
203              
204 143         174 my $ret = '';
205 143         1182 for my $str ( split(/($PLUGIN_OPEN|$PLUGIN_CLOSE)/o, $string) ) {
206 341 100       849 if ( $str eq $PLUGIN_OPEN ) {
    100          
207 48         79 $plugin = 'true';
208 48         82 $plugin_str .= $str;
209             }
210             elsif ( $str eq $PLUGIN_CLOSE ) {
211 51 100       99 if ( $plugin eq 'true' ) {
212 50         73 $plugin_str .= $str;
213 50         196 (my $tmp = $plugin_str) =~ s/(['"]).*?\1//sg;
214 50 100       192 unless ( $tmp =~ /['"]/ ) {
215 47         74 $plugin = 'false';
216 47         131 $ret .= $self->_store_plugin_block($self->_unescape_meta_char($plugin_str,'true'));
217 47         106 $plugin_str = '';
218             }
219             }
220             else {
221 1         3 $ret .= $str;
222             }
223             }
224             else {
225 242 100       456 if ( $plugin eq 'true' ) {
226 51         89 $plugin_str .= $str;
227             }
228             else {
229 191         502 $ret .= $str;
230             }
231             }
232             }
233 143 100       442 $ret .= $plugin_str if $plugin eq 'true';
234              
235 143         392 return $ret;
236             }
237              
238             ##
239             # pre
240             sub _parse_pre {
241 138     138   184 my $self = shift;
242 138   50     351 my $string = shift || '';
243              
244 138         167 my $MULTI_PRE_OPEN_RE = '<<<';
245 138         180 my $MULTI_PRE_CLOSE_RE = '>>>';
246 138         162 my $PRE_RE = "^[ \t]";
247              
248 138         799 $string =~ s|^$MULTI_PRE_OPEN_RE[ \t]*(\w*)$(.*?)^$MULTI_PRE_CLOSE_RE$|"\n".$self->_store_block('
'.$self->_restore_pre($2).'
')."\n\n"|esgm;
  7         30  
249              
250             my $c = sub {
251 40     40   89 my $string = shift;
252 40         48 my $regexp = shift;
253              
254 40         53 chomp $string;
255 40         293 $string =~ s|$regexp||gm;
256              
257 40         132 return $string;
258 138         604 };
259 138         822 $string =~ s|((?:$PRE_RE.*\n?)+)|"\n".$self->_store_block("
\n".$self->_restore_pre($c->($1,$PRE_RE))."\n
")."\n\n"|egm;
  40         89  
260 138         218 $c = undef;
261              
262 138         751 return $string;
263             }
264              
265              
266             sub _restore_pre {
267 48     48   67 my $self = shift;
268 48   50     122 my $string = shift || '';
269              
270 48         115 $string = $self->_unescape_meta_char($string, 'true');
271 48         133 $string = $self->_restore_plugin_block($string, 'true');
272              
273 48         213 return $string;
274             }
275              
276             ##
277             # header
278             sub _parse_header {
279 143     143   172 my $self = shift;
280 143   50     322 my $string = shift || '';
281              
282 143         299 my $level = 7 - $self->{level};
283              
284 143         720 $string =~ s|^(!{1,$level})\s*(.*)\n?|sprintf("\n%s\n\n",length($1) + $self->{level} -1,$self->_inline_parser($2),length($1) + $self->{level} -1)|egm;
  54         200  
285              
286 143         339 return $string;
287             }
288              
289             ##
290             # hrules
291             sub _parse_hrules {
292 143     143   184 my $self = shift;
293 143         220 my $string = shift;
294              
295 143         270 $string =~ s|^----$|\n{empty_element_suffix}\n|gm;
296              
297 143         268 return $string;
298             }
299              
300             ##
301             # list
302             sub _parse_list {
303 143     143   225 my $self = shift;
304 143         168 my $string = shift;
305              
306 143         202 my $LIST_UL = '*';
307 143         191 my $LIST_OL = '#';
308              
309 143         273 my $LIST_MARK_RE = "[${LIST_UL}${LIST_OL}]";
310 143         252 my $LIST_RE = "^$LIST_MARK_RE+\\s*.*";
311 143         270 my $LIST_RE2 = "^(($LIST_MARK_RE)+)\\s*(.*)";
312 143         280 my $LISTS_RE = "(?:$LIST_RE\n)+";
313              
314 143         937 for my $str ( $string =~ /$LISTS_RE/gm ) {
315 72         112 my $cur_str = "\n";
316 72         98 my @list_type_array = ();
317 72         93 my $level = 0;
318              
319 72         185 for my $line (split(/\n/,$str)) {
320 123 50       573 if ( $line =~ /$LIST_RE2/ ) {
321 123 100       299 my $list_type = $2 eq $LIST_UL ? 'ul' : 'ol';
322 123         164 my $new_level = length($1);
323 123         182 my $item = $3;
324 123 100       258 if ( $new_level > $level ) {
    100          
    100          
325 87         161 for my $i ( 1 .. $new_level - $level ) {
326 91         124 push @list_type_array, $list_type;
327 91         227 $cur_str .= '<'.$list_type.">\n
  • ";
    • 328             }
    329 87         211 $cur_str .= $self->_inline_parser($item);
    330             }
    331             elsif ( $new_level < $level) {
    332 9         21 for my $i ( 1 .. $level - $new_level ) {
    333 10         29 $cur_str .= "\n';
    334             }
    335 9         25 $cur_str .= "\n
  • ".$self->_inline_parser($item);
    • 336             }
    337             elsif ( $list_type eq $list_type_array[$#list_type_array] ) {
    338 26         56 $cur_str .= "\n
  • ".$self->_inline_parser($item);
    • 339             }
    340             else {
    341 1         4 $cur_str .= "\n\n";
    342 1         2 $cur_str .= '<'.$list_type.">\n";
    343 1         3 $cur_str .= '
  • '.$self->_inline_parser($item);
    • 344 1         2 push @list_type_array, $list_type;
    345             }
    346 123         308 $level = $new_level;
    347             }
    348             }
    349 72         130 for my $i ( 1 .. $level) {
    350 81         199 $cur_str .= "\n';
    351             }
    352 72         97 $cur_str .= "\n\n";
    353              
    354 72         1974 $string =~ s/$LISTS_RE/$cur_str/m;
    355             }
    356              
    357 143         389 return $string;
    358             }
    359              
    360             ##
    361             # definition
    362             sub _parse_definition {
    363 143     143   197 my $self = shift;
    364 143         192 my $string = shift;
    365              
    366 143         195 my $DEFINITION_RE = "^:(?:.*?)?:(?:.*)\n?";
    367 143         173 my $DEFINITION_RE2 = "^:(.*?)?:(.*)\n?";
    368 143         261 my $DEFINITIONS_RE = "(?:$DEFINITION_RE)+";
    369              
    370 143         607 $string =~ s/($DEFINITION_RE)/$self->_inline_parser($1)/gem;
      15         40  
    371              
    372              
    373             my $c = sub {
    374 10     10   24 my $string = shift;
    375 10         17 my $regexp1 = shift;
    376 10         14 my $regexp2 = shift;
    377              
    378 10         15 my $ret = '';
    379              
    380 10         19 chomp $string;
    381              
    382 10         90 for my $str ( $string =~ /$regexp1/gm ) {
    383 15         89 $str =~ /$regexp2/m;
    384 15 100       55 if ( $1 eq '' ) {
        100          
    385 2         8 $ret .= '
    '.$2."
    \n";
    386             }
    387             elsif ( $2 eq '' ) {
    388 1         6 $ret .= '
    '.$1."
    \n";
    389             }
    390             else {
    391 12         51 $ret .= '
    '.$1.'
    '.$2."
    \n";
    392             }
    393             }
    394 10         58 return $ret;
    395 143         678 };
    396 143         677 $string =~ s/($DEFINITIONS_RE)/"\n
    \n".$c->($1,$DEFINITION_RE,$DEFINITION_RE2)."<\/dl>\n\n"/gem;
      10         32  
    397 143         226 $c = undef;
    398              
    399 143         1075 return $string;
    400             }
    401              
    402             ##
    403             # blockquote
    404             sub _parse_blockquote {
    405 143     143   198 my $self = shift;
    406 143         187 my $string = shift;
    407              
    408 143         196 my $BLOCKQUOTE_RE = "^\"\"[ \t]?";
    409 143         284 my $BLOCKQUOTES_RE = "(?:$BLOCKQUOTE_RE.*\n?)+";
    410              
    411             my $c = sub {
    412 11     11   28 my $string = shift;
    413 11         19 my $regexp = shift;
    414              
    415 11         13 chomp $string;
    416 11         95 $string =~ s/$regexp//gm;
    417              
    418 11         173 return $string;
    419 143         434 };
    420 143         663 $string =~ s/($BLOCKQUOTES_RE)/"\n
    \n".$self->_block_parser($c->($1,$BLOCKQUOTE_RE))."\n<\/blockquote>\n\n"/egm;
      11         37  
    421 143         199 $c = undef;
    422              
    423 143         596 return $string;
    424             }
    425              
    426             ##
    427             # table
    428             sub _parse_table {
    429 143     143   205 my $self = shift;
    430 143         183 my $string = shift;
    431              
    432 143         184 my $TABLE_SPLIT_RE = '\|\|';
    433 143         274 my $TABLE_RE = "^$TABLE_SPLIT_RE.+\n?";
    434 143         245 my $TABLES_RE = "(?:$TABLE_RE)+";
    435              
    436 143         535 $string =~ s/($TABLE_RE)/$self->_inline_parser($1)/gme;
      19         45  
    437              
    438 143         840 for my $str ( $string =~ /($TABLES_RE)/gm ) {
    439 9         16 my $ret = '';
    440 9 50       25 if ( $self->{table_border} eq 'false' ) {
    441 0         0 $ret = "\n\n";
    442             }
    443             else {
    444 9         17 $ret = "\n\n"; '; \n";
    445             }
    446              
    447 9         33 for my $line (split(/\n/,$str)) {
    448 19         26 $ret .= '
    449 19         27 chomp $line;
    450 19         101 $line =~ s/^$TABLE_SPLIT_RE//;
    451 19         226 for my $i ( grep !/$TABLE_SPLIT_RE/, split(/($TABLE_SPLIT_RE)/,$line) ) {
    452 59 100       165 my $tag = $i =~ s/^!// ? 'th' : 'td';
    453 59         80 my $attr = '';
    454 59 100       205 if ( $i =~ s/^((?:\^|>)+)// ) {
    455 12         25 my $tmp = $1;
    456 12         39 my $rs = (() = $tmp =~ /\^/g) +1;
    457 12         35 my $cs = (() = $tmp =~ /(?:>)/g)+1;
    458 12 100       39 $attr .= ' rowspan="'.$rs.'"' if $rs > 1;
    459 12 100       40 $attr .= ' colspan="'.$cs.'"' if $cs > 1;
    460             }
    461 59         165 $ret .= '<'.$tag.$attr.'>'.$self->_inline_parser($i).'';
    462             }
    463 19         55 $ret .= "
    464             }
    465              
    466 9         17 $ret .= "
    \n\n";
    467 9         126 $string =~ s/$TABLES_RE/$ret/m;
    468             }
    469              
    470 143         412 return $string;
    471             }
    472              
    473             ##
    474             # comment
    475             sub _parse_comment {
    476 143     143   230 my $self = shift;
    477 143         213 my $string = shift;
    478              
    479 143         354 $string =~ s|^//.*\n?||gm;
    480              
    481 143         285 return $string;
    482             }
    483              
    484             ##
    485             # paragraph
    486             sub _parse_paragraph {
    487 143     143   190 my $self = shift;
    488 143         195 my $string = shift;
    489              
    490 143         182 my $PARAGRAPH_BOUNDARY_RE = "\n{2,}";
    491 143         180 my $NON_PARAGRAPH_RE = "^<[^!]";
    492              
    493 143         170 my @ret;
    494 143         858 for my $str ( split(/$PARAGRAPH_BOUNDARY_RE/mo, $string) ) {
    495 360         466 my $tmp = $str;
    496 360         462 chomp $tmp;
    497              
    498 360 100       1445 if ( $tmp eq '' ) {
        100          
    499 3         10 push @ret, '';
    500             }
    501             elsif ( $tmp =~ /$NON_PARAGRAPH_RE/m ) {
    502 211         427 push @ret, $tmp;
    503             }
    504             else {
    505 146         328 my $paragraph = '

    '.$self->_inline_parser($tmp).'

    ';
    506 146 100       393 $paragraph =~ s/\n/{empty_element_suffix}\n/g if ($self->{br_mode} eq 'true');
    507 146         387 push @ret, $paragraph;
    508             }
    509             }
    510              
    511 143         404 $string = join("\n\n",@ret);
    512              
    513 143         383 return $string;
    514             }
    515              
    516             ##
    517             # Inline Parser
    518             ##
    519             sub _inline_parser {
    520 416     416   591 my $self = shift;
    521 416   100     1051 my $string = shift || '';
    522              
    523 416         855 $string = $self->_parse_link($string);
    524 416         918 $string = $self->_parse_modifier($string);
    525              
    526 416         1417 return $string;
    527             }
    528              
    529             ##
    530             # link and image
    531             sub _parse_link {
    532 416     416   561 my $self = shift;
    533 416   100     858 my $string = shift || '';
    534              
    535 416         440 my $IMAGE_RE = '.(jpe?g|gif|png)\z';
    536 416         461 my $BLACKET_LINK_RE = '\[\[(.+?)\]\]';
    537 416         468 my $NAMED_LINK_RE = '(.+?)\|(.+)';
    538 416         444 my $URI_RE = '((?:(?:https?|ftp|file):|mailto:)[A-Za-z0-9;\/?:@&=+$,\-_.!~*\'()#%]+)';
    539              
    540 416         1382 for my $str ( $string =~ /$BLACKET_LINK_RE/gm ) {
    541 18         31 my $uri;
    542             my $title;
    543 18 100       98 if ( $str =~ /$NAMED_LINK_RE/ ) {
    544 10         28 $title = $self->_parse_modifier($1);
    545 10         28 $uri = $2;
    546             }
    547             else {
    548 8         19 $uri = $title = $str;
    549             }
    550 18 50 66     82 if ( $uri !~ m|://| and $uri !~ /^mailto:/ ) {
    551 8         24 $uri =~ s/^(?:https?|ftp|file)+://;
    552             }
    553              
    554 18         49 my $key = $self->_store_block(''.$title.'');
    555 18         191 $string =~ s/$BLACKET_LINK_RE/$key/m;
    556             }
    557              
    558 416         3013 for my $str ( $string =~ /$URI_RE/gm ) {
    559 5         9 my $uri = $str;
    560 5         7 my $key;
    561 5 50 66     27 if ( $uri !~ m|://| and $uri !~ /^mailto:/ ) {
    562 1         5 $uri =~ s/^\w+://;
    563             }
    564 5 100       147 if ( $uri =~ /$IMAGE_RE/i ) {
    565 2         107 $key = $self->_store_block(''.File::Basename::basename($uri).'{empty_element_suffix});
    566             }
    567             else {
    568 3         19 $key = $self->_store_block(''.$uri.'');
    569             }
    570 5         167 $string =~ s/$URI_RE/$key/m;
    571             }
    572              
    573 416         1080 return $string;
    574             }
    575              
    576             ##
    577             # modifier (strong, em, re)
    578             sub _parse_modifier {
    579 453     453   578 my $self = shift;
    580 453   100     1028 my $string = shift || '';
    581              
    582 453         585 my $STRONG = "'''";
    583 453         524 my $EM = "''";
    584 453         510 my $DEL = '==';
    585              
    586 453         726 my $STRONG_RE = "$STRONG(.+?)$STRONG";
    587 453         665 my $EM_RE = "$EM(.+?)$EM";
    588 453         636 my $DEL_RE = "$DEL(.+?)$DEL";
    589              
    590 453         2242 (my $MODIFIER_RE = "($STRONG_RE|$EM_RE|$DEL_RE)") =~ s/\(\.\+\?\)/(?:.+?)/g;
    591              
    592 453         2032 for my $str ( $string =~ /$MODIFIER_RE/gm ) {
    593 27         34 my $key;
    594 27 100       322 if ( $str =~ /(.*)$STRONG_RE(.*)/ ) {
        100          
        50          
    595 12         79 $key = $self->_store_block($self->_parse_modifier($1.''.$2.''.$3));
    596             }
    597             elsif ( $str =~ /(.*)$EM_RE(.*)/ ) {
    598 8         48 $key = $self->_store_block($self->_parse_modifier($1.''.$2.''.$3));
    599             }
    600             elsif ( $str =~ /(.*)$DEL_RE(.*)/ ) {
    601 7         44 $key = $self->_store_block($self->_parse_modifier($1.''.$2.''.$3));
    602             }
    603 27 50       344 $string =~ s/$MODIFIER_RE/$key/ if $key;
    604             }
    605              
    606 453         1177 return $string;
    607             }
    608              
    609              
    610             ##
    611             # Utility Methods
    612             ##
    613             sub _escape_html {
    614 135     135   26379 my $self = shift;
    615 135   50     386 my $string = shift || '';
    616              
    617 135         299 $string =~ s/&/&/g;
    618 135         288 $string =~ s/
    619 135         264 $string =~ s/>/>/g;
    620              
    621 135         328 return $string;
    622             }
    623              
    624             sub _escape_quote {
    625 18     18   30 my $self = shift;
    626 18   50     42 my $string = shift || '';
    627              
    628 18         31 $string =~ s/"/"/g;
    629              
    630 18         78 return $string;
    631             }
    632              
    633             sub _store_block {
    634 101     101   137 my $self = shift;
    635 101   50     238 my $string = shift || '';
    636              
    637 101         112 push @{$self->{stack}}, $string;
      101         319  
    638 101         128 my $key = '<'.$#{$self->{stack}}.'>';
      101         270  
    639              
    640 101         560 return $key;
    641             }
    642              
    643             sub _restore_block {
    644 185     185   233 my $self = shift;
    645 185   100     457 my $string = shift || '';
    646 185   100     753 my $count = shift || 0;
    647              
    648 185 100       193 return $string if $#{$self->{stack}} < 0;
      185         709  
    649 101 50       234 return $string if $count > 10;
    650              
    651 101 100       638 if ( $string =~ s|<(\d+)>|${$self->{stack}}[$1]|gm ) {
      101         674  
    652 53         148 $string = $self->_restore_block($string,++$count);
    653             }
    654              
    655 101         314 return $string;
    656             }
    657              
    658             sub _store_plugin_block {
    659 47     47   75 my $self = shift;
    660 47   50     129 my $string = shift || '';
    661              
    662 47         54 push @{$self->{plugin_stack}}, $string;
      47         138  
    663 47         69 my $key = '{plugin_stack}}.'>';
      47         156  
    664              
    665 47         117 return $key;
    666             }
    667              
    668             sub _restore_plugin_block {
    669 180     180   277 my $self = shift;
    670 180   100     408 my $string = shift || '';
    671 180   100     599 my $original = shift || 'false';
    672              
    673 180         218 my $BLOCK_PLUGIN_RE = '

    ';
    674 180         207 my $BLOCK_PLUGIN_OPEN = '
    ';
    675 180         220 my $BLOCK_PLUGIN_CLOSE = '';
    676 180         239 my $INLINE_PLUGIN_RE = '';
    677 180         209 my $INLINE_PLUGIN_OPEN = '';
    678 180         241 my $INLINE_PLUGIN_CLOSE = '';
    679              
    680 180 100       194 return $string if $#{$self->{plugin_stack}} < 0;
      180         730  
    681              
    682 79 100       173 if ( $original eq 'true' ) {
      43 100       129  
    683 36         133 $string =~ s|$INLINE_PLUGIN_RE|${$self->{plugin_stack}}[$1]|g;
      6         28  
    684             }
    685             elsif ( $#{$self->{enabled_plugin}} >= 0 ) {
    686 29         166 $string =~ s|$BLOCK_PLUGIN_RE|$self->_do_plugin(${$self->{plugin_stack}}[$1],$BLOCK_PLUGIN_OPEN,$BLOCK_PLUGIN_CLOSE)|ge;
      0         0  
      0         0  
    687 29         235 $string =~ s|$INLINE_PLUGIN_RE|$self->_do_plugin(${$self->{plugin_stack}}[$1],$INLINE_PLUGIN_OPEN,$INLINE_PLUGIN_CLOSE)|eg;
      29         38  
      29         247  
    688             }
    689             else {
    690 14         103 $string =~ s|$BLOCK_PLUGIN_RE|$BLOCK_PLUGIN_OPEN${$self->{plugin_stack}}[$1]$BLOCK_PLUGIN_CLOSE|g;
      9         72  
    691 14         99 $string =~ s|$INLINE_PLUGIN_RE|$INLINE_PLUGIN_OPEN${$self->{plugin_stack}}[$1]$INLINE_PLUGIN_CLOSE|g;
      3         18  
    692             }
    693              
    694 79         389 return $string;
    695             }
    696              
    697             sub _do_plugin {
    698 29     29   40 my $self = shift;
    699 29         44 my $string = shift;
    700 29         36 my $prefix = shift;
    701 29         40 my $suffix = shift;
    702              
    703             # $string =~ s/^{{(.*)}}$/$1/;
    704             # return eval ref($self).'::Plugin::'.$string || $prefix.'{{'.$string.'}}'.$suffix;
    705 29         132 $string =~ /{{([^\s\(\)\'\"]+)([\000-\377]*)}}/m;
    706 29 50       49 eval {
    707 29         52 my $method = $1;
    708 29   100     124 my $args = $2 || '';
    709              
    710 29         74 my $obj = ref($self).'::Plugin::'.$method.'->new($self)';
    711 29         2327 return eval $obj.'->to_html('.$args.')';
    712             } or return $prefix.$string.$suffix;
    713             }
    714              
    715             sub _escape_meta_char {
    716 136     136   21681 my $self = shift;
    717 136   50     322 my $string = shift || '';
    718              
    719 136         318 $string =~ s{\\(\{|\}|:|'|"|\|)}{'&#x'.unpack('H2',$1).';'}eg;
      9         70  
    720              
    721 136         283 return $string;
    722             }
    723              
    724             sub _unescape_meta_char {
    725 227     227   315 my $self = shift;
    726 227   100     501 my $string = shift || '';
    727 227   100     656 my $original = shift || 'false';
    728              
    729 227 100       473 if ( $original eq 'true' ) {
    730 95         186 $string =~ s|&#x([0-9a-f]{2});|'\\'.pack('H2',$1)|eg;
      2         13  
    731             }
    732             else {
    733 132         290 $string =~ s|&#x([0-9a-f]{2});|pack('H2',$1)|eg;
      3         18  
    734             }
    735              
    736 227         566 return $string;
    737             }
    738              
    739             1;
    740             __END__