File Coverage

blib/lib/Perl/Signature.pm
Criterion Covered Total %
statement 53 53 100.0
branch 19 36 52.7
condition n/a
subroutine 17 17 100.0
pod 9 9 100.0
total 98 115 85.2


line stmt bran cond sub pod time code
1             package Perl::Signature;
2              
3             =pod
4              
5             =head1 NAME
6              
7             Perl::Signature - Generate functional signatures for Perl source code
8              
9             =head2 DESCRIPTION
10              
11             In early beta, L introduced the concept of "Document Normalization"
12             into the core. It had previously only been implemented "behind the scenes"
13             as part of L.
14              
15             Unfortunately, there isn't a whole lot of things you can do with a
16             L object. It's a giant twisty mass of objects
17             and perl structure, and not very practical for long term storage.
18              
19             L implements the idea of a "functional signature" for
20             Perl documents, implemented in a similar way to L.
21              
22             The normalized document is serialized to a string with L, then
23             this string is converted into a MD5 hash, producing a single short string
24             which represents the functionality of the Perl document.
25              
26             This signature can then be stored and transfered easily, and at any later
27             point the signature can be regenerated for the file to ensure that it has
28             not changed (functionally).
29              
30             =head2 Not Stable Across Upgrades
31              
32             Perl::Signature is relatively sensitive to change.
33              
34             Primarily, this is because L is biased towards false
35             negative comparison. (Avoiding false "these are the same" by accepting a
36             number of false "these are not the same" results).
37              
38             In addition, the serialization of L is not assured to use
39             identical file formats across versions.
40              
41             In short, you should assume that a signature is valid at best for only
42             as long as the PPI and Storable versions are the same, and at worst only
43             for the current process.
44              
45             =head1 METHODS
46              
47             PPI::Signature provides two sets of methods. A set of
48              
49             =cut
50              
51 2     2   29433 use 5.005;
  2         5  
  2         69  
52 2     2   10 use strict;
  2         3  
  2         60  
53 2     2   1764 use PPI ();
  2         301945  
  2         61  
54 2     2   20 use PPI::Util '_Document';
  2         3  
  2         113  
55 2     2   2216 use Storable ();
  2         6751  
  2         46  
56 2     2   16 use Digest::MD5 ();
  2         4  
  2         32  
57              
58 2     2   8 use vars qw{$VERSION};
  2         5  
  2         86  
59             BEGIN {
60 2     2   960 $VERSION = '1.09';
61             }
62              
63              
64              
65              
66              
67             #####################################################################
68             # Static Methods
69              
70             =pod
71              
72             =head2 file_signature $filename
73              
74             The C static method takes a filename and produces a
75             signature for the file.
76              
77             Returns a 32 character hexidecimal MD5 signature, or C on error.
78              
79             =cut
80              
81             sub file_signature {
82 29 100   29 1 839 my $class = ref $_[0] ? ref shift : shift;
83 29 50       787 my $filename = -f $_[0] ? shift : return undef;
84 29 50       196 my $Document = PPI::Document->new( $filename ) or return undef;
85 29         44391 $class->document_signature( $Document );
86             }
87              
88             =pod
89              
90             =head2 source_signature $content | \$content
91              
92             The C static method generates a signature for any
93             arbitrary Perl source code, which can be passed as either a raw string,
94             or a reference to a SCALAR containing the code.
95              
96             Returns a 32 character hexidecimal MD5 signature, or C on error.
97              
98             =cut
99              
100             sub source_signature {
101 2 50   2 1 1217 my $class = ref $_[0] ? ref shift : shift;
102 2 50       7 my $source = defined $_[0] ? shift : return undef;
103 2 50       7 $source = $$source if ref $source;
104              
105             # Build the PPI::Document
106 2 50       9 my $Document = PPI::Document->new( \$source ) or return undef;
107 2         2217 $class->document_signature( $Document );
108             }
109              
110             =pod
111              
112             =head2 document_signature $Document
113              
114             The C method takes a L object and
115             generates a signature for it.
116              
117             Returns a 32 character hexidecimal MD5 signature, or C on error.
118              
119             =cut
120              
121             sub document_signature {
122 32 50   32 1 3684 my $class = ref $_[0] ? ref shift : shift;
123 32 50       109 my $Document = _Document(shift) or return undef;
124              
125             # Normalize the PPI::Document
126 32 50       601 my $Normalized = $Document->normalized or return undef;
127              
128             # Freeze the normalized document
129 32         18033 my $string = Storable::freeze $Normalized;
130 32 50       3693 return undef unless defined $string;
131              
132             # Last step, hash the string
133 32 50       338 Digest::MD5::md5_hex( $string ) or undef;
134             }
135              
136              
137              
138              
139              
140             #####################################################################
141             # Object Methods
142              
143             =pod
144              
145             =head2 new $file
146              
147             As well as static methods for generatic signatures, L
148             also provides a simple way to create signature objects for a particular
149             file.
150              
151             This makes it relatively easy to see if a file has changed
152              
153             The C constructor takes as argument the name of a file, and creates
154             an object that remembers current signature of the file.
155              
156             =cut
157              
158             sub new {
159 3 50   3 1 2589 my $class = ref $_[0] ? ref shift : shift;
160 3 50       42 my $file = -f $_[0] ? shift : return undef;
161              
162             # Get the current signature for the file
163 3 50       12 my $signature = $class->file_signature( $file ) or return undef;
164              
165             # Create the object
166 3         495 my $self = bless {
167             file => $file,
168             signature => $signature,
169             }, $class;
170              
171 3         35 $self;
172             }
173              
174             =pod
175              
176             =head2 file
177              
178             The C accessor returns the name of the file that a Perl::Signature
179             object is set to.
180              
181             =cut
182              
183 56     56 1 1373 sub file { $_[0]->{file} }
184              
185             =pod
186              
187             =head2 current
188              
189             The C method returns the current signature for the file.
190              
191             Returns a 32 character hexidecimal MD5 signature, or C on error.
192              
193             =cut
194              
195             sub current {
196 25     25 1 3896 my $self = shift;
197 25 50       68 -f $self->file or return undef;
198 25         65 $self->file_signature( $self->file );
199             }
200              
201             =pod
202              
203             =head2 original
204              
205             The C accessor returns the original signature at the time of
206             the creation of the object.
207              
208             =cut
209              
210 26     26 1 492 sub original { $_[0]->{signature} }
211              
212             =pod
213              
214             =head2 changed
215              
216             The C method checks to see if the signature has changed since
217             the object was created.
218              
219             Returns true if the file has been (functionally) changed, false if not,
220             or C on error.
221              
222             =cut
223              
224             sub changed {
225 11     11 1 914 my $self = shift;
226 11 50       35 my $current = $self->current or return undef;
227 11         1781 $current ne $self->original;
228             }
229              
230             =pod
231              
232             =head2 unchanged
233              
234             The C method checks to ensure that the signature has not
235             changed since the object was created.
236              
237             Returns true if the file is (functionally) unchanged, false if it has
238             changed, or C on error.
239              
240             =cut
241              
242             sub unchanged {
243 4     4 1 8 my $self = shift;
244 4 50       10 my $current = $self->current or return undef;
245 4         488 $current eq $self->original;
246             }
247              
248             1;
249              
250             =pod
251              
252             =head1 SUPPORT
253              
254             All bugs should be filed via the CPAN bug tracker at
255              
256             L
257              
258             For other issues, or commercial enhancement or support, contact the author.
259              
260             =head1 AUTHORS
261              
262             Adam Kennedy Eadamk@cpan.orgE
263              
264             =head1 SEE ALSO
265              
266             L, L
267              
268             =head1 COPYRIGHT
269              
270             Copyright 2004 - 2008 Adam Kennedy.
271              
272             This program is free software; you can redistribute
273             it and/or modify it under the same terms as Perl itself.
274              
275             The full text of the license can be found in the
276             LICENSE file included with this module.
277              
278             =cut