1package Text::Haml;
2
3use strict;
4use warnings;
5
6use IO::File;
7use Scalar::Util qw/weaken/;
8use Encode qw/decode/;
9use Carp ();
10use File::Spec;
11use File::Basename ();
12use URI::Escape ();
13use Digest::MD5;
14
15our $VERSION = '0.990118';
16
17use constant CHUNK_SIZE => 4096;
18use constant _DEFAULT_CACHE_DIR => '.text_haml_cache';
19my $cache_dir;
20
21BEGIN {
22    for my $dir ($ENV{HOME}, File::Spec->tmpdir) {
23        if (defined($dir) && -d $dir && -w _) {
24            $cache_dir = File::Spec->catdir($dir, _DEFAULT_CACHE_DIR);
25            last;
26        }
27    }
28}
29
30my $ESCAPE = {
31    '\"'   => "\x22",
32    "\'"   => "\x27",
33    '\\'   => "\x5c",
34    '\/'   => "\x2f",
35    '\b'   => "\x8",
36    '\f'   => "\xC",
37    '\n'   => "\xA",
38    '\r'   => "\xD",
39    '\t'   => "\x9",
40    '\\\\' => "\x5c\x5c"
41};
42
43my $UNESCAPE_RE = qr/
44    \\[\"\'\/\\bfnrt]
45/x;
46
47my $STRING_DOUBLE_QUOTES_RE = qr/
48    \"
49    (?:
50    $UNESCAPE_RE
51    |
52    [\x20-\x21\x23-\x5b\x5b-\x{10ffff}]
53    )*
54    \"
55/x;
56
57my $STRING_SINGLE_QUOTES_RE = qr/
58    \'
59    (?:
60    $UNESCAPE_RE
61    |
62    [\x20-\x26\x28-\x5b\x5b-\x{10ffff}]
63    )*
64    \'
65/x;
66
67my $STRING_RE = qr/
68    $STRING_SINGLE_QUOTES_RE
69    |
70    $STRING_DOUBLE_QUOTES_RE
71/x;
72
73sub new {
74    my $class = shift;
75
76    # Default attributes
77    my $attrs = {};
78    $attrs->{vars_as_subs} = 0;
79    $attrs->{tape}         = [];
80    $attrs->{encoding}     = 'utf-8';
81    $attrs->{escape_html}  = 1;
82    $attrs->{helpers}      = {};
83    $attrs->{helpers_options} = {};
84    $attrs->{format}       = 'xhtml';
85    $attrs->{prepend}      = '';
86    $attrs->{append}       = '';
87    $attrs->{namespace}    = '';
88    $attrs->{path}         = ['.'];
89    $attrs->{cache}        = 1; # 0: not cached, 1: checks mtime, 2: always cached
90    $attrs->{cache_dir}    = _DEFAULT_CACHE_DIR;
91
92    $attrs->{escape}       = <<'EOF';
93    my $s = shift;
94    return unless defined $s;
95    $s =~ s/&/&amp;/g;
96    $s =~ s/</&lt;/g;
97    $s =~ s/>/&gt;/g;
98    $s =~ s/"/&quot;/g;
99    $s =~ s/'/&apos;/g;
100    return $s;
101EOF
102
103    $attrs->{filters} = {
104        plain => sub { $_[0] =~ s/\n*$//; $_[0] },
105        escaped  => sub { $_[0] },
106        preserve => sub { $_[0] =~ s/\n/&#x000A;/g; $_[0] },
107        javascript => sub {
108            "<script type='text/javascript'>\n"
109              . "  //<![CDATA[\n"
110              . "    $_[0]\n"
111              . "  //]]>\n"
112              . "</script>";
113        },
114        css => sub {
115            "<style type='text/css'>\n"
116              . "  /*<![CDATA[*/\n"
117              . "    $_[0]\n"
118              . "  /*]]>*/\n"
119              . "</style>";
120        },
121    };
122
123    my $self = {%$attrs, @_};
124    bless $self, $class;
125
126    # Convert to template fullpath
127    $self->path([
128        map { ref($_) ? $_ : File::Spec->rel2abs($_) }
129            ref($self->path) eq 'ARRAY' ? @{$self->path} : $self->path
130    ]);
131
132    $self->{helpers_arg} ||= $self;
133    weaken $self->{helpers_arg};
134
135    return $self;
136}
137
138# Yes, i know!
139sub vars_as_subs  { @_ > 1 ? $_[0]->{vars_as_subs}  = $_[1] : $_[0]->{vars_as_subs}; }
140sub format        { @_ > 1 ? $_[0]->{format}        = $_[1] : $_[0]->{format} }
141sub encoding      { @_ > 1 ? $_[0]->{encoding}      = $_[1] : $_[0]->{encoding} }
142sub escape_html   { @_ > 1 ? $_[0]->{escape_html}   = $_[1] : $_[0]->{escape_html}; }
143sub code          { @_ > 1 ? $_[0]->{code}          = $_[1] : $_[0]->{code} }
144sub compiled      { @_ > 1 ? $_[0]->{compiled}      = $_[1] : $_[0]->{compiled} }
145sub helpers       { @_ > 1 ? $_[0]->{helpers}       = $_[1] : $_[0]->{helpers} }
146sub helpers_options { @_ > 1 ? $_[0]->{helpers_options} = $_[1] : $_[0]->{helpers_options} }
147sub filters       { @_ > 1 ? $_[0]->{filters}       = $_[1] : $_[0]->{filters} }
148sub prepend       { @_ > 1 ? $_[0]->{prepend}       = $_[1] : $_[0]->{prepend} }
149sub append        { @_ > 1 ? $_[0]->{append}        = $_[1] : $_[0]->{append} }
150sub escape        { @_ > 1 ? $_[0]->{escape}        = $_[1] : $_[0]->{escape} }
151sub tape          { @_ > 1 ? $_[0]->{tape}          = $_[1] : $_[0]->{tape} }
152sub path          { @_ > 1 ? $_[0]->{path}          = $_[1] : $_[0]->{path} }
153sub cache         { @_ > 1 ? $_[0]->{cache}         = $_[1] : $_[0]->{cache} }
154sub fullpath      { @_ > 1 ? $_[0]->{fullpath}      = $_[1] : $_[0]->{fullpath}; }
155sub cache_dir     { @_ > 1 ? $_[0]->{cache_dir}     = $_[1] : $_[0]->{cache_dir}; }
156sub cache_path    { @_ > 1 ? $_[0]->{cache_path}    = $_[1] : $_[0]->{cache_path}; }
157sub namespace     { @_ > 1 ? $_[0]->{namespace}     = $_[1] : $_[0]->{namespace}; }
158sub error         { @_ > 1 ? $_[0]->{error}         = $_[1] : $_[0]->{error} }
159
160sub helpers_arg {
161    if (@_ > 1) {
162        $_[0]->{helpers_arg} = $_[1];
163        weaken $_[0]->{helpers_arg};
164    }
165    else {
166        return $_[0]->{helpers_arg};
167    }
168}
169
170
171our @AUTOCLOSE = (qw/meta img link br hr input area param col base/);
172
173sub add_helper {
174    my $self = shift;
175    my ($name, $code, %options) = @_;
176
177    $self->helpers->{$name} = $code;
178    $self->helpers_options->{$name} = \%options;
179}
180
181sub add_filter {
182    my $self = shift;
183    my ($name, $code) = @_;
184
185    $self->filters->{$name} = $code;
186}
187
188sub parse {
189    my $self = shift;
190    my $tmpl = shift;
191
192    $tmpl = '' unless defined $tmpl;
193
194    $self->tape([]);
195
196    my $level_token    = quotemeta ' ';
197    my $escape_token   = quotemeta '&';
198    my $unescape_token = quotemeta '!';
199    my $expr_token     = quotemeta '=';
200    my $tag_start      = quotemeta '%';
201    my $class_start    = quotemeta '.';
202    my $id_start       = quotemeta '#';
203
204    my $attributes_start = quotemeta '{';
205    my $attributes_end   = quotemeta '}';
206    my $attribute_arrow  = quotemeta '=>';
207    my $attributes_sep   = quotemeta ',';
208    my $attribute_prefix = quotemeta ':';
209    my $attribute_name   = qr/(?:$STRING_RE|.*?(?= |$attribute_arrow))/;
210    my $attribute_value =
211      qr/(?:$STRING_RE|[^ $attributes_sep$attributes_end]+)/x;
212
213    my $attributes_start2 = quotemeta '(';
214    my $attributes_end2   = quotemeta ')';
215    my $attribute_arrow2  = quotemeta '=';
216    my $attributes_sep2   = ' ';
217    my $attribute_name2   = qr/(?:$STRING_RE|.*?(?= |$attribute_arrow2))/;
218    my $attribute_value2 =
219      qr/(?:$STRING_RE|[^ $attributes_sep2$attributes_end2]+)/;
220
221    my $filter_token    = quotemeta ':';
222    my $quote           = "'";
223    my $comment_token   = quotemeta '-#';
224    my $trim_in         = quotemeta '<';
225    my $trim_out        = quotemeta '>';
226    my $autoclose_token = quotemeta '/';
227    my $multiline_token = quotemeta '|';
228
229    my $tag_name = qr/([^
230        $level_token
231        $attributes_start
232        $attributes_start2
233        $class_start
234        $id_start
235        $trim_in
236        $trim_out
237        $unescape_token
238        $escape_token
239        $expr_token
240        $autoclose_token]+)/;
241
242    my $tape = $self->tape;
243
244    my $level;
245    my @multiline_el_queue;
246    my $multiline_code_el = undef;
247    my @lines = split /\n/, $tmpl;
248    push @lines, '' if $tmpl =~ m/\n$/;
249    @lines = ('') if $tmpl eq "\n";
250    for (my $i = 0; $i < @lines; $i++) {
251        my $line = $lines[$i];
252
253        if ($line =~ s/^($level_token+)//) {
254            $level = length $1;
255        }
256        else {
257            $level = 0;
258        }
259
260        my $el = {level => $level, type => 'text', line => $line, lineno => $i+1};
261
262        if (defined $multiline_code_el && $line =~ /^[-!=%#.:]/) {
263            push @$tape, $multiline_code_el;
264            undef $multiline_code_el;
265        }
266
267        # Haml comment
268        if ($line =~ m/^$comment_token(?: (.*))?/) {
269            $el->{type} = 'comment';
270            $el->{text} = $1 if $1;
271            push @$tape, $el;
272            next;
273        }
274
275        # Inside a filter
276        my $prev = $tape->[-1];
277        if ($prev && $prev->{type} eq 'filter') {
278            if ($prev->{level} < $el->{level}
279                || ($i + 1 < @lines && $line eq ''))
280            {
281                $prev->{text} .= "\n" if $prev->{text};
282                $prev->{text} .= $line;
283                $prev->{line} .= "\n" . (' ' x $el->{level}) . $el->{line};
284                _update_lineno($prev, $i);
285                next;
286            }
287        }
288
289        # Filter
290        if ($line =~ m/^:(\w+)/) {
291            $el->{type} = 'filter';
292            $el->{name} = $1;
293            $el->{text} = '';
294            push @$tape, $el;
295            next;
296        }
297
298        # Doctype
299        if ($line =~ m/^!!!(?: ([^ ]+)(?: (.*))?)?$/) {
300            $el->{type}   = 'text';
301            $el->{escape} = 0;
302            $el->{text}   = $self->_doctype($1, $2);
303            push @$tape, $el;
304            next;
305        }
306
307        # HTML comment
308        if ($line =~ m/^\/(?:\[if (.*)?\])?(?: *(.*))?/) {
309            $el->{type} = 'html_comment';
310            $el->{if}   = $1 if $1;
311            $el->{text} = $2 if $2;
312            push @$tape, $el;
313            next;
314        }
315
316        # Escaping, everything after is a text
317        if ($line =~ s/^\\//) {
318            $el->{type} = 'text', $el->{text} = $line;
319            push @$tape, $el;
320            next;
321        }
322
323        # Block (note even the final multiline block must end in |)
324        if ($line =~ s/^- \s*(.*)(\s\|\s*)$// ||
325            $line =~ s/^- \s*(.*)// ||
326                (defined $multiline_code_el && $line =~ s/^(.*)(\s\|\s*)$//)) {
327
328            $el->{type} = 'block';
329
330            if ($2) {
331                $multiline_code_el ||= $el;
332                $multiline_code_el->{text} ||= '';
333                $multiline_code_el->{text} .= $1;
334
335                next;
336            }
337
338            $el->{text} = $1;
339            push @$tape, $el;
340            next;
341
342        }
343
344        # Preserve whitespace
345        if ($line =~ s/^~ \s*(.*)//) {
346            $el->{type}                = 'text';
347            $el->{text}                = $1;
348            $el->{expr}                = 1;
349            $el->{preserve_whitespace} = 1;
350            push @$tape, $el;
351            next;
352        }
353
354        # Tag
355        if ($line =~ m/^(?:$tag_start
356            |$class_start
357            |$id_start
358            )/x
359          )
360        {
361            $el->{type} = 'tag';
362            $el->{name} = '';
363
364            if ($line =~ s/^$tag_start$tag_name//) {
365                $el->{name} = $1;
366            }
367
368            while (1) {
369                if ($line =~ s/^$class_start$tag_name//) {
370                    my $class = join(' ', split(/\./, $1));
371
372                    $el->{name}  ||= 'div';
373                    $el->{class} ||= [];
374                    push @{$el->{class}}, $class;
375                }
376                elsif ($line =~ s/^$id_start$tag_name//) {
377                    my $id = $1;
378
379                    $el->{name} ||= 'div';
380                    $el->{id} = $id;
381                }
382                else {
383                    last;
384                }
385            }
386
387            if ($line =~ m/^
388                (?:
389                    $attributes_start\s*
390                    $attribute_prefix?
391                    $attribute_name\s*
392                    $attribute_arrow\s*
393                    $attribute_value
394                    |
395                    $attributes_start2\s*
396                    $attribute_name2\s*
397                    $attribute_arrow2\s*
398                    $attribute_value2
399                )
400                /x
401              )
402            {
403                my $attrs = [];
404
405                my $type = 'html';
406                if ($line =~ s/^$attributes_start//) {
407                    $type = 'perl';
408                }
409                else {
410                    $line =~ s/^$attributes_start2//;
411                }
412
413                while (1) {
414                    if (!$line) {
415                        $line = $lines[++$i] || last;
416                        $el->{line} .= "\n$line";
417                        _update_lineno($el, $i);
418                    }
419                    elsif ($type eq 'perl' && $line =~ s/^$attributes_end//) {
420                        last;
421                    }
422                    elsif ($type eq 'html' && $line =~ s/^$attributes_end2//)
423                    {
424                        last;
425                    }
426                    else {
427                        my ($name, $value);
428
429                        if ($line =~ s/^\s*$attribute_prefix?
430                                    ($attribute_name)\s*
431                                    $attribute_arrow\s*
432                                    ($attribute_value)\s*
433                                    (?:$attributes_sep\s*)?//x
434                          )
435                        {
436                            $name  = $1;
437                            $value = $2;
438                        }
439                        elsif (
440                            $line =~ s/^\s*
441                                    ($attribute_name2)\s*
442                                    $attribute_arrow2\s*
443                                    ($attribute_value2)\s*
444                                    (?:$attributes_sep2\s*)?//x
445                          )
446                        {
447                            $name  = $1;
448                            $value = $2;
449                        }
450                        else {
451                            $self->error('Tag attributes parsing error');
452                            return;
453                        }
454
455                        if ($name =~ s/^(?:'|")//) {
456                            $name =~ s/(?:'|")$//;
457                            $name =~ s/($UNESCAPE_RE)/$ESCAPE->{$1}/g;
458                        }
459
460                        if ($value =~ s/^(?:'|")//) {
461                            $value =~ s/(?:'|")$//;
462                            $value =~ s/($UNESCAPE_RE)/$ESCAPE->{$1}/g;
463                            push @$attrs,
464                              $name => {type => 'text', text => $value};
465                        }
466                        elsif ($value eq 'true' || $value eq 'false') {
467                            push @$attrs, $name => {
468                                type => 'boolean',
469                                text => $value eq 'true' ? 1 : 0
470                            };
471                        }
472                        else {
473                            push @$attrs,
474                              $name => {type => 'expr', text => $value};
475                        }
476                    }
477                }
478
479                $el->{type} = 'tag';
480                $el->{attrs} = $attrs if @$attrs;
481            }
482
483            if ($line =~ s/^$trim_out ?//) {
484                $el->{trim_out} = 1;
485            }
486
487            if ($line =~ s/^$trim_in ?//) {
488                $el->{trim_in} = 1;
489            }
490        }
491
492        if ($line =~ s/^($escape_token|$unescape_token)?$expr_token //) {
493            $el->{expr} = 1;
494            if ($1) {
495                $el->{escape} = quotemeta($1) eq $escape_token ? 1 : 0;
496            }
497        }
498
499        if ($el->{type} eq 'tag'
500            && ($line =~ s/$autoclose_token$//
501                || grep { $el->{name} eq $_ } @AUTOCLOSE)
502          )
503        {
504            $el->{autoclose} = 1;
505        }
506
507        $line =~ s/^ // if $line;
508
509        # Multiline
510        if ($line && $line =~ s/(\s*)$multiline_token$//) {
511
512            # For the first time
513            if (!$tape->[-1] || ref $tape->[-1]->{text} ne 'ARRAY') {
514                $el->{text} = [$line];
515                $el->{line} ||= $line . "$1|"; # XXX: is this really necessary?
516
517                push @$tape, $el;
518                push @multiline_el_queue, $el;
519            }
520
521            # Continue concatenation
522            else {
523                my $prev_stack_el = $tape->[-1];
524                push @{$prev_stack_el->{text}}, $line;
525                $prev_stack_el->{line} .= "\n" . $line . "$1|";
526                _update_lineno($prev_stack_el, $i);
527            }
528        }
529
530        # Normal text
531        else {
532            $el->{text} = $line if $line;
533
534            push @$tape, $el;
535        }
536    }
537
538    # Finalize multilines
539    for my $el (@multiline_el_queue) {
540        $el->{text} = join(" ", @{$el->{text}});
541    }
542}
543
544# Updates lineno entry on the tape element
545# for itens spanning more than one line
546sub _update_lineno {
547    my ($el, $lineno) = @_;
548    $lineno++;    # report line numbers starting at 1 instead of 0
549    $el->{lineno} =~ s/^(\d+)(?:-\d+)?/$1-$lineno/;
550    return;
551}
552
553sub _open_implicit_brace {
554    my ($lines) = @_;
555        if (scalar(@$lines) && $lines->[-1] eq '}') {
556        pop @$lines;
557    } else {
558        push @$lines, '{';
559    }
560}
561
562sub _close_implicit_brace {
563    my ($lines) = @_;
564    if (scalar(@$lines) && $lines->[-1] eq '{') {
565        pop @$lines;
566    } else {
567        push @$lines, '}';
568    }
569}
570
571sub build {
572    my $self = shift;
573    my %vars = @_;
574
575    my $code;
576
577    my $ESCAPE = $self->escape;
578    $ESCAPE = <<"EOF";
579no strict 'refs'; no warnings 'redefine';
580sub escape;
581*escape = sub {
582    $ESCAPE
583};
584use strict; use warnings;
585EOF
586
587    $ESCAPE =~ s/\n//g;
588
589    # ensure namespace is set so that (for now) helpers
590    # can access outs & outs_raw (until we correctly allow
591    # helpers in `=` lines to capture their blocks eg. for `surrounds`
592
593    if (! $self->namespace) {
594        $self->namespace(ref($self) . '::template');
595    }
596
597    my $namespace = $self->namespace;
598    $code .= qq/package $namespace;/;
599
600    $code .= qq/sub { my \$_H = ''; $ESCAPE; /;
601
602    $code .= qq/my \$self = shift;/;
603    $code .= qq/\$${namespace}::__self = \$self;/;
604
605    $code .= qq/my \%____vars = \@_;/;
606
607    $code .= qq/no strict 'refs'; no warnings 'redefine';/;
608
609    # using [1] since when called with arrow from namespace, [0] will be the namespace
610    $code .= qq/*${namespace}::outs = sub { \$_H .= escape(\$_[1]) };/;
611    $code .= qq/*${namespace}::outs_raw = sub { \$_H .= \$_[1] };/;
612    $code .= qq/*${namespace}::out_chomp = sub { chomp \$_H };/;
613
614    # Install helpers
615    for my $name (sort keys %{$self->helpers}) {
616        next unless $name =~ m/^\w+$/;
617
618        my $options = $self->{helpers_options}{$name} || {};
619
620        # allow bareword helpers and block capturing with optional helper prototypes
621        my $prototype = $options->{prototype};
622        $prototype = defined $prototype ? "($prototype)" : '';
623
624        # this option allows per-helper overriding of the helper_arg, important for builtin
625        # helpers to be safe in assuming the arg is self
626        my $helper_arg_code = $options->{arg_force_self} ? "\$${namespace}::__self" : "\$${namespace}::__self->helpers_arg";
627
628        # sub must be defined inside BEGIN {} for the prototype to be ready before main helper code is
629        # compiled
630        $code .= "BEGIN { \*${namespace}::${name} = sub $prototype { ";
631        $code .= "\$${namespace}::__self->helpers->{'$name'}->($helper_arg_code, \@_) }; } ";
632    }
633
634    # Install variables
635    foreach my $var (sort keys %vars) {
636        next unless $var =~ m/^\w+$/;
637        if ($self->vars_as_subs) {
638            next if $self->helpers->{$var};
639            $code
640                .= qq/sub $var() : lvalue; *$var = sub () : lvalue {\$____vars{'$var'}};/;
641        }
642        else {
643            $code .= qq/my \$$var = \$____vars{'$var'};/;
644        }
645    }
646
647    $code .= qq/use strict; use warnings;/;
648
649    $code .= $self->prepend;
650
651    my $stack = [];
652
653    my $output = '';
654    my @lines;
655    my $count    = 0;
656    my $in_block = 0;
657  ELEM:
658    for my $el (@{$self->tape}) {
659        my $level = $el->{level};
660        $level -= 2 * $in_block if $in_block;
661
662        my $offset = '';
663        $offset .= ' ' x $level if $level > 0;
664
665        my $escape = '';
666        if (   (!exists $el->{escape} && $self->escape_html)
667            || (exists $el->{escape} && $el->{escape} == 1))
668        {
669            $escape = 'escape';
670        }
671
672        my $prev_el = $self->tape->[$count - 1];
673        my $next_el = $self->tape->[$count + 1];
674
675        my $prev_stack_el = $stack->[-1];
676
677        if ($prev_stack_el && $prev_stack_el->{type} eq 'comment') {
678            if (   $el->{line}
679                && $prev_stack_el->{level} >= $el->{level})
680            {
681                pop @$stack;
682                undef $prev_stack_el;
683                _close_implicit_brace(\@lines);
684            }
685            else {
686                next ELEM;
687            }
688        }
689
690        if (   $el->{line}
691            && $prev_stack_el
692            && $prev_stack_el->{level} >= $el->{level})
693        {
694          STACKEDBLK:
695            while (my $poped = pop @$stack) {
696                my $level = $poped->{level};
697                $level -= 2 * $in_block if $in_block;
698                my $poped_offset = $level > 0 ? ' ' x $level : '';
699
700                my $ending = '';
701                if ($poped->{type} eq 'tag') {
702                    $ending .= "</$poped->{name}>";
703                }
704                elsif ($poped->{type} eq 'html_comment') {
705                    $ending .= "<![endif]" if $poped->{if};
706                    $ending .= "-->";
707                }
708
709                if ($poped->{type} ne 'block') {
710                    push @lines, qq|\$_H .= "$poped_offset$ending\n";|;
711                }
712
713                _close_implicit_brace(\@lines);
714
715                if ($poped->{type} eq 'block') {
716                    _close_implicit_brace(\@lines);
717                }
718
719                last STACKEDBLK if $poped->{level} == $el->{level};
720            }
721        }
722
723
724      SWITCH: {
725
726            if ($el->{type} eq 'tag') {
727                my $ending =
728                  $el->{autoclose} && $self->format eq 'xhtml' ? ' /' : '';
729
730                my $attrs = '';
731                if ($el->{attrs}) {
732                  ATTR:
733                    for (my $i = 0; $i < @{$el->{attrs}}; $i += 2) {
734                        my $name  = $el->{attrs}->[$i];
735                        my $value = $el->{attrs}->[$i + 1];
736                        my $text  = $value->{text};
737
738                        if ($name eq 'class') {
739                            $el->{class} ||= [];
740                            if ($value->{type} eq 'text') {
741                                push @{$el->{class}}, $self->_parse_text($text);
742                            }
743                            else {
744                                push @{$el->{class}}, qq/" . $text . "/;
745                            }
746                            next ATTR;
747                        }
748                        elsif ($name eq 'id') {
749                            $el->{id} ||= '';
750                            $el->{id} = $el->{id} . '_' if $el->{id};
751                            $el->{id} .= $self->_parse_text($value->{text});
752                            next ATTR;
753                        }
754
755                        if (   $value->{type} eq 'text'
756                            || $value->{type} eq 'expr')
757                        {
758                            $attrs .= ' ';
759                            $attrs .= $name;
760                            $attrs .= '=';
761
762                            if ($value->{type} eq 'text') {
763                                $attrs
764                                  .= "'" . $self->_parse_text($text) . "'";
765                            }
766                            else {
767                                $attrs .= qq/'" . $text . "'/;
768                            }
769                        }
770                        elsif ($value->{type} eq 'boolean' && $value->{text})
771                        {
772                            $attrs .= ' ';
773                            $attrs .= $name;
774                            if ($self->format eq 'xhtml') {
775                                $attrs .= '=';
776                                $attrs .= qq/'$name'/;
777                            }
778                        }
779                    }    #end:for ATTR
780                }
781
782                my $tail = '';
783                if ($el->{class}) {
784                    $tail .= qq/ class='"./;
785                    $tail .= qq/join(' ', sort(/;
786                    $tail .= join(',', map {"\"$_\""} @{$el->{class}});
787                    $tail .= qq/))/;
788                    $tail .= qq/."'/;
789                }
790
791                if ($el->{id}) {
792                    $tail .= qq/ id='$el->{id}'/;
793                }
794
795                $output .= qq|"$offset<$el->{name}$tail$attrs$ending>"|;
796
797                if ($el->{text} && $el->{expr}) {
798                  if ($escape eq 'escape') {
799                    $output .= '. ( do { my $ret = ' .  qq/ $escape( do { $el->{text} } )/ . '; defined($ret) ? $ret : "" } )';
800                    $output .= qq| . "</$el->{name}>"|;
801                  } else {
802                    $output .= '. ( do {' . $el->{text} . '} || "")';
803                    $output .= qq| . "</$el->{name}>"|;
804                  }
805                }
806                elsif ($el->{text}) {
807                    $output .= qq/. $escape(/ . '"'
808                      . $self->_parse_text($el->{text}) . '");';
809                    $output .= qq|\$_H .= "</$el->{name}>"|
810                      unless $el->{autoclose};
811                }
812                elsif (
813                    !$next_el
814                    || (   $next_el
815                        && $next_el->{level} <= $el->{level})
816                  )
817                {
818                    $output .= qq|. "</$el->{name}>"| unless $el->{autoclose};
819                }
820                elsif (!$el->{autoclose}) {
821                    push @$stack, $el;
822                    _open_implicit_brace(\@lines);
823                }
824
825                $output .= qq|. "\n"|;
826                $output .= qq|;|;
827                last SWITCH;
828            }
829
830            if ($el->{line} && $el->{type} eq 'text') {
831                $output = qq/"$offset"/;
832
833                $el->{text} = '' unless defined $el->{text};
834
835                if ($el->{expr}) {
836                    $output .= '. ( do { my $ret = ' .  qq/ $escape( do { $el->{text} } )/ . '; defined($ret) ? $ret : "" } )';
837                    $output .= qq/;\$_H .= "\n"/;
838                }
839                elsif ($el->{text}) {
840                    $output
841                      .= '.'
842                      . qq/$escape / . '"'
843                      . $self->_parse_text($el->{text}) . '"';
844                    $output .= qq/. "\n"/;
845                }
846
847                $output .= qq/;/;
848                last SWITCH;
849            }
850
851            if ($el->{type} eq 'block') {
852                _open_implicit_brace(\@lines);
853                push @lines,  ';' . $el->{text};
854                push @$stack, $el;
855                _open_implicit_brace(\@lines);
856
857                if ($prev_el && $prev_el->{level} > $el->{level}) {
858                    $in_block--;
859                }
860
861                if ($next_el && $next_el->{level} > $el->{level}) {
862                    $in_block++;
863                }
864                last SWITCH;
865            }
866
867            if ($el->{type} eq 'html_comment') {
868                $output = qq/"$offset"/;
869
870                $output .= qq/ . "<!--"/;
871                $output .= qq/ . "[if $el->{if}]>"/ if $el->{if};
872
873                if ($el->{text}) {
874                    $output .= '." ' . quotemeta($el->{text}) . ' ".';
875                    $output .= qq/"-->\n"/;
876                }
877                else {
878                    $output .= qq/. "\n"/;
879                    push @$stack, $el;
880                    _open_implicit_brace(\@lines);
881                }
882
883                $output .= qq/;/;
884                last SWITCH;
885            }
886
887            if ($el->{type} eq 'comment') {
888                push @$stack, $el;
889                _open_implicit_brace(\@lines);
890                last SWITCH;
891            }
892
893            if ($el->{type} eq 'filter') {
894                my $filter = $self->filters->{$el->{name}};
895                die "unknown filter: $el->{name}" unless $filter;
896
897                if ($el->{name} eq 'escaped') {
898                    $output =
899                        qq/escape "/
900                      . $self->_parse_text($el->{text})
901                      . qq/\n";/;
902                }
903                else {
904                    $el->{text} = $filter->($el->{text});
905
906                    my $text = $self->_parse_text($el->{text});
907                    $text =~ s/\\\n/\\n/g;
908                    $output = qq/"/ . $text . qq/\n";/;
909                }
910                last SWITCH;
911            }
912
913            unless ($el->{text}) {
914                last SWITCH;
915            }
916
917            die "unknown type=" . $el->{type};
918
919        }    #end:SWITCH
920    }    #end:ELEM
921    continue {
922
923        # by bracing the content blocks, we will continue any existing block at the same level.
924        # this is important eg. if previously at this level the template has declared a `my`
925        # variable.
926
927        _open_implicit_brace(\@lines);
928        push @lines, '$_H .= ' . $output if $output;
929        _close_implicit_brace(\@lines);
930        $output = '';
931        $count++;
932    }    #ELEM
933
934    my $last_empty_line = 0;
935    $last_empty_line = 1
936      if $self->tape->[-1] && $self->tape->[-1]->{line} eq '';
937
938    # Close remaining conten tblocks, last-seen first
939    foreach my $el (reverse @$stack) {
940        my $offset = ' ' x $el->{level};
941        my $ending = '';
942        if ($el->{type} eq 'tag') {
943            $ending = "</$el->{name}>";
944        }
945        elsif ($el->{type} eq 'html_comment') {
946            $ending .= '<![endif]' if $el->{if};
947            $ending .= "-->";
948        }
949
950        push @lines, qq|\$_H .= "$offset$ending\n";| if $ending;
951
952        _close_implicit_brace(\@lines);
953        if ($el->{type} eq 'block') {
954            _close_implicit_brace(\@lines);
955        }
956
957    }
958
959    if ($lines[-1] && !$last_empty_line) {
960        # usually (always?) there will be a closing '}' after the actual last .=
961        if ($lines[-2] && $lines[-1] eq '}') {
962            $lines[-2] =~ s/\n";$/";/;
963        } else {
964            $lines[-1] =~ s/\n";$/";/;
965        }
966    }
967
968    $code .= join("\n", @lines);
969
970    $code .= $self->append;
971
972    $code .= q/return $_H; };/;
973
974    $self->code($code);
975
976    return $self;
977}
978
979sub _parse_text {
980    my $self = shift;
981    my $text = shift;
982
983    my $expr = 0;
984    if ($text =~ m/^\"/ && $text =~ m/\"$/) {
985        $text =~ s/^"//;
986        $text =~ s/"$//;
987        $expr = 1;
988    }
989
990    $text =~ s/($UNESCAPE_RE)/$ESCAPE->{$1}/g;
991
992    my $output = '';
993    while (1) {
994        my $t;
995        my $escape = 0;
996        my $found  = 0;
997        my $variable;
998
999        our $curly_brace_n;
1000        $curly_brace_n = qr/ (?> [^{}]+ | \{ (??{ $curly_brace_n }) \} )* /x;
1001
1002        if ($text =~ s/^(.*?)?(?<!\\)(\#\{$curly_brace_n\})//xms) {
1003            $found    = 1;
1004            $t        = $1;
1005            $variable = $2;
1006        }
1007        elsif ($text =~ s/^(.*?)?\\\\(\#\{$curly_brace_n\})//xms) {
1008            $found    = 1;
1009            $t        = $1;
1010            $variable = $2;
1011            $escape   = 1;
1012        }
1013
1014        if ($t) {
1015            $t =~ s/\\\#/\#/g;
1016            $output .= $expr ? $t : quotemeta($t);
1017        }
1018
1019        if ($found) {
1020            $variable =~ s/\#\{(.*)\}/$1/;
1021
1022            my $prefix = $escape ? quotemeta("\\") : '';
1023            $output .= qq/$prefix".do { $variable }."/;
1024        }
1025        else {
1026            $text = $self->_parse_interpolation($text);
1027            $output .= $text;
1028            last;
1029        }
1030    }
1031
1032    return $expr ? qq/$output/ : $output;
1033}
1034
1035sub _parse_interpolation {
1036    my $self = shift;
1037    my ($text) = @_;
1038
1039    my @parts;
1040
1041    my $start_tag = qr{(?<!\\)\#\{};
1042    my $end_tag   = qr{\}};
1043
1044    pos $text = 0;
1045    while (pos $text < length $text) {
1046        if ($text =~ m/\G $start_tag (.*?) $end_tag/xgcms) {
1047            push @parts, 'do {' . $1 . '}';
1048        }
1049        elsif ($text =~ m/\G (.*?) (?=$start_tag)/xgcms) {
1050            push @parts, 'qq{' . quotemeta($1) . '}';
1051        }
1052        else {
1053            my $leftover = substr($text, pos($text));
1054            push @parts, 'qq{' . quotemeta($leftover) . '}';
1055            last;
1056        }
1057    }
1058
1059    return '' unless @parts;
1060
1061    return '" . ' . join('.', map {s/\\\\#\\\{/#\\\{/; $_} @parts) . '."';
1062}
1063
1064sub compile {
1065    my $self = shift;
1066
1067    my $code = $self->code;
1068    return unless $code;
1069
1070    my $compiled = eval $code;
1071
1072    if ($@) {
1073        $self->error($@);
1074        return undef;
1075    }
1076
1077    $self->compiled($compiled);
1078
1079    return $self;
1080}
1081
1082sub interpret {
1083    my $self = shift;
1084
1085    my $compiled = $self->compiled;
1086
1087    my $output = eval { $compiled->($self, @_) };
1088
1089    if ($@) {
1090        $self->error($@);
1091        return undef;
1092    }
1093
1094    return $output;
1095}
1096
1097sub render {
1098    my $self = shift;
1099    my $tmpl = shift;
1100
1101    # Parse
1102    $self->parse($tmpl);
1103
1104    # Build
1105    return unless defined $self->build(@_);
1106
1107    # Compile
1108    $self->compile || return undef;
1109
1110    # Interpret
1111    return $self->interpret(@_);
1112}
1113
1114# For templates in __DATA__ section
1115sub _eq_checksum {
1116  my $self = shift;
1117
1118  # Exit if not virtual path
1119  return 0 unless ref $self->fullpath eq 'SCALAR';
1120
1121  return 1 if $self->cache == 2;
1122  return 0 if $self->cache == 0;
1123
1124  my $fullpath = $self->fullpath;
1125  $fullpath = $$fullpath;
1126
1127  my $file = IO::File->new;
1128  $file->open($self->cache_path, 'r') or return;
1129  $file->sysread(my $cache_md5_checksum, 33); # 33 = # + hashsum
1130  $file->close;
1131
1132  my $orig_md5_checksum = '#'.$self->_digest($fullpath);
1133
1134  return $cache_md5_checksum eq $orig_md5_checksum;
1135}
1136
1137sub _digest {
1138    my ($self, $content) = @_;
1139
1140    my $md5 = Digest::MD5->new();
1141    $content = decode($self->encoding, $content) if $self->encoding;
1142    $md5->add($content);
1143    return $md5->hexdigest();
1144}
1145
1146sub render_file {
1147    my $self = shift;
1148    my $path = shift;
1149
1150    # Set file fullpath
1151    $self->_fullpath($path);
1152
1153    if ($self->cache >= 1) {
1154        # Make cache directory
1155        my $cache_dir = $self->_cache_dir;
1156        # Set cache path
1157        $self->_cache_path($path, $cache_dir);
1158
1159        # Exists same cache file?
1160        if (-e $self->cache_path && ($self->_eq_mtime || $self->_eq_checksum)) {
1161          return $self->_interpret_cached(@_);
1162        }
1163    }
1164
1165    my $content = '';
1166    my $file = IO::File->new;
1167    if (ref $self->fullpath eq 'SCALAR') { # virtual path
1168      $content = $self->fullpath;
1169      $content = $$content;
1170    } else {
1171      # Open file
1172      $file->open($self->fullpath, 'r') or die "Can't open template '$path': $!";
1173
1174      # Slurp file
1175      while ($file->sysread(my $buffer, CHUNK_SIZE, 0)) {
1176          $content .= $buffer;
1177      }
1178      $file->close;
1179    }
1180
1181    $content =~ s/\r//g;
1182
1183    # Encoding
1184    $content = decode($self->encoding, $content) if $self->encoding;
1185
1186    # Render
1187    my $output;
1188    if ($output = $self->render($content, @_)) {
1189        if ($self->cache >= 1) {
1190            # Create cache
1191            if ($file->open($self->cache_path, 'w')) {
1192                binmode $file, ':utf8';
1193
1194                if (ref $self->fullpath eq 'SCALAR') {
1195                  my $md5_checksum = $self->_digest($content);
1196                  print $file '#'.$md5_checksum."\n".$self->code; # Write with file checksum (virtual path)
1197                } else {
1198                  my $mtime = (stat($self->fullpath))[9];
1199                  print $file '#'.$mtime."\n".$self->code; # Write with file mtime
1200                }
1201
1202                $file->close;
1203            }
1204        }
1205    }
1206
1207    return $output;
1208}
1209
1210sub _fullpath {
1211    my $self = shift;
1212    my $path = shift;
1213
1214    if (File::Spec->file_name_is_absolute($path) and -r $path) {
1215        $self->fullpath($path);
1216        return;
1217    }
1218
1219    for my $p (@{$self->path}) {
1220      if (ref $p eq 'HASH') { # virtual path
1221        if (defined(my $content = $p->{$path})) {
1222          $self->fullpath(\$content);
1223          return;
1224        }
1225      } else {
1226        my $fullpath = File::Spec->catfile($p, $path);
1227        if (-r $fullpath) { # is readable ?
1228          $self->fullpath($fullpath);
1229          return;
1230        }
1231      }
1232    }
1233
1234    Carp::croak("Can't find template '$path'");
1235}
1236
1237sub _cache_dir {
1238    my $self = shift;
1239
1240    my $cache_prefix = (ref $self->fullpath eq 'SCALAR')
1241      ? 'HASH'
1242      : URI::Escape::uri_escape(
1243          File::Basename::dirname($self->fullpath)
1244        );
1245
1246    my $cache_dir = File::Spec->catdir(
1247        $self->cache_dir,
1248        $cache_prefix,
1249    );
1250
1251    if (not -e $cache_dir) {
1252        require File::Path;
1253        eval { File::Path::mkpath($cache_dir) };
1254        Carp::carp("Can't mkpath '$cache_dir': $@") if $@;
1255    }
1256
1257    return $cache_dir;
1258}
1259
1260sub _cache_path {
1261    my $self = shift;
1262    my $path = shift;
1263    my $cache_dir = shift;
1264
1265    $self->cache_path(File::Spec->catfile(
1266        $cache_dir,
1267        File::Basename::basename($path).'.pl',
1268    ));
1269}
1270
1271sub _eq_mtime {
1272    my $self = shift;
1273
1274    # Exit if virtual path
1275    return 0 if ref $self->fullpath eq 'SCALAR';
1276
1277    return 1 if $self->cache == 2;
1278    return 0 if $self->cache == 0;
1279
1280    my $file = IO::File->new;
1281    $file->open($self->cache_path, 'r') or return;
1282    $file->sysread(my $cache_mtime, length('#xxxxxxxxxx'));
1283    $file->close;
1284    my $orig_mtime = '#'.(stat($self->fullpath))[9];
1285
1286    return $cache_mtime eq $orig_mtime;
1287}
1288
1289sub _interpret_cached {
1290    my $self = shift;
1291
1292    my $compiled = do $self->cache_path;
1293    $self->compiled($compiled);
1294    return $self->interpret(@_);
1295}
1296
1297sub _doctype {
1298    my $self = shift;
1299    my ($type, $encoding) = @_;
1300
1301    $type     ||= '';
1302    $encoding ||= 'utf-8';
1303
1304    $type = lc $type;
1305
1306    if ($type eq 'xml') {
1307        return '' if $self->format eq 'html5';
1308        return '' if $self->format eq 'html4';
1309
1310        return qq|<?xml version='1.0' encoding='$encoding' ?>|;
1311    }
1312
1313    if ($self->format eq 'xhtml') {
1314        if ($type eq 'strict') {
1315            return
1316              q|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">|;
1317        }
1318        elsif ($type eq 'frameset') {
1319            return
1320              q|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Frameset//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-frameset.dtd">|;
1321        }
1322        elsif ($type eq '5') {
1323            return '<!DOCTYPE html>';
1324        }
1325        elsif ($type eq '1.1') {
1326            return
1327              q|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd">|;
1328        }
1329        elsif ($type eq 'basic') {
1330            return
1331              q|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML Basic 1.1//EN" "http://www.w3.org/TR/xhtml-basic/xhtml-basic11.dtd">|;
1332        }
1333        elsif ($type eq 'mobile') {
1334            return
1335              q|<!DOCTYPE html PUBLIC "-//WAPFORUM//DTD XHTML Mobile 1.2//EN" "http://www.openmobilealliance.org/tech/DTD/xhtml-mobile12.dtd">|;
1336        }
1337        else {
1338            return
1339              q|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">|;
1340        }
1341    }
1342    elsif ($self->format eq 'html4') {
1343        if ($type eq 'strict') {
1344            return
1345              q|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html4/strict.dtd">|;
1346        }
1347        elsif ($type eq 'frameset') {
1348            return
1349              q|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Frameset//EN" "http://www.w3.org/TR/html4/frameset.dtd">|;
1350        }
1351        else {
1352            return
1353              q|<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd">|;
1354        }
1355    }
1356    elsif ($self->format eq 'html5') {
1357        return '<!DOCTYPE html>';
1358    }
1359
1360    return '';
1361}
1362
13631;
1364__END__
1365
1366=encoding utf-8
1367
1368=head1 NAME
1369
1370Text::Haml - Haml Perl implementation
1371
1372=head1 SYNOPSIS
1373
1374    use Text::Haml;
1375
1376    my $haml = Text::Haml->new;
1377
1378    my $html = $haml->render('%p foo'); # <p>foo</p>
1379
1380    $html = $haml->render('= $user', user => 'friend'); # <div>friend</div>
1381
1382    # Use Haml file
1383    $html = $haml->render_file('tmpl/index.haml', user => 'friend');
1384
1385=head1 DESCRIPTION
1386
1387L<Text::Haml> implements Haml
1388L<http://haml.info/docs/yardoc/file.REFERENCE.html> specification.
1389
1390L<Text::Haml> passes specification tests written by Norman Clarke
1391https://github.com/haml/haml-spec and supports only cross-language Haml
1392features. Do not expect ruby or Rails specific extensions to work.
1393
1394=head1 ATTRIBUTES
1395
1396L<Text::Haml> implements the following attributes:
1397
1398=head2 C<append>
1399
1400Holds the string of code that is appended to the generated Perl code.
1401
1402=head2 C<code>
1403
1404Holds the Perl code.
1405
1406=head2 C<compiled>
1407
1408Holds compiled code.
1409
1410=head2 C<encoding>
1411
1412    $haml->encoding('utf-8');
1413
1414Default is utf-8.
1415
1416=head2 C<escape>
1417
1418Escape subroutine presented as string.
1419
1420Default is
1421
1422    $haml->escape(<<'EOF');
1423        my $s = shift;
1424        return unless defined $s;
1425        $s =~ s/&/&amp;/g;
1426        $s =~ s/</&lt;/g;
1427        $s =~ s/>/&gt;/g;
1428        $s =~ s/"/&quot;/g;
1429        $s =~ s/'/&apos;/g;
1430        return $s;
1431    EOF
1432
1433=head2 C<escape_html>
1434
1435    $haml->escape_html(0);
1436
1437Switch on/off Haml output html escaping. Default is on.
1438
1439=head2 C<filters>
1440
1441Holds filters.
1442
1443=head2 C<format>
1444
1445    $haml->format('xhtml');
1446
1447Supported formats: xhtml, html, html5.
1448
1449Default is xhtml.
1450
1451=head2 C<namespace>
1452
1453Holds the namespace under which the Perl package is generated.
1454
1455=head2 C<prepend>
1456
1457Holds the string of code that is prepended to the generated Perl code.
1458
1459=head2 C<vars>
1460
1461Holds the variables that are passed during the rendering.
1462
1463=head2 C<vars_as_subs>
1464
1465When options is B<NOT SET> (by default) passed variables are normal Perl
1466variables and are used with C<$> prefix.
1467
1468    $haml->render('%p $var', var => 'hello');
1469
1470When this option is B<SET> passed variables are Perl lvalue
1471subroutines and are used without C<$> prefix.
1472
1473    $haml->render('%p var', var => 'hello');
1474
1475But if you declare Perl variable in a block, it must be used with C<$>
1476prefix.
1477
1478    $haml->render('<<EOF')
1479        - my $foo;
1480        %p= $foo
1481    EOF
1482
1483=head2 C<helpers>
1484
1485    helpers => {
1486        foo => sub {
1487            my $self   = shift;
1488            my $string = shift;
1489
1490            $string =~ s/r/z/;
1491
1492            return $string;
1493        }
1494    }
1495
1496Holds helpers subroutines. Helpers can be called in Haml text as normal Perl
1497functions. See also add_helper.
1498
1499=head2 C<helpers_arg>
1500
1501    $haml->helpers_args($my_context);
1502
1503First argument passed to the helper (L<Text::Haml> instance by default).
1504
1505=head2 C<error>
1506
1507    $haml->error;
1508
1509Holds the last error.
1510
1511=head2 C<tape>
1512
1513Holds parsed haml elements.
1514
1515=head2 C<path>
1516
1517Holds path of Haml templates. Current directory is a default.
1518If you want to set several paths, arrayref can also be set up.
1519This way is the same as L<Text::Xslate>.
1520
1521=head2 C<cache>
1522
1523Holds cache level of Haml templates. 1 is a default.
15240 means "Not cached", 1 means "Checked template mtime" and 2 means "Used always cached".
1525This way is the same as L<Text::Xslate>.
1526
1527=head2 C<cache_dir>
1528
1529Holds cache directory of Haml templates. $ENV{HOME}/.text_haml_cache is a default.
1530Unless $ENV{HOME}, File::Spec->tempdir was used.
1531This way is the same as L<Text::Xslate>.
1532
1533=head1 METHODS
1534
1535=head2 C<new>
1536
1537    my $haml = Text::Haml->new;
1538
1539=head2 C<add_helper>
1540
1541    $haml->add_helper(current_time => sub { time });
1542
1543Adds a new helper.
1544
1545=head2 C<add_filter>
1546
1547    $haml->add_filter(compress => sub { $_[0] =~ s/\s+/ /g; $_[0]});
1548
1549Adds a new filter.
1550
1551=head2 C<build>
1552
1553    $haml->build(@_);
1554
1555Builds the Perl code.
1556
1557=head2 C<compile>
1558
1559    $haml->compile;
1560
1561Compiles parsed code.
1562
1563=head2 C<interpret>
1564
1565    $haml->interpret(@_);
1566
1567Interprets compiled code.
1568
1569=head2 C<parse>
1570
1571    $haml->parse('%p foo');
1572
1573Parses Haml string building a tree.
1574
1575=head2 C<render>
1576
1577    my $text = $haml->render('%p foo');
1578
1579    my $text = $haml->render('%p var', var => 'hello');
1580
1581Renders Haml string. Returns undef on error. See error attribute.
1582
1583=head2 C<render_file>
1584
1585    my $text = $haml->render_file('foo.haml', var => 'hello');
1586
1587A helper method that loads a file and passes it to the render method.
1588Since "%____vars" is used internally, you cannot use this as parameter name.
1589
1590=head1 PERL SPECIFIC IMPLEMENTATION ISSUES
1591
1592=head2 String interpolation
1593
1594Despite of existing string interpolation in Perl, Ruby interpolation is also
1595supported.
1596
1597$haml->render('%p Hello #{user}', user => 'foo')
1598
1599=head2 Hash keys
1600
1601When declaring tag attributes C<:> symbol can be used.
1602
1603$haml->render("%a{:href => 'bar'}");
1604
1605Perl-style is supported but not recommented, since your Haml template won't
1606work with Ruby Haml implementation parser.
1607
1608$haml->render("%a{href => 'bar'}");
1609
1610=head2 Using with Data::Section::Simple
1611
1612When using the Data::Section::Simple, you need to unset the variable C<encoding> in the constructor or using the C<encoding> attribute of the Text::Haml:
1613
1614    use Data::Section::Simple qw/get_data_section/;
1615    my $vpath = get_data_section;
1616
1617    my $haml = Text::Haml->new(cache => 0, path => $vpath, encoding => '');
1618    # or
1619    #my $haml = Text::Haml->new(cache => 0, path => $vpath);
1620    #$haml->encoding(''); # encoding attribute
1621
1622    my $index = $haml->render_file('index.haml');
1623    say $index;
1624
1625    __DATA__
1626
1627    @@ index.haml
1628    %strong текст
1629
1630see L<https://metacpan.org/pod/Data::Section::Simple#utf8-pragma>
1631
1632=head1 DEVELOPMENT
1633
1634=head2 Repository
1635
1636    http://github.com/vti/text-haml
1637
1638=head1 AUTHOR
1639
1640Viacheslav Tykhanovskyi, C<vti@cpan.org>.
1641
1642=head1 CREDITS
1643
1644In order of appearance:
1645
1646Nick Ragouzis
1647
1648Norman Clarke
1649
1650rightgo09
1651
1652Breno G. de Oliveira (garu)
1653
1654Yuya Tanaka
1655
1656Wanradt Koell (wanradt)
1657
1658Keedi Kim
1659
1660Carlos Lima
1661
1662Jason Younker
1663
1664TheAthlete
1665
1666Mark Aufflick (aufflick)
1667
1668Graham Todd (grtodd)
1669
1670=head1 COPYRIGHT AND LICENSE
1671
1672Copyright (C) 2009-2017, Viacheslav Tykhanovskyi.
1673
1674This program is free software, you can redistribute it and/or modify it under
1675the terms of the Artistic License version 2.0.
1676
1677=cut
1678