From: Uri Guttman <uri@cpan.org>
Date: Mon, 8 Dec 2008 19:10:21 +0000 (-0500)
Subject: added support for compiling templates.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=urisagit%2FTemplate-Simple.git;a=commitdiff_plain;h=59d7205c3790d7e64e02805cc0bc414f4dba461b

added support for compiling templates.
todo:
	support loops
	add tests (hook into existing table driven ones)
	benchmark variations
---

diff --git a/lib/Template/Simple.pm b/lib/Template/Simple.pm
index 173c605..4906108 100644
--- a/lib/Template/Simple.pm
+++ b/lib/Template/Simple.pm
@@ -94,14 +94,167 @@ sub new {
 	return $self ;
 }
 
+sub compile {
 
+	my( $self, $template_name ) = @_ ;
+
+	my $tmpl_ref = eval {
+		 $self->_get_template( $template_name ) ;
+	} ;
+
+	croak "Template::Simple $@" if $@ ;
+
+# compile a copy of the template as it will be destroyed
+
+	my $code_body = $self->_compile_chunk( '', "${$tmpl_ref}", "\t" ) ;
+
+	$self->{source} = <<CODE ;
+
+no warnings ;
+
+sub {
+	my( \$data ) = \@_ ;
+
+	my \$out =
+	$code_body ;
+
+	return \\\$out ;
+}
+CODE
+
+	$self->{source_cache}{$template_name} = $self->{source} ;
+	print $self->{source} ;
+
+	my $code_ref = eval $self->{source} ;
+
+die $@ if $@ ;
+
+	$self->{compiled_cache}{$template_name} = $code_ref ;
+}
+
+
+sub _compile_chunk {
+
+	my( $self, $chunk_name, $template, $indent ) = @_ ;
+
+	return '' unless length $template ;
+
+	$indent .= "\t" ;
+
+	my @parts ;
+
+# loop all nested chunks and the text separating them
+
+	while( $template =~ m{$self->{chunk_re}}g ) {
+
+# grab the pre-chunk text and compile it for scalars and save all of its parts
+
+		push @parts, $self->_compile_scalars(
+				substr( $template, 0, $-[0] ) ) ;
+
+# compile the nested chunk and save its parts
+
+		push @parts, $self->_compile_chunk( $1, $2, $indent ) ;
+
+# chop off the pre-chunk and chunk
+
+		substr( $template, 0, $+[0], '' ) ;
+	}
+
+# compile trailing text for scalars and save all of its parts
+
+	push @parts, $self->_compile_scalars( $template ) ;
+
+# generate the code for this chunk
+
+# start it with a do{} block open
+
+	my $code = "do {\n$indent" ;
+
+# generate a lookup in data for this chunk name (unless it is the top
+# level). this descends down the data tree during rendering
+
+	$code .= <<CODE . $indent if $chunk_name ;
+my \$data = \$data->{$chunk_name} ;
+CODE
+
+# now generate the code to output all the parts of this chunk. they
+# are all concatentated by the . operator
+
+	$code .= join( "\n$indent.\n$indent", @parts ) ;
+
+# now we close the do block
+
+	chop $indent ;
+	$code .= "\n$indent}" ;
+
+	return $code ;
+}
+
+sub _compile_scalars {
+
+	my( $self, $template ) = @_ ;
+
+# if the template is empty return no parts
+
+	return unless length $template ;
+
+	my @parts ;
+
+	while( $template =~ m{$self->{scalar_re}}g ) {
+
+# keep the text before the scalar markup and the code to access the scalar
+
+		push( @parts,
+			dump_text( substr( $template, 0, $-[0] ) ),
+			"\$data->{$1}"
+		) ;
+		substr( $template, 0, $+[0], '' ) ;
+	}
+
+# keep any trailing text part
+
+	push @parts, dump_text( $template ) ;
+
+	return @parts ;
+}
+
+use Data::Dumper ;
+
+sub dump_text {
+
+	my( $text ) = @_ ;
+
+	return unless length $text ;
+
+	local( $Data::Dumper::Useqq ) = 1 ;
+
+	my $dumped = Dumper $text ;
+
+	$dumped =~ s/^[^"]+// ;
+	$dumped =~ s/;\n$// ;
+
+	return $dumped ;
+}
 
 sub render {
 
-	my( $self, $template, $data ) = @_ ;
+	my( $self, $template_name, $data ) = @_ ;
+
+# render with cached code if we precompiled this template
+
+	if ( my $compiled = $self->{compiled_cache}{$template_name} ) {
+
+		return $compiled->($data) ;
+	}
 
-# make a copy if a scalar ref is passed as the template text is
-# modified in place
+# TODO: look for template by name 
+
+	my $template = eval{ $self->_get_template($1) } ;
+
+print "GOT [$template]\n" ;
+
+# force the template into a ref
 
 	my $tmpl_ref = ref $template eq 'SCALAR' ? $template : \$template ;
 
@@ -184,6 +337,8 @@ sub _render_hash {
 	$rendered =~ s{$self->{chunk_re}}
 		      {
 			# print "CHUNK $1\nBODY\n----\n<$2>\n\n------\n" ;
+			print "CHUNK $1\nBODY\n----\n<$2>\n\n------\n" ;
+			print "pre CHUNK [$`]\n" ;
 			${ $self->_render_chunk( \"$2", $href->{$1} ) }
 		      }gex ;
 
@@ -238,11 +393,14 @@ sub add_templates {
 	return unless defined $tmpls ;
 
  	ref $tmpls eq 'HASH' or croak "templates argument is not a hash ref" ;
+
+# copy all the templates from the arg hash and force the values to be
+# scalar refs
 	
-	@{ $self->{templates}}{ keys %{$tmpls} } =
+	@{ $self->{tmpl_cache}}{ keys %{$tmpls} } =
 		map ref $_ eq 'SCALAR' ? \"${$_}" : \"$_", values %{$tmpls} ;
 
-#print Dumper $self->{templates} ;
+#print Dumper $self->{tmpl_cache} ;
 
 	return ;
 }
@@ -251,9 +409,9 @@ sub delete_templates {
 
 	my( $self, @names ) = @_ ;
 
-	@names = keys %{$self->{templates}} unless @names ;
+	@names = keys %{$self->{tmpl_cache}} unless @names ;
 
-	delete @{$self->{templates}}{ @names } ;
+	delete @{$self->{tmpl_cache}}{ @names } ;
 
 	delete @{$self->{template_paths}}{ @names } ;
 
@@ -266,7 +424,7 @@ sub _get_template {
 
 #print "INC $tmpl_name\n" ;
 
-	my $tmpls = $self->{templates} ;
+	my $tmpls = $self->{tmpl_cache} ;
 
 # get the template from the cache and send it back if it was found there