]> git.donarmstrong.com Git - debbugs.git/blob - Debbugs/Text.pm
Merge branch 'don/rebuild-index'
[debbugs.git] / Debbugs / Text.pm
1 # This module is part of debbugs, and is released
2 # under the terms of the GPL version 2, or any later
3 # version at your option.
4 # See the file README and COPYING for more information.
5 #
6 # Copyright 2007 by Don Armstrong <don@donarmstrong.com>.
7
8 package Debbugs::Text;
9
10 use warnings;
11 use strict;
12
13 =head1 NAME
14
15 Debbugs::Text -- General routines for text templates
16
17 =head1 SYNOPSIS
18
19  use Debbugs::Text qw(:templates);
20  print fill_in_template(template => 'cgi/foo');
21
22 =head1 DESCRIPTION
23
24 This module is a replacement for parts of common.pl; subroutines in
25 common.pl will be gradually phased out and replaced with equivalent
26 (or better) functionality here.
27
28 =head1 BUGS
29
30 None known.
31
32 =cut
33
34
35 use vars qw($DEBUG $VERSION @EXPORT_OK %EXPORT_TAGS @EXPORT @ISA);
36 use base qw(Exporter);
37
38 BEGIN {
39      $VERSION = 1.00;
40      $DEBUG = 0 unless defined $DEBUG;
41
42      @EXPORT = ();
43      %EXPORT_TAGS = (templates => [qw(fill_in_template)],
44                     );
45      @EXPORT_OK = ();
46      Exporter::export_ok_tags(qw(templates));
47      $EXPORT_TAGS{all} = [@EXPORT_OK];
48      push @ISA,qw(Safe::Hole::User);
49 }
50
51 use Safe;
52 use Safe::Hole;
53 use Text::Template;
54
55 use Storable qw(dclone);
56
57 use Debbugs::Config qw(:config);
58
59 use Params::Validate qw(:types validate_with);
60 use Carp;
61 use IO::File;
62 use Data::Dumper;
63
64 our %tt_templates;
65 our %filled_templates;
66 our $safe;
67 our $hole = Safe::Hole->new({});
68 our $language;
69
70 # This function is what is called when someone does include('foo/bar')
71 # {include('foo/bar')}
72
73 sub include {
74      my $template = shift;
75      $filled_templates{$template}++;
76      print STDERR "include template $template language $language safe $safe\n" if $DEBUG;
77      # Die if we're in a template loop
78      die "Template loop with $template" if $filled_templates{$template} > 10;
79      my $filled_tmpl = '';
80      eval {
81           $filled_tmpl = fill_in_template(template  => $template,
82                                           variables => {},
83                                           language  => $language,
84                                           safe      => $safe,
85                                          );
86      };
87      if ($@) {
88           print STDERR "failed to fill template $template: $@";
89      }
90      print STDERR "failed to fill template $template\n" if $filled_tmpl eq '' and $DEBUG;
91      print STDERR "template $template '$filled_tmpl'\n" if $DEBUG;
92      $filled_templates{$template}--;
93      return $filled_tmpl;
94 };
95
96
97 =head2 fill_in_template
98
99      print fill_in_template(template => 'template_name',
100                             variables => \%variables,
101                             language  => '..'
102                            );
103
104 Reads a template from disk (if it hasn't already been read in) and
105 fills the template in.
106
107 =cut
108
109
110 sub fill_in_template{
111      my %param = validate_with(params => \@_,
112                                spec   => {template => SCALAR|HANDLE|SCALARREF,
113                                           variables => {type => HASHREF,
114                                                         default => {},
115                                                        },
116                                           language  => {type => SCALAR,
117                                                         default => 'en_US',
118                                                        },
119                                           output    => {type => HANDLE,
120                                                         optional => 1,
121                                                        },
122                                           safe      => {type => OBJECT|UNDEF,
123                                                         optional => 1,
124                                                        },
125                                           hole_var  => {type => HASHREF,
126                                                         optional => 1,
127                                                        },
128                                          },
129                               );
130      #@param{qw(template variables language safe output hole_var no_safe)} = @_;
131      if ($DEBUG) {
132           print STDERR "fill_in_template ";
133           print STDERR join(" ",map {exists $param{$_}?"$_:$param{$_}":()} keys %param);
134           print STDERR "\n";
135      }
136
137      # Get the text
138      my $tt_type = '';
139      my $tt_source;
140      if (ref($param{template}) eq 'GLOB' or
141          ref(\$param{template}) eq 'GLOB') {
142           $tt_type = 'FILE_HANDLE';
143           $tt_source = $param{template};
144           binmode($tt_source,":encoding(UTF-8)");
145      }
146      elsif (ref($param{template}) eq 'SCALAR') {
147           $tt_type = 'STRING';
148           $tt_source = ${$param{template}};
149      }
150      else {
151           $tt_type = 'FILE';
152           $tt_source = _locate_text($param{template},$param{language});
153      }
154      if (not defined $tt_source) {
155           die "Unable to find template $param{template} with language $param{language}";
156      }
157
158 #      if (defined $param{safe}) {
159 #         $safe = $param{safe};
160 #      }
161 #      else {
162 #         print STDERR "Created new safe\n" if $DEBUG;
163 #         $safe = Safe->new() or die "Unable to create safe compartment";
164 #         $safe->permit_only(':base_core',':base_loop',':base_mem',
165 #                            qw(padsv padav padhv padany),
166 #                            qw(rv2gv refgen srefgen ref),
167 #                            qw(caller require entereval),
168 #                            qw(gmtime time sprintf prtf),
169 #                            qw(sort),
170 #                           );
171 #         $safe->share('*STDERR');
172 #         $safe->share('%config');
173 #         $hole->wrap(\&Debbugs::Text::include,$safe,'&include');
174 #         my $root = $safe->root();
175 #         # load variables into the safe
176 #         for my $key (keys %{$param{variables}||{}}) {
177 #              print STDERR "Loading $key\n" if $DEBUG;
178 #              if (ref($param{variables}{$key})) {
179 #                   no strict 'refs';
180 #                   print STDERR $safe->root().'::'.$key,qq(\n) if $DEBUG;
181 #                   *{"${root}::$key"} = $param{variables}{$key};
182 #              }
183 #              else {
184 #                   no strict 'refs';
185 #                   ${"${root}::$key"} = $param{variables}{$key};
186 #              }
187 #         }
188 #         for my $key (keys %{exists $param{hole_var}?$param{hole_var}:{}}) {
189 #              print STDERR "Wraping $key as $param{hole_var}{$key}\n" if $DEBUG;
190 #              $hole->wrap($param{hole_var}{$key},$safe,$key);
191 #         }
192 #      }
193      $language = $param{language};
194      my $tt;
195      if ($tt_type eq 'FILE' and
196          defined $tt_templates{$tt_source} and
197          ($tt_templates{$tt_source}{mtime} + 60) < time and
198          (stat $tt_source)[9] <= $tt_templates{$tt_source}{mtime}
199         ) {
200           $tt = $tt_templates{$tt_source}{template};
201      }
202      else {
203          my $passed_source = $tt_source;
204          my $passed_type = $tt_type;
205           if ($tt_type eq 'FILE') {
206                $tt_templates{$tt_source}{mtime} =
207                     (stat $tt_source)[9];
208                $passed_source = IO::File->new($tt_source,'r');
209                binmode($passed_source,":encoding(UTF-8)");
210                $passed_type = 'FILEHANDLE';
211           }
212           $tt = Text::Template->new(TYPE => $passed_type,
213                                     SOURCE => $passed_source,
214                                     UNTAINT => 1,
215                                    );
216           if ($tt_type eq 'FILE') {
217                $tt_templates{$tt_source}{template} = $tt;
218           }
219      }
220      if (not defined $tt) {
221           die "Unable to create Text::Template for $tt_type:$tt_source";
222      }
223      my $ret = $tt->fill_in(#SAFE => $safe,
224                             PACKAGE => 'DTT',
225                             HASH => {%{$param{variables}//{}},
226                                      (map {my $t = $_; $t =~ s/^\&//; ($t => $param{hole_var}{$_})}
227                                       keys %{$param{hole_var}//{}}),
228                                      include => \&Debbugs::Text::include,
229                                      config  => \%config,
230                                     },
231                             defined $param{output}?(OUTPUT=>$param{output}):(),
232                            );
233      if (not defined $ret) {
234           print STDERR $Text::Template::ERROR;
235           return '';
236      }
237      if ($DEBUG) {
238           no strict 'refs';
239           no warnings 'uninitialized';
240 #         my $temp = $param{nosafe}?'main':$safe->{Root};
241           print STDERR "Variables for $param{template}\n";
242 #         print STDERR "Safe $temp\n";
243 #         print STDERR map {"$_: ".*{$_}."\n"} keys %{"${temp}::"};
244      }
245
246      return $ret;
247 }
248
249 sub _locate_text{
250      my ($template,$language) = @_;
251      $template =~ s/\.tmpl$//g;
252      # if a language doesn't exist, use the en_US template
253      if (not -e $config{template_dir}.'/'.$language.'/'.$template.'.tmpl') {
254           $language = 'en_US';
255      }
256      my $loc = $config{template_dir}.'/'.$language.'/'.$template.'.tmpl';
257      if (not -e $loc) {
258           print STDERR "Unable to locate template $loc\n";
259           return undef;
260      }
261      return $loc;
262 }
263
264 1;