File Coverage

blib/lib/Dancer/Template/Simple.pm

Criterion	Covered	Total	%
statement	89	89	100.0
branch	38	44	86.3
condition	7	7	100.0
subroutine	12	12	100.0
pod	2	3	66.6
total	148	155	95.4

package Dancer::Template::Simple;
our $AUTHORITY = 'cpan:SUKRIA';
#ABSTRACT: pure Perl 5 template engine for Dancer
$Dancer::Template::Simple::VERSION = '1.3514_04'; # TRIAL
$Dancer::Template::Simple::VERSION = '1.351404';
use strict;
use warnings;
use Carp;

use base 'Dancer::Template::Abstract';
Dancer::Template::Simple->attributes('start_tag', 'stop_tag');
use Dancer::FileUtils 'read_file_content';
use Dancer::Exception qw(:all);

sub init {
    my $self     = shift;
    my $settings = $self->config;

    my $start = $settings->{'start_tag'} || '<%';
    my $stop  = $settings->{'stop_tag'}  || '%>';

    $self->start_tag($start) unless defined $self->start_tag;
    $self->stop_tag($stop)   unless defined $self->stop_tag;
}

sub render {
    my ($self, $template, $tokens) = @_;
    my $content;

    $content = _read_content_from_template($template);
    $content = $self->parse_branches($content, $tokens);

    return $content;
}

sub parse_branches {
    my ($self, $content, $tokens) = @_;
    my ($start, $stop) = ($self->start_tag, $self->stop_tag);

    my @buffer;
    my $prefix             = "";
    my $should_bufferize   = 1;
    my $bufferize_if_token = 0;

#    $content =~ s/\Q${start}\E(\S)/${start} $1/sg;
#    $content =~ s/(\S)\Q${stop}\E/$1 ${stop}/sg;

    # we get here a list of tokens without the start/stop tags
    my @full = split(/\Q$start\E\s*(.*?)\s*\Q$stop\E/, $content);

    # and here a list of tokens without variables
    my @flat = split(/\Q$start\E\s*.*?\s*\Q$stop\E/, $content);

    # eg: for 'foo=<% var %>'
    #   @full = ('foo=', 'var')
    #   @flat = ('foo=')

    my $flat_index = 0;
    my $full_index = 0;
    for my $word (@full) {

        # flat word, nothing to do
        if (defined $flat[$flat_index]
            && ($flat[$flat_index] eq $full[$full_index]))
        {
            push @buffer, $word if $should_bufferize;
            $flat_index++;
            $full_index++;
            next;
        }

        my @to_parse = ($word);
        @to_parse = split(/\s+/, $word) if $word =~ /\s+/;

        for my $w (@to_parse) {

            if ($w eq 'if') {
                $bufferize_if_token = 1;
            }
            elsif ($w eq 'else') {
                $should_bufferize = !$should_bufferize;
            }
            elsif ($w eq 'end') {
                $should_bufferize = 1;
            }
            elsif ($bufferize_if_token) {
                my $bool = _find_value_from_token_name($w, $tokens);
                $should_bufferize = _interpolate_value($bool) ? 1 : 0;
                $bufferize_if_token = 0;
            }
            elsif ($should_bufferize) {
                my $val =
                  _interpolate_value(_find_value_from_token_name($w, $tokens));
                push @buffer, $val;
            }
        }

        $full_index++;
    }

    return join "", @buffer;
}

# private

sub _read_content_from_template {
    my ($template) = @_;
    my $content = undef;

    if (ref($template)) {
        $content = $$template;
    }
    else {
        raise core_template => "'$template' is not a regular file"
          unless -f $template;
        $content = read_file_content($template);
        raise core_template => "unable to read content for file $template"
          if not defined $content;
    }
    return $content;
}

sub _find_value_from_token_name {
    my ($key, $tokens) = @_;
    my $value = undef;

    my @elements = split /\./, $key;
    foreach my $e (@elements) {
        if (not defined $value) {
            $value = $tokens->{$e};
        }
        elsif (ref($value) eq 'HASH') {
            $value = $value->{$e};
        }
        elsif (ref($value)) {
            local $@;
            eval { $value = $value->$e };
            $value = "" if $@;
        }
    }
    return $value;
}

sub _interpolate_value {
    my ($value) = @_;
    if (ref($value) eq 'CODE') {
        local $@;
        eval { $value = $value->() };
        $value = "" if $@;
    }
    elsif (ref($value) eq 'ARRAY') {
        $value = "@{$value}";
    }

    $value = "" if not defined $value;
    return $value;
}

1;

__END__