File Coverage

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

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

    ';
    503 146 100       292 $paragraph =~ s/\n/{empty_element_suffix}\n/g if ($self->{br_mode} eq 'true');
    504 146         198 push @ret, $paragraph;
    505             }
    506             }
    507              
    508 143         250 $string = join("\n\n",@ret);
    509              
    510 143         223 return $string;
    511             }
    512              
    513             ##
    514             # Inline Parser
    515             ##
    516             sub _inline_parser {
    517 416     416   308 my $self = shift;
    518 416   100     605 my $string = shift || '';
    519              
    520 416         437 $string = $self->_parse_link($string);
    521 416         484 $string = $self->_parse_modifier($string);
    522              
    523 416         800 return $string;
    524             }
    525              
    526             ##
    527             # link and image
    528             sub _parse_link {
    529 416     416   275 my $self = shift;
    530 416   100     498 my $string = shift || '';
    531              
    532 416         274 my $IMAGE_RE = '.(jpe?g|gif|png)\z';
    533 416         266 my $BLACKET_LINK_RE = '\[\[(.+?)\]\]';
    534 416         242 my $NAMED_LINK_RE = '(.+?)\|(.+)';
    535 416         272 my $URI_RE = '((?:(?:https?|ftp|file):|mailto:)[A-Za-z0-9;\/?:@&=+$,\-_.!~*\'()#%]+)';
    536              
    537 416         706 for my $str ( $string =~ /$BLACKET_LINK_RE/gm ) {
    538 18         15 my $uri;
    539             my $title;
    540 18 100       67 if ( $str =~ /$NAMED_LINK_RE/ ) {
    541 10         17 $title = $self->_parse_modifier($1);
    542 10         16 $uri = $2;
    543             }
    544             else {
    545 8         11 $uri = $title = $str;
    546             }
    547 18 50 66     50 if ( $uri !~ m|://| and $uri !~ /^mailto:/ ) {
    548 8         19 $uri =~ s/^(?:https?|ftp|file)+://;
    549             }
    550              
    551 18         28 my $key = $self->_store_block(''.$title.'');
    552 18         94 $string =~ s/$BLACKET_LINK_RE/$key/m;
    553             }
    554              
    555 416         1539 for my $str ( $string =~ /$URI_RE/gm ) {
    556 5         5 my $uri = $str;
    557 5         5 my $key;
    558 5 50 66     15 if ( $uri !~ m|://| and $uri !~ /^mailto:/ ) {
    559 1         4 $uri =~ s/^\w+://;
    560             }
    561 5 100       62 if ( $uri =~ /$IMAGE_RE/i ) {
    562 2         66 $key = $self->_store_block(''.File::Basename::basename($uri).'{empty_element_suffix});
    563             }
    564             else {
    565 3         12 $key = $self->_store_block(''.$uri.'');
    566             }
    567 5         94 $string =~ s/$URI_RE/$key/m;
    568             }
    569              
    570 416         513 return $string;
    571             }
    572              
    573             ##
    574             # modifier (strong, em, re)
    575             sub _parse_modifier {
    576 453     453   320 my $self = shift;
    577 453   100     576 my $string = shift || '';
    578              
    579 453         324 my $STRONG = "'''";
    580 453         266 my $EM = "''";
    581 453         284 my $DEL = '==';
    582              
    583 453         405 my $STRONG_RE = "$STRONG(.+?)$STRONG";
    584 453         368 my $EM_RE = "$EM(.+?)$EM";
    585 453         326 my $DEL_RE = "$DEL(.+?)$DEL";
    586              
    587 453         1234 (my $MODIFIER_RE = "($STRONG_RE|$EM_RE|$DEL_RE)") =~ s/\(\.\+\?\)/(?:.+?)/g;
    588              
    589 453         1031 for my $str ( $string =~ /$MODIFIER_RE/gm ) {
    590 27         18 my $key;
    591 27 100       210 if ( $str =~ /(.*)$STRONG_RE(.*)/ ) {
        100          
        50          
    592 12         49 $key = $self->_store_block($self->_parse_modifier($1.''.$2.''.$3));
    593             }
    594             elsif ( $str =~ /(.*)$EM_RE(.*)/ ) {
    595 8         30 $key = $self->_store_block($self->_parse_modifier($1.''.$2.''.$3));
    596             }
    597             elsif ( $str =~ /(.*)$DEL_RE(.*)/ ) {
    598 7         52 $key = $self->_store_block($self->_parse_modifier($1.''.$2.''.$3));
    599             }
    600 27 50       202 $string =~ s/$MODIFIER_RE/$key/ if $key;
    601             }
    602              
    603 453         540 return $string;
    604             }
    605              
    606              
    607             ##
    608             # Utility Methods
    609             ##
    610             sub _escape_html {
    611 135     135   7399 my $self = shift;
    612 135   50     217 my $string = shift || '';
    613              
    614 135         150 $string =~ s/&/&/g;
    615 135         148 $string =~ s/
    616 135         146 $string =~ s/>/>/g;
    617              
    618 135         155 return $string;
    619             }
    620              
    621             sub _escape_quote {
    622 18     18   15 my $self = shift;
    623 18   50     40 my $string = shift || '';
    624              
    625 18         16 $string =~ s/"/"/g;
    626              
    627 18         44 return $string;
    628             }
    629              
    630             sub _store_block {
    631 101     101   66 my $self = shift;
    632 101   50     139 my $string = shift || '';
    633              
    634 101         57 push @{$self->{stack}}, $string;
      101         142  
    635 101         78 my $key = '<'.$#{$self->{stack}}.'>';
      101         137  
    636              
    637 101         300 return $key;
    638             }
    639              
    640             sub _restore_block {
    641 185     185   139 my $self = shift;
    642 185   100     270 my $string = shift || '';
    643 185   100     473 my $count = shift || 0;
    644              
    645 185 100       136 return $string if $#{$self->{stack}} < 0;
      185         444  
    646 101 50       130 return $string if $count > 10;
    647              
    648 101 100       397 if ( $string =~ s|<(\d+)>|${$self->{stack}}[$1]|gm ) {
      101         417  
    649 53         90 $string = $self->_restore_block($string,++$count);
    650             }
    651              
    652 101         148 return $string;
    653             }
    654              
    655             sub _store_plugin_block {
    656 47     47   39 my $self = shift;
    657 47   50     84 my $string = shift || '';
    658              
    659 47         36 push @{$self->{plugin_stack}}, $string;
      47         98  
    660 47         39 my $key = '{plugin_stack}}.'>';
      47         97  
    661              
    662 47         64 return $key;
    663             }
    664              
    665             sub _restore_plugin_block {
    666 180     180   135 my $self = shift;
    667 180   100     255 my $string = shift || '';
    668 180   100     402 my $original = shift || 'false';
    669              
    670 180         109 my $BLOCK_PLUGIN_RE = '

    ';
    671 180         122 my $BLOCK_PLUGIN_OPEN = '
    ';
    672 180         112 my $BLOCK_PLUGIN_CLOSE = '';
    673 180         108 my $INLINE_PLUGIN_RE = '';
    674 180         117 my $INLINE_PLUGIN_OPEN = '';
    675 180         101 my $INLINE_PLUGIN_CLOSE = '';
    676              
    677 180 100       117 return $string if $#{$self->{plugin_stack}} < 0;
      180         396  
    678              
    679 79 100       101 if ( $original eq 'true' ) {
        100          
    680 36         73 $string =~ s|$INLINE_PLUGIN_RE|${$self->{plugin_stack}}[$1]|g;
      6         18  
    681             }
    682 43         74 elsif ( $#{$self->{enabled_plugin}} >= 0 ) {
    683 29         93 $string =~ s|$BLOCK_PLUGIN_RE|$self->_do_plugin(${$self->{plugin_stack}}[$1],$BLOCK_PLUGIN_OPEN,$BLOCK_PLUGIN_CLOSE)|ge;
      0         0  
      0         0  
    684 29         131 $string =~ s|$INLINE_PLUGIN_RE|$self->_do_plugin(${$self->{plugin_stack}}[$1],$INLINE_PLUGIN_OPEN,$INLINE_PLUGIN_CLOSE)|eg;
      29         29  
      29         90  
    685             }
    686             else {
    687 14         57 $string =~ s|$BLOCK_PLUGIN_RE|$BLOCK_PLUGIN_OPEN${$self->{plugin_stack}}[$1]$BLOCK_PLUGIN_CLOSE|g;
      9         50  
    688 14         52 $string =~ s|$INLINE_PLUGIN_RE|$INLINE_PLUGIN_OPEN${$self->{plugin_stack}}[$1]$INLINE_PLUGIN_CLOSE|g;
      3         11  
    689             }
    690              
    691 79         222 return $string;
    692             }
    693              
    694             sub _do_plugin {
    695 29     29   28 my $self = shift;
    696 29         19 my $string = shift;
    697 29         28 my $prefix = shift;
    698 29         20 my $suffix = shift;
    699              
    700             # $string =~ s/^{{(.*)}}$/$1/;
    701             # return eval ref($self).'::Plugin::'.$string || $prefix.'{{'.$string.'}}'.$suffix;
    702 29         81 $string =~ /\{\{([^\s\(\)\'\"]+)([\000-\377]*)\}\}/m;
    703 29 50       34 eval {
    704 29         35 my $method = $1;
    705 29   100     77 my $args = $2 || '';
    706              
    707 29         50 my $obj = ref($self).'::Plugin::'.$method.'->new($self)';
    708 29         1596 return eval $obj.'->to_html('.$args.')';
    709             } or return $prefix.$string.$suffix;
    710             }
    711              
    712             sub _escape_meta_char {
    713 136     136   8388 my $self = shift;
    714 136   50     189 my $string = shift || '';
    715              
    716 136         155 $string =~ s{\\(\{|\}|:|'|"|\|)}{'&#x'.unpack('H2',$1).';'}eg;
      9         47  
    717              
    718 136         142 return $string;
    719             }
    720              
    721             sub _unescape_meta_char {
    722 227     227   177 my $self = shift;
    723 227   100     322 my $string = shift || '';
    724 227   100     434 my $original = shift || 'false';
    725              
    726 227 100       297 if ( $original eq 'true' ) {
    727 95         113 $string =~ s|&#x([0-9a-f]{2});|'\\'.pack('H2',$1)|eg;
      2         17  
    728             }
    729             else {
    730 132         173 $string =~ s|&#x([0-9a-f]{2});|pack('H2',$1)|eg;
      3         14  
    731             }
    732              
    733 227         283 return $string;
    734             }
    735              
    736             1;
    737             __END__