view release on metacpan or  search on metacpan

lib/CGI/AppToolkit/Template.pm  view on Meta::CPAN

@PATH = qw/. templates/;

### Subroutines ###

sub template {
	if ($_[0] eq __PACKAGE__) {
		shift;
	} 
	if (@_ == 1) {
		if (ref $_[0] || $_[0] =~ /(\x0D|\x0A)/) {
			unshift @_, '-set';
		} else {
			unshift @_, '-load';		
		}
	}
	return __PACKAGE__->new(@_, -cache => 1);
}

#-------------------------


sub new {
	my $self = bless {}, shift;
	$self->init(@_);
	$self
}

#-------------------------


sub init {
	my $self = shift;
	my %in = ref $_[0] ? %{ shift() } : @_;
	my %hash = ();
	foreach my $inkey (keys %in) {
		my $key = lc $inkey;
		$key =~ s/^-//;
		$key = $KEYMAP{$key} || $key;
		$hash{$key} ||= $in{$inkey};
	}
	undef %in;
	
	$self->{'cache'} = $hash{'cache'};
	$self->{'fatal'} = $hash{'fatal'};
		
	$self->load($hash{'file'}) if $hash{'file'};
	$self->set($hash{'set'}) if $hash{'set'};
}

#-------------------------


sub load {
	my $self = shift;
	my $template_file_orig = shift;
	
	if (!$self->{'cache'}
	       ||
	   (!$CACHE{$template_file_orig})
	       ||
	   ((stat(_))[9] != $CACHE{$template_file_orig}[0])) {
	   
		my $template_file = '';
		if ($template_file_orig !~ m{/}) {
			foreach my $dir (@PATH) {
				if (-d $dir && (-e "$dir/$template_file_orig" || -e "$dir/$template_file_orig.tmpl")) {
					$template_file = -e "$dir/$template_file_orig" ? "$dir/$template_file_orig" : "$dir/$template_file_orig.tmpl";
					last;
				}
			}
			
			carp "File '$template_file_orig' doesn't exist in template path ('",
				join("', '", @PATH), "')!" unless -e $template_file;

		} else {
			$template_file = $template_file_orig;
			carp "File '$template_file' doesn't exist!" unless -e $template_file;
		}		
		
		open FORM, $template_file or die "Unable to open $template_file! $!\n";	
			local $/ = undef;
			my $template = _cleanup(<FORM>);
		close FORM;
		
		$self->{'template'} = CGI::AppToolkit::Template::TemplateC->new($template);
		$self->_load_vars unless $self->{'vars-loaded'};
		
		# MAKE PATH FULL HERE
		
		$CACHE{$template_file} = [
			(stat(_))[9],
			$self->{'template'},
			$self->{'vars'}
		] if $self->{'cache'};
		
	} else {
	
		($self->{'template'}, $self->{'vars'}) = @{$CACHE{$template_file_orig}}[1, 2];

	}
}

#-------------------------


sub set {
	my $self = shift;
	my @lines = ref $_[0] ? @{$_[0]} : @_;
	my $template = _cleanup(join("", @lines));

	$self->{'template'} = CGI::AppToolkit::Template::TemplateC->new($template);
	$self->_load_vars unless $self->{'vars-loaded'};
	
	$self
}

#-------------------------


sub _cleanup {
	my $t = shift;
	
#	my $r = "\x0D"; # \r
#	my $n = "\x0A"; # \n
#	# Mac = \r
#	# Unix = \n
#	# DOS = \r\n
#	$t =~ s/($r|$n|$r$n)/\n/go; # Convert line-endings to current "\n" - Mac or UNIX

	# change {? ... ?} to <? ... ?>
	#$t =~ s/{\?((?:[^{}]+?|{\?.*?\?}|{[^?])+)\?}/<?$1?>/sg;
	
	# change {?@token?} to {?@token --?} line {?-- @token?}
	$t =~ s/^(.*?)[{<]\?\s*(\@[-_a-zA-Z0-9]+)\s*\?[}>](.*(?:\n|\z))/<?$2 --?>$1$3<?-- $2?>/mg;

	# change <repeattoken name="token"/> to <repeattoken name="token"> line </repeattoken>
	$t =~ s/^(.*?)<\s*repeattoken\s*(?:name\s*=\s*(['"])([-_a-zA-Z0-9]+)\2?|name\s*=\s*([-_a-zA-Z0-9]+)|([-_a-zA-Z0-9]+))\s*([^>]*)\/>(.*(?:\n|\z))/<repeattoken name="$3$4$5"$6>$1$7<\/repeattoken>/mg;
	
	$t
}

#-------------------------


sub check_cache {
	my($self) = shift;
	if (($self->{'file-name'}) && ((stat($self->{'file-name'}))[9] != $self->{'file-date'})) {
		$self->load($self->{'file-name'});
		return 1;
	}
	0
}

#-------------------------


sub make {
	my $self = shift;
	my $values = ref $_[0] ? shift : {@_};
	
	my $template = $self->{'template'};
	
	my $output = $template->value($self, [$values]);
	
	my $error = $template->get_error();
	if ($error) {
		die '$error' if $self->{'fatal'};
		return undef;
	}
	
	$output
}

*output = \&make;
*print = \&make;

#-------------------------


sub get_error {
	my $self = shift;
	my $template = $self->{'template'};

	$template->get_error()
}

#-------------------------


sub var {
	my $self = shift;
	return $self->vars(@_);
}

#-------------------------


sub vars {
	my $self = shift;
	my $val = shift;
	
	if ($val) {
		return $self->{'vars'}{$val};
	} else {
		return $self->{'vars'};
	}
}