X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=Debbugs%2FText.pm;h=21bde013adbdf4035a3b8d79b712d8be763b6129;hb=1f81df46999fc3699ce73aeba95af5095a5a413a;hp=bc1363b648b0a6bf3f8f59e3867f5e41e670d9eb;hpb=e10b2cf931a5c935c3adf677ca5b2e10661a3ead;p=debbugs.git

diff --git a/Debbugs/Text.pm b/Debbugs/Text.pm
index bc1363b..21bde01 100644
--- a/Debbugs/Text.pm
+++ b/Debbugs/Text.pm
@@ -16,8 +16,8 @@ Debbugs::Text -- General routines for text templates
 
 =head1 SYNOPSIS
 
-use Debbugs::Text qw(:templates);
-print fill_in_template(template => 'cgi/foo');
+ use Debbugs::Text qw(:templates);
+ print fill_in_template(template => 'cgi/foo');
 
 =head1 DESCRIPTION
 
@@ -33,7 +33,7 @@ None known.
 
 
 use vars qw($DEBUG $VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT @ISA);
-use base qw(Exporter);
+use Exporter qw(import);
 
 BEGIN {
      $VERSION = 1.00;
@@ -45,9 +45,11 @@ BEGIN {
      @EXPORT_OK = ();
      Exporter::export_ok_tags(qw(templates));
      $EXPORT_TAGS{all} = [@EXPORT_OK];
+     push @ISA,qw(Safe::Hole::User);
 }
 
 use Safe;
+use Safe::Hole;
 use Text::Template;
 
 use Storable qw(dclone);
@@ -59,6 +61,39 @@ use Carp;
 use IO::File;
 use Data::Dumper;
 
+our %tt_templates;
+our %filled_templates;
+our $safe;
+our $hole = Safe::Hole->new({});
+our $language;
+
+# This function is what is called when someone does include('foo/bar')
+# {include('foo/bar')}
+
+sub include {
+     my $template = shift;
+     $filled_templates{$template}++;
+     print STDERR "include template $template language $language safe $safe\n" if $DEBUG;
+     # Die if we're in a template loop
+     die "Template loop with $template" if $filled_templates{$template} > 10;
+     my $filled_tmpl = '';
+     eval {
+	  $filled_tmpl = fill_in_template(template  => $template,
+					  variables => {},
+					  language  => $language,
+					  safe      => $safe,
+					 );
+     };
+     if ($@) {
+	  print STDERR "failed to fill template $template: $@";
+     }
+     print STDERR "failed to fill template $template\n" if $filled_tmpl eq '' and $DEBUG;
+     print STDERR "template $template '$filled_tmpl'\n" if $DEBUG;
+     $filled_templates{$template}--;
+     return $filled_tmpl;
+};
+
+
 =head2 fill_in_template
 
      print fill_in_template(template => 'template_name',
@@ -71,11 +106,7 @@ fills the template in.
 
 =cut
 
-our %tt_templates;
-our %filled_templates;
-our $safe;
-our $hole;
-our $language;
+
 sub fill_in_template{
      my %param = validate_with(params => \@_,
 			       spec   => {template => SCALAR|HANDLE|SCALARREF,
@@ -88,7 +119,7 @@ sub fill_in_template{
 					  output    => {type => HANDLE,
 							optional => 1,
 						       },
-					  safe      => {type => OBJECT,
+					  safe      => {type => OBJECT|UNDEF,
 							optional => 1,
 						       },
 					  hole_var  => {type => HASHREF,
@@ -96,41 +127,12 @@ sub fill_in_template{
 						       },
 					 },
 			      );
-     return _fill_in_template(@param{qw(template variables language safe output hole_var)});
-}
-
-
-sub include {
-     my $template = shift;
-     $filled_templates{$template}++;
-     print STDERR "include template $template language $language safe $safe\n" if $DEBUG;
-     # Die if we're in a template loop
-     die "Template loop with $template" if $filled_templates{$template} > 10;
-     my $filled_tmpl;
-     eval {
-	  $filled_tmpl = Debbugs::Text::_fill_in_template($template,
-							  {},
-							  $language,
-							  $safe,
-							  undef,
-							  {},
-							  1
-							 );
-     };
-     if ($@) {
-	  print STDERR "failed to fill template $template: $@";
+     #@param{qw(template variables language safe output hole_var no_safe)} = @_;
+     if ($DEBUG) {
+	  print STDERR "fill_in_template ";
+	  print STDERR join(" ",map {exists $param{$_}?"$_:$param{$_}":()} keys %param);
+	  print STDERR "\n";
      }
-     print STDERR "failed to fill template $template\n" if $filled_tmpl eq '' and $DEBUG;
-     print STDERR "template $template '$filled_tmpl'\n" if $DEBUG;
-     $filled_templates{$template}--;
-     return $filled_tmpl;
-};
-
-sub _fill_in_template{
-     my %param;
-     @param{qw(template variables language safe output hole_var no_safe)} = @_;
-     print STDERR "_fill template $param{template} language $param{language} safe $param{safe}\n"
-	  if $DEBUG;
 
      # Get the text
      my $tt_type = '';
@@ -139,6 +141,7 @@ sub _fill_in_template{
 	 ref(\$param{template}) eq 'GLOB') {
 	  $tt_type = 'FILE_HANDLE';
 	  $tt_source = $param{template};
+	  binmode($tt_source,":encoding(UTF-8)");
      }
      elsif (ref($param{template}) eq 'SCALAR') {
 	  $tt_type = 'STRING';
@@ -152,76 +155,63 @@ sub _fill_in_template{
 	  die "Unable to find template $param{template} with language $param{language}";
      }
 
-     if (defined $param{safe}) {
-	  $safe = $param{safe};
-	  if (not defined $hole) {
-	       $hole = Safe::Hole->new();
-	  }
-     }
-     else {
-	  print STDERR "Created new safe\n" if $DEBUG;
-	  $safe = Safe->new() or die "Unable to create safe compartment";
-	  $safe->deny_only();
-	  my @modules = ('Text::Template' => undef,
-			 # This doesn't work yet; have to figure it out
-			 #'Debbugs::Config' => [qw(:globals :config)],
-			);
-	  while (my ($module,$param) = splice (@modules,0,2)) {
-	       print STDERR "Eval $module\n" if $DEBUG;
-	       my $code = '';
-	       if (not defined $param) {
-		    $code = "use $module;";
-	       }
-	       else {
-		    $code = "use $module ".(join(',',map {"q($_)"} @{$param})).';';
-	       }
-	       $safe->reval($code);
-	       print STDERR "Error while attempting to eval '$code': $@" if $@;
-	  }
-	  $safe->permit_only(':base_core',':base_io',':base_mem',':base_loop',
-			     qw(padsv padav padhv padany),
-			     qw(rv2gv refgen srefgen ref),
-			    );
-	  $safe->share('$language','%tt_templates','$safe','$variables','%filled_templates');
-	  $safe->share('*STDERR');
-	  $safe->share('&_fill_in_template');
-	  $safe->share('%config');
-	  $safe->share('&include');
-	  my $root = $safe->root();
-	  # load variables into the safe
-	  for my $key (keys %{$param{variables}||{}}) {
-	       print STDERR "Loading $key\n" if $DEBUG;
-	       if (ref($param{variables}{$key})) {
-		    no strict 'refs';
-		    print STDERR $safe->root().'::'.$key,qq(\n) if $DEBUG;
-		    *{"${root}::$key"} = $param{variables}{$key};
-	       }
-	       else {
-		    no strict 'refs';
-		    ${"${root}::$key"} = $param{variables}{$key};
-	       }
-	  }
-	  for my $key (keys %{$param{hole_var}||{}}) {
-	       $hole->wrap($param{hole_var}{$key},$safe,$key);
-	  }
-     }
-     #$safe->deny_only();
-     # perldoc Opcode; for details
+#      if (defined $param{safe}) {
+# 	  $safe = $param{safe};
+#      }
+#      else {
+# 	  print STDERR "Created new safe\n" if $DEBUG;
+# 	  $safe = Safe->new() or die "Unable to create safe compartment";
+# 	  $safe->permit_only(':base_core',':base_loop',':base_mem',
+# 			     qw(padsv padav padhv padany),
+# 			     qw(rv2gv refgen srefgen ref),
+# 			     qw(caller require entereval),
+# 			     qw(gmtime time sprintf prtf),
+# 			     qw(sort),
+# 			    );
+# 	  $safe->share('*STDERR');
+# 	  $safe->share('%config');
+# 	  $hole->wrap(\&Debbugs::Text::include,$safe,'&include');
+# 	  my $root = $safe->root();
+# 	  # load variables into the safe
+# 	  for my $key (keys %{$param{variables}||{}}) {
+# 	       print STDERR "Loading $key\n" if $DEBUG;
+# 	       if (ref($param{variables}{$key})) {
+# 		    no strict 'refs';
+# 		    print STDERR $safe->root().'::'.$key,qq(\n) if $DEBUG;
+# 		    *{"${root}::$key"} = $param{variables}{$key};
+# 	       }
+# 	       else {
+# 		    no strict 'refs';
+# 		    ${"${root}::$key"} = $param{variables}{$key};
+# 	       }
+# 	  }
+# 	  for my $key (keys %{exists $param{hole_var}?$param{hole_var}:{}}) {
+# 	       print STDERR "Wraping $key as $param{hole_var}{$key}\n" if $DEBUG;
+# 	       $hole->wrap($param{hole_var}{$key},$safe,$key);
+# 	  }
+#      }
      $language = $param{language};
      my $tt;
      if ($tt_type eq 'FILE' and
 	 defined $tt_templates{$tt_source} and
-	 (stat $tt_source)[9] > $tt_templates{$tt_source}{mtime}
+	 ($tt_templates{$tt_source}{mtime} + 60) < time and
+	 (stat $tt_source)[9] <= $tt_templates{$tt_source}{mtime}
 	) {
 	  $tt = $tt_templates{$tt_source}{template};
      }
      else {
+	 my $passed_source = $tt_source;
+	 my $passed_type = $tt_type;
 	  if ($tt_type eq 'FILE') {
 	       $tt_templates{$tt_source}{mtime} =
 		    (stat $tt_source)[9];
+	       $passed_source = IO::File->new($tt_source,'r');
+	       binmode($passed_source,":encoding(UTF-8)");
+	       $passed_type = 'FILEHANDLE';
 	  }
-	  $tt = Text::Template->new(TYPE => $tt_type,
-				    SOURCE => $tt_source,
+	  $tt = Text::Template->new(TYPE => $passed_type,
+				    SOURCE => $passed_source,
+				    UNTAINT => 1,
 				   );
 	  if ($tt_type eq 'FILE') {
 	       $tt_templates{$tt_source}{template} = $tt;
@@ -230,10 +220,14 @@ sub _fill_in_template{
      if (not defined $tt) {
 	  die "Unable to create Text::Template for $tt_type:$tt_source";
      }
-     my $ret = $tt->fill_in(#(defined $param{nosafe} and $param{nosafe})?():(HASH=>$param{variables}),
-			    (defined $param{nosafe} and $param{nosafe})?():(SAFE=>$safe),
-			    #SAFE => $safe,
-			    (defined $param{nosafe} and $param{nosafe})?(PACKAGE => 'main'):(),
+     my $ret = $tt->fill_in(#SAFE => $safe,
+			    PACKAGE => 'DTT',
+			    HASH => {%{$param{variables}//{}},
+				     (map {my $t = $_; $t =~ s/^\&//; ($t => $param{hole_var}{$_})}
+				      keys %{$param{hole_var}//{}}),
+				     include => \&Debbugs::Text::include,
+				     config  => \%config,
+				    },
 			    defined $param{output}?(OUTPUT=>$param{output}):(),
 			   );
      if (not defined $ret) {
@@ -243,11 +237,10 @@ sub _fill_in_template{
      if ($DEBUG) {
 	  no strict 'refs';
 	  no warnings 'uninitialized';
-	  my $temp = $param{nosafe}?'main':$safe->{Root};
+#	  my $temp = $param{nosafe}?'main':$safe->{Root};
 	  print STDERR "Variables for $param{template}\n";
-	  print STDERR "Safe $temp\n";
-	  print STDERR map {"$_:${$_}\n"} keys %{"${temp}::"};
-	  print STDERR ${"${temp}::search_value"},qq(\n);
+#	  print STDERR "Safe $temp\n";
+#	  print STDERR map {"$_: ".*{$_}."\n"} keys %{"${temp}::"};
      }
 
      return $ret;