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 |