1 # -*- perl -*-

     2 # Text::Template.pm

     3 #

     4 # Fill in `templates'

     5 #

     6 # Copyright 1996, 1997, 1999, 2001, 2002, 2003 M-J. Dominus.

     7 # You may copy and distribute this program under the

     8 # same terms as Perl iteself.  

     9 # If in doubt, write to mjd-perl-template+@plover.com for a license.

    10 #

    11 # Version 1.44

    12 

    13 package Text::Template;

    14 require 5.004;

    15 use Exporter;

    16 @ISA = qw(Exporter);

    17 @EXPORT_OK = qw(fill_in_file fill_in_string TTerror);

    18 use vars '$ERROR';

    19 use strict;

    20 

    21 $Text::Template::VERSION = '1.44';

    22 my %GLOBAL_PREPEND = ('Text::Template' => '');

    23 

    24 sub Version {

    25   $Text::Template::VERSION;

    26 }

    27 

    28 sub _param {

    29   my $kk;

    30   my ($k, %h) = @_;

    31   for $kk ($k, "\u$k", "\U$k", "-$k", "-\u$k", "-\U$k") {

    32     return $h{$kk} if exists $h{$kk};

    33   }

    34   return;

    35 }

    36 

    37 sub always_prepend

    38 {

    39   my $pack = shift;

    40   my $old = $GLOBAL_PREPEND{$pack};

    41   $GLOBAL_PREPEND{$pack} = shift;

    42   $old;

    43 }

    44 

    45 {

    46   my %LEGAL_TYPE;

    47   BEGIN { 

    48     %LEGAL_TYPE = map {$_=>1} qw(FILE FILEHANDLE STRING ARRAY);

    49   }

    50   sub new {

    51     my $pack = shift;

    52     my %a = @_;

    53     my $stype = uc(_param('type', %a)) || 'FILE';

    54     my $source = _param('source', %a);

    55     my $untaint = _param('untaint', %a);

    56     my $prepend = _param('prepend', %a);

    57     my $alt_delim = _param('delimiters', %a);

    58     my $broken = _param('broken', %a);

    59     unless (defined $source) {

    60       require Carp;

    61       Carp::croak("Usage: $ {pack}::new(TYPE => ..., SOURCE => ...)");

    62     }

    63     unless ($LEGAL_TYPE{$stype}) {

    64       require Carp;

    65       Carp::croak("Illegal value `$stype' for TYPE parameter");

    66     }

    67     my $self = {TYPE => $stype,

    68 		PREPEND => $prepend,

    69                 UNTAINT => $untaint,

    70                 BROKEN => $broken,

    71 		(defined $alt_delim ? (DELIM => $alt_delim) : ()),

    72 	       };

    73     # Under 5.005_03, if any of $stype, $prepend, $untaint, or $broken

    74     # are tainted, all the others become tainted too as a result of

    75     # sharing the expression with them.  We install $source separately

    76     # to prevent it from acquiring a spurious taint.

    77     $self->{SOURCE} = $source;

    78 

    79     bless $self => $pack;

    80     return unless $self->_acquire_data;

    81     

    82     $self;

    83   }

    84 }

    85 

    86 # Convert template objects of various types to type STRING,

    87 # in which the template data is embedded in the object itself.

    88 sub _acquire_data {

    89   my ($self) = @_;

    90   my $type = $self->{TYPE};

    91   if ($type eq 'STRING') {

    92     # nothing necessary    

    93   } elsif ($type eq 'FILE') {

    94     my $data = _load_text($self->{SOURCE});

    95     unless (defined $data) {

    96       # _load_text already set $ERROR

    97       return undef;

    98     }

    99     if ($self->{UNTAINT} && _is_clean($self->{SOURCE})) {

   100       _unconditionally_untaint($data);

   101     }

   102     $self->{TYPE} = 'STRING';

   103     $self->{FILENAME} = $self->{SOURCE};

   104     $self->{SOURCE} = $data;

   105   } elsif ($type eq 'ARRAY') {

   106     $self->{TYPE} = 'STRING';

   107     $self->{SOURCE} = join '', @{$self->{SOURCE}};

   108   } elsif ($type eq 'FILEHANDLE') {

   109     $self->{TYPE} = 'STRING';

   110     local $/;

   111     my $fh = $self->{SOURCE};

   112     my $data = <$fh>; # Extra assignment avoids bug in Solaris perl5.00[45].

   113     if ($self->{UNTAINT}) {

   114       _unconditionally_untaint($data);

   115     }

   116     $self->{SOURCE} = $data;

   117   } else {

   118     # This should have been caught long ago, so it represents a 

   119     # drastic `can't-happen' sort of failure

   120     my $pack = ref $self;

   121     die "Can only acquire data for $pack objects of subtype STRING, but this is $type; aborting";

   122   }

   123   $self->{DATA_ACQUIRED} = 1;

   124 }

   125 

   126 sub source {

   127   my ($self) = @_;

   128   $self->_acquire_data unless $self->{DATA_ACQUIRED};

   129   return $self->{SOURCE};

   130 }

   131 

   132 sub set_source_data {

   133   my ($self, $newdata) = @_;

   134   $self->{SOURCE} = $newdata;

   135   $self->{DATA_ACQUIRED} = 1;

   136   $self->{TYPE} = 'STRING';

   137   1;

   138 }

   139 

   140 sub compile {

   141   my $self = shift;

   142 

   143   return 1 if $self->{TYPE} eq 'PREPARSED';

   144 

   145   return undef unless $self->_acquire_data;

   146   unless ($self->{TYPE} eq 'STRING') {

   147     my $pack = ref $self;

   148     # This should have been caught long ago, so it represents a 

   149     # drastic `can't-happen' sort of failure

   150     die "Can only compile $pack objects of subtype STRING, but this is $self->{TYPE}; aborting";

   151   }

   152 

   153   my @tokens;

   154   my $delim_pats = shift() || $self->{DELIM};

   155 

   156   

   157 

   158   my ($t_open, $t_close) = ('{', '}');

   159   my $DELIM;			# Regex matches a delimiter if $delim_pats

   160   if (defined $delim_pats) {

   161     ($t_open, $t_close) = @$delim_pats;

   162     $DELIM = "(?:(?:\Q$t_open\E)|(?:\Q$t_close\E))";

   163     @tokens = split /($DELIM|\n)/, $self->{SOURCE};

   164   } else {

   165     @tokens = split /(\\\\(?=\\*[{}])|\\[{}]|[{}\n])/, $self->{SOURCE};

   166   }

   167   my $state = 'TEXT';

   168   my $depth = 0;

   169   my $lineno = 1;

   170   my @content;

   171   my $cur_item = '';

   172   my $prog_start;

   173   while (@tokens) {

   174     my $t = shift @tokens;

   175     next if $t eq '';

   176     if ($t eq $t_open) {	# Brace or other opening delimiter

   177       if ($depth == 0) {

   178 	push @content, [$state, $cur_item, $lineno] if $cur_item ne '';

   179 	$cur_item = '';

   180 	$state = 'PROG';

   181 	$prog_start = $lineno;

   182       } else {

   183 	$cur_item .= $t;

   184       }

   185       $depth++;

   186     } elsif ($t eq $t_close) {	# Brace or other closing delimiter

   187       $depth--;

   188       if ($depth < 0) {

   189 	$ERROR = "Unmatched close brace at line $lineno";

   190 	return undef;

   191       } elsif ($depth == 0) {

   192 	push @content, [$state, $cur_item, $prog_start] if $cur_item ne '';

   193 	$state = 'TEXT';

   194 	$cur_item = '';

   195       } else {

   196 	$cur_item .= $t;

   197       }

   198     } elsif (!$delim_pats && $t eq '\\\\') { # precedes \\\..\\\{ or \\\..\\\}

   199       $cur_item .= '\\';

   200     } elsif (!$delim_pats && $t =~ /^\\([{}])$/) { # Escaped (literal) brace?

   201 	$cur_item .= $1;

   202     } elsif ($t eq "\n") {	# Newline

   203       $lineno++;

   204       $cur_item .= $t;

   205     } else {			# Anything else

   206       $cur_item .= $t;

   207     }

   208   }

   209 

   210   if ($state eq 'PROG') {

   211     $ERROR = "End of data inside program text that began at line $prog_start";

   212     return undef;

   213   } elsif ($state eq 'TEXT') {

   214     push @content, [$state, $cur_item, $lineno] if $cur_item ne '';

   215   } else {

   216     die "Can't happen error #1";

   217   }

   218   

   219   $self->{TYPE} = 'PREPARSED';

   220   $self->{SOURCE} = \@content;

   221   1;

   222 }

   223 

   224 sub prepend_text {

   225   my ($self) = @_;

   226   my $t = $self->{PREPEND};

   227   unless (defined $t) {

   228     $t = $GLOBAL_PREPEND{ref $self};

   229     unless (defined $t) {

   230       $t = $GLOBAL_PREPEND{'Text::Template'};

   231     }

   232   }

   233   $self->{PREPEND} = $_[1] if $#_ >= 1;

   234   return $t;

   235 }

   236 

   237 sub fill_in {

   238   my $fi_self = shift;

   239   my %fi_a = @_;

   240 

   241   unless ($fi_self->{TYPE} eq 'PREPARSED') {

   242     my $delims = _param('delimiters', %fi_a);

   243     my @delim_arg = (defined $delims ? ($delims) : ());

   244     $fi_self->compile(@delim_arg)

   245       or return undef;

   246   }

   247 

   248   my $fi_varhash = _param('hash', %fi_a);

   249   my $fi_package = _param('package', %fi_a) ;

   250   my $fi_broken  = 

   251     _param('broken', %fi_a)  || $fi_self->{BROKEN} || \&_default_broken;

   252   my $fi_broken_arg = _param('broken_arg', %fi_a) || [];

   253   my $fi_safe = _param('safe', %fi_a);

   254   my $fi_ofh = _param('output', %fi_a);

   255   my $fi_eval_package;

   256   my $fi_scrub_package = 0;

   257   my $fi_filename = _param('filename') || $fi_self->{FILENAME} || 'template';

   258 

   259   my $fi_prepend = _param('prepend', %fi_a);

   260   unless (defined $fi_prepend) {

   261     $fi_prepend = $fi_self->prepend_text;

   262   }

   263 

   264   if (defined $fi_safe) {

   265     $fi_eval_package = 'main';

   266   } elsif (defined $fi_package) {

   267     $fi_eval_package = $fi_package;

   268   } elsif (defined $fi_varhash) {

   269     $fi_eval_package = _gensym();

   270     $fi_scrub_package = 1;

   271   } else {

   272     $fi_eval_package = caller;

   273   }

   274 

   275   my $fi_install_package;

   276   if (defined $fi_varhash) {

   277     if (defined $fi_package) {

   278       $fi_install_package = $fi_package;

   279     } elsif (defined $fi_safe) {

   280       $fi_install_package = $fi_safe->root;

   281     } else {

   282       $fi_install_package = $fi_eval_package; # The gensymmed one

   283     }

   284     _install_hash($fi_varhash => $fi_install_package);

   285   }

   286 

   287   if (defined $fi_package && defined $fi_safe) {

   288     no strict 'refs';

   289     # Big fat magic here: Fix it so that the user-specified package

   290     # is the default one available in the safe compartment.

   291     *{$fi_safe->root . '::'} = \%{$fi_package . '::'};   # LOD

   292   }

   293 

   294   my $fi_r = '';

   295   my $fi_item;

   296   foreach $fi_item (@{$fi_self->{SOURCE}}) {

   297     my ($fi_type, $fi_text, $fi_lineno) = @$fi_item;

   298     if ($fi_type eq 'TEXT') {

   299       if ($fi_ofh) {

   300 	print $fi_ofh $fi_text;

   301       } else {

   302 	$fi_r .= $fi_text;

   303       }

   304     } elsif ($fi_type eq 'PROG') {

   305       no strict;

   306       my $fi_lcomment = "#line $fi_lineno $fi_filename";

   307       my $fi_progtext = 

   308         "package $fi_eval_package; $fi_prepend;\n$fi_lcomment\n$fi_text;";

   309       my $fi_res;

   310       my $fi_eval_err = '';

   311       if ($fi_safe) {

   312         $fi_safe->reval(q{undef $OUT});

   313 	$fi_res = $fi_safe->reval($fi_progtext);

   314 	$fi_eval_err = $@;

   315 	my $OUT = $fi_safe->reval('$OUT');

   316 	$fi_res = $OUT if defined $OUT;

   317       } else {

   318 	my $OUT;

   319 	$fi_res = eval $fi_progtext;

   320 	$fi_eval_err = $@;

   321 	$fi_res = $OUT if defined $OUT;

   322       }

   323 

   324       # If the value of the filled-in text really was undef,

   325       # change it to an explicit empty string to avoid undefined

   326       # value warnings later.

   327       $fi_res = '' unless defined $fi_res;

   328 

   329       if ($fi_eval_err) {

   330 	$fi_res = $fi_broken->(text => $fi_text,

   331 			       error => $fi_eval_err,

   332 			       lineno => $fi_lineno,

   333 			       arg => $fi_broken_arg,

   334 			       );

   335 	if (defined $fi_res) {

   336 	  if (defined $fi_ofh) {

   337 	    print $fi_ofh $fi_res;

   338 	  } else {

   339 	    $fi_r .= $fi_res;

   340 	  }

   341 	} else {

   342 	  return $fi_res;		# Undefined means abort processing

   343 	}

   344       } else {

   345 	if (defined $fi_ofh) {

   346 	  print $fi_ofh $fi_res;

   347 	} else {

   348 	  $fi_r .= $fi_res;

   349 	}

   350       }

   351     } else {

   352       die "Can't happen error #2";

   353     }

   354   }

   355 

   356   _scrubpkg($fi_eval_package) if $fi_scrub_package;

   357   defined $fi_ofh ? 1 : $fi_r;

   358 }

   359 

   360 sub fill_this_in {

   361   my $pack = shift;

   362   my $text = shift;

   363   my $templ = $pack->new(TYPE => 'STRING', SOURCE => $text, @_)

   364     or return undef;

   365   $templ->compile or return undef;

   366   my $result = $templ->fill_in(@_);

   367   $result;

   368 }

   369 

   370 sub fill_in_string {

   371   my $string = shift;

   372   my $package = _param('package', @_);

   373   push @_, 'package' => scalar(caller) unless defined $package;

   374   Text::Template->fill_this_in($string, @_);

   375 }

   376 

   377 sub fill_in_file {

   378   my $fn = shift;

   379   my $templ = Text::Template->new(TYPE => 'FILE', SOURCE => $fn, @_)

   380     or return undef;

   381   $templ->compile or return undef;

   382   my $text = $templ->fill_in(@_);

   383   $text;

   384 }

   385 

   386 sub _default_broken {

   387   my %a = @_;

   388   my $prog_text = $a{text};

   389   my $err = $a{error};

   390   my $lineno = $a{lineno};

   391   chomp $err;

   392 #  $err =~ s/\s+at .*//s;

   393   "Program fragment delivered error ``$err''";

   394 }

   395 

   396 sub _load_text {

   397   my $fn = shift;

   398   local *F;

   399   unless (open F, $fn) {

   400     $ERROR = "Couldn't open file $fn: $!";

   401     return undef;

   402   }

   403   local $/;

   404   <F>;

   405 }

   406 

   407 sub _is_clean {

   408   my $z;

   409   eval { ($z = join('', @_)), eval '#' . substr($z,0,0); 1 }   # LOD

   410 }

   411 

   412 sub _unconditionally_untaint {

   413   for (@_) {

   414     ($_) = /(.*)/s;

   415   }

   416 }

   417 

   418 {

   419   my $seqno = 0;

   420   sub _gensym {

   421     __PACKAGE__ . '::GEN' . $seqno++;

   422   }

   423   sub _scrubpkg {

   424     my $s = shift;

   425     $s =~ s/^Text::Template:://;

   426     no strict 'refs';

   427     my $hash = $Text::Template::{$s."::"};

   428     foreach my $key (keys %$hash) {

   429       undef $hash->{$key};

   430     }

   431   }

   432 }

   433   

   434 # Given a hashful of variables (or a list of such hashes)

   435 # install the variables into the specified package,

   436 # overwriting whatever variables were there before.

   437 sub _install_hash {

   438   my $hashlist = shift;

   439   my $dest = shift;

   440   if (UNIVERSAL::isa($hashlist, 'HASH')) {

   441     $hashlist = [$hashlist];

   442   }

   443   my $hash;

   444   foreach $hash (@$hashlist) {

   445     my $name;

   446     foreach $name (keys %$hash) {

   447       my $val = $hash->{$name};

   448       no strict 'refs';

   449       local *SYM = *{"$ {dest}::$name"};

   450       if (! defined $val) {

   451 	delete ${"$ {dest}::"}{$name};

   452       } elsif (ref $val) {

   453 	*SYM = $val;

   454       } else {

   455  	*SYM = \$val;

   456       }

   457     }

   458   }

   459 }

   460 

   461 sub TTerror { $ERROR }

   462 

   463 1;

   464 

   465 

   466 =head1 NAME

   467 

   468 Text::Template - Expand template text with embedded Perl

   469 

   470 =head1 VERSION

   471 

   472 This file documents C<Text::Template> version B<1.44>

   473 

   474 =head1 SYNOPSIS

   475 

   476  use Text::Template;

   477 

   478 

   479  $template = Text::Template->new(TYPE => 'FILE',  SOURCE => 'filename.tmpl');

   480  $template = Text::Template->new(TYPE => 'ARRAY', SOURCE => [ ... ] );

   481  $template = Text::Template->new(TYPE => 'FILEHANDLE', SOURCE => $fh );

   482  $template = Text::Template->new(TYPE => 'STRING', SOURCE => '...' );

   483  $template = Text::Template->new(PREPEND => q{use strict;}, ...);

   484 

   485  # Use a different template file syntax:

   486  $template = Text::Template->new(DELIMITERS => [$open, $close], ...);

   487 

   488  $recipient = 'King';

   489  $text = $template->fill_in();  # Replaces `{$recipient}' with `King'

   490  print $text;

   491 

   492  $T::recipient = 'Josh';

   493  $text = $template->fill_in(PACKAGE => T);

   494 

   495  # Pass many variables explicitly

   496  $hash = { recipient => 'Abed-Nego',

   497            friends => [ 'me', 'you' ],

   498            enemies => { loathsome => 'Bill Gates',

   499                         fearsome => 'Larry Ellison' },

   500          };

   501  $text = $template->fill_in(HASH => $hash, ...);

   502  # $recipient is Abed-Nego,

   503  # @friends is ( 'me', 'you' ),

   504  # %enemies is ( loathsome => ..., fearsome => ... )

   505 

   506 

   507  # Call &callback in case of programming errors in template

   508  $text = $template->fill_in(BROKEN => \&callback, BROKEN_ARG => $ref, ...);

   509 

   510  # Evaluate program fragments in Safe compartment with restricted permissions

   511  $text = $template->fill_in(SAFE => $compartment, ...);

   512 

   513  # Print result text instead of returning it

   514  $success = $template->fill_in(OUTPUT => \*FILEHANDLE, ...);

   515 

   516  # Parse template with different template file syntax:

   517  $text = $template->fill_in(DELIMITERS => [$open, $close], ...);

   518  # Note that this is *faster* than using the default delimiters

   519 

   520  # Prepend specified perl code to each fragment before evaluating:

   521  $text = $template->fill_in(PREPEND => q{use strict 'vars';}, ...);

   522 

   523  use Text::Template 'fill_in_string';

   524  $text = fill_in_string( <<EOM, PACKAGE => 'T', ...);

   525  Dear {$recipient},

   526  Pay me at once.

   527         Love,

   528          G.V.

   529  EOM

   530 

   531  use Text::Template 'fill_in_file';

   532  $text = fill_in_file($filename, ...);

   533 

   534  # All templates will always have `use strict vars' attached to all fragments

   535  Text::Template->always_prepend(q{use strict 'vars';});

   536 

   537 =head1 DESCRIPTION

   538 

   539 This is a library for generating form letters, building HTML pages, or

   540 filling in templates generally.  A `template' is a piece of text that

   541 has little Perl programs embedded in it here and there.  When you

   542 `fill in' a template, you evaluate the little programs and replace

   543 them with their values.

   544 

   545 You can store a template in a file outside your program.  People can

   546 modify the template without modifying the program.  You can separate

   547 the formatting details from the main code, and put the formatting

   548 parts of the program into the template.  That prevents code bloat and

   549 encourages functional separation.

   550 

   551 =head2 Example

   552 

   553 Here's an example of a template, which we'll suppose is stored in the

   554 file C<formletter.tmpl>:

   555 

   556 	Dear {$title} {$lastname},

   557 

   558 	It has come to our attention that you are delinquent in your

   559 	{$monthname[$last_paid_month]} payment.  Please remit

   560 	${sprintf("%.2f", $amount)} immediately, or your patellae may

   561 	be needlessly endangered.

   562 

   563 			Love,

   564 

   565 			Mark "Vizopteryx" Dominus

   566 

   567 

   568 The result of filling in this template is a string, which might look

   569 something like this:

   570 

   571 	Dear Mr. Gates,

   572 

   573 	It has come to our attention that you are delinquent in your

   574 	February payment.  Please remit

   575 	$392.12 immediately, or your patellae may

   576 	be needlessly endangered.

   577 

   578 

   579 			Love,

   580 

   581 			Mark "Vizopteryx" Dominus

   582 

   583 Here is a complete program that transforms the example

   584 template into the example result, and prints it out:

   585 

   586 	use Text::Template;

   587 

   588 	my $template = Text::Template->new(SOURCE => 'formletter.tmpl')

   589 	  or die "Couldn't construct template: $Text::Template::ERROR";

   590 

   591 	my @monthname = qw(January February March April May June

   592                            July August September October November December);

   593 	my %vars = (title => 'Mr.',

   594 		    firstname => 'Bill',

   595 		    lastname => 'Gates',

   596 		    last_paid_month => 1,   # February

   597 		    amount => 392.12,

   598 		    monthname => \@monthname,

   599 		   );

   600 

   601 	my $result = $template->fill_in(HASH => \%vars);

   602 

   603 	if (defined $result) { print $result }

   604 	else { die "Couldn't fill in template: $Text::Template::ERROR" }

   605 

   606 

   607 =head2 Philosophy

   608 

   609 When people make a template module like this one, they almost always

   610 start by inventing a special syntax for substitutions.  For example,

   611 they build it so that a string like C<%%VAR%%> is replaced with the

   612 value of C<$VAR>.  Then they realize the need extra formatting, so

   613 they put in some special syntax for formatting.  Then they need a

   614 loop, so they invent a loop syntax.  Pretty soon they have a new

   615 little template language.

   616 

   617 This approach has two problems: First, their little language is

   618 crippled. If you need to do something the author hasn't thought of,

   619 you lose.  Second: Who wants to learn another language?  You already

   620 know Perl, so why not use it?

   621 

   622 C<Text::Template> templates are programmed in I<Perl>.  You embed Perl

   623 code in your template, with C<{> at the beginning and C<}> at the end.

   624 If you want a variable interpolated, you write it the way you would in

   625 Perl.  If you need to make a loop, you can use any of the Perl loop

   626 constructions.  All the Perl built-in functions are available.

   627 

   628 =head1 Details

   629 

   630 =head2 Template Parsing

   631 

   632 The C<Text::Template> module scans the template source.  An open brace

   633 C<{> begins a program fragment, which continues until the matching

   634 close brace C<}>.  When the template is filled in, the program

   635 fragments are evaluated, and each one is replaced with the resulting

   636 value to yield the text that is returned.

   637 

   638 A backslash C<\> in front of a brace (or another backslash that is in

   639 front of a brace) escapes its special meaning.  The result of filling

   640 out this template:

   641 

   642 	\{ The sum of 1 and 2 is {1+2}  \}

   643 

   644 is

   645 

   646 	{ The sum of 1 and 2 is 3  }

   647 

   648 If you have an unmatched brace, C<Text::Template> will return a

   649 failure code and a warning about where the problem is.  Backslashes

   650 that do not precede a brace are passed through unchanged.  If you have

   651 a template like this:

   652 

   653 	{ "String that ends in a newline.\n" }

   654 

   655 The backslash inside the string is passed through to Perl unchanged,

   656 so the C<\n> really does turn into a newline.  See the note at the end

   657 for details about the way backslashes work.  Backslash processing is

   658 I<not> done when you specify alternative delimiters with the

   659 C<DELIMITERS> option.  (See L<"Alternative Delimiters">, below.)

   660 

   661 Each program fragment should be a sequence of Perl statements, which

   662 are evaluated the usual way.  The result of the last statement

   663 executed will be evaluted in scalar context; the result of this

   664 statement is a string, which is interpolated into the template in

   665 place of the program fragment itself.

   666 

   667 The fragments are evaluated in order, and side effects from earlier

   668 fragments will persist into later fragments:

   669 

   670 	{$x = @things; ''}The Lord High Chamberlain has gotten {$x}

   671 	things for me this year.

   672 	{ $diff = $x - 17;

   673 	  $more = 'more'

   674 	  if ($diff == 0) {

   675 	    $diff = 'no';

   676 	  } elsif ($diff < 0) {

   677 	    $more = 'fewer';

   678 	  }

   679           '';

   680 	}

   681 	That is {$diff} {$more} than he gave me last year.

   682 

   683 The value of C<$x> set in the first line will persist into the next

   684 fragment that begins on the third line, and the values of C<$diff> and

   685 C<$more> set in the second fragment will persist and be interpolated

   686 into the last line.  The output will look something like this:

   687 

   688 	The Lord High Chamberlain has gotten 42

   689 	things for me this year.

   690 

   691 	That is 25 more than he gave me last year.

   692 

   693 That is all the syntax there is.

   694 

   695 =head2 The C<$OUT> variable

   696 

   697 There is one special trick you can play in a template.  Here is the

   698 motivation for it:  Suppose you are going to pass an array, C<@items>,

   699 into the template, and you want the template to generate a bulleted

   700 list with a header, like this:

   701 

   702 	Here is a list of the things I have got for you since 1907:

   703 	  * Ivory

   704 	  * Apes

   705 	  * Peacocks

   706 	  * ...

   707 

   708 One way to do it is with a template like this:

   709 

   710 	Here is a list of the things I have got for you since 1907:

   711 	{ my $blist = '';

   712           foreach $i (@items) {

   713             $blist .= qq{  * $i\n};

   714           }

   715           $blist;

   716         }

   717 

   718 Here we construct the list in a variable called C<$blist>, which we

   719 return at the end.  This is a little cumbersome.  There is a shortcut.

   720 

   721 Inside of templates, there is a special variable called C<$OUT>.

   722 Anything you append to this variable will appear in the output of the

   723 template.  Also, if you use C<$OUT> in a program fragment, the normal

   724 behavior, of replacing the fragment with its return value, is

   725 disabled; instead the fragment is replaced with the value of C<$OUT>.

   726 This means that you can write the template above like this:

   727 

   728 	Here is a list of the things I have got for you since 1907:

   729 	{ foreach $i (@items) {

   730             $OUT .= "  * $i\n";

   731           }

   732         }

   733 

   734 C<$OUT> is reinitialized to the empty string at the start of each

   735 program fragment.  It is private to C<Text::Template>, so

   736 you can't use a variable named C<$OUT> in your template without

   737 invoking the special behavior.

   738 

   739 =head2 General Remarks

   740 

   741 All C<Text::Template> functions return C<undef> on failure, and set the

   742 variable C<$Text::Template::ERROR> to contain an explanation of what

   743 went wrong.  For example, if you try to create a template from a file

   744 that does not exist, C<$Text::Template::ERROR> will contain something like:

   745 

   746 	Couldn't open file xyz.tmpl: No such file or directory

   747 

   748 =head2 C<new>

   749 

   750 	$template = new Text::Template ( TYPE => ..., SOURCE => ... );

   751 

   752 This creates and returns a new template object.  C<new> returns

   753 C<undef> and sets C<$Text::Template::ERROR> if it can't create the

   754 template object.  C<SOURCE> says where the template source code will

   755 come from.  C<TYPE> says what kind of object the source is.

   756 

   757 The most common type of source is a file:

   758 

   759 	new Text::Template ( TYPE => 'FILE', SOURCE => $filename );

   760 

   761 This reads the template from the specified file.  The filename is

   762 opened with the Perl C<open> command, so it can be a pipe or anything

   763 else that makes sense with C<open>.

   764 

   765 The C<TYPE> can also be C<STRING>, in which case the C<SOURCE> should

   766 be a string:

   767 

   768 	new Text::Template ( TYPE => 'STRING',

   769                              SOURCE => "This is the actual template!" );

   770 

   771 The C<TYPE> can be C<ARRAY>, in which case the source should be a

   772 reference to an array of strings.  The concatenation of these strings

   773 is the template:

   774 

   775 	new Text::Template ( TYPE => 'ARRAY',

   776                              SOURCE => [ "This is ", "the actual",

   777                                          " template!",

   778                                        ]

   779                            );

   780 

   781 The C<TYPE> can be FILEHANDLE, in which case the source should be an

   782 open filehandle (such as you got from the C<FileHandle> or C<IO::*>

   783 packages, or a glob, or a reference to a glob).  In this case

   784 C<Text::Template> will read the text from the filehandle up to

   785 end-of-file, and that text is the template:

   786 

   787 	# Read template source code from STDIN:

   788 	new Text::Template ( TYPE => 'FILEHANDLE',

   789                              SOURCE => \*STDIN  );

   790 

   791 

   792 If you omit the C<TYPE> attribute, it's taken to be C<FILE>.

   793 C<SOURCE> is required.  If you omit it, the program will abort.

   794 

   795 The words C<TYPE> and C<SOURCE> can be spelled any of the following ways:

   796 

   797 	TYPE	SOURCE

   798 	Type	Source

   799 	type	source

   800 	-TYPE	-SOURCE

   801 	-Type	-Source

   802 	-type	-source

   803 

   804 Pick a style you like and stick with it.

   805 

   806 =over 4

   807 

   808 =item C<DELIMITERS>

   809 

   810 You may also add a C<DELIMITERS> option.  If this option is present,

   811 its value should be a reference to an array of two strings.  The first

   812 string is the string that signals the beginning of each program

   813 fragment, and the second string is the string that signals the end of

   814 each program fragment.  See L<"Alternative Delimiters">, below.

   815 

   816 =item C<UNTAINT>

   817 

   818 If your program is running in taint mode, you may have problems if

   819 your templates are stored in files.  Data read from files is

   820 considered 'untrustworthy', and taint mode will not allow you to

   821 evaluate the Perl code in the file.  (It is afraid that a malicious

   822 person might have tampered with the file.)

   823 

   824 In some environments, however, local files are trustworthy.  You can

   825 tell C<Text::Template> that a certain file is trustworthy by supplying

   826 C<UNTAINT =E<gt> 1> in the call to C<new>.  This will tell

   827 C<Text::Template> to disable taint checks on template code that has

   828 come from a file, as long as the filename itself is considered

   829 trustworthy.  It will also disable taint checks on template code that

   830 comes from a filehandle.  When used with C<TYPE =E<gt> 'string'> or C<TYPE

   831 =E<gt> 'array'>, it has no effect.

   832 

   833 See L<perlsec> for more complete information about tainting.

   834 

   835 Thanks to Steve Palincsar, Gerard Vreeswijk, and Dr. Christoph Baehr

   836 for help with this feature.

   837 

   838 =item C<PREPEND>

   839 

   840 This option is passed along to the C<fill_in> call unless it is

   841 overridden in the arguments to C<fill_in>.  See L<C<PREPEND> feature

   842 and using C<strict> in templates> below.

   843 

   844 =item C<BROKEN>

   845 

   846 This option is passed along to the C<fill_in> call unless it is

   847 overridden in the arguments to C<fill_in>.  See L<C<BROKEN>> below.

   848 

   849 =back

   850 

   851 =head2 C<compile>

   852 

   853 	$template->compile()

   854 

   855 Loads all the template text from the template's source, parses and

   856 compiles it.  If successful, returns true; otherwise returns false and

   857 sets C<$Text::Template::ERROR>.  If the template is already compiled,

   858 it returns true and does nothing.

   859 

   860 You don't usually need to invoke this function, because C<fill_in>

   861 (see below) compiles the template if it isn't compiled already.

   862 

   863 If there is an argument to this function, it must be a reference to an

   864 array containing alternative delimiter strings.  See C<"Alternative

   865 Delimiters">, below.

   866 

   867 =head2 C<fill_in>

   868 

   869 	$template->fill_in(OPTIONS);

   870 

   871 Fills in a template.  Returns the resulting text if successful.

   872 Otherwise, returns C<undef>  and sets C<$Text::Template::ERROR>.

   873 

   874 The I<OPTIONS> are a hash, or a list of key-value pairs.  You can

   875 write the key names in any of the six usual styles as above; this

   876 means that where this manual says C<PACKAGE> (for example) you can

   877 actually use any of

   878 

   879 	PACKAGE Package package -PACKAGE -Package -package

   880 

   881 Pick a style you like and stick with it.  The all-lowercase versions

   882 may yield spurious warnings about

   883 

   884 	Ambiguous use of package => resolved to "package"

   885 

   886 so you might like to avoid them and use the capitalized versions.

   887 

   888 At present, there are eight legal options:  C<PACKAGE>, C<BROKEN>,

   889 C<BROKEN_ARG>, C<SAFE>, C<HASH>, C<OUTPUT>, and C<DELIMITERS>.

   890 

   891 =over 4

   892 

   893 =item C<PACKAGE>

   894 

   895 C<PACKAGE> specifies the name of a package in which the program

   896 fragments should be evaluated.  The default is to use the package from

   897 which C<fill_in> was called.  For example, consider this template:

   898 

   899 	The value of the variable x is {$x}.

   900 

   901 If you use C<$template-E<gt>fill_in(PACKAGE =E<gt> 'R')> , then the C<$x> in

   902 the template is actually replaced with the value of C<$R::x>.  If you

   903 omit the C<PACKAGE> option, C<$x> will be replaced with the value of

   904 the C<$x> variable in the package that actually called C<fill_in>.

   905 

   906 You should almost always use C<PACKAGE>.  If you don't, and your

   907 template makes changes to variables, those changes will be propagated

   908 back into the main program.  Evaluating the template in a private

   909 package helps prevent this.  The template can still modify variables

   910 in your program if it wants to, but it will have to do so explicitly.

   911 See the section at the end on `Security'.

   912 

   913 Here's an example of using C<PACKAGE>:

   914 

   915 	Your Royal Highness,

   916 

   917 	Enclosed please find a list of things I have gotten

   918 	for you since 1907:

   919 

   920 	{ foreach $item (@items) {

   921             $item_no++;

   922 	    $OUT .= " $item_no. \u$item\n";

   923 	  }

   924 	}

   925 

   926 	Signed,

   927 	Lord High Chamberlain

   928 

   929 We want to pass in an array which will be assigned to the array

   930 C<@items>.  Here's how to do that:

   931 

   932 

   933 	@items = ('ivory', 'apes', 'peacocks', );

   934 	$template->fill_in();

   935 

   936 This is not very safe.  The reason this isn't as safe is that if you

   937 had a variable named C<$item_no> in scope in your program at the point

   938 you called C<fill_in>, its value would be clobbered by the act of

   939 filling out the template.  The problem is the same as if you had

   940 written a subroutine that used those variables in the same way that

   941 the template does.  (C<$OUT> is special in templates and is always

   942 safe.)

   943 

   944 One solution to this is to make the C<$item_no> variable private to the

   945 template by declaring it with C<my>.  If the template does this, you

   946 are safe.

   947 

   948 But if you use the C<PACKAGE> option, you will probably be safe even

   949 if the template does I<not> declare its variables with C<my>:

   950 

   951 	@Q::items = ('ivory', 'apes', 'peacocks', );

   952 	$template->fill_in(PACKAGE => 'Q');

   953 

   954 In this case the template will clobber the variable C<$Q::item_no>,

   955 which is not related to the one your program was using.

   956 

   957 Templates cannot affect variables in the main program that are

   958 declared with C<my>, unless you give the template references to those

   959 variables.

   960 

   961 =item C<HASH>

   962 

   963 You may not want to put the template variables into a package.

   964 Packages can be hard to manage:  You can't copy them, for example.

   965 C<HASH> provides an alternative.

   966 

   967 The value for C<HASH> should be a reference to a hash that maps

   968 variable names to values.  For example,

   969 

   970 	$template->fill_in(HASH => { recipient => "The King",

   971 				     items => ['gold', 'frankincense', 'myrrh'],

   972 	                             object => \$self,

   973 				   });

   974 

   975 will fill out the template and use C<"The King"> as the value of

   976 C<$recipient> and the list of items as the value of C<@items>.  Note

   977 that we pass an array reference, but inside the template it appears as

   978 an array.  In general, anything other than a simple string or number

   979 should be passed by reference.

   980 

   981 We also want to pass an object, which is in C<$self>; note that we

   982 pass a reference to the object, C<\$self> instead.  Since we've passed

   983 a reference to a scalar, inside the template the object appears as

   984 C<$object>.  

   985 

   986 The full details of how it works are a little involved, so you might

   987 want to skip to the next section.

   988 

   989 Suppose the key in the hash is I<key> and the value is I<value>.

   990 

   991 =over 4

   992 

   993 =item *

   994 

   995 If the I<value> is C<undef>, then any variables named C<$key>,

   996 C<@key>, C<%key>, etc., are undefined.

   997 

   998 =item *

   999 

  1000 If the I<value> is a string or a number, then C<$key> is set to that

  1001 value in the template.

  1002 

  1003 =item *

  1004 

  1005 For anything else, you must pass a reference.

  1006 

  1007 If the I<value> is a reference to an array, then C<@key> is set to

  1008 that array.  If the I<value> is a reference to a hash, then C<%key> is

  1009 set to that hash.  Similarly if I<value> is any other kind of

  1010 reference.  This means that

  1011 

  1012 	var => "foo"

  1013 

  1014 and

  1015 

  1016 	var => \"foo"

  1017 

  1018 have almost exactly the same effect.  (The difference is that in the

  1019 former case, the value is copied, and in the latter case it is

  1020 aliased.)

  1021 

  1022 =item *

  1023 

  1024 In particular, if you want the template to get an object or any kind,

  1025 you must pass a reference to it:

  1026 

  1027 	$template->fill_in(HASH => { database_handle => \$dbh, ... });

  1028 

  1029 If you do this, the template will have a variable C<$database_handle>

  1030 which is the database handle object.  If you leave out the C<\>, the

  1031 template will have a hash C<%database_handle>, which exposes the

  1032 internal structure of the database handle object; you don't want that.

  1033 

  1034 =back

  1035 

  1036 Normally, the way this works is by allocating a private package,

  1037 loading all the variables into the package, and then filling out the

  1038 template as if you had specified that package.  A new package is

  1039 allocated each time.  However, if you I<also> use the C<PACKAGE>

  1040 option, C<Text::Template> loads the variables into the package you

  1041 specified, and they stay there after the call returns.  Subsequent

  1042 calls to C<fill_in> that use the same package will pick up the values

  1043 you loaded in.

  1044 

  1045 If the argument of C<HASH> is a reference to an array instead of a

  1046 reference to a hash, then the array should contain a list of hashes

  1047 whose contents are loaded into the template package one after the

  1048 other.  You can use this feature if you want to combine several sets

  1049 of variables.  For example, one set of variables might be the defaults

  1050 for a fill-in form, and the second set might be the user inputs, which

  1051 override the defaults when they are present:

  1052 

  1053 	$template->fill_in(HASH => [\%defaults, \%user_input]);

  1054 

  1055 You can also use this to set two variables with the same name:

  1056 

  1057 	$template->fill_in(HASH => [{ v => "The King" },

  1058                                     { v => [1,2,3] },

  1059 	                           ]

  1060                           );

  1061 

  1062 This sets C<$v> to C<"The King"> and C<@v> to C<(1,2,3)>.

  1063 

  1064 =item C<BROKEN>

  1065 

  1066 If any of the program fragments fails to compile or aborts for any

  1067 reason, and you have set the C<BROKEN> option to a function reference,

  1068 C<Text::Template> will invoke the function.  This function is called

  1069 the I<C<BROKEN> function>.  The C<BROKEN> function will tell

  1070 C<Text::Template> what to do next.

  1071 

  1072 If the C<BROKEN> function returns C<undef>, C<Text::Template> will

  1073 immediately abort processing the template and return the text that it

  1074 has accumulated so far.  If your function does this, it should set a

  1075 flag that you can examine after C<fill_in> returns so that you can

  1076 tell whether there was a premature return or not.

  1077 

  1078 If the C<BROKEN> function returns any other value, that value will be

  1079 interpolated into the template as if that value had been the return

  1080 value of the program fragment to begin with.  For example, if the

  1081 C<BROKEN> function returns an error string, the error string will be

  1082 interpolated into the output of the template in place of the program

  1083 fragment that cased the error.

  1084 

  1085 If you don't specify a C<BROKEN> function, C<Text::Template> supplies

  1086 a default one that returns something like

  1087 

  1088 	Program fragment delivered error ``Illegal division by 0 at

  1089 	template line 37''

  1090 

  1091 (Note that the format of this message has changed slightly since

  1092 version 1.31.)  The return value of the C<BROKEN> function is

  1093 interpolated into the template at the place the error occurred, so

  1094 that this template:

  1095 

  1096 	(3+4)*5 = { 3+4)*5 }

  1097 

  1098 yields this result:

  1099 

  1100 	(3+4)*5 = Program fragment delivered error ``syntax error at template line 1''

  1101 

  1102 If you specify a value for the C<BROKEN> attribute, it should be a

  1103 reference to a function that C<fill_in> can call instead of the

  1104 default function.

  1105 

  1106 C<fill_in> will pass a hash to the C<broken> function.

  1107 The hash will have at least these three members:

  1108 

  1109 =over 4

  1110 

  1111 =item C<text>

  1112 

  1113 The source code of the program fragment that failed

  1114 

  1115 =item C<error>

  1116 

  1117 The text of the error message (C<$@>) generated by eval.

  1118 

  1119 The text has been modified to omit the trailing newline and to include

  1120 the name of the template file (if there was one).  The line number

  1121 counts from the beginning of the template, not from the beginning of

  1122 the failed program fragment.

  1123 

  1124 =item C<lineno>

  1125 

  1126 The line number of the template at which the program fragment began.

  1127 

  1128 =back

  1129 

  1130 There may also be an C<arg> member.  See C<BROKEN_ARG>, below

  1131 

  1132 =item C<BROKEN_ARG>

  1133 

  1134 If you supply the C<BROKEN_ARG> option to C<fill_in>, the value of the