File Coverage

blib/lib/Text/Template/Tiny.pm
Criterion Covered Total %
statement 35 43 81.4
branch 6 10 60.0
condition 1 3 33.3
subroutine 5 6 83.3
pod 0 3 0.0
total 47 65 72.3


line stmt bran cond sub pod time code
1             #! perl
2              
3             package Text::Template::Tiny;
4              
5 2     2   248738 use warnings;
  2         5  
  2         139  
6 2     2   12 use strict;
  2         9  
  2         1136  
7              
8             =head1 NAME
9              
10             Text::Template::Tiny - Variable substituting template processor
11              
12             =cut
13              
14             our $VERSION = '1.000.1';
15              
16             =head1 SYNOPSIS
17              
18             This is a very small and limited template processor. The only thing it
19             can do is substitute variables in a text.
20              
21             Often that is all you need :-).
22              
23             Example:
24              
25             use Text::Template::Tiny;
26              
27             # Create a template processor, with preset subtitutions.
28             my $xp = Text::Template::Tiny->new(
29             home => $ENV{HOME},
30             lib => {
31             dev => "/tmp/mylib",
32             std => "/etc/mylib",
33             },
34             version => 1.02,
35             );
36              
37             # Add some more substitutions.
38             $xp->add( app => "MyApp" );
39              
40             # Apply it.
41             print $xp->expand(<
42             For [% app %] version [% version %], the home of all operations
43             will be [% home %], and the library is [% lib.std %].
44             EOD
45              
46             # Same, with additional substitutions for this call only.
47             print $xp->expand( < "ThisApp" } );
48             For [% app %] version [% version %], the home of all operations
49             will be [% home %], and the library is [% lib.std %].
50             EOD
51              
52             =cut
53              
54             sub new {
55 1     1 0 184752 my ($pkg, %ctrl) = @_;
56 1         11 bless { _ctrl => { %ctrl } }, $pkg;
57             }
58              
59             sub add {
60 0     0 0 0 my ($self, %ctrl) = @_;
61 0         0 @{$self->{_ctrl}}{keys %ctrl} = values %ctrl;
  0         0  
62 0         0 delete $self->{_pat};
63 0         0 delete $self->{_rep};
64             }
65              
66             sub expand {
67 1     1 0 7 my ($self, $text, %ctrl) = @_;
68              
69 1         5 my $save_ctrl;
70 1 50       5 if ( %ctrl ) {
71 0         0 $save_ctrl = { %{$self->{_ctrl} } };
  0         0  
72 0         0 $self->add(%ctrl);
73             }
74              
75 1         6 my $pat = $self->{_pat};
76 1         3 my $rep = $self->{_rep};
77 1         3 my $ctrl = $self->{_ctrl};
78              
79 1 50 33     5 unless ( $pat && $rep ) {
80 1         2 my $addpat;
81             $addpat = sub {
82 3     3   9 my ( $c, $pfx ) = @_;
83 3         14 while ( my ($k,$v) = each %$c ) {
84 6 100       25 if ( UNIVERSAL::isa( $v, 'HASH' ) ) {
85 2         10 $addpat->( $v, "$pfx$k." );
86             }
87             else {
88 4         13 $pat .= quotemeta($pfx.$k) . "|";
89 4         23 $rep->{$pfx.$k} = $v;
90             }
91             }
92 1         25 };
93 1         5 $pat = "(";
94 1         4 $addpat->( $self->{_ctrl}, "" );
95 1         3 chop($pat);
96 1         2 $pat .= ")";
97 1         95 $pat = qr/\[\%\s+$pat\s+\%\]/;
98 1 50       6 unless ( %ctrl ) {
99 1         4 $self->{_pat} = $pat;
100 1         2 $self->{_rep} = $rep;
101             }
102             }
103              
104 1         14 $text =~ s/$pat/$rep->{$1}/ge;
  4         25  
105              
106 1 50       7 $self->{_ctrl} = $save_ctrl if $save_ctrl;
107              
108 1         9 return $text;
109             }
110              
111             =head1 AUTHOR
112              
113             Johan Vromans, C<< >>
114              
115             =head1 SUPPORT AND DOCUMENTATION
116              
117             Development of this module takes place on GitHub:
118             https://github.com/sciurius/perl-Text-Template-Tiny.
119              
120             You can find documentation for this module with the perldoc command.
121              
122             perldoc Text::Template::Tiny
123              
124             Please report any bugs or feature requests using the issue tracker on
125             GitHub.
126              
127              
128             =head1 COPYRIGHT & LICENSE
129              
130             Copyright 2008,2015,2024 Johan Vromans, all rights reserved.
131              
132             This program is free software; you can redistribute it and/or modify it
133             under the same terms as Perl itself.
134              
135             =cut
136              
137             1; # End of Text::Template::Tiny