├── .github └── workflows │ └── ci.yaml ├── .gitignore ├── Changes ├── INSTALL ├── MANIFEST.SKIP ├── README ├── dist.ini ├── lib └── Text │ ├── Template.pm │ └── Template │ └── Preprocess.pm ├── t ├── basic.t ├── broken.t ├── delimiters.t ├── error.t ├── exported.t ├── hash.t ├── inline-comment.t ├── nested-tags.t ├── ofh.t ├── out.t ├── prepend.t ├── preprocess.t ├── rt29928.t ├── safe.t ├── safe2.t ├── safe3.t ├── strict.t ├── taint.t ├── template-encoding.t └── warnings.t └── tools ├── docker-test.sh └── smoke.sh /.github/workflows/ci.yaml: -------------------------------------------------------------------------------- 1 | name: Run Tests 2 | on: 3 | push: 4 | branches: [ master ] 5 | jobs: 6 | build: 7 | runs-on: ${{ matrix.os }} 8 | strategy: 9 | matrix: 10 | os: ['ubuntu-latest'] 11 | perl: 12 | - '5.20' 13 | - '5.28' 14 | - '5.30' 15 | - '5.32' 16 | - '5.34' 17 | name: Perl ${{ matrix.perl }} on ${{ matrix.os }} 18 | steps: 19 | - uses: actions/checkout@v2 20 | - name: Set up perl 21 | uses: shogo82148/actions-setup-perl@v1 22 | with: 23 | perl-version: ${{ matrix.perl }} 24 | - run: perl -V 25 | - run: git config --global user.name "Github Tests" 26 | - run: git config --global user.email not-for-mail@github-actions.com 27 | - name: Cache CPAN Deps 28 | id: cache-cpan-deps 29 | uses: actions/cache@v2 30 | with: 31 | path: /opt/hostedtoolcache/perl 32 | key: cpan-deps-${{ matrix.os }}-${{ matrix.perl }}-${{ hashFiles('dist.ini') }} 33 | - run: cpanm -q --notest Dist::Zilla 34 | - run: dzil authordeps --missing | cpanm -q --notest 35 | - run: dzil listdeps --author --missing | cpanm --verbose --notest 36 | - run: dzil smoke --author 37 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .build/ 2 | Text-Template-* 3 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Text::Template 2 | 3 | {{$NEXT}} 4 | 5 | 1.61 2022-04-28 6 | - Skip taint tests if perl was compiled with taint disabled. (Thanks Neil Bowers) [GitHub PR #20] 7 | 8 | 1.60 2021-09-03 9 | - Fix another POD syntax error. 10 | 11 | 1.59 2020-07-03 12 | - Fix syntax error in POD example code. 13 | 14 | 1.58 2019-09-27 15 | - Remove hard coded (old) version number from README 16 | 17 | 1.57 2019-09-09 18 | - Fix several doc typos (Thanks Antoine Cœur) 19 | 20 | 1.56 2019-07-09 21 | - Fix typos in Changes 22 | 23 | 1.55 2019-02-25 24 | - Improve AppVeyor tests for older Perls (Thanks Roy Ivy) 25 | - Check for Test::More 0.94 and skip tests if not installed where 26 | done_testing() is used (Thanks Roy Ivy). 27 | - Improve workaround for broken Win32 File::Temp taint failure (Thanks Roy Ivy). 28 | - Skip/todo tests which fail under Devel::Cover (Thanks Roy Ivy) 29 | - Add checks and skip_all checks for non-core test modules (Thanks Roy Ivy) 30 | 31 | 1.54 2019-01-13 32 | - Fix tempfile creation during tests on Win32 33 | 34 | 1.53 2018-05-02 35 | - Add support for decoding template files via ENCODING constructor arg 36 | [github #11] 37 | - Docs cleanup: replace indirect-object style examples and use class method 38 | style constructor calls in the POD docs 39 | - Docs cleanup: remove hard tabs from POD, replace dated, unfair synopsis 40 | [github #5], convert "THANKS" section to a POD list 41 | 42 | 1.52 2018-03-19 43 | - Fix possible 'Subroutine ... redefined' warning (Github #10) 44 | 45 | 1.51 2018-03-04 46 | - Add test for nested tags breakage that happened in v1.46 47 | - Turn off strict+warnings in sections where template code is eval'ed 48 | [github #9] 49 | 50 | 1.50 2018-02-10 51 | *** Revert support for identical start/end delimiters (e.g.: @@foo@@, XXfooXX) 52 | due to breakage with nested tags (see 53 | https://github.com/mschout/perl-text-template/issues/8). Will revisit 54 | this in a future release. 55 | 56 | 1.49 2018-02-07 57 | - Fix failing tests in v1.48 under perl < 5.8.9 58 | 59 | 1.48 2018-02-07 60 | - remove COPYING and Artistic files from the dist. These are replaced by 61 | the Dist::Zilla generated LICENSE file. 62 | - use strict/warnings (thanks Mohammad S Anwar) 63 | - remove $VERSION checks from tests. This makes it easier to run the test 64 | with Dist::Zilla and avoids maintenance issue of updating the tests for 65 | each release (Thanks Andrew Ruder). 66 | - Allow precompiled templates to work with preprocessing [#29928] (Thanks 67 | Nik LaBelle) 68 | - Add "strict" option to fill_in(). This adds "use strict" and "use vars 69 | (...)" to the prepend section, and only the keys of the HASH option are 70 | allowed in the template. (Thanks Desmond Daignault, Kivanc Yazan, CJM) 71 | [55696] 72 | - Fix templates with inline comments without newline after comment for perl 73 | < 5.18 [34292] 74 | - Don't use bareword file handles 75 | - use three arg form of open() 76 | - Fix BROKEN behaviour so that it returns the text accumulated so far on 77 | undef as documented [28974] 78 | - Source code cleanups 79 | - Minimum perl version is now 5.8.0 80 | - Allow start/end delimiters to be identical (e.g.: @@foo@@, XXfooXX) 81 | (Thanks mirod) [46639] 82 | - Fix + document the FILENAME parameter to fill_in() (Thanks VDB) [106093] 83 | - Test suite cleanups: 84 | + turn on strict/warnings for all tests 85 | + run tests through perltidy and formatting cleanup 86 | + remove number prefixes from test names 87 | + use Test::More instead of generating TAP by hand 88 | + use three-arg form of open() 89 | + don't use indirect object syntax 90 | + don't use bareword file handles 91 | + use File::Temp to generate temporary files 92 | 93 | 1.47 2017-02-27 94 | - Fix longstanding memory leak in _scrubpkg() [#22031] 95 | - Fix various spelling errors [#86872] 96 | 97 | NOTE: Changes for versions prior to 1.47 have been imported from README 98 | 99 | 1.46 2013-02-11 100 | - Thanks to Rik Signes, there is a new 101 | Text::Template->append_text_to_output method, which Text::Template always 102 | uses whenever it wants to emit output. You can subclass this to get 103 | control over the output, for example for postprocessing. 104 | - A spurious warning is no longer emitted when the TYPE parameter to ->new 105 | is omitted. 106 | 107 | 1.45 2008-04-16 108 | 109 | 1.44 2003-04-29 110 | - This is a maintenance release. There are no feature changes. 111 | - _scrubpkg, which was responsible for eptying out temporary packages after 112 | the module had done with them, wasn't always working; the result was 113 | memory leaks in long-running applications. This should be fixed now, and 114 | there is a test in the test suite for it. 115 | - Minor changes to the test suite to prevent spurious errors. 116 | - Minor documentation changes. 117 | 118 | 1.43 2002-03-25 119 | - The ->new method now fails immediately and sets $Text::Template::ERROR if 120 | the file that is named by a filename argument does not exist or cannot be 121 | opened for some other reason. Formerly, the constructor would succeed 122 | and the ->fill_in call would fail. 123 | 124 | 1.42 2001-11-05 125 | - This is a maintenance release. There are no feature changes. 126 | - Fixed a bug relating to use of UNTAINT under perl 5.005_03 and possibly 127 | other versions. 128 | - Taint-related tests are now more comprehensive. 129 | 130 | 1.41 2001-09-04 131 | - This is a maintenance release. There are no feature changes. 132 | - Tests now work correctly on Windows systems and possibly on other 133 | non-unix systems. 134 | 135 | 1.40 2001-08-30 136 | *** INCOMPATIBLE CHANGE *** 137 | - The format of the default error message has changed. It used to look 138 | like: 139 | 140 | Program fragment at line 30 delivered error ``Illegal division by zero'' 141 | 142 | It now looks like: 143 | 144 | Program fragment delivered error ``Illegal division by zero at catalog.tmpl line 37'' 145 | 146 | Note that the default message used to report the line number at which the 147 | program fragment began; it now reports the line number at which the error 148 | actually occurred. 149 | 150 | *** INCOMPATIBLE CHANGE *** 151 | - The format of the default error message has changed. It used to look like: 152 | 153 | Program fragment at line 30 delivered error ``Illegal division by zero'' 154 | 155 | It now looks like: 156 | 157 | Program fragment delivered error ``Illegal division by zero at catalog.tmpl line 37'' 158 | 159 | - Note that the default message used to report the line number at which the 160 | program fragment began; it now reports the line number at which the error 161 | actually occurred. 162 | - New UNTAINT option tells the module that it is safe to 'eval' code even 163 | though it has come from a file or filehandle. 164 | - Code added to prevent memory leaks when filling many templates. Thanks 165 | to Itamar Almeida de Carvalho. 166 | - Bug fix: $OUT was not correctly initialized when used in conjunction 167 | with SAFE. 168 | - You may now use a glob ref when passing a filehandle to the ->new 169 | function. Formerly, a glob was required. 170 | - New subclass: Text::Template::Preprocess. Just like Text::Template, but 171 | you may supply a PREPROCESS option in the constructor or the fill_in 172 | call; this is a function which receives each code fragment prior to 173 | evaluation, and which may modify and return the fragment; the modified 174 | fragment is what is evaluated. 175 | - Error messages passed to BROKEN subroutines will now report the correct 176 | line number of the template at which the error occurred: 177 | 178 | Illegal division by zero at template line 37. 179 | 180 | - If the template comes from a file, the filename will be reported as well: 181 | 182 | Illegal division by zero at catalog.tmpl line 37. 183 | 184 | - New UNTAINT option tells the module that it is safe to eval template code 185 | even if it has come from a file or filehandle, disabling taint checking 186 | in these cases. 187 | - Code added to prevent memory leaks when filling many templates. Thanks to 188 | Itamar Almeida de Carvalho. 189 | - Bug fix: $OUT was not always correctly initialized when used in 190 | conjunction with SAFE. 191 | - You may now use a glob ref when passing a filehandle to the new function. 192 | Formerly, a glob was required. 193 | - Error messages passed to BROKEN subroutines will now report the correct 194 | line number of the template at which the error occurred: 195 | 196 | Illegal division by zero at template line 37. 197 | 198 | If the template comes from a file, the filename will be reported as well: 199 | 200 | Illegal division by zero at catalog.tmpl line 37. 201 | 202 | - New subclass: Text::Template::Preprocess. Just like Text::Template, but 203 | you may supply a PREPROCESS option in the fill_in call; this is a 204 | function which receives each code fragment prior to evaluation, and which 205 | may modify and return the fragment; the modified fragment is what is 206 | evaluated. 207 | 208 | 1.31 2001-02-05 209 | - Maintenance and bug fix release 210 | - fill_in_string was failing. Thanks to Donald L. Greer Jr. for the test case. 211 | 212 | 1.23 1999-12-21 213 | - Small bug fix: DELIMITER and other arguments were being ignored in calls 214 | to fill_in_file and fill_this_in. (Thanks to Jonathan Roy for reporting 215 | this.) 216 | 217 | 1.22 218 | - You can now specify that certain Perl statements be prepended to the 219 | beginning of every program fragment in a template, either per template, 220 | or for all templates, or for the duration of only one call to fill_in. 221 | This is useful, for example, if you want to enable `strict' checks in 222 | your templates but you don't want to manually add `use strict' to the 223 | front of every program fragment everywhere. 224 | 225 | 1.20 1999-03-08 226 | - You can now specify that the program fragment delimiters are strings 227 | other than { and }. This has three interesting effects: First, it 228 | changes the delimiter strings. Second, it disables the special meaning 229 | of \, so you have to be really, really sure that the delimiters will not 230 | appear in your templates. And third, because of the simplifications 231 | introduced by the elimination of \ processing, template parsing is 20-25% 232 | faster. See the manual section on `Alternative Delimiters'. 233 | - Fixed bug having to do with undefined values in HASH options. In 234 | particular, Text::Template no longer generates a warning if you try to 235 | give a variable an undefined value. 236 | 237 | 1.12 1999-02-28 238 | - I forgot to say that Text::Template ISA Exporter, so the exported 239 | functions never got exported. Duhhh! 240 | - Template TYPEs are now case-insensitive. The `new' method now diagnoses 241 | attempts to use an invalid TYPE. 242 | - More tests for these things. 243 | 244 | 1.11 1999-02-25 245 | - Fixed a bug in the way backslashes were processed. The 1.10 behavior was 246 | incompatible with the beta versions and was also inconvenient. (`\n' in 247 | templates was replaced with `n' before it was given to Perl for 248 | evaluation.) The new behavior is also incompatible with the beta 249 | versions, but it is only a little bit incompatible, and it is probably 250 | better. 251 | - Documentation for the new behavior, and tests for the bug. 252 | 253 | 1.10 1999-02-13 254 | - New OUTPUT option delivers template results directly to a filehandle 255 | instead of making them into a string. Saves space and time. 256 | - PACKAGE and HASH now work intelligently with SAFE. 257 | - Fragments may now output data directly to the template, rather than 258 | having to arrange to return it as a return value at the end. This means 259 | that where you used to have to write this: 260 | 261 | { my $blist = ''; 262 | foreach $i (@items) { 263 | $blist .= qq{ * $i\n}; 264 | } 265 | $blist; 266 | } 267 | 268 | You can now write this instead, because $OUT is special. 269 | 270 | { foreach $i (@items) { 271 | $OUT.= " * $i\n"; 272 | } 273 | } 274 | 275 | (`A spoonful of sugar makes the medicine go down.') 276 | - Fixed some small bugs. Worked around a bug in Perl that does the wrong 277 | thing with $x = when $x contains a glob. 278 | - More documentation. Errors fixed. 279 | - Lots more tests. 280 | 281 | 1.03 1999-02-06 282 | - Code added to support HASH option to fill_in. (Incl. `_gensym' 283 | function.) 284 | - Documentation for HASH. 285 | - New test file for HASH. 286 | - Note about failure of lexical variables to propagate into templates. Why 287 | does this surprise people? 288 | - Bug fix: program fragments are evaluated in an environment with `no 289 | strict' by default. Otherwise, you get a lot of `Global symbol "$v" 290 | requires explicit package name' failures. Why didn't the test program 291 | pick this up? Because the only variable the test program ever used was 292 | `$a', which is exempt. Duhhhhh. 293 | - Fixed the test program. 294 | - Various minor documentation fixes. 295 | 296 | 1.00 1999-02-05 297 | This is a complete rewrite. The new version delivers better functionality 298 | but is only 2/3 as long, which I think is a good sign. It is supposed to be 299 | 100% backward-compatible with the previous versions. With one cosmetic 300 | change, it passes the test suite that the previous versions passed. If you 301 | have compatibility problems, please mail me immediately. 302 | 303 | - At least twice as fast 304 | - Better support for filling out the same template more than once 305 | - Now supports evaluation of program fragments in Safe compartments. 306 | (Thanks, Jonathan!) 307 | - Better argument syntax 308 | - More convenience functions 309 | - The parser is much better and simpler 310 | - Once a template is parsed, the parsed version is stored so that 311 | it needn't be parsed again. 312 | - BROKEN function behavior is rationalized. You can now pass an 313 | arbitrary argument to your BROKEN function, or return a value 314 | from it to the main program. 315 | - Documentation overhauled. 316 | 317 | Previous Versions 318 | - Maintained by Mark Jason Dominus (MJD) 319 | -------------------------------------------------------------------------------- /INSTALL: -------------------------------------------------------------------------------- 1 | 2 | To install: 3 | 4 | perl Makefile.PL 5 | 6 | to construct the Makefile, then 7 | 8 | make test 9 | 10 | to test the package. If it fails any tests, please send me the output 11 | of `make test' and `perl -V'. I'll tell you whether it is safe to go 12 | ahead, or I'll provide a fix. 13 | 14 | If it passes the tests, use 15 | 16 | make install 17 | 18 | to install it. 19 | 20 | Detailed documentation is at the bottom of the lib/Text/Template.pm 21 | file. You may be able to view it with the following command: 22 | 23 | perldoc Text::Template 24 | 25 | Or: 26 | 27 | perldoc lib/Text/Template.pm 28 | 29 | If you have problems, send me mail: 30 | 31 | mjd-perl-template+@plover.com 32 | -------------------------------------------------------------------------------- /MANIFEST.SKIP: -------------------------------------------------------------------------------- 1 | # Avoid Makemaker generated and utility files. 2 | \bMANIFEST\.bak 3 | \bMakefile$ 4 | \bblib/ 5 | \bMakeMaker-\d 6 | \bpm_to_blib\.ts$ 7 | \bpm_to_blib$ 8 | \bblibdirs\.ts$ # 6.18 through 6.25 generated this 9 | 10 | # Avoid temp and backup files. 11 | ~$ 12 | \.old$ 13 | \#$ 14 | \b\.# 15 | \.bak$ 16 | 17 | \.lwpcookies 18 | \.releaserc 19 | .+\.diff 20 | .+\.patch 21 | .+\.bak 22 | .+~ 23 | .+\.orig 24 | .+\.rej 25 | .hg 26 | .shipit 27 | .git 28 | blib 29 | dist.ini 30 | _build 31 | ^Build$ 32 | Makefile$ 33 | MYMETA.yml 34 | MANIFEST.SKIP 35 | Text-Template-.+.tar.gz 36 | ^MYMETA\.json$ 37 | ^tools/.*$ 38 | ^\.appveyor\..* 39 | -------------------------------------------------------------------------------- /README: -------------------------------------------------------------------------------- 1 | 2 | Text::Template 3 | 4 | This is a library for generating form letters, building HTML pages, or 5 | filling in templates generally. A `template' is a piece of text that 6 | has little Perl programs embedded in it here and there. When you 7 | `fill in' a template, you evaluate the little programs and replace 8 | them with their values. 9 | 10 | Here's an example of a template: 11 | 12 | Dear {$title} {$lastname}, 13 | 14 | It has come to our attention that you are delinquent in your 15 | {$monthname[$last_paid_month]} payment. Please remit 16 | ${sprintf("%.2f", $amount)} immediately, or your patellae may 17 | be needlessly endangered. 18 | 19 | Love, 20 | 21 | Mark "{nickname(rand 20)}" Dominus 22 | 23 | 24 | The result of filling in this template is a string, which might look 25 | something like this: 26 | 27 | Dear Mr. Gates, 28 | 29 | It has come to our attention that you are delinquent in your 30 | February payment. Please remit 31 | $392.12 immediately, or your patellae may 32 | be needlessly endangered. 33 | 34 | 35 | Love, 36 | 37 | Mark "Vizopteryx" Dominus 38 | 39 | You can store a template in a file outside your program. People can 40 | modify the template without modifying the program. You can separate 41 | the formatting details from the main code, and put the formatting 42 | parts of the program into the template. That prevents code bloat and 43 | encourages functional separation. 44 | 45 | You can fill in the template in a `Safe' compartment. This means that 46 | if you don't trust the person who wrote the code in the template, you 47 | won't have to worry that they are tampering with your program when you 48 | execute it. 49 | 50 | ---------------------------------------------------------------- 51 | 52 | Text::Template was originally released some time in late 1995 or early 53 | 1996. After three years of study and investigation, I rewrote it from 54 | scratch in January 1999. The new version, 1.0, was much faster, 55 | delivered better functionality and was almost 100% backward-compatible 56 | with the previous beta versions. 57 | 58 | I have added a number of useful features and conveniences since the 59 | 1.0 release, while still retaining backward compatibility. With one 60 | merely cosmetic change, the current version of Text::Template passes 61 | the test suite that the old beta versions passed. 62 | 63 | -------------------------------------------------------------------------------- /dist.ini: -------------------------------------------------------------------------------- 1 | name = Text-Template 2 | author = Michael Schout 3 | license = Perl_5 4 | copyright_holder = Mark Jason Dominus 5 | copyright_year = 2013 6 | 7 | [@MSCHOUT] 8 | -remove = Readme 9 | -remove = PodCoverageTests 10 | use_twitter = 1 11 | -------------------------------------------------------------------------------- /lib/Text/Template.pm: -------------------------------------------------------------------------------- 1 | # -*- perl -*- 2 | # Text::Template.pm 3 | # 4 | # Fill in `templates' 5 | # 6 | # Copyright 2013 M. J. Dominus. 7 | # You may copy and distribute this program under the 8 | # same terms as Perl itself. 9 | # If in doubt, write to mjd-perl-template+@plover.com for a license. 10 | # 11 | 12 | package Text::Template; 13 | 14 | # ABSTRACT: Expand template text with embedded Perl 15 | 16 | use strict; 17 | use warnings; 18 | 19 | require 5.008; 20 | 21 | use base 'Exporter'; 22 | 23 | our @EXPORT_OK = qw(fill_in_file fill_in_string TTerror); 24 | our $ERROR; 25 | 26 | my %GLOBAL_PREPEND = ('Text::Template' => ''); 27 | 28 | sub Version { 29 | $Text::Template::VERSION; 30 | } 31 | 32 | sub _param { 33 | my ($k, %h) = @_; 34 | 35 | for my $kk ($k, "\u$k", "\U$k", "-$k", "-\u$k", "-\U$k") { 36 | return $h{$kk} if exists $h{$kk}; 37 | } 38 | 39 | return undef; 40 | } 41 | 42 | sub always_prepend { 43 | my $pack = shift; 44 | 45 | my $old = $GLOBAL_PREPEND{$pack}; 46 | 47 | $GLOBAL_PREPEND{$pack} = shift; 48 | 49 | $old; 50 | } 51 | 52 | { 53 | my %LEGAL_TYPE; 54 | 55 | BEGIN { 56 | %LEGAL_TYPE = map { $_ => 1 } qw(FILE FILEHANDLE STRING ARRAY); 57 | } 58 | 59 | sub new { 60 | my ($pack, %a) = @_; 61 | 62 | my $stype = uc(_param('type', %a) || "FILE"); 63 | my $source = _param('source', %a); 64 | my $untaint = _param('untaint', %a); 65 | my $prepend = _param('prepend', %a); 66 | my $alt_delim = _param('delimiters', %a); 67 | my $broken = _param('broken', %a); 68 | my $encoding = _param('encoding', %a); 69 | 70 | unless (defined $source) { 71 | require Carp; 72 | Carp::croak("Usage: $ {pack}::new(TYPE => ..., SOURCE => ...)"); 73 | } 74 | 75 | unless ($LEGAL_TYPE{$stype}) { 76 | require Carp; 77 | Carp::croak("Illegal value `$stype' for TYPE parameter"); 78 | } 79 | 80 | my $self = { 81 | TYPE => $stype, 82 | PREPEND => $prepend, 83 | UNTAINT => $untaint, 84 | BROKEN => $broken, 85 | ENCODING => $encoding, 86 | (defined $alt_delim ? (DELIM => $alt_delim) : ()) 87 | }; 88 | 89 | # Under 5.005_03, if any of $stype, $prepend, $untaint, or $broken 90 | # are tainted, all the others become tainted too as a result of 91 | # sharing the expression with them. We install $source separately 92 | # to prevent it from acquiring a spurious taint. 93 | $self->{SOURCE} = $source; 94 | 95 | bless $self => $pack; 96 | return unless $self->_acquire_data; 97 | 98 | $self; 99 | } 100 | } 101 | 102 | # Convert template objects of various types to type STRING, 103 | # in which the template data is embedded in the object itself. 104 | sub _acquire_data { 105 | my $self = shift; 106 | 107 | my $type = $self->{TYPE}; 108 | 109 | if ($type eq 'STRING') { 110 | # nothing necessary 111 | } 112 | elsif ($type eq 'FILE') { 113 | my $data = _load_text($self->{SOURCE}); 114 | unless (defined $data) { 115 | 116 | # _load_text already set $ERROR 117 | return undef; 118 | } 119 | 120 | if ($self->{UNTAINT} && _is_clean($self->{SOURCE})) { 121 | _unconditionally_untaint($data); 122 | } 123 | 124 | if (defined $self->{ENCODING}) { 125 | require Encode; 126 | $data = Encode::decode($self->{ENCODING}, $data, &Encode::FB_CROAK); 127 | } 128 | 129 | $self->{TYPE} = 'STRING'; 130 | $self->{FILENAME} = $self->{SOURCE}; 131 | $self->{SOURCE} = $data; 132 | } 133 | elsif ($type eq 'ARRAY') { 134 | $self->{TYPE} = 'STRING'; 135 | $self->{SOURCE} = join '', @{ $self->{SOURCE} }; 136 | } 137 | elsif ($type eq 'FILEHANDLE') { 138 | $self->{TYPE} = 'STRING'; 139 | local $/; 140 | my $fh = $self->{SOURCE}; 141 | my $data = <$fh>; # Extra assignment avoids bug in Solaris perl5.00[45]. 142 | if ($self->{UNTAINT}) { 143 | _unconditionally_untaint($data); 144 | } 145 | $self->{SOURCE} = $data; 146 | } 147 | else { 148 | # This should have been caught long ago, so it represents a 149 | # drastic `can't-happen' sort of failure 150 | my $pack = ref $self; 151 | die "Can only acquire data for $pack objects of subtype STRING, but this is $type; aborting"; 152 | } 153 | 154 | $self->{DATA_ACQUIRED} = 1; 155 | } 156 | 157 | sub source { 158 | my $self = shift; 159 | 160 | $self->_acquire_data unless $self->{DATA_ACQUIRED}; 161 | 162 | return $self->{SOURCE}; 163 | } 164 | 165 | sub set_source_data { 166 | my ($self, $newdata, $type) = @_; 167 | 168 | $self->{SOURCE} = $newdata; 169 | $self->{DATA_ACQUIRED} = 1; 170 | $self->{TYPE} = $type || 'STRING'; 171 | 172 | 1; 173 | } 174 | 175 | sub compile { 176 | my $self = shift; 177 | 178 | return 1 if $self->{TYPE} eq 'PREPARSED'; 179 | 180 | return undef unless $self->_acquire_data; 181 | 182 | unless ($self->{TYPE} eq 'STRING') { 183 | my $pack = ref $self; 184 | 185 | # This should have been caught long ago, so it represents a 186 | # drastic `can't-happen' sort of failure 187 | die "Can only compile $pack objects of subtype STRING, but this is $self->{TYPE}; aborting"; 188 | } 189 | 190 | my @tokens; 191 | my $delim_pats = shift() || $self->{DELIM}; 192 | 193 | my ($t_open, $t_close) = ('{', '}'); 194 | my $DELIM; # Regex matches a delimiter if $delim_pats 195 | 196 | if (defined $delim_pats) { 197 | ($t_open, $t_close) = @$delim_pats; 198 | $DELIM = "(?:(?:\Q$t_open\E)|(?:\Q$t_close\E))"; 199 | @tokens = split /($DELIM|\n)/, $self->{SOURCE}; 200 | } 201 | else { 202 | @tokens = split /(\\\\(?=\\*[{}])|\\[{}]|[{}\n])/, $self->{SOURCE}; 203 | } 204 | 205 | my $state = 'TEXT'; 206 | my $depth = 0; 207 | my $lineno = 1; 208 | my @content; 209 | my $cur_item = ''; 210 | my $prog_start; 211 | 212 | while (@tokens) { 213 | my $t = shift @tokens; 214 | 215 | next if $t eq ''; 216 | 217 | if ($t eq $t_open) { # Brace or other opening delimiter 218 | if ($depth == 0) { 219 | push @content, [ $state, $cur_item, $lineno ] if $cur_item ne ''; 220 | $cur_item = ''; 221 | $state = 'PROG'; 222 | $prog_start = $lineno; 223 | } 224 | else { 225 | $cur_item .= $t; 226 | } 227 | $depth++; 228 | } 229 | elsif ($t eq $t_close) { # Brace or other closing delimiter 230 | $depth--; 231 | if ($depth < 0) { 232 | $ERROR = "Unmatched close brace at line $lineno"; 233 | return undef; 234 | } 235 | elsif ($depth == 0) { 236 | push @content, [ $state, $cur_item, $prog_start ] if $cur_item ne ''; 237 | $state = 'TEXT'; 238 | $cur_item = ''; 239 | } 240 | else { 241 | $cur_item .= $t; 242 | } 243 | } 244 | elsif (!$delim_pats && $t eq '\\\\') { # precedes \\\..\\\{ or \\\..\\\} 245 | $cur_item .= '\\'; 246 | } 247 | elsif (!$delim_pats && $t =~ /^\\([{}])$/) { # Escaped (literal) brace? 248 | $cur_item .= $1; 249 | } 250 | elsif ($t eq "\n") { # Newline 251 | $lineno++; 252 | $cur_item .= $t; 253 | } 254 | else { # Anything else 255 | $cur_item .= $t; 256 | } 257 | } 258 | 259 | if ($state eq 'PROG') { 260 | $ERROR = "End of data inside program text that began at line $prog_start"; 261 | return undef; 262 | } 263 | elsif ($state eq 'TEXT') { 264 | push @content, [ $state, $cur_item, $lineno ] if $cur_item ne ''; 265 | } 266 | else { 267 | die "Can't happen error #1"; 268 | } 269 | 270 | $self->{TYPE} = 'PREPARSED'; 271 | $self->{SOURCE} = \@content; 272 | 273 | 1; 274 | } 275 | 276 | sub prepend_text { 277 | my $self = shift; 278 | 279 | my $t = $self->{PREPEND}; 280 | 281 | unless (defined $t) { 282 | $t = $GLOBAL_PREPEND{ ref $self }; 283 | unless (defined $t) { 284 | $t = $GLOBAL_PREPEND{'Text::Template'}; 285 | } 286 | } 287 | 288 | $self->{PREPEND} = $_[1] if $#_ >= 1; 289 | 290 | return $t; 291 | } 292 | 293 | sub fill_in { 294 | my ($fi_self, %fi_a) = @_; 295 | 296 | unless ($fi_self->{TYPE} eq 'PREPARSED') { 297 | my $delims = _param('delimiters', %fi_a); 298 | my @delim_arg = (defined $delims ? ($delims) : ()); 299 | $fi_self->compile(@delim_arg) 300 | or return undef; 301 | } 302 | 303 | my $fi_varhash = _param('hash', %fi_a); 304 | my $fi_package = _param('package', %fi_a); 305 | my $fi_broken = _param('broken', %fi_a) || $fi_self->{BROKEN} || \&_default_broken; 306 | my $fi_broken_arg = _param('broken_arg', %fi_a) || []; 307 | my $fi_safe = _param('safe', %fi_a); 308 | my $fi_ofh = _param('output', %fi_a); 309 | my $fi_filename = _param('filename', %fi_a) || $fi_self->{FILENAME} || 'template'; 310 | my $fi_strict = _param('strict', %fi_a); 311 | my $fi_prepend = _param('prepend', %fi_a); 312 | 313 | my $fi_eval_package; 314 | my $fi_scrub_package = 0; 315 | 316 | unless (defined $fi_prepend) { 317 | $fi_prepend = $fi_self->prepend_text; 318 | } 319 | 320 | if (defined $fi_safe) { 321 | $fi_eval_package = 'main'; 322 | } 323 | elsif (defined $fi_package) { 324 | $fi_eval_package = $fi_package; 325 | } 326 | elsif (defined $fi_varhash) { 327 | $fi_eval_package = _gensym(); 328 | $fi_scrub_package = 1; 329 | } 330 | else { 331 | $fi_eval_package = caller; 332 | } 333 | 334 | my @fi_varlist; 335 | my $fi_install_package; 336 | 337 | if (defined $fi_varhash) { 338 | if (defined $fi_package) { 339 | $fi_install_package = $fi_package; 340 | } 341 | elsif (defined $fi_safe) { 342 | $fi_install_package = $fi_safe->root; 343 | } 344 | else { 345 | $fi_install_package = $fi_eval_package; # The gensymmed one 346 | } 347 | @fi_varlist = _install_hash($fi_varhash => $fi_install_package); 348 | if ($fi_strict) { 349 | $fi_prepend = "use vars qw(@fi_varlist);$fi_prepend" if @fi_varlist; 350 | $fi_prepend = "use strict;$fi_prepend"; 351 | } 352 | } 353 | 354 | if (defined $fi_package && defined $fi_safe) { 355 | no strict 'refs'; 356 | 357 | # Big fat magic here: Fix it so that the user-specified package 358 | # is the default one available in the safe compartment. 359 | *{ $fi_safe->root . '::' } = \%{ $fi_package . '::' }; # LOD 360 | } 361 | 362 | my $fi_r = ''; 363 | my $fi_item; 364 | foreach $fi_item (@{ $fi_self->{SOURCE} }) { 365 | my ($fi_type, $fi_text, $fi_lineno) = @$fi_item; 366 | if ($fi_type eq 'TEXT') { 367 | $fi_self->append_text_to_output( 368 | text => $fi_text, 369 | handle => $fi_ofh, 370 | out => \$fi_r, 371 | type => $fi_type,); 372 | } 373 | elsif ($fi_type eq 'PROG') { 374 | no strict; 375 | 376 | my $fi_lcomment = "#line $fi_lineno $fi_filename"; 377 | my $fi_progtext = "package $fi_eval_package; $fi_prepend;\n$fi_lcomment\n$fi_text;\n;"; 378 | my $fi_res; 379 | my $fi_eval_err = ''; 380 | 381 | if ($fi_safe) { 382 | no strict; 383 | no warnings; 384 | 385 | $fi_safe->reval(q{undef $OUT}); 386 | $fi_res = $fi_safe->reval($fi_progtext); 387 | $fi_eval_err = $@; 388 | my $OUT = $fi_safe->reval('$OUT'); 389 | $fi_res = $OUT if defined $OUT; 390 | } 391 | else { 392 | no strict; 393 | no warnings; 394 | 395 | my $OUT; 396 | $fi_res = eval $fi_progtext; 397 | $fi_eval_err = $@; 398 | $fi_res = $OUT if defined $OUT; 399 | } 400 | 401 | # If the value of the filled-in text really was undef, 402 | # change it to an explicit empty string to avoid undefined 403 | # value warnings later. 404 | $fi_res = '' unless defined $fi_res; 405 | 406 | if ($fi_eval_err) { 407 | $fi_res = $fi_broken->( 408 | text => $fi_text, 409 | error => $fi_eval_err, 410 | lineno => $fi_lineno, 411 | arg => $fi_broken_arg,); 412 | if (defined $fi_res) { 413 | $fi_self->append_text_to_output( 414 | text => $fi_res, 415 | handle => $fi_ofh, 416 | out => \$fi_r, 417 | type => $fi_type,); 418 | } 419 | else { 420 | return $fi_r; # Undefined means abort processing 421 | } 422 | } 423 | else { 424 | $fi_self->append_text_to_output( 425 | text => $fi_res, 426 | handle => $fi_ofh, 427 | out => \$fi_r, 428 | type => $fi_type,); 429 | } 430 | } 431 | else { 432 | die "Can't happen error #2"; 433 | } 434 | } 435 | 436 | _scrubpkg($fi_eval_package) if $fi_scrub_package; 437 | 438 | defined $fi_ofh ? 1 : $fi_r; 439 | } 440 | 441 | sub append_text_to_output { 442 | my ($self, %arg) = @_; 443 | 444 | if (defined $arg{handle}) { 445 | print { $arg{handle} } $arg{text}; 446 | } 447 | else { 448 | ${ $arg{out} } .= $arg{text}; 449 | } 450 | 451 | return; 452 | } 453 | 454 | sub fill_this_in { 455 | my ($pack, $text) = splice @_, 0, 2; 456 | 457 | my $templ = $pack->new(TYPE => 'STRING', SOURCE => $text, @_) 458 | or return undef; 459 | 460 | $templ->compile or return undef; 461 | 462 | my $result = $templ->fill_in(@_); 463 | 464 | $result; 465 | } 466 | 467 | sub fill_in_string { 468 | my $string = shift; 469 | 470 | my $package = _param('package', @_); 471 | 472 | push @_, 'package' => scalar(caller) unless defined $package; 473 | 474 | Text::Template->fill_this_in($string, @_); 475 | } 476 | 477 | sub fill_in_file { 478 | my $fn = shift; 479 | my $templ = Text::Template->new(TYPE => 'FILE', SOURCE => $fn, @_) or return undef; 480 | 481 | $templ->compile or return undef; 482 | 483 | my $text = $templ->fill_in(@_); 484 | 485 | $text; 486 | } 487 | 488 | sub _default_broken { 489 | my %a = @_; 490 | 491 | my $prog_text = $a{text}; 492 | my $err = $a{error}; 493 | my $lineno = $a{lineno}; 494 | 495 | chomp $err; 496 | 497 | # $err =~ s/\s+at .*//s; 498 | "Program fragment delivered error ``$err''"; 499 | } 500 | 501 | sub _load_text { 502 | my $fn = shift; 503 | 504 | open my $fh, '<', $fn or do { 505 | $ERROR = "Couldn't open file $fn: $!"; 506 | return undef; 507 | }; 508 | 509 | local $/; 510 | 511 | <$fh>; 512 | } 513 | 514 | sub _is_clean { 515 | my $z; 516 | 517 | eval { ($z = join('', @_)), eval '#' . substr($z, 0, 0); 1 } # LOD 518 | } 519 | 520 | sub _unconditionally_untaint { 521 | for (@_) { 522 | ($_) = /(.*)/s; 523 | } 524 | } 525 | 526 | { 527 | my $seqno = 0; 528 | 529 | sub _gensym { 530 | __PACKAGE__ . '::GEN' . $seqno++; 531 | } 532 | 533 | sub _scrubpkg { 534 | my $s = shift; 535 | 536 | $s =~ s/^Text::Template:://; 537 | 538 | no strict 'refs'; 539 | 540 | my $hash = $Text::Template::{ $s . "::" }; 541 | 542 | foreach my $key (keys %$hash) { 543 | undef $hash->{$key}; 544 | } 545 | 546 | %$hash = (); 547 | 548 | delete $Text::Template::{ $s . "::" }; 549 | } 550 | } 551 | 552 | # Given a hashful of variables (or a list of such hashes) 553 | # install the variables into the specified package, 554 | # overwriting whatever variables were there before. 555 | sub _install_hash { 556 | my $hashlist = shift; 557 | my $dest = shift; 558 | 559 | if (UNIVERSAL::isa($hashlist, 'HASH')) { 560 | $hashlist = [$hashlist]; 561 | } 562 | 563 | my @varlist; 564 | 565 | for my $hash (@$hashlist) { 566 | for my $name (keys %$hash) { 567 | my $val = $hash->{$name}; 568 | 569 | no strict 'refs'; 570 | no warnings 'redefine'; 571 | 572 | local *SYM = *{"$ {dest}::$name"}; 573 | 574 | if (!defined $val) { 575 | delete ${"$ {dest}::"}{$name}; 576 | my $match = qr/^.\Q$name\E$/; 577 | @varlist = grep { $_ !~ $match } @varlist; 578 | } 579 | elsif (ref $val) { 580 | *SYM = $val; 581 | push @varlist, do { 582 | if (UNIVERSAL::isa($val, 'ARRAY')) { '@' } 583 | elsif (UNIVERSAL::isa($val, 'HASH')) { '%' } 584 | else { '$' } 585 | } 586 | . $name; 587 | } 588 | else { 589 | *SYM = \$val; 590 | push @varlist, '$' . $name; 591 | } 592 | } 593 | } 594 | 595 | @varlist; 596 | } 597 | 598 | sub TTerror { $ERROR } 599 | 600 | 1; 601 | 602 | __END__ 603 | 604 | =encoding UTF-8 605 | 606 | =head1 SYNOPSIS 607 | 608 | use Text::Template; 609 | 610 | 611 | $template = Text::Template->new(TYPE => 'FILE', SOURCE => 'filename.tmpl'); 612 | $template = Text::Template->new(TYPE => 'ARRAY', SOURCE => [ ... ] ); 613 | $template = Text::Template->new(TYPE => 'FILEHANDLE', SOURCE => $fh ); 614 | $template = Text::Template->new(TYPE => 'STRING', SOURCE => '...' ); 615 | $template = Text::Template->new(PREPEND => q{use strict;}, ...); 616 | 617 | # Use a different template file syntax: 618 | $template = Text::Template->new(DELIMITERS => [$open, $close], ...); 619 | 620 | $recipient = 'King'; 621 | $text = $template->fill_in(); # Replaces `{$recipient}' with `King' 622 | print $text; 623 | 624 | $T::recipient = 'Josh'; 625 | $text = $template->fill_in(PACKAGE => T); 626 | 627 | # Pass many variables explicitly 628 | $hash = { recipient => 'Abed-Nego', 629 | friends => [ 'me', 'you' ], 630 | enemies => { loathsome => 'Saruman', 631 | fearsome => 'Sauron' }, 632 | }; 633 | $text = $template->fill_in(HASH => $hash, ...); 634 | # $recipient is Abed-Nego, 635 | # @friends is ( 'me', 'you' ), 636 | # %enemies is ( loathsome => ..., fearsome => ... ) 637 | 638 | 639 | # Call &callback in case of programming errors in template 640 | $text = $template->fill_in(BROKEN => \&callback, BROKEN_ARG => $ref, ...); 641 | 642 | # Evaluate program fragments in Safe compartment with restricted permissions 643 | $text = $template->fill_in(SAFE => $compartment, ...); 644 | 645 | # Print result text instead of returning it 646 | $success = $template->fill_in(OUTPUT => \*FILEHANDLE, ...); 647 | 648 | # Parse template with different template file syntax: 649 | $text = $template->fill_in(DELIMITERS => [$open, $close], ...); 650 | # Note that this is *faster* than using the default delimiters 651 | 652 | # Prepend specified perl code to each fragment before evaluating: 653 | $text = $template->fill_in(PREPEND => q{use strict 'vars';}, ...); 654 | 655 | use Text::Template 'fill_in_string'; 656 | $text = fill_in_string( <<'EOM', PACKAGE => 'T', ...); 657 | Dear {$recipient}, 658 | Pay me at once. 659 | Love, 660 | G.V. 661 | EOM 662 | 663 | use Text::Template 'fill_in_file'; 664 | $text = fill_in_file($filename, ...); 665 | 666 | # All templates will always have `use strict vars' attached to all fragments 667 | Text::Template->always_prepend(q{use strict 'vars';}); 668 | 669 | =head1 DESCRIPTION 670 | 671 | This is a library for generating form letters, building HTML pages, or 672 | filling in templates generally. A `template' is a piece of text that 673 | has little Perl programs embedded in it here and there. When you 674 | `fill in' a template, you evaluate the little programs and replace 675 | them with their values. 676 | 677 | You can store a template in a file outside your program. People can 678 | modify the template without modifying the program. You can separate 679 | the formatting details from the main code, and put the formatting 680 | parts of the program into the template. That prevents code bloat and 681 | encourages functional separation. 682 | 683 | =head2 Example 684 | 685 | Here's an example of a template, which we'll suppose is stored in the 686 | file C: 687 | 688 | Dear {$title} {$lastname}, 689 | 690 | It has come to our attention that you are delinquent in your 691 | {$monthname[$last_paid_month]} payment. Please remit 692 | ${sprintf("%.2f", $amount)} immediately, or your patellae may 693 | be needlessly endangered. 694 | 695 | Love, 696 | 697 | Mark "Vizopteryx" Dominus 698 | 699 | 700 | The result of filling in this template is a string, which might look 701 | something like this: 702 | 703 | Dear Mr. Smith, 704 | 705 | It has come to our attention that you are delinquent in your 706 | February payment. Please remit 707 | $392.12 immediately, or your patellae may 708 | be needlessly endangered. 709 | 710 | 711 | Love, 712 | 713 | Mark "Vizopteryx" Dominus 714 | 715 | Here is a complete program that transforms the example 716 | template into the example result, and prints it out: 717 | 718 | use Text::Template; 719 | 720 | my $template = Text::Template->new(SOURCE => 'formletter.tmpl') 721 | or die "Couldn't construct template: $Text::Template::ERROR"; 722 | 723 | my @monthname = qw(January February March April May June 724 | July August September October November December); 725 | my %vars = (title => 'Mr.', 726 | firstname => 'John', 727 | lastname => 'Smith', 728 | last_paid_month => 1, # February 729 | amount => 392.12, 730 | monthname => \@monthname); 731 | 732 | my $result = $template->fill_in(HASH => \%vars); 733 | 734 | if (defined $result) { print $result } 735 | else { die "Couldn't fill in template: $Text::Template::ERROR" } 736 | 737 | 738 | =head2 Philosophy 739 | 740 | When people make a template module like this one, they almost always 741 | start by inventing a special syntax for substitutions. For example, 742 | they build it so that a string like C<%%VAR%%> is replaced with the 743 | value of C<$VAR>. Then they realize the need extra formatting, so 744 | they put in some special syntax for formatting. Then they need a 745 | loop, so they invent a loop syntax. Pretty soon they have a new 746 | little template language. 747 | 748 | This approach has two problems: First, their little language is 749 | crippled. If you need to do something the author hasn't thought of, 750 | you lose. Second: Who wants to learn another language? You already 751 | know Perl, so why not use it? 752 | 753 | C templates are programmed in I. You embed Perl 754 | code in your template, with C<{> at the beginning and C<}> at the end. 755 | If you want a variable interpolated, you write it the way you would in 756 | Perl. If you need to make a loop, you can use any of the Perl loop 757 | constructions. All the Perl built-in functions are available. 758 | 759 | =head1 Details 760 | 761 | =head2 Template Parsing 762 | 763 | The C module scans the template source. An open brace 764 | C<{> begins a program fragment, which continues until the matching 765 | close brace C<}>. When the template is filled in, the program 766 | fragments are evaluated, and each one is replaced with the resulting 767 | value to yield the text that is returned. 768 | 769 | A backslash C<\> in front of a brace (or another backslash that is in 770 | front of a brace) escapes its special meaning. The result of filling 771 | out this template: 772 | 773 | \{ The sum of 1 and 2 is {1+2} \} 774 | 775 | is 776 | 777 | { The sum of 1 and 2 is 3 } 778 | 779 | If you have an unmatched brace, C will return a 780 | failure code and a warning about where the problem is. Backslashes 781 | that do not precede a brace are passed through unchanged. If you have 782 | a template like this: 783 | 784 | { "String that ends in a newline.\n" } 785 | 786 | The backslash inside the string is passed through to Perl unchanged, 787 | so the C<\n> really does turn into a newline. See the note at the end 788 | for details about the way backslashes work. Backslash processing is 789 | I done when you specify alternative delimiters with the 790 | C option. (See L<"Alternative Delimiters">, below.) 791 | 792 | Each program fragment should be a sequence of Perl statements, which 793 | are evaluated the usual way. The result of the last statement 794 | executed will be evaluated in scalar context; the result of this 795 | statement is a string, which is interpolated into the template in 796 | place of the program fragment itself. 797 | 798 | The fragments are evaluated in order, and side effects from earlier 799 | fragments will persist into later fragments: 800 | 801 | {$x = @things; ''}The Lord High Chamberlain has gotten {$x} 802 | things for me this year. 803 | { $diff = $x - 17; 804 | $more = 'more' 805 | if ($diff == 0) { 806 | $diff = 'no'; 807 | } elsif ($diff < 0) { 808 | $more = 'fewer'; 809 | } 810 | ''; 811 | } 812 | That is {$diff} {$more} than he gave me last year. 813 | 814 | The value of C<$x> set in the first line will persist into the next 815 | fragment that begins on the third line, and the values of C<$diff> and 816 | C<$more> set in the second fragment will persist and be interpolated 817 | into the last line. The output will look something like this: 818 | 819 | The Lord High Chamberlain has gotten 42 820 | things for me this year. 821 | 822 | That is 25 more than he gave me last year. 823 | 824 | That is all the syntax there is. 825 | 826 | =head2 The C<$OUT> variable 827 | 828 | There is one special trick you can play in a template. Here is the 829 | motivation for it: Suppose you are going to pass an array, C<@items>, 830 | into the template, and you want the template to generate a bulleted 831 | list with a header, like this: 832 | 833 | Here is a list of the things I have got for you since 1907: 834 | * Ivory 835 | * Apes 836 | * Peacocks 837 | * ... 838 | 839 | One way to do it is with a template like this: 840 | 841 | Here is a list of the things I have got for you since 1907: 842 | { my $blist = ''; 843 | foreach $i (@items) { 844 | $blist .= qq{ * $i\n}; 845 | } 846 | $blist; 847 | } 848 | 849 | Here we construct the list in a variable called C<$blist>, which we 850 | return at the end. This is a little cumbersome. There is a shortcut. 851 | 852 | Inside of templates, there is a special variable called C<$OUT>. 853 | Anything you append to this variable will appear in the output of the 854 | template. Also, if you use C<$OUT> in a program fragment, the normal 855 | behavior, of replacing the fragment with its return value, is 856 | disabled; instead the fragment is replaced with the value of C<$OUT>. 857 | This means that you can write the template above like this: 858 | 859 | Here is a list of the things I have got for you since 1907: 860 | { foreach $i (@items) { 861 | $OUT .= " * $i\n"; 862 | } 863 | } 864 | 865 | C<$OUT> is reinitialized to the empty string at the start of each 866 | program fragment. It is private to C, so 867 | you can't use a variable named C<$OUT> in your template without 868 | invoking the special behavior. 869 | 870 | =head2 General Remarks 871 | 872 | All C functions return C on failure, and set the 873 | variable C<$Text::Template::ERROR> to contain an explanation of what 874 | went wrong. For example, if you try to create a template from a file 875 | that does not exist, C<$Text::Template::ERROR> will contain something like: 876 | 877 | Couldn't open file xyz.tmpl: No such file or directory 878 | 879 | =head2 C 880 | 881 | $template = Text::Template->new( TYPE => ..., SOURCE => ... ); 882 | 883 | This creates and returns a new template object. C returns 884 | C and sets C<$Text::Template::ERROR> if it can't create the 885 | template object. C says where the template source code will 886 | come from. C says what kind of object the source is. 887 | 888 | The most common type of source is a file: 889 | 890 | Text::Template->new( TYPE => 'FILE', SOURCE => $filename ); 891 | 892 | This reads the template from the specified file. The filename is 893 | opened with the Perl C command, so it can be a pipe or anything 894 | else that makes sense with C. 895 | 896 | The C can also be C, in which case the C should 897 | be a string: 898 | 899 | Text::Template->new( TYPE => 'STRING', 900 | SOURCE => "This is the actual template!" ); 901 | 902 | The C can be C, in which case the source should be a 903 | reference to an array of strings. The concatenation of these strings 904 | is the template: 905 | 906 | Text::Template->new( TYPE => 'ARRAY', 907 | SOURCE => [ "This is ", "the actual", 908 | " template!", 909 | ] 910 | ); 911 | 912 | The C can be FILEHANDLE, in which case the source should be an 913 | open filehandle (such as you got from the C or C 914 | packages, or a glob, or a reference to a glob). In this case 915 | C will read the text from the filehandle up to 916 | end-of-file, and that text is the template: 917 | 918 | # Read template source code from STDIN: 919 | Text::Template->new ( TYPE => 'FILEHANDLE', 920 | SOURCE => \*STDIN ); 921 | 922 | 923 | If you omit the C attribute, it's taken to be C. 924 | C is required. If you omit it, the program will abort. 925 | 926 | The words C and C can be spelled any of the following ways: 927 | 928 | TYPE SOURCE 929 | Type Source 930 | type source 931 | -TYPE -SOURCE 932 | -Type -Source 933 | -type -source 934 | 935 | Pick a style you like and stick with it. 936 | 937 | =over 4 938 | 939 | =item C 940 | 941 | You may also add a C option. If this option is present, 942 | its value should be a reference to an array of two strings. The first 943 | string is the string that signals the beginning of each program 944 | fragment, and the second string is the string that signals the end of 945 | each program fragment. See L<"Alternative Delimiters">, below. 946 | 947 | =item C 948 | 949 | You may also add a C option. If this option is present, and the 950 | C is a C, then the data will be decoded from the given encoding 951 | using the L module. You can use any encoding that L recognizes. 952 | E.g.: 953 | 954 | Text::Template->new( 955 | TYPE => 'FILE', 956 | ENCODING => 'UTF-8', 957 | SOURCE => 'xyz.tmpl'); 958 | 959 | =item C 960 | 961 | If your program is running in taint mode, you may have problems if 962 | your templates are stored in files. Data read from files is 963 | considered 'untrustworthy', and taint mode will not allow you to 964 | evaluate the Perl code in the file. (It is afraid that a malicious 965 | person might have tampered with the file.) 966 | 967 | In some environments, however, local files are trustworthy. You can 968 | tell C that a certain file is trustworthy by supplying 969 | C 1> in the call to C. This will tell 970 | C to disable taint checks on template code that has 971 | come from a file, as long as the filename itself is considered 972 | trustworthy. It will also disable taint checks on template code that 973 | comes from a filehandle. When used with C 'string'> or C 'array'>, it has no effect. 975 | 976 | See L for more complete information about tainting. 977 | 978 | Thanks to Steve Palincsar, Gerard Vreeswijk, and Dr. Christoph Baehr 979 | for help with this feature. 980 | 981 | =item C 982 | 983 | This option is passed along to the C call unless it is 984 | overridden in the arguments to C. See L> feature 985 | and using C in templates> below. 986 | 987 | =item C 988 | 989 | This option is passed along to the C call unless it is 990 | overridden in the arguments to C. See L> below. 991 | 992 | =back 993 | 994 | =head2 C 995 | 996 | $template->compile() 997 | 998 | Loads all the template text from the template's source, parses and 999 | compiles it. If successful, returns true; otherwise returns false and 1000 | sets C<$Text::Template::ERROR>. If the template is already compiled, 1001 | it returns true and does nothing. 1002 | 1003 | You don't usually need to invoke this function, because C 1004 | (see below) compiles the template if it isn't compiled already. 1005 | 1006 | If there is an argument to this function, it must be a reference to an 1007 | array containing alternative delimiter strings. See C<"Alternative 1008 | Delimiters">, below. 1009 | 1010 | =head2 C 1011 | 1012 | $template->fill_in(OPTIONS); 1013 | 1014 | Fills in a template. Returns the resulting text if successful. 1015 | Otherwise, returns C and sets C<$Text::Template::ERROR>. 1016 | 1017 | The I are a hash, or a list of key-value pairs. You can 1018 | write the key names in any of the six usual styles as above; this 1019 | means that where this manual says C (for example) you can 1020 | actually use any of 1021 | 1022 | PACKAGE Package package -PACKAGE -Package -package 1023 | 1024 | Pick a style you like and stick with it. The all-lowercase versions 1025 | may yield spurious warnings about 1026 | 1027 | Ambiguous use of package => resolved to "package" 1028 | 1029 | so you might like to avoid them and use the capitalized versions. 1030 | 1031 | At present, there are eight legal options: C, C, 1032 | C, C, C, C, C, and C. 1033 | 1034 | =over 4 1035 | 1036 | =item C 1037 | 1038 | C specifies the name of a package in which the program 1039 | fragments should be evaluated. The default is to use the package from 1040 | which C was called. For example, consider this template: 1041 | 1042 | The value of the variable x is {$x}. 1043 | 1044 | If you use C<$template-Efill_in(PACKAGE =E 'R')> , then the C<$x> in 1045 | the template is actually replaced with the value of C<$R::x>. If you 1046 | omit the C option, C<$x> will be replaced with the value of 1047 | the C<$x> variable in the package that actually called C. 1048 | 1049 | You should almost always use C. If you don't, and your 1050 | template makes changes to variables, those changes will be propagated 1051 | back into the main program. Evaluating the template in a private 1052 | package helps prevent this. The template can still modify variables 1053 | in your program if it wants to, but it will have to do so explicitly. 1054 | See the section at the end on `Security'. 1055 | 1056 | Here's an example of using C: 1057 | 1058 | Your Royal Highness, 1059 | 1060 | Enclosed please find a list of things I have gotten 1061 | for you since 1907: 1062 | 1063 | { foreach $item (@items) { 1064 | $item_no++; 1065 | $OUT .= " $item_no. \u$item\n"; 1066 | } 1067 | } 1068 | 1069 | Signed, 1070 | Lord High Chamberlain 1071 | 1072 | We want to pass in an array which will be assigned to the array 1073 | C<@items>. Here's how to do that: 1074 | 1075 | 1076 | @items = ('ivory', 'apes', 'peacocks', ); 1077 | $template->fill_in(); 1078 | 1079 | This is not very safe. The reason this isn't as safe is that if you 1080 | had a variable named C<$item_no> in scope in your program at the point 1081 | you called C, its value would be clobbered by the act of 1082 | filling out the template. The problem is the same as if you had 1083 | written a subroutine that used those variables in the same way that 1084 | the template does. (C<$OUT> is special in templates and is always 1085 | safe.) 1086 | 1087 | One solution to this is to make the C<$item_no> variable private to the 1088 | template by declaring it with C. If the template does this, you 1089 | are safe. 1090 | 1091 | But if you use the C option, you will probably be safe even 1092 | if the template does I declare its variables with C: 1093 | 1094 | @Q::items = ('ivory', 'apes', 'peacocks', ); 1095 | $template->fill_in(PACKAGE => 'Q'); 1096 | 1097 | In this case the template will clobber the variable C<$Q::item_no>, 1098 | which is not related to the one your program was using. 1099 | 1100 | Templates cannot affect variables in the main program that are 1101 | declared with C, unless you give the template references to those 1102 | variables. 1103 | 1104 | =item C 1105 | 1106 | You may not want to put the template variables into a package. 1107 | Packages can be hard to manage: You can't copy them, for example. 1108 | C provides an alternative. 1109 | 1110 | The value for C should be a reference to a hash that maps 1111 | variable names to values. For example, 1112 | 1113 | $template->fill_in( 1114 | HASH => { 1115 | recipient => "The King", 1116 | items => ['gold', 'frankincense', 'myrrh'], 1117 | object => \$self, 1118 | } 1119 | ); 1120 | 1121 | will fill out the template and use C<"The King"> as the value of 1122 | C<$recipient> and the list of items as the value of C<@items>. Note 1123 | that we pass an array reference, but inside the template it appears as 1124 | an array. In general, anything other than a simple string or number 1125 | should be passed by reference. 1126 | 1127 | We also want to pass an object, which is in C<$self>; note that we 1128 | pass a reference to the object, C<\$self> instead. Since we've passed 1129 | a reference to a scalar, inside the template the object appears as 1130 | C<$object>. 1131 | 1132 | The full details of how it works are a little involved, so you might 1133 | want to skip to the next section. 1134 | 1135 | Suppose the key in the hash is I and the value is I. 1136 | 1137 | =over 4 1138 | 1139 | =item * 1140 | 1141 | If the I is C, then any variables named C<$key>, 1142 | C<@key>, C<%key>, etc., are undefined. 1143 | 1144 | =item * 1145 | 1146 | If the I is a string or a number, then C<$key> is set to that 1147 | value in the template. 1148 | 1149 | =item * 1150 | 1151 | For anything else, you must pass a reference. 1152 | 1153 | If the I is a reference to an array, then C<@key> is set to 1154 | that array. If the I is a reference to a hash, then C<%key> is 1155 | set to that hash. Similarly if I is any other kind of 1156 | reference. This means that 1157 | 1158 | var => "foo" 1159 | 1160 | and 1161 | 1162 | var => \"foo" 1163 | 1164 | have almost exactly the same effect. (The difference is that in the 1165 | former case, the value is copied, and in the latter case it is 1166 | aliased.) 1167 | 1168 | =item * 1169 | 1170 | In particular, if you want the template to get an object or any kind, 1171 | you must pass a reference to it: 1172 | 1173 | $template->fill_in(HASH => { database_handle => \$dbh, ... }); 1174 | 1175 | If you do this, the template will have a variable C<$database_handle> 1176 | which is the database handle object. If you leave out the C<\>, the 1177 | template will have a hash C<%database_handle>, which exposes the 1178 | internal structure of the database handle object; you don't want that. 1179 | 1180 | =back 1181 | 1182 | Normally, the way this works is by allocating a private package, 1183 | loading all the variables into the package, and then filling out the 1184 | template as if you had specified that package. A new package is 1185 | allocated each time. However, if you I use the C 1186 | option, C loads the variables into the package you 1187 | specified, and they stay there after the call returns. Subsequent 1188 | calls to C that use the same package will pick up the values 1189 | you loaded in. 1190 | 1191 | If the argument of C is a reference to an array instead of a 1192 | reference to a hash, then the array should contain a list of hashes 1193 | whose contents are loaded into the template package one after the 1194 | other. You can use this feature if you want to combine several sets 1195 | of variables. For example, one set of variables might be the defaults 1196 | for a fill-in form, and the second set might be the user inputs, which 1197 | override the defaults when they are present: 1198 | 1199 | $template->fill_in(HASH => [\%defaults, \%user_input]); 1200 | 1201 | You can also use this to set two variables with the same name: 1202 | 1203 | $template->fill_in( 1204 | HASH => [ 1205 | { v => "The King" }, 1206 | { v => [1,2,3] } 1207 | ] 1208 | ); 1209 | 1210 | This sets C<$v> to C<"The King"> and C<@v> to C<(1,2,3)>. 1211 | 1212 | =item C 1213 | 1214 | If any of the program fragments fails to compile or aborts for any 1215 | reason, and you have set the C option to a function reference, 1216 | C will invoke the function. This function is called 1217 | the I function>. The C function will tell 1218 | C what to do next. 1219 | 1220 | If the C function returns C, C will 1221 | immediately abort processing the template and return the text that it 1222 | has accumulated so far. If your function does this, it should set a 1223 | flag that you can examine after C returns so that you can 1224 | tell whether there was a premature return or not. 1225 | 1226 | If the C function returns any other value, that value will be 1227 | interpolated into the template as if that value had been the return 1228 | value of the program fragment to begin with. For example, if the 1229 | C function returns an error string, the error string will be 1230 | interpolated into the output of the template in place of the program 1231 | fragment that cased the error. 1232 | 1233 | If you don't specify a C function, C supplies 1234 | a default one that returns something like 1235 | 1236 | Program fragment delivered error ``Illegal division by 0 at 1237 | template line 37'' 1238 | 1239 | (Note that the format of this message has changed slightly since 1240 | version 1.31.) The return value of the C function is 1241 | interpolated into the template at the place the error occurred, so 1242 | that this template: 1243 | 1244 | (3+4)*5 = { 3+4)*5 } 1245 | 1246 | yields this result: 1247 | 1248 | (3+4)*5 = Program fragment delivered error ``syntax error at template line 1'' 1249 | 1250 | If you specify a value for the C attribute, it should be a 1251 | reference to a function that C can call instead of the 1252 | default function. 1253 | 1254 | C will pass a hash to the C function. 1255 | The hash will have at least these three members: 1256 | 1257 | =over 4 1258 | 1259 | =item C 1260 | 1261 | The source code of the program fragment that failed 1262 | 1263 | =item C 1264 | 1265 | The text of the error message (C<$@>) generated by eval. 1266 | 1267 | The text has been modified to omit the trailing newline and to include 1268 | the name of the template file (if there was one). The line number 1269 | counts from the beginning of the template, not from the beginning of 1270 | the failed program fragment. 1271 | 1272 | =item C 1273 | 1274 | The line number of the template at which the program fragment began. 1275 | 1276 | =back 1277 | 1278 | There may also be an C member. See C, below 1279 | 1280 | =item C 1281 | 1282 | If you supply the C option to C, the value of the 1283 | option is passed to the C function whenever it is called. The 1284 | default C function ignores the C, but you can 1285 | write a custom C function that uses the C to get 1286 | more information about what went wrong. 1287 | 1288 | The C function could also use the C as a reference 1289 | to store an error message or some other information that it wants to 1290 | communicate back to the caller. For example: 1291 | 1292 | $error = ''; 1293 | 1294 | sub my_broken { 1295 | my %args = @_; 1296 | my $err_ref = $args{arg}; 1297 | ... 1298 | $$err_ref = "Some error message"; 1299 | return undef; 1300 | } 1301 | 1302 | $template->fill_in( 1303 | BROKEN => \&my_broken, 1304 | BROKEN_ARG => \$error 1305 | ); 1306 | 1307 | if ($error) { 1308 | die "It didn't work: $error"; 1309 | } 1310 | 1311 | If one of the program fragments in the template fails, it will call 1312 | the C function, C, and pass it the C, 1313 | which is a reference to C<$error>. C can store an error 1314 | message into C<$error> this way. Then the function that called 1315 | C can see if C has left an error message for it 1316 | to find, and proceed accordingly. 1317 | 1318 | =item C 1319 | 1320 | If you give C a C option, then this is the file name that 1321 | you loaded the template source from. This only affects the error message that 1322 | is given for template errors. If you loaded the template from C for 1323 | example, and pass C as the C parameter, errors will look 1324 | like C<... at foo.txt line N> rather than C<... at template line N>. 1325 | 1326 | Note that this does NOT have anything to do with loading a template from the 1327 | given filename. See C for that. 1328 | 1329 | For example: 1330 | 1331 | my $template = Text::Template->new( 1332 | TYPE => 'string', 1333 | SOURCE => 'The value is {1/0}'); 1334 | 1335 | $template->fill_in(FILENAME => 'foo.txt') or die $Text::Template::ERROR; 1336 | 1337 | will die with an error that contains 1338 | 1339 | Illegal division by zero at at foo.txt line 1 1340 | 1341 | =item C 1342 | 1343 | If you give C a C option, its value should be a safe 1344 | compartment object from the C package. All evaluation of 1345 | program fragments will be performed in this compartment. See L 1346 | for full details about such compartments and how to restrict the 1347 | operations that can be performed in them. 1348 | 1349 | If you use the C option with C, the package you specify 1350 | will be placed into the safe compartment and evaluation will take 1351 | place in that package as usual. 1352 | 1353 | If not, C operation is a little different from the default. 1354 | Usually, if you don't specify a package, evaluation of program 1355 | fragments occurs in the package from which the template was invoked. 1356 | But in C mode the evaluation occurs inside the safe compartment 1357 | and cannot affect the calling package. Normally, if you use C 1358 | without C, the hash variables are imported into a private, 1359 | one-use-only package. But if you use C and C together 1360 | without C, the hash variables will just be loaded into the 1361 | root namespace of the C compartment. 1362 | 1363 | =item C 1364 | 1365 | If your template is going to generate a lot of text that you are just 1366 | going to print out again anyway, you can save memory by having 1367 | C print out the text as it is generated instead of 1368 | making it into a big string and returning the string. If you supply 1369 | the C option to C, the value should be a filehandle. 1370 | The generated text will be printed to this filehandle as it is 1371 | constructed. For example: 1372 | 1373 | $template->fill_in(OUTPUT => \*STDOUT, ...); 1374 | 1375 | fills in the C<$template> as usual, but the results are immediately 1376 | printed to STDOUT. This may result in the output appearing more 1377 | quickly than it would have otherwise. 1378 | 1379 | If you use C, the return value from C is still true on 1380 | success and false on failure, but the complete text is not returned to 1381 | the caller. 1382 | 1383 | =item C 1384 | 1385 | You can have some Perl code prepended automatically to the beginning 1386 | of every program fragment. See L feature and using 1387 | C in templates> below. 1388 | 1389 | =item C 1390 | 1391 | If this option is present, its value should be a reference to a list 1392 | of two strings. The first string is the string that signals the 1393 | beginning of each program fragment, and the second string is the 1394 | string that signals the end of each program fragment. See 1395 | L<"Alternative Delimiters">, below. 1396 | 1397 | If you specify C in the call to C, they override 1398 | any delimiters you set when you created the template object with 1399 | C. 1400 | 1401 | =back 1402 | 1403 | =head1 Convenience Functions 1404 | 1405 | =head2 C 1406 | 1407 | The basic way to fill in a template is to create a template object and 1408 | then call C on it. This is useful if you want to fill in 1409 | the same template more than once. 1410 | 1411 | In some programs, this can be cumbersome. C accepts a 1412 | string, which contains the template, and a list of options, which are 1413 | passed to C as above. It constructs the template object for 1414 | you, fills it in as specified, and returns the results. It returns 1415 | C and sets C<$Text::Template::ERROR> if it couldn't generate 1416 | any results. 1417 | 1418 | An example: 1419 | 1420 | $Q::name = 'Donald'; 1421 | $Q::amount = 141.61; 1422 | $Q::part = 'hyoid bone'; 1423 | 1424 | $text = Text::Template->fill_this_in( <<'EOM', PACKAGE => Q); 1425 | Dear {$name}, 1426 | You owe me \\${sprintf('%.2f', $amount)}. 1427 | Pay or I will break your {$part}. 1428 | Love, 1429 | Grand Vizopteryx of Irkutsk. 1430 | EOM 1431 | 1432 | Notice how we included the template in-line in the program by using a 1433 | `here document' with the CE> notation. 1434 | 1435 | C is a deprecated feature. It is only here for 1436 | backwards compatibility, and may be removed in some far-future version 1437 | in C. You should use C instead. It 1438 | is described in the next section. 1439 | 1440 | =head2 C 1441 | 1442 | It is stupid that C is a class method. It should have 1443 | been just an imported function, so that you could omit the 1444 | C> in the example above. But I made the mistake 1445 | four years ago and it is too late to change it. 1446 | 1447 | C is exactly like C except that it is 1448 | not a method and you can omit the C> and just say 1449 | 1450 | print fill_in_string(<<'EOM', ...); 1451 | Dear {$name}, 1452 | ... 1453 | EOM 1454 | 1455 | To use C, you need to say 1456 | 1457 | use Text::Template 'fill_in_string'; 1458 | 1459 | at the top of your program. You should probably use 1460 | C instead of C. 1461 | 1462 | =head2 C 1463 | 1464 | If you import C, you can say 1465 | 1466 | $text = fill_in_file(filename, ...); 1467 | 1468 | The C<...> are passed to C as above. The filename is the 1469 | name of the file that contains the template you want to fill in. It 1470 | returns the result text. or C, as usual. 1471 | 1472 | If you are going to fill in the same file more than once in the same 1473 | program you should use the longer C / C sequence instead. 1474 | It will be a lot faster because it only has to read and parse the file 1475 | once. 1476 | 1477 | =head2 Including files into templates 1478 | 1479 | People always ask for this. ``Why don't you have an include 1480 | function?'' they want to know. The short answer is this is Perl, and 1481 | Perl already has an include function. If you want it, you can just put 1482 | 1483 | {qx{cat filename}} 1484 | 1485 | into your template. VoilE. 1486 | 1487 | If you don't want to use C, you can write a little four-line 1488 | function that opens a file and dumps out its contents, and call it 1489 | from the template. I wrote one for you. In the template, you can say 1490 | 1491 | {Text::Template::_load_text(filename)} 1492 | 1493 | If that is too verbose, here is a trick. Suppose the template package 1494 | that you are going to be mentioning in the C call is package 1495 | C. Then in the main program, write 1496 | 1497 | *Q::include = \&Text::Template::_load_text; 1498 | 1499 | This imports the C<_load_text> function into package C with the 1500 | name C. From then on, any template that you fill in with 1501 | package C can say 1502 | 1503 | {include(filename)} 1504 | 1505 | to insert the text from the named file at that point. If you are 1506 | using the C option instead, just put C 1507 | \&Text::Template::_load_text> into the hash instead of importing it 1508 | explicitly. 1509 | 1510 | Suppose you don't want to insert a plain text file, but rather you 1511 | want to include one template within another? Just use C 1512 | in the template itself: 1513 | 1514 | {Text::Template::fill_in_file(filename)} 1515 | 1516 | You can do the same importing trick if this is too much to type. 1517 | 1518 | =head1 Miscellaneous 1519 | 1520 | =head2 C variables 1521 | 1522 | People are frequently surprised when this doesn't work: 1523 | 1524 | my $recipient = 'The King'; 1525 | my $text = fill_in_file('formletter.tmpl'); 1526 | 1527 | The text C doesn't get into the form letter. Why not? 1528 | Because C<$recipient> is a C variable, and the whole point of 1529 | C variables is that they're private and inaccessible except in the 1530 | scope in which they're declared. The template is not part of that 1531 | scope, so the template can't see C<$recipient>. 1532 | 1533 | If that's not the behavior you want, don't use C. C means a 1534 | private variable, and in this case you don't want the variable to be 1535 | private. Put the variables into package variables in some other 1536 | package, and use the C option to C: 1537 | 1538 | $Q::recipient = $recipient; 1539 | my $text = fill_in_file('formletter.tmpl', PACKAGE => 'Q'); 1540 | 1541 | or pass the names and values in a hash with the C option: 1542 | 1543 | my $text = fill_in_file('formletter.tmpl', HASH => { recipient => $recipient }); 1544 | 1545 | =head2 Security Matters 1546 | 1547 | All variables are evaluated in the package you specify with the 1548 | C option of C. if you use this option, and if your 1549 | templates don't do anything egregiously stupid, you won't have to 1550 | worry that evaluation of the little programs will creep out into the 1551 | rest of your program and wreck something. 1552 | 1553 | Nevertheless, there's really no way (except with C) to protect 1554 | against a template that says 1555 | 1556 | { $Important::Secret::Security::Enable = 0; 1557 | # Disable security checks in this program 1558 | } 1559 | 1560 | or 1561 | 1562 | { $/ = "ho ho ho"; # Sabotage future uses of . 1563 | # $/ is always a global variable 1564 | } 1565 | 1566 | or even 1567 | 1568 | { system("rm -rf /") } 1569 | 1570 | so B go filling in templates unless you're sure you know what's 1571 | in them. If you're worried, or you can't trust the person who wrote 1572 | the template, use the C option. 1573 | 1574 | A final warning: program fragments run a small risk of accidentally 1575 | clobbering local variables in the C function itself. These 1576 | variables all have names that begin with C<$fi_>, so if you stay away 1577 | from those names you'll be safe. (Of course, if you're a real wizard 1578 | you can tamper with them deliberately for exciting effects; this is 1579 | actually how C<$OUT> works.) I can fix this, but it will make the 1580 | package slower to do it, so I would prefer not to. If you are worried 1581 | about this, send me mail and I will show you what to do about it. 1582 | 1583 | =head2 Alternative Delimiters 1584 | 1585 | Lorenzo Valdettaro pointed out that if you are using C 1586 | to generate TeX output, the choice of braces as the program fragment 1587 | delimiters makes you suffer suffer suffer. Starting in version 1.20, 1588 | you can change the choice of delimiters to something other than curly 1589 | braces. 1590 | 1591 | In either the C call or the C call, you can specify 1592 | an alternative set of delimiters with the C option. For 1593 | example, if you would like code fragments to be delimited by C<[@--> 1594 | and C<--@]> instead of C<{> and C<}>, use 1595 | 1596 | ... DELIMITERS => [ '[@--', '--@]' ], ... 1597 | 1598 | Note that these delimiters are I, not regexes. (I 1599 | tried for regexes, but it complicates the lexical analysis too much.) 1600 | Note also that C disables the special meaning of the 1601 | backslash, so if you want to include the delimiters in the literal 1602 | text of your template file, you are out of luck---it is up to you to 1603 | choose delimiters that do not conflict with what you are doing. The 1604 | delimiter strings may still appear inside of program fragments as long 1605 | as they nest properly. This means that if for some reason you 1606 | absolutely must have a program fragment that mentions one of the 1607 | delimiters, like this: 1608 | 1609 | [@-- 1610 | print "Oh no, a delimiter: --@]\n" 1611 | --@] 1612 | 1613 | you may be able to make it work by doing this instead: 1614 | 1615 | [@-- 1616 | # Fake matching delimiter in a comment: [@-- 1617 | print "Oh no, a delimiter: --@]\n" 1618 | --@] 1619 | 1620 | It may be safer to choose delimiters that begin with a newline 1621 | character. 1622 | 1623 | Because the parsing of templates is simplified by the absence of 1624 | backslash escapes, using alternative C may speed up the 1625 | parsing process by 20-25%. This shows that my original choice of C<{> 1626 | and C<}> was very bad. 1627 | 1628 | =head2 C feature and using C in templates 1629 | 1630 | Suppose you would like to use C in your templates to detect 1631 | undeclared variables and the like. But each code fragment is a 1632 | separate lexical scope, so you have to turn on C at the top of 1633 | each and every code fragment: 1634 | 1635 | { use strict; 1636 | use vars '$foo'; 1637 | $foo = 14; 1638 | ... 1639 | } 1640 | 1641 | ... 1642 | 1643 | { # we forgot to put `use strict' here 1644 | my $result = $boo + 12; # $boo is misspelled and should be $foo 1645 | # No error is raised on `$boo' 1646 | } 1647 | 1648 | Because we didn't put C at the top of the second fragment, 1649 | it was only active in the first fragment, and we didn't get any 1650 | C checking in the second fragment. Then we misspelled C<$foo> 1651 | and the error wasn't caught. 1652 | 1653 | C version 1.22 and higher has a new feature to make 1654 | this easier. You can specify that any text at all be automatically 1655 | added to the beginning of each program fragment. 1656 | 1657 | When you make a call to C, you can specify a 1658 | 1659 | PREPEND => 'some perl statements here' 1660 | 1661 | option; the statements will be prepended to each program fragment for 1662 | that one call only. Suppose that the C call included a 1663 | 1664 | PREPEND => 'use strict;' 1665 | 1666 | option, and that the template looked like this: 1667 | 1668 | { use vars '$foo'; 1669 | $foo = 14; 1670 | ... 1671 | } 1672 | 1673 | ... 1674 | 1675 | { my $result = $boo + 12; # $boo is misspelled and should be $foo 1676 | ... 1677 | } 1678 | 1679 | The code in the second fragment would fail, because C<$boo> has not 1680 | been declared. C was implied, even though you did not 1681 | write it explicitly, because the C option added it for you 1682 | automatically. 1683 | 1684 | There are three other ways to do this. At the time you create the 1685 | template object with C, you can also supply a C option, 1686 | in which case the statements will be prepended each time you fill in 1687 | that template. If the C call has its own C option, 1688 | this overrides the one specified at the time you created the 1689 | template. Finally, you can make the class method call 1690 | 1691 | Text::Template->always_prepend('perl statements'); 1692 | 1693 | If you do this, then call calls to C for I template will 1694 | attach the perl statements to the beginning of each program fragment, 1695 | except where overridden by C options to C or C. 1696 | 1697 | An alternative to adding "use strict;" to the PREPEND option, you can 1698 | pass STRICT => 1 to fill_in when also passing the HASH option. 1699 | 1700 | Suppose that the C call included both 1701 | 1702 | HASH => {$foo => ''} and 1703 | STRICT => 1 1704 | 1705 | options, and that the template looked like this: 1706 | 1707 | { 1708 | $foo = 14; 1709 | ... 1710 | } 1711 | 1712 | ... 1713 | 1714 | { my $result = $boo + 12; # $boo is misspelled and should be $foo 1715 | ... 1716 | } 1717 | 1718 | The code in the second fragment would fail, because C<$boo> has not 1719 | been declared. C was implied, even though you did not 1720 | write it explicitly, because the C option added it for you 1721 | automatically. Any variable referenced in the template that is not in the 1722 | C option will be an error. 1723 | 1724 | =head2 Prepending in Derived Classes 1725 | 1726 | This section is technical, and you should skip it on the first few 1727 | readings. 1728 | 1729 | Normally there are three places that prepended text could come from. 1730 | It could come from the C option in the C call, from 1731 | the C option in the C call that created the template 1732 | object, or from the argument of the C call. 1733 | C looks for these three things in order and takes the 1734 | first one that it finds. 1735 | 1736 | In a subclass of C, this last possibility is 1737 | ambiguous. Suppose C is a subclass of C. Should 1738 | 1739 | Text::Template->always_prepend(...); 1740 | 1741 | affect objects in class C? The answer is that you can have it 1742 | either way. 1743 | 1744 | The C value for C is normally stored 1745 | in a hash variable named C<%GLOBAL_PREPEND> under the key 1746 | C. When C looks to see what text to 1747 | prepend, it first looks in the template object itself, and if not, it 1748 | looks in C<$GLOBAL_PREPEND{I}> where I is the class to 1749 | which the template object belongs. If it doesn't find any value, it 1750 | looks in C<$GLOBAL_PREPEND{'Text::Template'}>. This means that 1751 | objects in class C I be affected by 1752 | 1753 | Text::Template->always_prepend(...); 1754 | 1755 | I there is also a call to 1756 | 1757 | Derived->always_prepend(...); 1758 | 1759 | So when you're designing your derived class, you can arrange to have 1760 | your objects ignore C calls by simply 1761 | putting Calways_prepend('')> at the top of your module. 1762 | 1763 | Of course, there is also a final escape hatch: Templates support a 1764 | C that is used to look up the appropriate text to be 1765 | prepended at C time. Your derived class can override this 1766 | method to get an arbitrary effect. 1767 | 1768 | =head2 JavaScript 1769 | 1770 | Jennifer D. St Clair asks: 1771 | 1772 | > Most of my pages contain JavaScript and Stylesheets. 1773 | > How do I change the template identifier? 1774 | 1775 | Jennifer is worried about the braces in the JavaScript being taken as 1776 | the delimiters of the Perl program fragments. Of course, disaster 1777 | will ensue when perl tries to evaluate these as if they were Perl 1778 | programs. The best choice is to find some unambiguous delimiter 1779 | strings that you can use in your template instead of curly braces, and 1780 | then use the C option. However, if you can't do this for 1781 | some reason, there are two easy workarounds: 1782 | 1783 | 1. You can put C<\> in front of C<{>, C<}>, or C<\> to remove its 1784 | special meaning. So, for example, instead of 1785 | 1786 | if (br== "n3") { 1787 | // etc. 1788 | } 1789 | 1790 | you can put 1791 | 1792 | if (br== "n3") \{ 1793 | // etc. 1794 | \} 1795 | 1796 | and it'll come out of the template engine the way you want. 1797 | 1798 | But here is another method that is probably better. To see how it 1799 | works, first consider what happens if you put this into a template: 1800 | 1801 | { 'foo' } 1802 | 1803 | Since it's in braces, it gets evaluated, and obviously, this is going 1804 | to turn into 1805 | 1806 | foo 1807 | 1808 | So now here's the trick: In Perl, C is the same as C<'...'>. 1809 | So if we wrote 1810 | 1811 | {q{foo}} 1812 | 1813 | it would turn into 1814 | 1815 | foo 1816 | 1817 | So for your JavaScript, just write 1818 | 1819 | {q{if (br== "n3") { 1820 | // etc. 1821 | }} 1822 | } 1823 | 1824 | and it'll come out as 1825 | 1826 | if (br== "n3") { 1827 | // etc. 1828 | } 1829 | 1830 | which is what you want. 1831 | 1832 | head2 Shut Up! 1833 | 1834 | People sometimes try to put an initialization section at the top of 1835 | their templates, like this: 1836 | 1837 | { ... 1838 | $var = 17; 1839 | } 1840 | 1841 | Then they complain because there is a C<17> at the top of the output 1842 | that they didn't want to have there. 1843 | 1844 | Remember that a program fragment is replaced with its own return 1845 | value, and that in Perl the return value of a code block is the value 1846 | of the last expression that was evaluated, which in this case is 17. 1847 | If it didn't do that, you wouldn't be able to write C<{$recipient}> 1848 | and have the recipient filled in. 1849 | 1850 | To prevent the 17 from appearing in the output is very simple: 1851 | 1852 | { ... 1853 | $var = 17; 1854 | ''; 1855 | } 1856 | 1857 | Now the last expression evaluated yields the empty string, which is 1858 | invisible. If you don't like the way this looks, use 1859 | 1860 | { ... 1861 | $var = 17; 1862 | ($SILENTLY); 1863 | } 1864 | 1865 | instead. Presumably, C<$SILENTLY> has no value, so nothing will be 1866 | interpolated. This is what is known as a `trick'. 1867 | 1868 | =head2 Compatibility 1869 | 1870 | Every effort has been made to make this module compatible with older 1871 | versions. The only known exceptions follow: 1872 | 1873 | The output format of the default C subroutine has changed 1874 | twice, most recently between versions 1.31 and 1.40. 1875 | 1876 | Starting in version 1.10, the C<$OUT> variable is arrogated for a 1877 | special meaning. If you had templates before version 1.10 that 1878 | happened to use a variable named C<$OUT>, you will have to change them 1879 | to use some other variable or all sorts of strangeness will result. 1880 | 1881 | Between versions 0.1b and 1.00 the behavior of the \ metacharacter 1882 | changed. In 0.1b, \\ was special everywhere, and the template 1883 | processor always replaced it with a single backslash before passing 1884 | the code to Perl for evaluation. The rule now is more complicated but 1885 | probably more convenient. See the section on backslash processing, 1886 | below, for a full discussion. 1887 | 1888 | =head2 Backslash Processing 1889 | 1890 | In C beta versions, the backslash was special whenever 1891 | it appeared before a brace or another backslash. That meant that 1892 | while C<{"\n"}> did indeed generate a newline, C<{"\\"}> did not 1893 | generate a backslash, because the code passed to Perl for evaluation 1894 | was C<"\"> which is a syntax error. If you wanted a backslash, you 1895 | would have had to write C<{"\\\\"}>. 1896 | 1897 | In C versions 1.00 through 1.10, there was a bug: 1898 | Backslash was special everywhere. In these versions, C<{"\n"}> 1899 | generated the letter C. 1900 | 1901 | The bug has been corrected in version 1.11, but I did not go back to 1902 | exactly the old rule, because I did not like the idea of having to 1903 | write C<{"\\\\"}> to get one backslash. The rule is now more 1904 | complicated to remember, but probably easier to use. The rule is now: 1905 | Backslashes are always passed to Perl unchanged I they occur 1906 | as part of a sequence like C<\\\\\\{> or C<\\\\\\}>. In these 1907 | contexts, they are special; C<\\> is replaced with C<\>, and C<\{> and 1908 | C<\}> signal a literal brace. 1909 | 1910 | Examples: 1911 | 1912 | \{ foo \} 1913 | 1914 | is I evaluated, because the C<\> before the braces signals that 1915 | they should be taken literally. The result in the output looks like this: 1916 | 1917 | { foo } 1918 | 1919 | 1920 | This is a syntax error: 1921 | 1922 | { "foo}" } 1923 | 1924 | because C thinks that the code ends at the first C<}>, 1925 | and then gets upset when it sees the second one. To make this work 1926 | correctly, use 1927 | 1928 | { "foo\}" } 1929 | 1930 | This passes C<"foo}"> to Perl for evaluation. Note there's no C<\> in 1931 | the evaluated code. If you really want a C<\> in the evaluated code, 1932 | use 1933 | 1934 | { "foo\\\}" } 1935 | 1936 | This passes C<"foo\}"> to Perl for evaluation. 1937 | 1938 | Starting with C version 1.20, backslash processing is 1939 | disabled if you use the C option to specify alternative 1940 | delimiter strings. 1941 | 1942 | =head2 A short note about C<$Text::Template::ERROR> 1943 | 1944 | In the past some people have fretted about `violating the package 1945 | boundary' by examining a variable inside the C 1946 | package. Don't feel this way. C<$Text::Template::ERROR> is part of 1947 | the published, official interface to this package. It is perfectly OK 1948 | to inspect this variable. The interface is not going to change. 1949 | 1950 | If it really, really bothers you, you can import a function called 1951 | C that returns the current value of the C<$ERROR> variable. 1952 | So you can say: 1953 | 1954 | use Text::Template 'TTerror'; 1955 | 1956 | my $template = Text::Template->new(SOURCE => $filename); 1957 | unless ($template) { 1958 | my $err = TTerror; 1959 | die "Couldn't make template: $err; aborting"; 1960 | } 1961 | 1962 | I don't see what benefit this has over just doing this: 1963 | 1964 | use Text::Template; 1965 | 1966 | my $template = Text::Template->new(SOURCE => $filename) 1967 | or die "Couldn't make template: $Text::Template::ERROR; aborting"; 1968 | 1969 | But if it makes you happy to do it that way, go ahead. 1970 | 1971 | =head2 Sticky Widgets in Template Files 1972 | 1973 | The C module provides functions for `sticky widgets', which are 1974 | form input controls that retain their values from one page to the 1975 | next. Sometimes people want to know how to include these widgets 1976 | into their template output. 1977 | 1978 | It's totally straightforward. Just call the C functions from 1979 | inside the template: 1980 | 1981 | { $q->checkbox_group(NAME => 'toppings', 1982 | LINEBREAK => true, 1983 | COLUMNS => 3, 1984 | VALUES => \@toppings, 1985 | ); 1986 | } 1987 | 1988 | =head2 Automatic preprocessing of program fragments 1989 | 1990 | It may be useful to preprocess the program fragments before they are 1991 | evaluated. See C for more details. 1992 | 1993 | =head2 Automatic postprocessing of template hunks 1994 | 1995 | It may be useful to process hunks of output before they are appended to 1996 | the result text. For this, subclass and replace the C 1997 | method. It is passed a list of pairs with these entries: 1998 | 1999 | handle - a filehandle to which to print the desired output 2000 | out - a ref to a string to which to append, to use if handle is not given 2001 | text - the text that will be appended 2002 | type - where the text came from: TEXT for literal text, PROG for code 2003 | 2004 | =head1 HISTORY 2005 | 2006 | Originally written by Mark Jason Dominus, Plover Systems (versions 0.01 - 1.46) 2007 | 2008 | Maintainership transferred to Michael Schout Emschout@cpan.orgE in version 2009 | 1.47 2010 | 2011 | =head1 THANKS 2012 | 2013 | Many thanks to the following people for offering support, 2014 | encouragement, advice, bug reports, and all the other good stuff. 2015 | 2016 | =for :list 2017 | * Andrew G Wood 2018 | * Andy Wardley 2019 | * António Aragão 2020 | * Archie Warnock 2021 | * Bek Oberin 2022 | * Bob Dougherty 2023 | * Brian C. Shensky 2024 | * Chris Nandor 2025 | * Chris Wesley 2026 | * Chris.Brezil 2027 | * Daini Xie 2028 | * Dan Franklin 2029 | * Daniel LaLiberte 2030 | * David H. Adler 2031 | * David Marshall 2032 | * Dennis Taylor 2033 | * Donald L. Greer Jr. 2034 | * Dr. Frank Bucolo 2035 | * Fred Steinberg 2036 | * Gene Damon 2037 | * Hans Persson 2038 | * Hans Stoop 2039 | * Itamar Almeida de Carvalho 2040 | * James H. Thompson 2041 | * James Mastros 2042 | * Jarko Hietaniemi 2043 | * Jason Moore 2044 | * Jennifer D. St Clair 2045 | * Joel Appelbaum 2046 | * Joel Meulenberg 2047 | * Jonathan Roy 2048 | * Joseph Cheek 2049 | * Juan E. Camacho 2050 | * Kevin Atteson 2051 | * Kevin Madsen 2052 | * Klaus Arnhold 2053 | * Larry Virden 2054 | * Lieven Tomme 2055 | * Lorenzo Valdettaro 2056 | * Marek Grac 2057 | * Matt Womer 2058 | * Matt X. Hunter 2059 | * Michael G Schwern 2060 | * Michael J. Suzio 2061 | * Michaely Yeung 2062 | * Michelangelo Grigni 2063 | * Mike Brodhead 2064 | * Niklas Skoglund 2065 | * Randal L. Schwartz 2066 | * Reuven M. Lerner 2067 | * Robert M. Ioffe 2068 | * Ron Pero 2069 | * San Deng 2070 | * Sean Roehnelt 2071 | * Sergey Myasnikov 2072 | * Shabbir J. Safdar 2073 | * Shad Todd 2074 | * Steve Palincsar 2075 | * Tim Bunce 2076 | * Todd A. Green 2077 | * Tom Brown 2078 | * Tom Henry 2079 | * Tom Snee 2080 | * Trip Lilley 2081 | * Uwe Schneider 2082 | * Val Luck 2083 | * Yannis Livassof 2084 | * Yonat Sharon 2085 | * Zac Hansen 2086 | * gary at dls.net 2087 | 2088 | Special thanks to: 2089 | 2090 | =over 2 2091 | 2092 | =item Jonathan Roy 2093 | 2094 | for telling me how to do the C support (I spent two years 2095 | worrying about it, and then Jonathan pointed out that it was trivial.) 2096 | 2097 | =item Ranjit Bhatnagar 2098 | 2099 | for demanding less verbose fragments like they have in ASP, for 2100 | helping me figure out the Right Thing, and, especially, for talking me 2101 | out of adding any new syntax. These discussions resulted in the 2102 | C<$OUT> feature. 2103 | 2104 | =back 2105 | 2106 | =head2 Bugs and Caveats 2107 | 2108 | C variables in C are still susceptible to being clobbered 2109 | by template evaluation. They all begin with C, so avoid those 2110 | names in your templates. 2111 | 2112 | The line number information will be wrong if the template's lines are 2113 | not terminated by C<"\n">. You should let me know if this is a 2114 | problem. If you do, I will fix it. 2115 | 2116 | The C<$OUT> variable has a special meaning in templates, so you cannot 2117 | use it as if it were a regular variable. 2118 | 2119 | There are not quite enough tests in the test suite. 2120 | 2121 | =cut 2122 | -------------------------------------------------------------------------------- /lib/Text/Template/Preprocess.pm: -------------------------------------------------------------------------------- 1 | 2 | package Text::Template::Preprocess; 3 | 4 | # ABSTRACT: Expand template text with embedded Perl 5 | 6 | use strict; 7 | use warnings; 8 | 9 | use Text::Template; 10 | our @ISA = qw(Text::Template); 11 | 12 | sub fill_in { 13 | my $self = shift; 14 | my (%args) = @_; 15 | 16 | my $pp = $args{PREPROCESSOR} || $self->{PREPROCESSOR}; 17 | 18 | if ($pp) { 19 | local $_ = $self->source(); 20 | my $type = $self->{TYPE}; 21 | 22 | # print "# fill_in: before <$_>\n"; 23 | &$pp; 24 | 25 | # print "# fill_in: after <$_>\n"; 26 | $self->set_source_data($_, $type); 27 | } 28 | 29 | $self->SUPER::fill_in(@_); 30 | } 31 | 32 | sub preprocessor { 33 | my ($self, $pp) = @_; 34 | 35 | my $old_pp = $self->{PREPROCESSOR}; 36 | 37 | $self->{PREPROCESSOR} = $pp if @_ > 1; # OK to pass $pp=undef 38 | 39 | $old_pp; 40 | } 41 | 42 | 1; 43 | 44 | __END__ 45 | 46 | =head1 SYNOPSIS 47 | 48 | use Text::Template::Preprocess; 49 | 50 | my $t = Text::Template::Preprocess->new(...); # identical to Text::Template 51 | 52 | # Fill in template, but preprocess each code fragment with pp(). 53 | my $result = $t->fill_in(..., PREPROCESSOR => \&pp); 54 | 55 | my $old_pp = $t->preprocessor(\&new_pp); 56 | 57 | =head1 DESCRIPTION 58 | 59 | C provides a new C option to 60 | C. If the C option is supplied, it must be a 61 | reference to a preprocessor subroutine. When filling out a template, 62 | C will use this subroutine to preprocess 63 | the program fragment prior to evaluating the code. 64 | 65 | The preprocessor subroutine will be called repeatedly, once for each 66 | program fragment. The program fragment will be in C<$_>. The 67 | subroutine should modify the contents of C<$_> and return. 68 | C will then execute contents of C<$_> and 69 | insert the result into the appropriate part of the template. 70 | 71 | C objects also support a utility method, 72 | C, which sets a new preprocessor for the object. This 73 | preprocessor is used for all subsequent calls to C except 74 | where overridden by an explicit C option. 75 | C returns the previous default preprocessor function, 76 | or undefined if there wasn't one. When invoked with no arguments, 77 | C returns the object's current default preprocessor 78 | function without changing it. 79 | 80 | In all other respects, C is identical to 81 | C. 82 | 83 | =head1 WHY? 84 | 85 | One possible purpose: If your files contain a lot of JavaScript, like 86 | this: 87 | 88 | 89 | Plain text here... 90 | { perl code } 91 | 96 | { more perl code } 97 | More plain text... 98 | 99 | You don't want C to confuse the curly braces in the 100 | JavaScript program with executable Perl code. One strategy: 101 | 102 | sub quote_scripts { 103 | s()(q{$1})gsi; 104 | } 105 | 106 | Then use C \"e_scripts>. This will transform 107 | 108 | 109 | 110 | =head1 SEE ALSO 111 | 112 | L 113 | 114 | =head1 AUTHOR 115 | 116 | Mark Jason Dominus, Plover Systems 117 | 118 | Please send questions and other remarks about this software to 119 | C 120 | 121 | You can join a very low-volume (E10 messages per year) mailing 122 | list for announcements about this package. Send an empty note to 123 | C to join. 124 | 125 | For updates, visit C. 126 | 127 | -------------------------------------------------------------------------------- /t/basic.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # Tests of basic, essential functionality 4 | # 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 34; 9 | use File::Temp; 10 | 11 | my $tmpfile = File::Temp->new; 12 | 13 | use_ok 'Text::Template' or exit 1; 14 | 15 | $X::v = $Y::v = 0; # Suppress `var used only once' 16 | 17 | my $template_1 = < {\$v} 19 | We will evaluate 1+1 here -> {1 + 1} 20 | EOM 21 | 22 | # (1) Construct temporary template file for testing 23 | # file operations 24 | my $TEMPFILE = $tmpfile->filename; 25 | 26 | eval { 27 | open my $tmp, '>', $TEMPFILE 28 | or die "Couldn't write tempfile $TEMPFILE: $!"; 29 | 30 | print $tmp $template_1; 31 | close $tmp; 32 | 33 | pass; 34 | }; 35 | if ($@) { 36 | fail $@; 37 | } 38 | 39 | # (2) Build template from file 40 | my $template = Text::Template->new('type' => 'FILE', 'source' => $TEMPFILE); 41 | ok(defined $template) or diag $Text::Template::ERROR; 42 | 43 | # (3) Fill in template from file 44 | $X::v = "abc"; 45 | my $resultX = < abc 47 | We will evaluate 1+1 here -> 2 48 | EOM 49 | $Y::v = "ABC"; 50 | my $resultY = < ABC 52 | We will evaluate 1+1 here -> 2 53 | EOM 54 | 55 | my $text = $template->fill_in('package' => 'X'); 56 | is $text, $resultX; 57 | 58 | # (4) Fill in same template again 59 | $text = $template->fill_in('package' => 'Y'); 60 | is $text, $resultY; 61 | 62 | # (5) Simple test of `fill_this_in' 63 | $text = Text::Template->fill_this_in($template_1, 'package' => 'X'); 64 | is $text, $resultX; 65 | 66 | # (6) test creation of template from filehandle 67 | open my $tmpl, '<', $TEMPFILE or die "failed to open $TEMPFILE: $!"; 68 | 69 | $template = Text::Template->new(type => 'FILEHANDLE', source => $tmpl); 70 | ok defined $template or diag $Text::Template::ERROR; 71 | 72 | # (7) test filling in of template from filehandle 73 | $text = $template->fill_in('package' => 'X'); 74 | is $text, $resultX; 75 | 76 | # (8) test second fill_in on same template object 77 | $text = $template->fill_in('package' => 'Y'); 78 | is $text, $resultY; 79 | 80 | close $tmpl; 81 | 82 | # (9) test creation of template from array 83 | $template = Text::Template->new( 84 | type => 'ARRAY', 85 | source => [ 86 | 'We will put value of $v (which is "abc") here -> {$v}', "\n", 87 | 'We will evaluate 1+1 here -> {1+1}', "\n" 88 | ] 89 | ); 90 | 91 | ok defined $template; # or diag $Text::Template::ERROR; 92 | 93 | # (10) test filling in of template from array 94 | $text = $template->fill_in('package' => 'X'); 95 | is $text, $resultX; 96 | 97 | # (11) test second fill_in on same array template object 98 | $text = $template->fill_in('package' => 'Y'); 99 | is $text, $resultY; 100 | 101 | # (12) Make sure \ is working properly 102 | # Test added for version 1.11 103 | $tmpl = Text::Template->new(TYPE => 'STRING', SOURCE => 'B{"\\}"}C{"\\{"}D'); 104 | 105 | # This should fail if the \ are not interpreted properly. 106 | $text = $tmpl->fill_in(); 107 | is $text, 'B}C{D'; 108 | 109 | # (13) Make sure \ is working properly 110 | # Test added for version 1.11 111 | $tmpl = Text::Template->new(TYPE => 'STRING', SOURCE => qq{A{"\t"}B}); 112 | 113 | # Symptom of old problem: ALL \ were special in templates, so 114 | # The lexer would return (A, PROGTEXT("t"), B), and the 115 | # result text would be AtB instead of A(tab)B. 116 | $text = $tmpl->fill_in(); 117 | 118 | is $text, "A\tB"; 119 | 120 | # (14-27) Make sure \ is working properly 121 | # Test added for version 1.11 122 | # This is a sort of general test. 123 | my @tests = ( 124 | '{""}' => '', # (14) 125 | '{"}"}' => undef, # (15) 126 | '{"\\}"}' => '}', # One backslash 127 | '{"\\\\}"}' => undef, # Two backslashes 128 | '{"\\\\\\}"}' => '}', # Three backslashes 129 | '{"\\\\\\\\}"}' => undef, # Four backslashes 130 | '{"\\\\\\\\\\}"}' => '\}', # Five backslashes (20) 131 | '{"x20"}' => 'x20', 132 | '{"\\x20"}' => ' ', # One backslash 133 | '{"\\\\x20"}' => '\\x20', # Two backslashes 134 | '{"\\\\\\x20"}' => '\\ ', # Three backslashes 135 | '{"\\\\\\\\x20"}' => '\\\\x20', # Four backslashes (25) 136 | '{"\\\\\\\\\\x20"}' => '\\\\ ', # Five backslashes 137 | '{"\\x20\\}"}' => ' }', # (27) 138 | ); 139 | 140 | while (my ($test, $result) = splice @tests, 0, 2) { 141 | my $tmpl = Text::Template->new(TYPE => 'STRING', SOURCE => $test); 142 | my $text = $tmpl->fill_in; 143 | 144 | ok(!defined $text && !defined $result || $text eq $result) 145 | or diag "expected .$result. got .$text."; 146 | } 147 | 148 | # (28-30) I discovered that you can't pass a glob ref as your filehandle. 149 | # MJD 20010827 150 | # (28) test creation of template from filehandle 151 | $tmpl = undef; 152 | ok(open $tmpl, '<', $TEMPFILE) or diag "Couldn't open $TEMPFILE: $!"; 153 | $template = Text::Template->new(type => 'FILEHANDLE', source => $tmpl); 154 | ok(defined $template) or diag $Text::Template::ERROR; 155 | 156 | # (29) test filling in of template from filehandle 157 | $text = $template->fill_in('package' => 'X'); 158 | is $text, $resultX; 159 | 160 | # (30) test second fill_in on same template object 161 | $text = $template->fill_in('package' => 'Y'); 162 | is $text, $resultY; 163 | 164 | close $tmpl; 165 | 166 | # (31) Test _scrubpkg for leakiness 167 | $Text::Template::GEN0::test = 1; 168 | Text::Template::_scrubpkg('Text::Template::GEN0'); 169 | ok !($Text::Template::GEN0::test 170 | || exists $Text::Template::GEN0::{test} 171 | || exists $Text::Template::{'GEN0::'}); 172 | 173 | # that filename parameter works. we use BROKEN to verify this 174 | $text = Text::Template->new( 175 | TYPE => 'string', 176 | SOURCE => 'Hello {1/0}' 177 | )->fill_in(FILENAME => 'foo.txt'); 178 | 179 | like $text, qr/division by zero at foo\.txt line 1/; 180 | -------------------------------------------------------------------------------- /t/broken.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # test apparatus for Text::Template module 3 | 4 | use strict; 5 | use warnings; 6 | use Test::More tests => 7; 7 | 8 | use_ok 'Text::Template' or exit 1; 9 | 10 | # (1) basic error delivery 11 | { 12 | my $r = Text::Template->new( 13 | TYPE => 'string', 14 | SOURCE => '{1/0}',)->fill_in(); 15 | is $r, q{Program fragment delivered error ``Illegal division by zero at template line 1.''}; 16 | } 17 | 18 | # (2) BROKEN sub called in ->new? 19 | { 20 | my $r = Text::Template->new( 21 | TYPE => 'string', 22 | SOURCE => '{1/0}', 23 | BROKEN => sub { '---' },)->fill_in(); 24 | is $r, q{---}; 25 | } 26 | 27 | # (3) BROKEN sub called in ->fill_in? 28 | { 29 | my $r = Text::Template->new( 30 | TYPE => 'string', 31 | SOURCE => '{1/0}',)->fill_in(BROKEN => sub { '---' }); 32 | is $r, q{---}; 33 | } 34 | 35 | # (4) BROKEN sub passed correct args when called in ->new? 36 | { 37 | my $r = Text::Template->new( 38 | TYPE => 'string', 39 | SOURCE => '{1/0}', 40 | BROKEN => sub { 41 | my %a = @_; 42 | qq{$a{lineno},$a{error},$a{text}}; 43 | },)->fill_in(); 44 | is $r, qq{1,Illegal division by zero at template line 1.\n,1/0}; 45 | } 46 | 47 | # (5) BROKEN sub passed correct args when called in ->fill_in? 48 | { 49 | my $r = Text::Template->new( 50 | TYPE => 'string', 51 | SOURCE => '{1/0}', 52 | )->fill_in( 53 | BROKEN => sub { 54 | my %a = @_; 55 | qq{$a{lineno},$a{error},$a{text}}; 56 | }); 57 | is $r, qq{1,Illegal division by zero at template line 1.\n,1/0}; 58 | } 59 | 60 | # BROKEN sub handles undef 61 | { 62 | my $r = Text::Template->new(TYPE => 'string', SOURCE => 'abc{1/0}defg') 63 | ->fill_in(BROKEN => sub { undef }); 64 | 65 | is $r, 'abc'; 66 | } 67 | -------------------------------------------------------------------------------- /t/delimiters.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # Tests for user-specified delimiter functions 4 | # These tests first appeared in version 1.20. 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 19; 9 | 10 | use_ok 'Text::Template' or exit 1; 11 | 12 | # (1) Try a simple delimiter: <<..>> 13 | # First with the delimiters specified at object creation time 14 | our $V = $V = 119; 15 | my $template = q{The value of $V is <<$V>>.}; 16 | my $result = q{The value of $V is 119.}; 17 | my $template1 = Text::Template->new( 18 | TYPE => 'STRING', 19 | SOURCE => $template, 20 | DELIMITERS => [ '<<', '>>' ]) 21 | or die "Couldn't construct template object: $Text::Template::ERROR; aborting"; 22 | 23 | my $text = $template1->fill_in(); 24 | is $text, $result; 25 | 26 | # (2) Now with delimiter choice deferred until fill-in time. 27 | $template1 = Text::Template->new(TYPE => 'STRING', SOURCE => $template); 28 | $text = $template1->fill_in(DELIMITERS => [ '<<', '>>' ]); 29 | is $text, $result; 30 | 31 | # (3) Now we'll try using regex metacharacters 32 | # First with the delimiters specified at object creation time 33 | $template = q{The value of $V is [$V].}; 34 | $template1 = Text::Template->new( 35 | TYPE => 'STRING', 36 | SOURCE => $template, 37 | DELIMITERS => [ '[', ']' ]) 38 | or die "Couldn't construct template object: $Text::Template::ERROR; aborting"; 39 | 40 | $text = $template1->fill_in(); 41 | is $text, $result; 42 | 43 | # (4) Now with delimiter choice deferred until fill-in time. 44 | $template1 = Text::Template->new(TYPE => 'STRING', SOURCE => $template); 45 | $text = $template1->fill_in(DELIMITERS => [ '[', ']' ]); 46 | is $text, $result; 47 | 48 | # (5-18) Make sure \ is working properly 49 | # (That is to say, it is ignored.) 50 | # These tests are similar to those in 01-basic.t. 51 | my @tests = ( 52 | '{""}' => '', # (5) 53 | 54 | # Backslashes don't matter 55 | '{"}"}' => undef, 56 | '{"\\}"}' => undef, # One backslash 57 | '{"\\\\}"}' => undef, # Two backslashes 58 | '{"\\\\\\}"}' => undef, # Three backslashes 59 | '{"\\\\\\\\}"}' => undef, # Four backslashes (10) 60 | '{"\\\\\\\\\\}"}' => undef, # Five backslashes 61 | 62 | # Backslashes are always passed directly to Perl 63 | '{"x20"}' => 'x20', 64 | '{"\\x20"}' => ' ', # One backslash 65 | '{"\\\\x20"}' => '\\x20', # Two backslashes 66 | '{"\\\\\\x20"}' => '\\ ', # Three backslashes (15) 67 | '{"\\\\\\\\x20"}' => '\\\\x20', # Four backslashes 68 | '{"\\\\\\\\\\x20"}' => '\\\\ ', # Five backslashes 69 | '{"\\x20\\}"}' => undef, # (18) 70 | ); 71 | 72 | while (my ($test, $result) = splice @tests, 0, 2) { 73 | my $tmpl = Text::Template->new( 74 | TYPE => 'STRING', 75 | SOURCE => $test, 76 | DELIMITERS => [ '{', '}' ]); 77 | 78 | my $text = $tmpl->fill_in; 79 | 80 | my $ok = (!defined $text && !defined $result || $text eq $result); 81 | 82 | ok($ok) or diag "expected .$result., got .$text."; 83 | } 84 | -------------------------------------------------------------------------------- /t/error.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # test apparatus for Text::Template module 4 | # still incomplete. 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 6; 9 | 10 | use_ok 'Text::Template' or exit 1; 11 | 12 | # (1-2) Missing source 13 | eval { 14 | Text::Template->new(); 15 | pass; 16 | }; 17 | 18 | like $@, qr/^\QUsage: Text::Template::new(TYPE => ..., SOURCE => ...)/; 19 | 20 | eval { Text::Template->new(TYPE => 'FILE'); }; 21 | like $@, qr/^\QUsage: Text::Template::new(TYPE => ..., SOURCE => ...)/; 22 | 23 | # (3) Invalid type 24 | eval { Text::Template->new(TYPE => 'wlunch', SOURCE => 'fish food'); }; 25 | like $@, qr/^\QIllegal value `WLUNCH' for TYPE parameter/; 26 | 27 | # (4-5) File does not exist 28 | my $o = Text::Template->new( 29 | TYPE => 'file', 30 | SOURCE => 'this file does not exist'); 31 | ok !defined $o; 32 | 33 | ok defined($Text::Template::ERROR) 34 | && $Text::Template::ERROR =~ /^Couldn't open file/; 35 | -------------------------------------------------------------------------------- /t/exported.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # test apparatus for Text::Template module 4 | # still incomplete. 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 7; 9 | use File::Temp; 10 | 11 | use_ok 'Text::Template' or exit 1; 12 | 13 | my $tfh = File::Temp->new; 14 | 15 | Text::Template->import('fill_in_file', 'fill_in_string'); 16 | 17 | $Q::n = $Q::n = 119; 18 | 19 | # (1) Test fill_in_string 20 | my $out = fill_in_string('The value of $n is {$n}.', PACKAGE => 'Q'); 21 | is $out, 'The value of $n is 119.'; 22 | 23 | # (2) Test fill_in_file 24 | my $TEMPFILE = $tfh->filename; 25 | 26 | print $tfh 'The value of $n is {$n}.', "\n"; 27 | close $tfh or die "Couldn't write test file: $!; aborting"; 28 | 29 | $R::n = $R::n = 8128; 30 | 31 | $out = fill_in_file($TEMPFILE, PACKAGE => 'R'); 32 | is $out, "The value of \$n is 8128.\n"; 33 | 34 | # (3) Jonathan Roy reported this bug: 35 | open my $ofh, '>', $TEMPFILE or die "Couldn't open test file: $!; aborting"; 36 | print $ofh "With a message here? [% \$var %]\n"; 37 | close $ofh or die "Couldn't close test file: $!; aborting"; 38 | $out = fill_in_file($TEMPFILE, 39 | DELIMITERS => [ '[%', '%]' ], 40 | HASH => { "var" => \"It is good!" }); 41 | is $out, "With a message here? It is good!\n"; 42 | 43 | # (4) It probably occurs in fill_this_in also: 44 | $out = Text::Template->fill_this_in("With a message here? [% \$var %]\n", 45 | DELIMITERS => [ '[%', '%]' ], 46 | HASH => { "var" => \"It is good!" }); 47 | is $out, "With a message here? It is good!\n"; 48 | 49 | # (5) This test failed in 1.25. It was supplied by Donald L. Greer Jr. 50 | # Note that it's different from (1) in that there's no explicit 51 | # package=> argument. 52 | use vars qw($string $foo $r); 53 | $string = 'Hello {$foo}'; 54 | $foo = "Don"; 55 | $r = fill_in_string($string); 56 | is $r, 'Hello Don'; 57 | 58 | # (6) This test failed in 1.25. It's a variation on (5) 59 | package Q2; 60 | use Text::Template 'fill_in_string'; 61 | use vars qw($string $foo $r); 62 | $string = 'Hello {$foo}'; 63 | $foo = "Don"; 64 | $r = fill_in_string($string); 65 | 66 | package main; 67 | 68 | is $Q2::r, 'Hello Don'; 69 | -------------------------------------------------------------------------------- /t/hash.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # test apparatus for Text::Template module 4 | # still incomplete. 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 13; 9 | 10 | use_ok 'Text::Template' or exit 1; 11 | 12 | my $template = 'We will put value of $v (which is "good") here -> {$v}'; 13 | 14 | my $v = 'oops (main)'; 15 | $Q::v = 'oops (Q)'; 16 | 17 | my $vars = { 'v' => \'good' }; 18 | 19 | # (1) Build template from string 20 | $template = Text::Template->new('type' => 'STRING', 'source' => $template); 21 | isa_ok $template, 'Text::Template'; 22 | 23 | # (2) Fill in template in anonymous package 24 | my $result2 = 'We will put value of $v (which is "good") here -> good'; 25 | my $text = $template->fill_in(HASH => $vars); 26 | is $text, $result2; 27 | 28 | # (3) Did we clobber the main variable? 29 | is $v, 'oops (main)'; 30 | 31 | # (4) Fill in same template again 32 | my $result4 = 'We will put value of $v (which is "good") here -> good'; 33 | $text = $template->fill_in(HASH => $vars); 34 | is $text, $result4; 35 | 36 | # (5) Now with a package 37 | my $result5 = 'We will put value of $v (which is "good") here -> good'; 38 | $text = $template->fill_in(HASH => $vars, PACKAGE => 'Q'); 39 | is $text, $result5; 40 | 41 | # (6) We expect to have clobbered the Q variable. 42 | is $Q::v, 'good'; 43 | 44 | # (7) Now let's try it without a package 45 | my $result7 = 'We will put value of $v (which is "good") here -> good'; 46 | $text = $template->fill_in(HASH => $vars); 47 | is $text, $result7; 48 | 49 | # (8-11) Now what does it do when we pass a hash with undefined values? 50 | # Roy says it does something bad. (Added for 1.20.) 51 | my $WARNINGS = 0; 52 | { 53 | local $SIG{__WARN__} = sub { $WARNINGS++ }; 54 | local $^W = 1; # Make sure this is on for this test 55 | my $template8 = 'We will put value of $v (which is "good") here -> {defined $v ? "bad" : "good"}'; 56 | my $result8 = 'We will put value of $v (which is "good") here -> good'; 57 | my $template = Text::Template->new('type' => 'STRING', 'source' => $template8); 58 | my $text = $template->fill_in(HASH => { 'v' => undef }); 59 | 60 | # (8) Did we generate a warning? 61 | cmp_ok $WARNINGS, '==', 0; 62 | 63 | # (9) Was the output correct? 64 | is $text, $result8; 65 | 66 | # (10-11) Let's try that again, with a twist this time 67 | $WARNINGS = 0; 68 | $text = $template->fill_in(HASH => [ { 'v' => 17 }, { 'v' => undef } ]); 69 | 70 | # (10) Did we generate a warning? 71 | cmp_ok $WARNINGS, '==', 0; 72 | 73 | # (11) Was the output correct? 74 | SKIP: { 75 | skip 'not supported before 5.005', 1 unless $] >= 5.005; 76 | 77 | is $text, $result8; 78 | } 79 | } 80 | 81 | # (12) Now we'll test the multiple-hash option (Added for 1.20.) 82 | $text = Text::Template::fill_in_string(q{$v: {$v}. @v: [{"@v"}].}, 83 | HASH => [ 84 | { 'v' => 17 }, 85 | { 'v' => [ 'a', 'b', 'c' ] }, 86 | { 'v' => \23 } 87 | ] 88 | ); 89 | 90 | my $result = q{$v: 23. @v: [a b c].}; 91 | is $text, $result; 92 | -------------------------------------------------------------------------------- /t/inline-comment.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # Test for comments within an inline code block 4 | 5 | use strict; 6 | use warnings; 7 | use Test::More tests => 2; 8 | 9 | use_ok 'Text::Template' or exit 1; 10 | 11 | my $tmpl = Text::Template->new( 12 | TYPE => 'STRING', 13 | SOURCE => "Hello {\$name#comment}"); 14 | 15 | my $vars = { name => 'Bob' }; 16 | 17 | is $tmpl->fill_in(HASH => $vars), 'Hello Bob'; 18 | -------------------------------------------------------------------------------- /t/nested-tags.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # Test for breakage of Dist::Milla in v1.46 4 | # 5 | 6 | use strict; 7 | use warnings; 8 | use Text::Template; 9 | 10 | BEGIN { 11 | # Minimum Test::More version; 0.94+ is required for `done_testing` 12 | unless (eval { require Test::More; "$Test::More::VERSION" >= 0.94; }) { 13 | Test::More::plan(skip_all => '[ Test::More v0.94+ ] is required for testing'); 14 | } 15 | 16 | Test::More->import; 17 | } 18 | 19 | my $tmpl = Text::Template->new( 20 | TYPE => 'STRING', 21 | SOURCE => q| {{ '{{$NEXT}}' }} |, 22 | DELIMITERS => [ '{{', '}}' ]); 23 | 24 | is $tmpl->fill_in, ' {{$NEXT}} '; 25 | 26 | done_testing; 27 | -------------------------------------------------------------------------------- /t/ofh.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # test apparatus for Text::Template module 4 | # still incomplete. 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 3; 9 | use File::Temp; 10 | 11 | use_ok 'Text::Template' or exit 1; 12 | 13 | my $template = Text::Template->new( 14 | TYPE => 'STRING', 15 | SOURCE => q{My process ID is {$$}}); 16 | 17 | my $of = File::Temp->new; 18 | 19 | my $text = $template->fill_in(OUTPUT => $of); 20 | 21 | # (1) No $text should have been constructed. Return value should be true. 22 | is $text, '1'; 23 | 24 | close $of or die "close(): $!"; 25 | 26 | open my $ifh, '<', $of->filename or die "open($of): $!"; 27 | 28 | my $t; 29 | { local $/; $t = <$ifh> } 30 | close $ifh; 31 | 32 | # (2) The text should have been printed to the file 33 | is $t, "My process ID is $$"; 34 | -------------------------------------------------------------------------------- /t/out.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # test apparatus for Text::Template module 4 | # still incomplete. 5 | # 6 | 7 | use strict; 8 | use warnings; 9 | use Test::More tests => 4; 10 | 11 | use_ok 'Text::Template' or exit 1; 12 | 13 | my $templateIN = q{ 14 | This line should have a 3: {1+2} 15 | 16 | This line should have several numbers: 17 | { $t = ''; foreach $n (1 .. 20) { $t .= $n . ' ' } $t } 18 | }; 19 | 20 | my $templateOUT = q{ 21 | This line should have a 3: { $OUT = 1+2 } 22 | 23 | This line should have several numbers: 24 | { foreach $n (1 .. 20) { $OUT .= $n . ' ' } } 25 | }; 26 | 27 | # Build templates from string 28 | my $template = Text::Template->new('type' => 'STRING', 'source' => $templateIN); 29 | isa_ok $template, 'Text::Template'; 30 | 31 | $templateOUT = Text::Template->new('type' => 'STRING', 'source' => $templateOUT); 32 | isa_ok $templateOUT, 'Text::Template'; 33 | 34 | # Fill in templates 35 | my $text = $template->fill_in(); 36 | my $textOUT = $templateOUT->fill_in(); 37 | 38 | # (1) They should be the same 39 | is $text, $textOUT; 40 | 41 | # Missing: Test this feature in Safe compartments; 42 | # it's a totally different code path. 43 | # Decision: Put that into safe.t, because that file should 44 | # be skipped when Safe.pm is unavailable. 45 | 46 | exit; 47 | -------------------------------------------------------------------------------- /t/prepend.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # Tests for PREPEND features 4 | # These tests first appeared in version 1.22. 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 10; 9 | 10 | use_ok 'Text::Template' or exit 1; 11 | 12 | @Emptyclass1::ISA = 'Text::Template'; 13 | @Emptyclass2::ISA = 'Text::Template'; 14 | 15 | my $tin = q{The value of $foo is: {$foo}}; 16 | 17 | Text::Template->always_prepend(q{$foo = "global"}); 18 | 19 | my $tmpl1 = Text::Template->new( 20 | TYPE => 'STRING', 21 | SOURCE => $tin); 22 | 23 | my $tmpl2 = Text::Template->new( 24 | TYPE => 'STRING', 25 | SOURCE => $tin, 26 | PREPEND => q{$foo = "template"}); 27 | 28 | $tmpl1->compile; 29 | $tmpl2->compile; 30 | 31 | my $t1 = $tmpl1->fill_in(PACKAGE => 'T1'); 32 | my $t2 = $tmpl2->fill_in(PACKAGE => 'T2'); 33 | my $t3 = $tmpl2->fill_in(PREPEND => q{$foo = "fillin"}, PACKAGE => 'T3'); 34 | 35 | is $t1, 'The value of $foo is: global'; 36 | is $t2, 'The value of $foo is: template'; 37 | is $t3, 'The value of $foo is: fillin'; 38 | 39 | Emptyclass1->always_prepend(q{$foo = 'Emptyclass global';}); 40 | $tmpl1 = Emptyclass1->new( 41 | TYPE => 'STRING', 42 | SOURCE => $tin); 43 | 44 | $tmpl2 = Emptyclass1->new( 45 | TYPE => 'STRING', 46 | SOURCE => $tin, 47 | PREPEND => q{$foo = "template"}); 48 | 49 | $tmpl1->compile; 50 | $tmpl2->compile; 51 | 52 | $t1 = $tmpl1->fill_in(PACKAGE => 'T4'); 53 | $t2 = $tmpl2->fill_in(PACKAGE => 'T5'); 54 | $t3 = $tmpl2->fill_in(PREPEND => q{$foo = "fillin"}, PACKAGE => 'T6'); 55 | 56 | is $t1, 'The value of $foo is: Emptyclass global'; 57 | is $t2, 'The value of $foo is: template'; 58 | is $t3, 'The value of $foo is: fillin'; 59 | 60 | $tmpl1 = Emptyclass2->new( 61 | TYPE => 'STRING', 62 | SOURCE => $tin); 63 | 64 | $tmpl2 = Emptyclass2->new( 65 | TYPE => 'STRING', 66 | SOURCE => $tin, 67 | PREPEND => q{$foo = "template"}); 68 | 69 | $tmpl1->compile; 70 | $tmpl2->compile; 71 | 72 | $t1 = $tmpl1->fill_in(PACKAGE => 'T4'); 73 | $t2 = $tmpl2->fill_in(PACKAGE => 'T5'); 74 | $t3 = $tmpl2->fill_in(PREPEND => q{$foo = "fillin"}, PACKAGE => 'T6'); 75 | 76 | is $t1, 'The value of $foo is: global'; 77 | is $t2, 'The value of $foo is: template'; 78 | is $t3, 'The value of $foo is: fillin'; 79 | -------------------------------------------------------------------------------- /t/preprocess.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # Tests for PREPROCESSOR features 4 | # These tests first appeared in version 1.25. 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 9; 9 | use File::Temp; 10 | 11 | use_ok 'Text::Template::Preprocess' or exit 1; 12 | 13 | my $tmpfile = File::Temp->new; 14 | my $TMPFILE = $tmpfile->filename; 15 | 16 | my $py = sub { tr/x/y/ }; 17 | my $pz = sub { tr/x/z/ }; 18 | 19 | my $t = 'xxx The value of $x is {$x}'; 20 | my $outx = 'xxx The value of $x is 119'; 21 | my $outy = 'yyy The value of $y is 23'; 22 | my $outz = 'zzz The value of $z is 5'; 23 | open my $tfh, '>', $TMPFILE or die "Couldn't open test file: $!; aborting"; 24 | print $tfh $t; 25 | close $tfh; 26 | 27 | my @result = ($outx, $outy, $outz, $outz); 28 | for my $trial (1, 0) { 29 | for my $test (0 .. 3) { 30 | my $tmpl; 31 | if ($trial == 0) { 32 | $tmpl = Text::Template::Preprocess->new(TYPE => 'STRING', SOURCE => $t) or die; 33 | } 34 | else { 35 | open $tfh, '<', $TMPFILE or die "Couldn't open test file: $!; aborting"; 36 | $tmpl = Text::Template::Preprocess->new(TYPE => 'FILEHANDLE', SOURCE => $tfh) or die; 37 | } 38 | $tmpl->preprocessor($py) if ($test & 1) == 1; 39 | my @args = ((($test & 2) == 2) ? (PREPROCESSOR => $pz) : ()); 40 | my $o = $tmpl->fill_in(@args, HASH => { x => 119, 'y' => 23, z => 5 }); 41 | is $o, $result[$test]; 42 | } 43 | } 44 | -------------------------------------------------------------------------------- /t/rt29928.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # Test for RT Bug 29928 fix 4 | # https://rt.cpan.org/Public/Bug/Display.html?id=29928 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 2; 9 | 10 | use_ok 'Text::Template::Preprocess' or exit 1; 11 | 12 | my $tin = q{The value of $foo is: {$foo}.}; 13 | 14 | sub tester { 15 | 1; # dummy preprocessor to cause the bug described. 16 | } 17 | 18 | my $tmpl1 = Text::Template::Preprocess->new(TYPE => 'STRING', SOURCE => $tin); 19 | 20 | $tmpl1->compile; 21 | 22 | my $t1 = $tmpl1->fill_in( 23 | HASH => { foo => 'things' }, 24 | PREPROCESSOR => \&tester); 25 | 26 | is $t1, 'The value of $foo is: things.'; 27 | -------------------------------------------------------------------------------- /t/safe.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # test apparatus for Text::Template module 4 | # still incomplete. 5 | 6 | use strict; 7 | use warnings; 8 | 9 | use Test::More; 10 | 11 | unless (eval { require Safe; 1 }) { 12 | plan skip_all => 'Safe.pm is required for this test'; 13 | } 14 | else { 15 | plan tests => 20; 16 | } 17 | 18 | use_ok 'Text::Template' or exit 1; 19 | 20 | my ($BADOP, $FAILURE); 21 | if ($^O eq 'MacOS') { 22 | $BADOP = qq{}; 23 | $FAILURE = q{}; 24 | } 25 | else { 26 | $BADOP = qq{kill 0}; 27 | $FAILURE = q{Program fragment at line 1 delivered error ``kill trapped by operation mask''}; 28 | } 29 | 30 | our $v = 119; 31 | 32 | my $c = Safe->new or die; 33 | 34 | my $goodtemplate = q{This should succeed: { $v }}; 35 | my $goodoutput = q{This should succeed: 119}; 36 | 37 | my $template1 = Text::Template->new(type => 'STRING', source => $goodtemplate); 38 | my $template2 = Text::Template->new(type => 'STRING', source => $goodtemplate); 39 | 40 | my $text1 = $template1->fill_in(); 41 | ok defined $text1; 42 | 43 | my $text2 = $template1->fill_in(SAFE => $c); 44 | ok defined $text2; 45 | 46 | my $text3 = $template2->fill_in(SAFE => $c); 47 | ok defined $text3; 48 | 49 | # (4) Safe and non-safe fills of different template objects with the 50 | # same template text should yield the same result. 51 | # print +($text1 eq $text3 ? '' : 'not '), "ok $n\n"; 52 | # (4) voided this test: it's not true, because the unsafe fill 53 | # uses package main, while the safe fill uses the secret safe package. 54 | # We could alias the secret safe package to be identical to main, 55 | # but that wouldn't be safe. If you want the aliasing, you have to 56 | # request it explicitly with `PACKAGE'. 57 | 58 | # (5) Safe and non-safe fills of the same template object 59 | # should yield the same result. 60 | # (5) voided this test for the same reason as #4. 61 | # print +($text1 eq $text2 ? '' : 'not '), "ok $n\n"; 62 | 63 | # (6) Make sure the output was actually correct 64 | is $text1, $goodoutput; 65 | 66 | my $badtemplate = qq{This should fail: { $BADOP; 'NOFAIL' }}; 67 | my $badnosafeoutput = q{This should fail: NOFAIL}; 68 | my $badsafeoutput = 69 | q{This should fail: Program fragment delivered error ``kill trapped by operation mask at template line 1.''}; 70 | 71 | $template1 = Text::Template->new('type' => 'STRING', 'source' => $badtemplate); 72 | isa_ok $template1, 'Text::Template'; 73 | 74 | $template2 = Text::Template->new('type' => 'STRING', 'source' => $badtemplate); 75 | isa_ok $template2, 'Text::Template'; 76 | 77 | # none of these should fail 78 | $text1 = $template1->fill_in(); 79 | ok defined $text1; 80 | 81 | $text2 = $template1->fill_in(SAFE => $c); 82 | ok defined $text2; 83 | 84 | $text3 = $template2->fill_in(SAFE => $c); 85 | ok defined $text3; 86 | 87 | my $text4 = $template1->fill_in(); 88 | ok defined $text4; 89 | 90 | # (11) text1 and text4 should be the same (using safe in between 91 | # didn't change anything.) 92 | is $text1, $text4; 93 | 94 | # (12) text2 and text3 should be the same (same template text in different 95 | # objects 96 | is $text2, $text3; 97 | 98 | # (13) text1 should yield badnosafeoutput 99 | is $text1, $badnosafeoutput; 100 | 101 | # (14) text2 should yield badsafeoutput 102 | $text2 =~ s/'kill'/kill/; # 5.8.1 added quote marks around the op name 103 | is $text2, $badsafeoutput; 104 | 105 | my $template = q{{$x=1}{$x+1}}; 106 | 107 | $template1 = Text::Template->new('type' => 'STRING', 'source' => $template); 108 | isa_ok $template1, 'Text::Template'; 109 | 110 | $template2 = Text::Template->new('type' => 'STRING', 'source' => $template); 111 | isa_ok $template2, 'Text::Template'; 112 | 113 | $text1 = $template1->fill_in(); 114 | $text2 = $template1->fill_in(SAFE => Safe->new); 115 | 116 | # (15) Do effects persist in safe compartments? 117 | is $text1, $text2; 118 | 119 | # (16) Try the BROKEN routine in safe compartments 120 | sub my_broken { 121 | my %a = @_; 122 | $a{error} =~ s/ at.*//s; 123 | "OK! text:$a{text} error:$a{error} lineno:$a{lineno} arg:$a{arg}"; 124 | } 125 | 126 | my $templateB = Text::Template->new(TYPE => 'STRING', SOURCE => '{die}'); 127 | isa_ok $templateB, 'Text::Template'; 128 | 129 | $text1 = $templateB->fill_in( 130 | BROKEN => \&my_broken, 131 | BROKEN_ARG => 'barg', 132 | SAFE => Safe->new); 133 | 134 | my $result1 = qq{OK! text:die error:Died lineno:1 arg:barg}; 135 | is $text1, $result1; 136 | -------------------------------------------------------------------------------- /t/safe2.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # test apparatus for Text::Template module 4 | # still incomplete. 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More; 9 | 10 | unless (eval { require Safe; 1 }) { 11 | plan skip_all => 'Safe.pm is required for this test'; 12 | } 13 | else { 14 | plan tests => 12; 15 | } 16 | 17 | use_ok 'Text::Template' or exit 1; 18 | 19 | my $c = Safe->new or die; 20 | 21 | # Test handling of packages and importing. 22 | $c->reval('$P = "safe root"'); 23 | our $P = 'main'; 24 | $Q::P = $Q::P = 'Q'; 25 | 26 | # How to effectively test the gensymming? 27 | 28 | my $t = Text::Template->new( 29 | TYPE => 'STRING', 30 | SOURCE => 'package is {$P}') or die; 31 | 32 | # (1) Default behavior: Inherit from calling package, `main' in this case. 33 | my $text = $t->fill_in(); 34 | is $text, 'package is main'; 35 | 36 | # (2) When a package is specified, we should use that package instead. 37 | $text = $t->fill_in(PACKAGE => 'Q'); 38 | is $text, 'package is Q'; 39 | 40 | # (3) When no package is specified in safe mode, we should use the 41 | # default safe root. 42 | $text = $t->fill_in(SAFE => $c); 43 | is $text, 'package is safe root'; 44 | 45 | # (4) When a package is specified in safe mode, we should use the 46 | # default safe root, after aliasing to the specified package 47 | TODO: { 48 | local $TODO = "test fails when tested with TAP/Devel::Cover" if defined $Devel::Cover::VERSION; 49 | $text = $t->fill_in(SAFE => $c, PACKAGE => 'Q'); 50 | is $text, 'package is Q'; 51 | } 52 | 53 | # Now let's see if hash vars are installed properly into safe templates 54 | $t = Text::Template->new( 55 | TYPE => 'STRING', 56 | SOURCE => 'hash is {$H}') or die; 57 | 58 | # (5) First in default mode 59 | $text = $t->fill_in(HASH => { H => 'good5' }); 60 | is $text, 'hash is good5'; 61 | 62 | # suppress "once" warnings 63 | $Q::H = $Q2::H = undef; 64 | 65 | # (6) Now in packages 66 | $text = $t->fill_in(HASH => { H => 'good6' }, PACKAGE => 'Q'); 67 | is $text, 'hash is good6'; 68 | 69 | # (7) Now in the default root of the safe compartment 70 | TODO: { 71 | local $TODO = "test fails when tested with TAP/Devel::Cover" if defined $Devel::Cover::VERSION; 72 | $text = $t->fill_in(HASH => { H => 'good7' }, SAFE => $c); 73 | is $text, 'hash is good7'; 74 | } 75 | 76 | # (8) Now in the default root after aliasing to a package that 77 | # got the hash stuffed in 78 | our $H; 79 | TODO: { 80 | local $TODO = "test fails when tested with TAP/Devel::Cover" if defined $Devel::Cover::VERSION; 81 | $text = $t->fill_in(HASH => { H => 'good8' }, SAFE => $c, PACKAGE => 'Q2'); 82 | is $text, 'hash is good8'; 83 | } 84 | 85 | # Now let's make sure that none of the packages leaked on each other. 86 | # (9) This var should NOT have been installed into the main package 87 | ok !defined $H; 88 | $H = $H; 89 | 90 | # (11) this value overwrote the one from test 6. 91 | is $Q::H, 'good7'; 92 | 93 | # (12) 94 | is $Q2::H, 'good8'; 95 | -------------------------------------------------------------------------------- /t/safe3.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # test apparatus for Text::Template module 4 | 5 | use strict; 6 | use warnings; 7 | use Test::More; 8 | 9 | unless (eval { require Safe; 1 }) { 10 | plan skip_all => 'Safe.pm is required for this test'; 11 | } 12 | else { 13 | plan tests => 4; 14 | } 15 | 16 | use_ok 'Text::Template' or exit 1; 17 | 18 | # Test the OUT feature with safe compartments 19 | 20 | my $template = q{ 21 | This line should have a 3: {1+2} 22 | 23 | This line should have several numbers: 24 | { $t = ''; foreach $n (1 .. 20) { $t .= $n . ' ' } $t } 25 | }; 26 | 27 | my $templateOUT = q{ 28 | This line should have a 3: { $OUT = 1+2 } 29 | 30 | This line should have several numbers: 31 | { foreach $n (1 .. 20) { $OUT .= $n . ' ' } } 32 | }; 33 | 34 | my $c = Safe->new; 35 | 36 | # Build templates from string 37 | $template = Text::Template->new( 38 | type => 'STRING', 39 | source => $template, 40 | SAFE => $c) or die; 41 | 42 | $templateOUT = Text::Template->new( 43 | type => 'STRING', 44 | source => $templateOUT, 45 | SAFE => $c) or die; 46 | 47 | # Fill in templates 48 | my $text = $template->fill_in() 49 | or die; 50 | my $textOUT = $templateOUT->fill_in() 51 | or die; 52 | 53 | # (1) They should be the same 54 | is $text, $textOUT; 55 | 56 | # (2-3) "Joel Appelbaum" <000701c0ac2c$aed1d6e0$0201a8c0@prime> 57 | # "Contrary to the documentation the $OUT variable is not always 58 | # undefined at the start of each program fragment. The $OUT variable 59 | # is never undefined after it is used once if you are using the SAFE 60 | # option. The result is that every fragment after the fragment that 61 | # $OUT was used in is replaced by the old $OUT value instead of the 62 | # result of the fragment. This holds true even after the 63 | # Text::Template object goes out of scope and a new one is created!" 64 | # 65 | # Also reported by Daini Xie. 66 | 67 | { 68 | my $template = q{{$OUT = 'x'}y{$OUT .= 'z'}}; 69 | my $expected = "xyz"; 70 | my $s = Safe->new; 71 | my $o = Text::Template->new( 72 | type => 'string', 73 | source => $template); 74 | 75 | for (1 .. 2) { 76 | my $r = $o->fill_in(SAFE => $s); 77 | 78 | is $r, $expected; 79 | } 80 | } 81 | -------------------------------------------------------------------------------- /t/strict.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | # 3 | # Tests for STRICT features 4 | # These tests first appeared in version 1.48. 5 | 6 | use strict; 7 | use warnings; 8 | use Test::More tests => 4; 9 | 10 | use_ok 'Text::Template' or exit 1; 11 | 12 | @Emptyclass1::ISA = 'Text::Template'; 13 | @Emptyclass2::ISA = 'Text::Template'; 14 | 15 | my $tin = q{The value of $foo is: {$foo}}; 16 | 17 | Text::Template->always_prepend(q{$foo = "global"}); 18 | 19 | my $tmpl1 = Text::Template->new( 20 | TYPE => 'STRING', 21 | SOURCE => $tin); 22 | 23 | my $tmpl2 = Text::Template->new( 24 | TYPE => 'STRING', 25 | SOURCE => $tin, 26 | PREPEND => q{$foo = "template"}); 27 | 28 | $tmpl1->compile; 29 | $tmpl2->compile; 30 | 31 | # strict should cause t1 to contain an error message if wrong variable is used in template 32 | my $t1 = $tmpl1->fill_in(PACKAGE => 'T1', STRICT => 1, HASH => { bar => 'baz' }); 33 | 34 | # non-strict still works 35 | my $t2 = $tmpl2->fill_in(PACKAGE => 'T2', HASH => { bar => 'baz' }); 36 | 37 | # prepend overrides the hash values 38 | my $t3 = $tmpl2->fill_in( 39 | PREPEND => q{$foo = "fillin"}, 40 | PACKAGE => 'T3', 41 | STRICT => 1, 42 | HASH => { foo => 'hashval2' }); 43 | 44 | like $t1, qr/Global symbol "\$foo" requires explicit package/; 45 | is $t2, 'The value of $foo is: template', "non-strict hash still works"; 46 | is $t3, "The value of \$foo is: fillin", "hash values with prepend, prepend wins, even under strict."; 47 | -------------------------------------------------------------------------------- /t/taint.t: -------------------------------------------------------------------------------- 1 | #!perl -T 2 | # Tests for taint-mode features 3 | 4 | use strict; 5 | use warnings; 6 | use lib 'blib/lib'; 7 | use Test::More; 8 | use File::Temp; 9 | use Config; 10 | 11 | if (exists($Config{taint_support}) && not $Config{taint_support}) { 12 | plan skip_all => "your perl was built without taint support"; 13 | } 14 | else { 15 | plan tests => 21; 16 | } 17 | 18 | use_ok 'Text::Template' or exit 1; 19 | 20 | if ($^O eq 'MSWin32') { 21 | # File::Temp (for all versions up to at least 0.2308) is currently bugged under MSWin32/taint mode [as of 2018-09] 22 | # ... fails unless "/tmp" on the current windows drive is a writable directory OR either $ENV{TMP} or $ENV{TEMP} are untainted and point to a writable directory 23 | # ref: [File-Temp: Fails under -T, Windows 7, Strawberry Perl 5.12.1](https://rt.cpan.org/Public/Bug/Display.html?id=60340) 24 | ($ENV{TEMP}) = $ENV{TEMP} =~ m/^.*$/gmsx; # untaint $ENV{TEMP} 25 | ($ENV{TMP}) = $ENV{TMP} =~ m/^.*$/gmsx; # untaint $ENV{TMP} 26 | } 27 | 28 | my $tmpfile = File::Temp->new; 29 | my $file = $tmpfile->filename; 30 | 31 | # makes its arguments tainted 32 | sub taint { 33 | for (@_) { 34 | $_ .= substr($0, 0, 0); # LOD 35 | } 36 | } 37 | 38 | my $template = 'The value of $n is {$n}.'; 39 | 40 | open my $fh, '>', $file or die "Couldn't write temporary file $file: $!"; 41 | print $fh $template, "\n"; 42 | close $fh or die "Couldn't finish temporary file $file: $!"; 43 | 44 | sub should_fail { 45 | my $obj = Text::Template->new(@_); 46 | eval { $obj->fill_in() }; 47 | if ($@) { 48 | pass $@; 49 | } 50 | else { 51 | fail q[didn't fail]; 52 | } 53 | } 54 | 55 | sub should_work { 56 | my $obj = Text::Template->new(@_); 57 | eval { $obj->fill_in() }; 58 | if ($@) { 59 | fail $@; 60 | } 61 | else { 62 | pass; 63 | } 64 | } 65 | 66 | sub should_be_tainted { 67 | ok !Text::Template::_is_clean($_[0]); 68 | } 69 | 70 | sub should_be_clean { 71 | ok Text::Template::_is_clean($_[0]); 72 | } 73 | 74 | # Tainted filename should die with and without UNTAINT option 75 | # untainted filename should die without UNTAINT option 76 | # filehandle should die without UNTAINT option 77 | # string and array with tainted data should die either way 78 | 79 | # (2)-(7) 80 | my $tfile = $file; 81 | taint($tfile); 82 | should_be_tainted($tfile); 83 | should_be_clean($file); 84 | should_fail TYPE => 'file', SOURCE => $tfile; 85 | should_fail TYPE => 'file', SOURCE => $tfile, UNTAINT => 1; 86 | should_fail TYPE => 'file', SOURCE => $file; 87 | should_work TYPE => 'file', SOURCE => $file, UNTAINT => 1; 88 | 89 | # (8-9) 90 | open $fh, '<', $file or die "Couldn't open $file for reading: $!; aborting"; 91 | should_fail TYPE => 'filehandle', SOURCE => $fh; 92 | close $fh; 93 | 94 | open $fh, '<', $file or die "Couldn't open $file for reading: $!; aborting"; 95 | should_work TYPE => 'filehandle', SOURCE => $fh, UNTAINT => 1; 96 | close $fh; 97 | 98 | # (10-15) 99 | my $ttemplate = $template; 100 | taint($ttemplate); 101 | should_be_tainted($ttemplate); 102 | should_be_clean($template); 103 | should_fail TYPE => 'string', SOURCE => $ttemplate; 104 | should_fail TYPE => 'string', SOURCE => $ttemplate, UNTAINT => 1; 105 | should_work TYPE => 'string', SOURCE => $template; 106 | should_work TYPE => 'string', SOURCE => $template, UNTAINT => 1; 107 | 108 | # (16-19) 109 | my $array = [$template]; 110 | my $tarray = [$ttemplate]; 111 | should_fail TYPE => 'array', SOURCE => $tarray; 112 | should_fail TYPE => 'array', SOURCE => $tarray, UNTAINT => 1; 113 | should_work TYPE => 'array', SOURCE => $array; 114 | should_work TYPE => 'array', SOURCE => $array, UNTAINT => 1; 115 | 116 | # (20-21) Test _unconditionally_untaint utility function 117 | Text::Template::_unconditionally_untaint($ttemplate); 118 | should_be_clean($ttemplate); 119 | Text::Template::_unconditionally_untaint($tfile); 120 | should_be_clean($tfile); 121 | -------------------------------------------------------------------------------- /t/template-encoding.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use utf8; 4 | use strict; 5 | use warnings; 6 | use Test::More; 7 | use Encode; 8 | use File::Temp; 9 | 10 | # Non-CORE module(s) 11 | unless (eval { require Test::More::UTF8; 1; } ) { 12 | plan skip_all => '[ Test::More::UTF8 ] is required for testing'; 13 | } 14 | 15 | plan tests => 3; 16 | 17 | use_ok 'Text::Template' or exit 1; 18 | 19 | my $tmp_fh = File::Temp->new; 20 | 21 | print $tmp_fh encode('UTF-8', "\x{4f60}\x{597d} {{\$name}}"); 22 | 23 | $tmp_fh->flush; 24 | 25 | # UTF-8 encoded template file 26 | my $str = Text::Template->new( 27 | TYPE => 'FILE', 28 | SOURCE => $tmp_fh->filename, 29 | ENCODING => 'UTF-8' 30 | )->fill_in(HASH => { name => 'World' }); 31 | 32 | is $str, "\x{4f60}\x{597d} World"; 33 | 34 | $tmp_fh = File::Temp->new; 35 | 36 | print $tmp_fh encode('iso-8859-1', "Ol\x{e1} {{\$name}}"); 37 | 38 | $tmp_fh->flush; 39 | 40 | # ISO-8859-1 encoded template file 41 | $str = Text::Template->new( 42 | TYPE => 'FILE', 43 | SOURCE => $tmp_fh->filename, 44 | ENCODING => 'iso-8859-1' 45 | )->fill_in(HASH => { name => 'World' }); 46 | 47 | is $str, "Ol\x{e1} World"; 48 | -------------------------------------------------------------------------------- /t/warnings.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use Text::Template; 6 | 7 | # Minimum Test::More version; 0.94+ is required for `done_testing` 8 | BEGIN { 9 | unless (eval { require Test::More; "$Test::More::VERSION" >= 0.94; }) { 10 | Test::More::plan(skip_all => '[ Test::More v0.94+ ] is required for testing'); 11 | } 12 | 13 | Test::More->import; 14 | 15 | # Non-CORE module(s) 16 | unless (eval { require Test::Warnings; 1; }) { 17 | plan(skip_all => '[ Test::Warnings ] is required for testing'); 18 | } 19 | 20 | Test::Warnings->import; 21 | } 22 | 23 | my $template = <<'EOT'; 24 | {{ 25 | if ($good =~ /good/) { 26 | 'This template should not produce warnings.'.$bad; 27 | } 28 | }} 29 | EOT 30 | 31 | $template = Text::Template->new(type => 'STRING', source => $template); 32 | isa_ok $template, 'Text::Template'; 33 | 34 | my $result = $template->fill_in(HASH => { good => 'good' }); 35 | 36 | $result =~ s/(?:^\s+)|(?:\s+$)//gs; 37 | is $result, 'This template should not produce warnings.'; 38 | 39 | # see https://github.com/mschout/perl-text-template/issues/10 40 | $template = Text::Template->new(type => 'STRING', package => 'MY', source => ''); 41 | $template->fill_in(package => 'MY', hash => { include => sub { 'XX' } }); 42 | 43 | $template = Text::Template->new(type => 'STRING', package => 'MY', source => ''); 44 | $template->fill_in(package => 'MY', hash => { include => sub { 'XX' } }); 45 | 46 | done_testing; 47 | -------------------------------------------------------------------------------- /tools/docker-test.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | git config --global user.name "TravisCI" 4 | git config --global user.email $HOSTNAME":not-for-mail@travis-ci.org" 5 | 6 | cd /app 7 | 8 | dzil test 9 | -------------------------------------------------------------------------------- /tools/smoke.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | docker images | grep mschout/perl-dzil-mschout | awk '{print $1 ":" $2}' | sort | \ 4 | while read image 5 | do 6 | echo 7 | echo "********** Testing in $image **********" 8 | echo 9 | 10 | docker run --rm -v $PWD:/app $image /app/tools/docker-test.sh 11 | 12 | if [ $? -ne 0 ]; then 13 | echo "********** Failed in $image **********" 14 | exit 1 15 | fi 16 | done 17 | --------------------------------------------------------------------------------