File Coverage

lib/Templer/Plugin/Hash.pm
Criterion Covered Total %
statement 16 46 34.7
branch 1 14 7.1
condition 1 3 33.3
subroutine 4 5 80.0
pod 2 3 66.6
total 24 71 33.8


line stmt bran cond sub pod time code
1              
2             =head1 NAME
3            
4             Templer::Plugin::Hash - Create SHA1 hashes from file contents.
5            
6             =cut
7              
8             =head1 SYNOPSIS
9            
10             The following is a good example use of this plugin
11            
12             title: About my site
13             hash: hash_file( "slaughter-2.7.tar.gz" )
14             ----
15             <p><!-- tmpl_var name='hash_src' --> has hash <!-- tmpl_var name='hash_val' --></p>
16            
17            
18             =cut
19              
20             =head1 DESCRIPTION
21            
22             Given a use of hash_file two variables will be populated, one containing the
23             path to the file, and one containing the hash.
24            
25             =cut
26              
27             =head1 LICENSE
28            
29             This module is free software; you can redistribute it and/or modify it
30             under the terms of either:
31            
32             a) the GNU General Public License as published by the Free Software
33             Foundation; either version 2, or (at your option) any later version,
34             or
35            
36             b) the Perl "Artistic License".
37            
38             =cut
39              
40             =head1 AUTHOR
41            
42             Steve Kemp <steve@steve.org.uk>
43            
44             =cut
45              
46             =head1 COPYRIGHT AND LICENSE
47            
48             Copyright (C) 2015-2015 Steve Kemp <steve@steve.org.uk>.
49            
50             This library is free software. You can modify and or distribute it under
51             the same terms as Perl itself.
52            
53             =cut
54              
55             =head1 METHODS
56            
57             =cut
58              
59              
60 11     11   4345 use strict;
  11         14  
  11         244  
61 11     11   30 use warnings;
  11         10  
  11         4186  
62              
63              
64             package Templer::Plugin::Hash;
65              
66              
67             =head2 new
68            
69             Constructor. No arguments are required/supported.
70            
71             =cut
72              
73             sub new
74             {
75 11     11 1 22     my ( $proto, %supplied ) = (@_);
76 11   33     63     my $class = ref($proto) || $proto;
77              
78 11         18     my $self = {};
79 11         18     bless( $self, $class );
80 11         74     return $self;
81             }
82              
83              
84              
85             =head2 expand_variables
86            
87             This is the method which is called by the L<Templer::Plugin::Factory>
88             to expand the variables contained in a L<Templer::Site::Page> object.
89            
90             This method will expand any variable that has a value of 'hash_file(.*)'
91             into two variables accessible from your template.
92            
93             =cut
94              
95             sub expand_variables
96             {
97 9     9 1 16     my ( $self, $site, $page, $data ) = (@_);
98              
99             #
100             # Get the page-variables in the template.
101             #
102 9         35     my %hash = %$data;
103              
104             #
105             # Look for a value of "read_file" in each key.
106             #
107 9         29     foreach my $key ( keys %hash )
108                 {
109 66 50       117         if ( $hash{ $key } =~ /^hash_file\((.*)\)/ )
110                     {
111              
112             #
113             # Get the filename specified.
114             #
115 0         0             my $file = $1;
116              
117             #
118             # Strip leading/trailing quotes and whitespace.
119             #
120 0         0             $file =~ s/['"]//g;
121 0         0             $file =~ s/^\s+|\s+$//g;
122              
123             #
124             # If the file is unqualified then make it refer to the
125             # path of the source file.
126             #
127 0         0             my $dirName = $page->source();
128 0 0       0             if ( $dirName =~ /^(.*)\/(.*)$/ )
129                         {
130 0         0                 $dirName = $1;
131                         }
132 0         0             my $pwd = Cwd::cwd();
133 0         0             chdir( $dirName . "/" );
134              
135             #
136             #
137             # Setup the two new variables.
138             #
139 0         0             $hash{ $key . "_src" } = $file;
140              
141 0         0             my $sha1 = $self->hash_file($file);
142 0         0             $hash{ $key . "_hash" } = $sha1;
143              
144 0 0       0             if ( $site->{ 'verbose' } )
145                         {
146 0         0                 print "Hash of $file is $sha1\n";
147                         }
148              
149              
150             #
151             # Delete the original one.
152             #
153 0         0             delete $hash{ $key };
154              
155              
156             #
157             # Restore the PWD.
158             #
159 0         0             chdir($pwd);
160              
161                     }
162                 }
163              
164 9         19     return ( \%hash );
165             }
166              
167             #
168             # Return the SHA1 hash of the file contents.
169             #
170             sub hash_file
171             {
172 0     0 0       my ( $self, $file ) = (@_);
173              
174 0               my $hash = undef;
175              
176 0               foreach my $module (qw! Digest::SHA Digest::SHA1 !)
177                 {
178              
179             # If we succeeded in calculating the hash we're done.
180 0 0                 next if ( defined($hash) );
181              
182             # Attempt to load the module
183 0                   my $eval = "use $module;";
184              
185             ## no critic (Eval)
186 0                   eval($eval);
187             ## use critic
188              
189             #
190             # Loaded module, with no errors.
191             #
192 0 0                 if ( !$@ )
193                     {
194 0                       my $object = $module->new;
195              
196 0 0                     open my $handle, "<", $file or
197                           die "Failed to read $file to hash contents with $module - $!";
198 0                       $object->addfile($handle);
199 0                       close($handle);
200              
201 0                       $hash = $object->hexdigest();
202                     }
203                 }
204              
205 0 0             unless ( defined $hash )
206                 {
207 0                   die "Failed to calculate hash of $file - internal error.";
208                 }
209              
210 0               return ($hash);
211             }
212              
213              
214             #
215             # Register the plugin.
216             #
217             Templer::Plugin::Factory->new()->register_plugin("Templer::Plugin::Hash");
218