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

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

    ';
    506 146 100       275 $paragraph =~ s/\n/{empty_element_suffix}\n/g if ($self->{br_mode} eq 'true');
    507 146         217 push @ret, $paragraph;
    508             }
    509             }
    510              
    511 143         271 $string = join("\n\n",@ret);
    512              
    513 143         205 return $string;
    514             }
    515              
    516             ##
    517             # Inline Parser
    518             ##
    519             sub _inline_parser {
    520 416     416   308 my $self = shift;
    521 416   100     645 my $string = shift || '';
    522              
    523 416         461 $string = $self->_parse_link($string);
    524 416         514 $string = $self->_parse_modifier($string);
    525              
    526 416         799 return $string;
    527             }
    528              
    529             ##
    530             # link and image
    531             sub _parse_link {
    532 416     416   245 my $self = shift;
    533 416   100     561 my $string = shift || '';
    534              
    535 416         304 my $IMAGE_RE = '.(jpe?g|gif|png)\z';
    536 416         268 my $BLACKET_LINK_RE = '\[\[(.+?)\]\]';
    537 416         258 my $NAMED_LINK_RE = '(.+?)\|(.+)';
    538 416         284 my $URI_RE = '((?:(?:https?|ftp|file):|mailto:)[A-Za-z0-9;\/?:@&=+$,\-_.!~*\'()#%]+)';
    539              
    540 416         682 for my $str ( $string =~ /$BLACKET_LINK_RE/gm ) {
    541 18         15 my $uri;
    542             my $title;
    543 18 100       68 if ( $str =~ /$NAMED_LINK_RE/ ) {
    544 10         21 $title = $self->_parse_modifier($1);
    545 10         22 $uri = $2;
    546             }
    547             else {
    548 8         12 $uri = $title = $str;
    549             }
    550 18 50 66     70 if ( $uri !~ m|://| and $uri !~ /^mailto:/ ) {
    551 8         21 $uri =~ s/^(?:https?|ftp|file)+://;
    552             }
    553              
    554 18         48 my $key = $self->_store_block(''.$title.'');
    555 18         130 $string =~ s/$BLACKET_LINK_RE/$key/m;
    556             }
    557              
    558 416         1600 for my $str ( $string =~ /$URI_RE/gm ) {
    559 5         6 my $uri = $str;
    560 5         7 my $key;
    561 5 50 66     21 if ( $uri !~ m|://| and $uri !~ /^mailto:/ ) {
    562 1         4 $uri =~ s/^\w+://;
    563             }
    564 5 100       79 if ( $uri =~ /$IMAGE_RE/i ) {
    565 2         95 $key = $self->_store_block(''.File::Basename::basename($uri).'{empty_element_suffix});
    566             }
    567             else {
    568 3         14 $key = $self->_store_block(''.$uri.'');
    569             }
    570 5         114 $string =~ s/$URI_RE/$key/m;
    571             }
    572              
    573 416         558 return $string;
    574             }
    575              
    576             ##
    577             # modifier (strong, em, re)
    578             sub _parse_modifier {
    579 453     453   313 my $self = shift;
    580 453   100     621 my $string = shift || '';
    581              
    582 453         292 my $STRONG = "'''";
    583 453         292 my $EM = "''";
    584 453         299 my $DEL = '==';
    585              
    586 453         416 my $STRONG_RE = "$STRONG(.+?)$STRONG";
    587 453         369 my $EM_RE = "$EM(.+?)$EM";
    588 453         366 my $DEL_RE = "$DEL(.+?)$DEL";
    589              
    590 453         1290 (my $MODIFIER_RE = "($STRONG_RE|$EM_RE|$DEL_RE)") =~ s/\(\.\+\?\)/(?:.+?)/g;
    591              
    592 453         1075 for my $str ( $string =~ /$MODIFIER_RE/gm ) {
    593 27         26 my $key;
    594 27 100       219 if ( $str =~ /(.*)$STRONG_RE(.*)/ ) {
        100          
        50          
    595 12         64 $key = $self->_store_block($self->_parse_modifier($1.''.$2.''.$3));
    596             }
    597             elsif ( $str =~ /(.*)$EM_RE(.*)/ ) {
    598 8         41 $key = $self->_store_block($self->_parse_modifier($1.''.$2.''.$3));
    599             }
    600             elsif ( $str =~ /(.*)$DEL_RE(.*)/ ) {
    601 7         32 $key = $self->_store_block($self->_parse_modifier($1.''.$2.''.$3));
    602             }
    603 27 50       209 $string =~ s/$MODIFIER_RE/$key/ if $key;
    604             }
    605              
    606 453         624 return $string;
    607             }
    608              
    609              
    610             ##
    611             # Utility Methods
    612             ##
    613             sub _escape_html {
    614 135     135   7755 my $self = shift;
    615 135   50     237 my $string = shift || '';
    616              
    617 135         151 $string =~ s/&/&/g;
    618 135         162 $string =~ s/
    619 135         157 $string =~ s/>/>/g;
    620              
    621 135         176 return $string;
    622             }
    623              
    624             sub _escape_quote {
    625 18     18   20 my $self = shift;
    626 18   50     33 my $string = shift || '';
    627              
    628 18         20 $string =~ s/"/"/g;
    629              
    630 18         62 return $string;
    631             }
    632              
    633             sub _store_block {
    634 101     101   81 my $self = shift;
    635 101   50     154 my $string = shift || '';
    636              
    637 101         62 push @{$self->{stack}}, $string;
      101         191  
    638 101         84 my $key = '<'.$#{$self->{stack}}.'>';
      101         151  
    639              
    640 101         339 return $key;
    641             }
    642              
    643             sub _restore_block {
    644 185     185   138 my $self = shift;
    645 185   100     290 my $string = shift || '';
    646 185   100     508 my $count = shift || 0;
    647              
    648 185 100       110 return $string if $#{$self->{stack}} < 0;
      185         508  
    649 101 50       139 return $string if $count > 10;
    650              
    651 101 100       408 if ( $string =~ s|<(\d+)>|${$self->{stack}}[$1]|gm ) {
      101         438  
    652 53         95 $string = $self->_restore_block($string,++$count);
    653             }
    654              
    655 101         151 return $string;
    656             }
    657              
    658             sub _store_plugin_block {
    659 47     47   40 my $self = shift;
    660 47   50     69 my $string = shift || '';
    661              
    662 47         44 push @{$self->{plugin_stack}}, $string;
      47         97  
    663 47         45 my $key = '{plugin_stack}}.'>';
      47         97  
    664              
    665 47         68 return $key;
    666             }
    667              
    668             sub _restore_plugin_block {
    669 180     180   160 my $self = shift;
    670 180   100     259 my $string = shift || '';
    671 180   100     367 my $original = shift || 'false';
    672              
    673 180         136 my $BLOCK_PLUGIN_RE = '

    ';
    674 180         124 my $BLOCK_PLUGIN_OPEN = '
    ';
    675 180         126 my $BLOCK_PLUGIN_CLOSE = '';
    676 180         114 my $INLINE_PLUGIN_RE = '';
    677 180         108 my $INLINE_PLUGIN_OPEN = '';
    678 180         125 my $INLINE_PLUGIN_CLOSE = '';
    679              
    680 180 100       121 return $string if $#{$self->{plugin_stack}} < 0;
      180         427  
    681              
    682 79 100       142 if ( $original eq 'true' ) {
        100          
    683 36         83 $string =~ s|$INLINE_PLUGIN_RE|${$self->{plugin_stack}}[$1]|g;
      6         18  
    684             }
    685 43         83 elsif ( $#{$self->{enabled_plugin}} >= 0 ) {
    686 29         105 $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         136 $string =~ s|$INLINE_PLUGIN_RE|$self->_do_plugin(${$self->{plugin_stack}}[$1],$INLINE_PLUGIN_OPEN,$INLINE_PLUGIN_CLOSE)|eg;
      29         24  
      29         92  
    688             }
    689             else {
    690 14         66 $string =~ s|$BLOCK_PLUGIN_RE|$BLOCK_PLUGIN_OPEN${$self->{plugin_stack}}[$1]$BLOCK_PLUGIN_CLOSE|g;
      9         59  
    691 14         54 $string =~ s|$INLINE_PLUGIN_RE|$INLINE_PLUGIN_OPEN${$self->{plugin_stack}}[$1]$INLINE_PLUGIN_CLOSE|g;
      3         12  
    692             }
    693              
    694 79         228 return $string;
    695             }
    696              
    697             sub _do_plugin {
    698 29     29   25 my $self = shift;
    699 29         22 my $string = shift;
    700 29         23 my $prefix = shift;
    701 29         20 my $suffix = shift;
    702              
    703             # $string =~ s/^{{(.*)}}$/$1/;
    704             # return eval ref($self).'::Plugin::'.$string || $prefix.'{{'.$string.'}}'.$suffix;
    705 29         77 $string =~ /\{\{([^\s\(\)\'\"]+)([\000-\377]*)\}\}/m;
    706 29 50       32 eval {
    707 29         36 my $method = $1;
    708 29   100     73 my $args = $2 || '';
    709              
    710 29         48 my $obj = ref($self).'::Plugin::'.$method.'->new($self)';
    711 29         1494 return eval $obj.'->to_html('.$args.')';
    712             } or return $prefix.$string.$suffix;
    713             }
    714              
    715             sub _escape_meta_char {
    716 136     136   9565 my $self = shift;
    717 136   50     200 my $string = shift || '';
    718              
    719 136         196 $string =~ s{\\(\{|\}|:|'|"|\|)}{'&#x'.unpack('H2',$1).';'}eg;
      9         51  
    720              
    721 136         137 return $string;
    722             }
    723              
    724             sub _unescape_meta_char {
    725 227     227   155 my $self = shift;
    726 227   100     322 my $string = shift || '';
    727 227   100     422 my $original = shift || 'false';
    728              
    729 227 100       312 if ( $original eq 'true' ) {
    730 95         114 $string =~ s|&#x([0-9a-f]{2});|'\\'.pack('H2',$1)|eg;
      2         23  
    731             }
    732             else {
    733 132         193 $string =~ s|&#x([0-9a-f]{2});|pack('H2',$1)|eg;
      3         14  
    734             }
    735              
    736 227         314 return $string;
    737             }
    738              
    739             1;
    740             __END__