File Coverage

blib/lib/Template/Recall.pm
Criterion Covered Total %
statement 62 66 93.9
branch 17 24 70.8
condition 3 9 33.3
subroutine 9 9 100.0
pod 3 5 60.0
total 94 113 83.1


line stmt bran cond sub pod time code
1             package Template::Recall;
2            
3 4     4   79685 use 5.008001;
  4         13  
  4         163  
4 4     4   17 use strict;
  4         4  
  4         117  
5 4     4   21 use warnings;
  4         10  
  4         146  
6            
7 4     4   25 use base qw(Template::Recall::Base);
  4         5  
  4         1713  
8            
9             # This version: only single file template or template string
10             our $VERSION='0.19';
11            
12            
13             sub new {
14            
15 3     3 1 75 my $class = shift;
16 3         7 my $self = {};
17 3         9 bless $self, $class;
18            
19 3         12 my ( %h ) = @_;
20            
21             # Default values
22 3         33 $self->{'secpat'} = qr/\[\s*=+\s*(\w+)\s*=+\s*\]/;
23 3         20 $self->{'val_delims'} = [ qr/\['/, qr/'\]/ ];
24 3         7 $self->{'trim'} = undef; # undef=off
25            
26            
27 3 50 33     16 if (exists $h{'secpat'} and ref $h{'secpat'}) {
28 0         0 $self->{'secpat'} = $h{'secpat'};
29             }
30            
31 3 50 33     26 if (exists $h{'val_delims'} and ref $h{'val_delims'} eq 'ARRAY') {
32 0         0 $self->{'val_delims'} = $h{'val_delims'};
33             }
34            
35             # User supplied the template from a string
36            
37 3 100       15 if ( defined($h{'template_str'}) ) {
38 2         9 $self->init_template($h{'template_str'});
39 2         7 return $self;
40             }
41            
42 1 50 33     36 die 'Path to template not defined or missing'
43             unless defined($h{'template_path'}) and -e $h{'template_path'};
44            
45            
46 1         6 $self->init_template_from_file($h{'template_path'});
47            
48 1         5 return $self;
49            
50             } # new()
51            
52            
53             sub init_template_from_file {
54            
55 1     1 0 4 my ($self, $tpath) = @_;
56            
57 1         2 my $s;
58 1 50       52 open my $fh, $tpath or die "Couldn't open $tpath: $!";
59 1         29 while(<$fh>) { $s .= $_; }
  2         11  
60 1         9 close $fh;
61 1         7 $self->init_template($s);
62            
63             }
64            
65             # Handle template passed by user as string
66             sub init_template {
67            
68 3     3 0 8 my ($self, $template) = @_;
69            
70 3         103 my $sec = [ split( /($self->{'secpat'})/, $template ) ];
71            
72 3         8 my %h;
73 3         5 my $curr = '';
74            
75             # Top-down + only one 'body' follows section, why this parse hack works
76 3         7 for (my $i=0; $i <= $#{$sec} ; $i++) {
  16         43  
77 13         18 my $el = $$sec[$i];
78 13 100       40 next if $el =~ /^$/;
79 10 100       93 if ($el =~ /$self->{'secpat'}/) {
80 5         17 $curr = $1;
81 5         12 $h{$curr} = '';
82 5         9 $i++; # Skip next, it's the section name (an artifact)
83             }
84             else {
85 5         14 $h{$curr} = $el;
86             }
87             }
88            
89 3         19 $self->{'template_secs'} = \%h;
90            
91             } # init_template()
92            
93            
94             sub render {
95            
96 8     8 1 971 my ( $self, $section, $hash_ref ) = @_;
97            
98 8 50       21 die "Error: no section to render: $section\n" if !defined($section);
99            
100 8 50       27 return if !exists $self->{'template_secs'}->{$section};
101            
102 8         56 return $self->SUPER::render(
103             $self->{'template_secs'}->{$section}, $hash_ref, $self->{'val_delims'});
104            
105             } # render()
106            
107            
108             # Set trim flags
109             sub trim {
110 4     4 1 1279 my ($self, $flag) = @_;
111            
112             # trim() with no params defaults to trimming both ends
113 4 100       8 if (!defined $flag) {
114 1         2 $self->{'trim'} = 'both';
115 1         2 return;
116             }
117            
118             # Turn trimming off
119 3 100       18 if ($flag =~ /^(off|o)$/i) {
120 1         2 $self->{'trim'} = undef;
121 1         2 return;
122             }
123            
124             # Make sure we get something valid
125 2 50       8 if ($flag !~ /^(off|left|right|both|l|r|b|o)$/i) {
126 0         0 $self->{'trim'} = undef;
127 0         0 return;
128             }
129            
130 2         3 $self->{'trim'} = $flag;
131 2         4 return;
132            
133            
134             } # trim()
135            
136            
137            
138             1;
139            
140            
141             __END__