File Coverage

blib/lib/Template/Trivial.pm

Criterion	Covered	Total	%
statement	112	122	91.8
branch	42	58	72.4
condition	9	18	50.0
subroutine	19	19	100.0
pod	9	10	90.0
total	191	227	84.1

package Template::Trivial;

use 5.00503;
use strict;
use warnings;

use vars qw($VERSION);
$VERSION = '0.08';

use vars qw($STRICT);           ## template stricture
use vars qw($TMPL_DIR);         ## template directory
use vars qw(%VARIABLES);        ## template variables (e.g., FOO, BAR)
use vars qw(%TEMPLATE_NAME);    ## template aliases (e.g., foo, bar)
use vars qw(%TEMPLATE_CACHE);   ## template contents

my $VAR_RE  = qr(^[A-Z][A-Z0-9_-]*?$)o;
my $TMPL_RE = qr(^[a-z][a-z0-9_-]*?$)o;
my $TVAR_RE = qr!\{([A-Z][A-Z0-9_-]*?)\}!o;

sub new {
    my $class = shift;
    my $proto = ref($class) || $class;
    my $self  = { };
    my %parms = @_;

    bless $self, $proto;

    $STRICT = ( defined $parms{strict}
		? $parms{strict}
		: 1 );
    $TMPL_DIR = ( defined $parms{templates}
		  ? $parms{templates}
		  : '' );
    %VARIABLES      = ();
    %TEMPLATE_NAME  = ();
    %TEMPLATE_CACHE = ();

    return $self;
}

sub strict {
    my $self = shift;
    $STRICT = ( @_ ? shift : $STRICT );
}

sub templates {
    my $self = shift;

    if( @_ ) {  ## new assignment
	$TMPL_DIR = shift;
	if( $TMPL_DIR && $TMPL_DIR !~ m!/$! ) {
	    $TMPL_DIR .= '/';
	}
    }

    return $TMPL_DIR;
}

sub define {
    my $self    = shift;
    my %defines = @_;

    for my $tmpl ( keys %defines ) {
	my $path = ( $defines{$tmpl} =~ m!^/!o
		     ? $defines{$tmpl}
		     : $TMPL_DIR . $defines{$tmpl} );

	if( $STRICT ) {
	    warn "Illegal template alias name '$tmpl'\n"
	      unless $tmpl =~ $TMPL_RE;

	    unless( -f $path || -c _ ) {
		warn "File '$path' ($tmpl) is not a file\n";
		next;
	    }
	}

	$TEMPLATE_NAME{$tmpl} = $path;

	## redefining a template clears it from the cache
	delete $TEMPLATE_CACHE{$tmpl}
	  if exists $TEMPLATE_CACHE{$tmpl};
    }
}

## FIXME: add an alias or two for define_from_string method

sub define_from_string {
    my $self = shift;
    my %defines = @_;

    for my $tmpl ( keys %defines ) {
	$TEMPLATE_CACHE{$tmpl} = $defines{$tmpl};
    }
}

sub assign {
    my $self = shift;
    my %assign = @_;

    for my $var ( keys %assign ) {
	my $append = $var =~ s/^\.//o;

	if( $STRICT ) {
	    warn "Illegal variable name '$var'\n"
	      unless $var =~ $VAR_RE;
	}

	if( $append ) {
	    $VARIABLES{$var} .= $assign{".$var"};
	}
	else {
	    $VARIABLES{$var} = $assign{$var};
	}
    }
}

sub assign_from_file {
    my $self = shift;
    my %assign = @_;

    for my $var ( keys %assign ) {
	my $append = $var =~ s/^\.//o;

	my $path = ( $assign{$var} =~ m!^/!
		     ? $assign{$var}
		     : $TMPL_DIR . $assign{$var} );

	if( $STRICT ) {
	    warn "Illegal variable name '$var'\n"
	      unless $var =~ $VAR_RE;

	    unless( -f $path || -c _ ) {
		warn "File '$path' is not a file\n";
		next;
	    }
	}

	open FILE, "$path"
	  or do {
	      warn "Could not open '$path': $!\n";
	      next;
	  };
	local($/) = undef;
	if( $append ) {
	    $VARIABLES{$var} .= ;
	}
	else {
	    $VARIABLES{$var} = ;
	}
	close FILE;
    }
}

sub append {
    my $self   = shift;
    my %assign = @_;

    for my $var ( keys %assign ) {
	if( $STRICT ) {
	    warn "Illegal key name '$var'\n"
	      unless $var =~ $VAR_RE;
	}

	$VARIABLES{$var} .= $assign{$var};
    }
}

## FIXME: append_from_file?
## FIXME: any defaults for to_string('MAIN'), etc.? How about
## FIXME: parse('MAIN') implies parse('MAIN => 'main')?

sub parse {
    my $self  = shift;
    my %parse = @_;

    while( my($var, $tmpl) = each %parse ) {
	my $append  = $var =~ s/^\.//o;
	my $file;

	## find the template in our cache
	unless( defined $TEMPLATE_CACHE{$tmpl} ) {
	    open TMPL, "$TEMPLATE_NAME{$tmpl}"
	      or do {
		  warn "Could not open template ($tmpl) '$TEMPLATE_NAME{$tmpl}': $!\n";
		  next;
	      };
	    local($/) = undef;
	    $TEMPLATE_CACHE{$tmpl} = ;
	    close TMPL;
	}

	$file = $TEMPLATE_CACHE{$tmpl};

	## parse the template
	$file =~ s{$TVAR_RE}{
	    if( exists $VARIABLES{$+} ) {
		$VARIABLES{$+};
	    }
	    else {
		if( $STRICT ) {
		    warn "Unknown variable '$+' found.\n";
		}
		"{$+}";  ## put it back how it was
	    }
	}xge;

	if( $append ) {
	    $VARIABLES{$var} .= $file;
	}
	else {
	    $VARIABLES{$var} = $file;
	}
    }
}

sub to_string {
    my $self = shift;

    if( $STRICT ) {
	unless( $_[0] && exists $VARIABLES{$_[0]} && $_[0] =~ $VAR_RE ) {
	    warn "Undefined or unknown variable '$_[0]' found.\n";
	    return undef;
	}
    }

    return ( defined $VARIABLES{$_[0]} ? $VARIABLES{$_[0]}: '' );
}

## FIXME: clear methods?

1;
__END__