view release on metacpan or  search on metacpan

SimpleTemplate.pm  view on Meta::CPAN

	my $inref = $s->{inref};
#	my $headerref = $s->{headerref};

	my $package = 'Apache::SimpleTemplate::Template'.$_[0];
	$package =~ s/\//\:\:/g;
	$package =~ s/[^\w\:]/_/g;
	print STDERR "-- RENDERING ($package)\n" if ($s->{debug} > 1);

	my $fun = $_cache{$_[0]};
	my $usecache = $fun ? 1 : $s->{cache};

	# check for updated template
	if ($fun && ($s->{reload} > 0)) {
		my $filetime = (stat($_[0]))[9];
		if ($_cache_time{$_[0]} < $filetime) {
			print STDERR "-- RELOADING ($package)\n" if ($s->{debug} > 1);
			$fun = undef;
		}
	}

	# check for cache
	if ($fun) {
		print STDERR "-- CACHE HIT ($package)\n" if ($s->{debug} > 1);
	} 
	else {
		print STDERR "-- COMPILING ($package)\n" if ($s->{debug} > 1);

		$fun = $s->compile($_[0]);
		if ($fun && ($usecache>0))  { 
			if ($s->{reload} > 0) { $_cache_time{$_[0]} = time; }
			$_cache{$_[0]} = $fun; 
		}
	}

	#print STDERR "-- SETTING STATUS for $s to $s->{status}\n" if $s->{debug};
	if (!(ref $fun)) {
		if ($fun != 200) { $s->{status} = $fun; return ''; }
		my $packagefun = $package.'::____st_go_';
		$fun = \&$packagefun;
	}

	return &$fun($s);

}

#
# compile a template
#
# load from file:
#   $s->compile('/www/myhost.com/foo.stml');
# pass in body:
#   $s->compile($template, 1);
#

sub compile {

	my $s = shift;

	my $template = $_[1] ? $_[0] : &load($_[0]);
	if (!defined $template) { $s->{_error} .= "Not Found: $_[0]\n"; return 404; }
	
	my $block_begin = $s->{block_begin} || $DEFAULT_BLOCK_BEGIN;
	my $block_end = $s->{block_end} || $DEFAULT_BLOCK_END;
	print STDERR "-- DELIM: $block_begin $block_end\n" if $s->{debug} > 2;

	$block_begin =~ s/([^\w])/\\$1/g;
	$block_end =~ s/([^\w])/\\$1/g;
	
	my $eval = '';
	my $precode = '';
	
	my $package = 'Apache::SimpleTemplate::Template'.$_[0];
	$package =~ s/\//\:\:/g;
	$package =~ s/[^\w\:]/_/g;
	my $usepackage = 0;

	$template =~ s/($block_begin)\#(.*?)\#($block_end)/$1.'-'.&blank_lines($2).$3/gse;
	#$template =~ s/$block_begin\-(.*?)$block_end/&blank_lines($1)/gse;
	
	if ($template =~ s/$block_begin\!(.*?)$block_end/
		$precode .= $1 . '; ';
		'';
		/gse) {
		$usepackage = 1;
		if ($s->{debug} > 3) {
			print STDERR "============================INITIAL BLOCK\n";
			print STDERR $precode . "\n";
			print STDERR "============================/INITIAL BLOCK\n";
		}
	}
	
	if ($usepackage) {
		$eval .= "package $package; use Apache::SimpleTemplate; " . $precode; 
	}
	
	$eval .= 'sub ' . ($usepackage?'____st_go_ ':''). '{ my ($s) = @_; ';
	$eval .= 'my $r = $s->{r}; my $____st_out_ = $s->{out}; my $inref=$s->{inref}; ';
	
	my @pieces = split (/$block_end/, $template);

	# fix parsing problem if code block at very end of template.
	if (($template =~ m/$block_end$/s) && !($template =~ m/$block_end\n$/s)) { push (@pieces, ''); }

#	for (my $i=0; $i<=$#pieces; $i++) {
#		print STDERR "==================================PIECE $i:\n";
#		print STDERR $pieces[$i];
#		print STDERR "\n==================================\n";
#	}

	my $i = 0;
	for (; $i<$#pieces; $i++) {

		if ($pieces[$i] =~ 
			m/(.*?)$block_begin([\^\+\\\-\=\:]?)(.*?)\;?(\s*)$/gs) {
			my $text = &quote_escape($1);
			my $encode = $2;
			my $block = $3.$4;

			if ($s->{debug} > 3) {
				print STDERR "==================================TEXT $i:\n";