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/&/&/g; 96 $s =~ s/</</g; 97 $s =~ s/>/>/g; 98 $s =~ s/"/"/g; 99 $s =~ s/'/'/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/
/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/&/&/g; 1426 $s =~ s/</</g; 1427 $s =~ s/>/>/g; 1428 $s =~ s/"/"/g; 1429 $s =~ s/'/'/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