File Coverage

blib/lib/Template/Nest.pm

Criterion	Covered	Total	%
statement	229	232	98.7
branch	88	112	78.5
condition	27	36	75.0
subroutine	30	30	100.0
pod	15	17	88.2
total	389	427	91.1

package Template::Nest;

use strict;
use warnings;
use File::Spec;
use Carp;
use Data::Dumper;

our $VERSION = '0.13';

sub new{
	my ($class,%opts) = @_;


    # defaults:
    my $self = {
        comment_delims => [ '' ],
        token_delims => [ '<%','%>' ],
        name_label => 'NAME',
        template_dir => '',
        template_ext => '.html',
        show_labels => 0,
        defaults => {},
        defaults_namespace_char => '.',
        fixed_indent => 0,
        die_on_bad_params => 1,
        escape_char => "\\",
        token_placeholder => '',
        file_encoding => undef, # UTF-8, latin1
    };

	bless $self,$class;

    if ( %opts ){
        for my $k (keys %opts){
            confess "$k is not a valid option" unless defined $self->can($k);
            $self->$k( $opts{$k} );
        }
    }

	return $self;
}


sub template_dir{
	my($self,$dir) = @_;
	confess "Expected a scalar directory name but got a ".ref($dir) if $dir && ref($dir);
	$self->{template_dir} = $dir if $dir;
	return $self->{template_dir};
}


sub template_hash{
    my ($self,$template_hash) = @_;

    $self->{template_hash} = $template_hash if $template_hash;
    return $self->{template_hash};
}


sub defaults{
    my ($self,$defaults) = @_;

    if ( $defaults ){

        confess "defaults should be a hashref" unless ref $defaults eq ref {};
        $self->{defaults} = $defaults;

    }

    return $self->{defaults};
}

sub token_placeholder{
    my ($self,$token) = @_;

    if (defined $token){
        $self->{token_placeholder} = $token;
    }
    return $self->{token_placeholder};
}

sub file_encoding {
    my ($self, $enc) = @_;
    if (defined $enc) {
        $self->{file_encoding} = $enc;
    }
    return $self->{file_encoding};
}

sub defaults_namespace_char{
    my ($self,$char) = @_;

    if ( defined $char ){
        if ( $char eq '' ){
            $self->{defaults_namespace_char} = '';
        } else {
            confess "defaults_namespace_char should be a single character or ''" unless $char =~ /./;
            $self->{defaults_namespace_char} = $char;
        }
    }

    return $self->{defaults_namespace_char};
}


sub comment_delims{
    my ($self,$delim1,$delim2) = @_;
    if (defined $delim1 ){
        $delim2 = $delim2 || '';
        $self->{'comment_delims'} = [ $delim1, $delim2 ];
    }
    return $self->{'comment_delims'};
}


sub token_delims{
    my ($self,$delim1,$delim2) = @_;

    if (defined $delim1 ){

        if ( ref $delim1 eq ref [] ){
            ($delim1,$delim2) = @$delim1;
        }

        $delim2 ||= '';
        $self->{'token_delims'} = [ $delim1, $delim2 ];
    }
    return $self->{'token_delims'};
}



sub show_labels{
	my ($self,$show) = @_;
	confess "Expected a boolean but got $show" if $show && ! ( $show == 0 || $show == 1 );
	$self->{show_labels} = $show if defined $show;
	return $self->{show_labels};
}


sub template_ext{
	my ($self,$ext) = @_;
	confess "Expected a scalar extension name but got a ".ref($ext) if defined $ext && ref($ext);
	$self->{template_ext} = $ext if defined $ext;
	return $self->{template_ext};
}


sub name_label{
	my ($self,$label) = @_;
	confess "Expected a scalar name label but got a ".ref($label) if defined $label && ref($label);
	$self->{name_label} = $label if $label;
	return $self->{name_label};
}


sub fixed_indent{
    my ($self,$indent) = @_;

    if ( defined $indent ){
        confess "Expected 0 or 1 but got $indent" unless $indent == 0 or $indent == 1;
        $self->{fixed_indent} = $indent;
    }

    return $self->{fixed_indent};
}


sub die_on_bad_params{
    my ($self,$should_die) = @_;

    if ( defined $should_die ){
        confess "Expected 0 or 1 but got $should_die" unless $should_die == 0 or $should_die == 1;
        $self->{die_on_bad_params} = $should_die;
    }

    return $self->{die_on_bad_params};
}



sub escape_char{
    my ($self,$char) = @_;

    if (defined $char){
        confess "escape_char should be a single character or ''" unless $char eq '' or $char =~ /./;
        $self->{escape_char} = $char;
    }

    return $self->{escape_char};
}



sub render{
    my ($self,$comp) = @_;

    my $html;
    if ( ref($comp) =~ /array/i ){
        $html = $self->_render_array( $comp );
    } elsif( ref( $comp ) =~ /hash/i ){
        $html = $self->_render_hash( $comp );
    } else {
		$html = $comp;
    }

    return $html;
}



sub _render_hash{
    my ($self,$h) = @_;

    confess "Expected a hashref. Instead got a ".ref($h) unless ref($h) =~ /hash/i;

    my $template_name = $h->{ $self->name_label };

    confess 'Encountered hash with no name_label ("'.$self->name_label.'"): '.Dumper( $h ) unless $template_name;

    my $param = {};

    foreach my $k ( keys %$h ){
        next if $k eq $self->name_label;
        $param->{$k} = $self->render( $h->{$k} );
    }

    my $template = $self->_get_template( $template_name );
    my $html = $self->_fill_in( $template_name, $template, $param );

	if ( $self->show_labels ){

        my $ca = $self->{comment_delims}->[0];
        my $cb = $self->{comment_delims}->[1];

		$html = "$ca BEGIN $template_name $cb\n$html\n$ca END $template_name $cb\n";
	}

    return $html;

}




sub _render_array{

    my ($self, $arr, $delim) = @_;
    confess "Expected an array. Instead got a ".ref($arr) unless ref($arr) =~ /array/i;
    my $html = '';
    foreach my $comp (@$arr){
        $html.= $delim if ($delim && $html);
        $html.= $self->render( $comp );
    }
    return $html;

}



sub _get_template{
    my ($self,$template_name) = @_;

    my $template = '';
    if ( $self->{template_hash} ){
        $template = $self->{template_hash}{$template_name};
    } else {

        my $filename = File::Spec->catdir(
            $self->template_dir,
            $template_name.$self->template_ext
        );

        my $fh;
        if ($self->{file_encoding}) {
            open $fh, "<:encoding($self->{file_encoding})", $filename
                or confess "Could not open file $filename: $!";
        } else {
            open $fh, '<', $filename
                or confess "Could not open file $filename: $!";
        }

        my $text = '';
        while( my $line = <$fh> ){
            $template.=$line;
        }

    }

    $template =~ s/\n$//;
    return $template;
}




sub params{
    my ($self,$template_name) = @_;

    my $esc = $self->{escape_char};
    my $template = $self->_get_template( $template_name );
    my @frags = split( /\Q$esc$esc\E/, $template );
    my $tda = $self->{token_delims}[0];
    my $tdb = $self->{token_delims}[1];

    my %rem;
    for my $i (0..$#frags){
        my @f = $frags[$i] =~ m/(?
        for my $f ( @f ){
            $f =~ s/^\s*//;
            $f =~ s/\s*$//;
            $rem{$f} = 1;
        }
    }

    my @params = sort(keys %rem);
    return \@params;
}



sub _token_regex{
    my ($self,$param_name) = @_;

    my $esc = $self->{escape_char};
    my $tda = $self->{token_delims}[0];
    my $tdb = $self->{token_delims}[1];

    $param_name = '.*?' unless defined $param_name;

    my $token_regex = qr/\Q$tda\E\s+$param_name\s+\Q$tdb\E/;
    if ( $esc ){
        $token_regex = qr/(?
    }
    return $token_regex;
}


sub _fill_in{
    my ($self,$template_name,$template,$params) = @_;

    my $esc = $self->{escape_char};
    my @frags;

    if ( $esc ){
        @frags = split( /\Q$esc$esc\E/, $template );
    } else {
        @frags = ( $template );
    }

    foreach my $param_name (keys %$params){

        my $param_val = $params->{$param_name};

        my $replaced = 0;

        if ( $self->{fixed_indent} ){ #if fixed_indent we need to add spaces during the replacement
            for my $i (0..$#frags){
                my $rx = $self->_token_regex( $param_name );
                my @spaces_repl = $frags[$i] =~ m/([^\S\r\n]*)$rx/g;

                while(@spaces_repl){
                    my $sp = shift @spaces_repl;
                    my $repl = shift @spaces_repl;
                    my $param_out = $param_val;
                    $param_out =~ s/\n/\n$sp/g;

                    if ( $esc ){
                        $replaced = 1 if $frags[$i] =~ s/(?
                    } else {
                        $replaced = 1 if $frags[$i] =~ s/\Q$repl\E/$param_out/;
                    }
                }
            }
        } else {
            for my $i (0..$#frags){
                my $rx = $self->_token_regex( $param_name );
                $replaced = 1 if $frags[$i] =~ s/$rx/$param_val/g;
            }
        }

        if ( $self->{die_on_bad_params} && $replaced == 0 ){
            confess "Could not replace template param '$param_name': token does not exist in template '$template_name'";
        }
    }

    for my $i (0..$#frags){

        if ( %{$self->{defaults}} ){
            my @rem = $self->_params_in( $frags[$i] );
            my $char = $self->defaults_namespace_char;
            for my $name ( @rem ){
                my @parts = ( $name );
                @parts = split( /\Q$char\E/, $name ) if $char;

                my $val = $self->_get_default_val( $self->{defaults}, @parts );
                my $rx = $self->_token_regex( $name );
                $frags[$i] =~ s/$rx/$val/g;
            }
        }

        # Handle unmatched parameters, if token_placeholder is set then
        # we replace these parameters with the placeholder.
        if ($self->{token_placeholder}) {
            my $param_rx = $self->_token_regex("param_name");

            my @rem = $self->_params_in( $frags[$i] );
            for my $name ( @rem ) {
                my @parts = ( $name );

                my $placeholder = $self->{token_placeholder};
                $placeholder =~ s/$param_rx/$name/g;

                my $rx = $self->_token_regex( $name );
                $frags[$i] =~ s/$rx/$placeholder/g;
            }
        }

        my $rx = $self->_token_regex;
        $frags[$i] =~ s/$rx//g;
    }

    if ( $esc ){
        for my $i (0..$#frags){
            $frags[$i] =~ s/\Q$esc\E//gs;
        }
    }

    my $text = $esc? join($esc,@frags): $frags[0];
    return $text;
}


sub _params_in{
    my ( $self, $text ) = @_;

    my $esc = $self->{escape_char};
    my $tda = $self->token_delims->[0];
    my $tdb = $self->token_delims->[1];

    my @rem;
    if ( $esc ){
        @rem = $text =~ m/(?
    } else {
        @rem = $text =~ m/\Q$tda\E\s+(.*?)\s+\Q$tdb\E/g;
    }

    my %rem;
    for my $name (@rem){
        $rem{$name} = 1
    }

    return keys %rem;
}



sub _get_default_val{
    my ($self,$ref,@parts) = @_;

    if ( @parts == 1 ){
        my $val = $ref->{$parts[0]} || '';
        return $val;
    } else {
        my $ref_name = shift @parts;
        my $new_ref = $ref->{ $ref_name };
        return '' unless $new_ref;
        return $self->_get_default_val( $new_ref, @parts );
    }
}



1;
__END__