got compiler working
[urisagit/Template-Simple.git] / lib / Template / Simple.pm
index 173c605..4dd68a4 100644 (file)
@@ -94,16 +94,222 @@ 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" ) ;
+
+       my $source = <<CODE ;
+
+no warnings ;
+
+sub {
+       my( \$data ) = \@_ ;
+
+       my \$out = $code_body ;
+
+       return \\\$out ;
+}
+CODE
+
+#print $source ;
+
+       my $code_ref = eval $source ;
+
+print $@ if $@ ;
+
+       $self->{compiled_cache}{$template_name} = $code_ref ;
+       $self->{source_cache}{$template_name} = $source ;
+}
+
+sub get_source {
+
+       my( $self, $template_name ) = @_ ;
+
+       return $self->{source_cache}{$template_name} ;
+}
+
+
+sub _compile_chunk {
+
+       my( $self, $chunk_name, $template, $indent ) = @_ ;
+
+       return '' unless length $template ;
+
+       my @parts ;
+
+# loop all nested chunks and the text separating them
+
+       while( $template =~ m{$self->{chunk_re}} ) {
+
+# grab the pre-match text and compile its scalars and save all of its parts
+
+               push @parts, $self->_compile_scalars(
+                               substr( $template, 0, $-[0] ) ) ;
+
+# print "OFF: $-[0] $+[0]\n" ;
+# print "PRE: [", substr( $template, 0, $-[0] ), "]\n\n" ;
+# print "CHUNK: [$1] BODY [$2]\n\n" ;
+# print "TRUNC: [", substr( $template, 0, $+[0] ), "]\n\n" ;
+# print "LEFT: [$template]\n\n" ;
+
+# compile the nested chunk and save its parts
+
+               push @parts, $self->_compile_chunk( $1, $2, "$indent\t\t" ) ;
+
+# chop off the pre-match and the chunk
+
+               substr( $template, 0, $+[0], '' ) ;
+
+# print "LEFT2: [$template]\n\n" ;
+# print Dumper \@parts ;
+
+       }
+
+# 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 = <<CODE ;
+do {
+CODE
+
+       $indent .= "\t" ;
+
+# 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 if $chunk_name ;
+${indent}my \$data = \$data->{$chunk_name} ;
+CODE
+
+# add the loop code to handle a scalar or an array
+
+       $code .= <<CODE ;
+${indent}my \$out ;
+
+${indent}my \@data = \$data ;
+${indent}while( defined( my \$data = shift \@data ) ) {
+
+${indent}      if ( ref \$data eq 'ARRAY' ) {
+${indent}              push \@data, \@{\$data} ;
+${indent}              next ;
+${indent}      }
+
+       ${indent}\$out .= ref \$data ne 'HASH' ? \$data :
+CODE
+
+#${indent}foreach my \$data ( ref \$data eq 'ARRAY' ? \@{\$data} : \$data ) {
+
+
+
+       $indent .= "\t" ;
+
+# now generate the code to output all the parts of this chunk. they
+# are all concatentated by the . operator
+
+       $code .= $indent . join( "\n$indent.\n$indent", @parts ) ;
+
+       chop $indent ;
+
+# now we end the .= statement, the loop and the do block for this chunk
+       $code .= <<CODE ;
+ ;
+$indent}
+$indent\$out ;
+CODE
+
+       chop $indent ;
+       $code .= "$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}"
+               ) ;
+
+# truncate the matched text so the next match starts at begining of string
+
+               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 ) = @_ ;
+
+       my $tmpl_ref = ref $template_name eq 'SCALAR' ? $template_name : '' ;
 
-# make a copy if a scalar ref is passed as the template text is
-# modified in place
+       unless( $tmpl_ref ) {
 
-       my $tmpl_ref = ref $template eq 'SCALAR' ? $template : \$template ;
+# render with cached code and return if we precompiled this template
+
+               if ( my $compiled = $self->{compiled_cache}{$template_name} ) {
+
+                       return $compiled->($data) ;
+               }
+
+# not compiled so get this template by name
+
+               $tmpl_ref ||= eval{ $self->_get_template($template_name) } ;
+
+# we couldn't find this template name so assume it is the template text
+
+               $tmpl_ref ||= \$template_name ;
+       }
 
        my $rendered = $self->_render_includes( $tmpl_ref ) ;
 
@@ -184,6 +390,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 +446,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 +462,18 @@ sub delete_templates {
 
        my( $self, @names ) = @_ ;
 
-       @names = keys %{$self->{templates}} unless @names ;
+# delete all the cached stuff or just the names passed in
+
+       @names = keys %{$self->{tmpl_cache}} unless @names ;
+
+# clear out all the caches
+# TODO: reorg these into a hash per name
+
+       delete @{$self->{tmpl_cache}}{ @names } ;
+       delete @{$self->{compiled_cache}}{ @names } ;
+       delete @{$self->{source_cache}}{ @names } ;
 
-       delete @{$self->{templates}}{ @names } ;
+# also remove where we found it to force a fresh search
 
        delete @{$self->{template_paths}}{ @names } ;
 
@@ -266,7 +486,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