File Coverage

blib/lib/Object/Signature/Portable.pm
Criterion Covered Total %
statement 32 34 94.1
branch 6 8 75.0
condition 5 7 71.4
subroutine 8 8 100.0
pod 1 1 100.0
total 52 58 89.6


line stmt bran cond sub pod time code
1             package Object::Signature::Portable;
2              
3             # ABSTRACT: generate portable fingerprints of objects
4              
5 1     1   475203 use v5.14;
  1         5  
6 1     1   7 use warnings;
  1         2  
  1         79  
7              
8 1     1   6 use Carp;
  1         3  
  1         114  
9 1     1   701 use Crypt::Digest;
  1         5626  
  1         71  
10 1     1   8 use Exporter 5.57 qw/ import /;
  1         18  
  1         41  
11 1     1   623 use JSON::MaybeXS;
  1         11009  
  1         574  
12              
13             # RECOMMEND PREREQ: Crypt::Digest 0.062
14              
15             our $VERSION = 'v1.2.2';
16              
17             our @EXPORT = qw/ signature /;
18             our @EXPORT_OK = @EXPORT;
19              
20              
21             sub signature {
22 10     10 1 756 my %args;
23              
24 10 100       33 if ( scalar(@_) <= 1 ) {
25 6         19 $args{data} = $_[0];
26             } else {
27 4         20 %args = @_;
28             }
29              
30 10   100     55 $args{digest} //= 'MD5';
31              
32 10   100     50 $args{format} //= 'hexdigest';
33 10 50       65 unless ( $args{format} =~ m/^(?:hex|b64u?)digest$/ ) {
34 0         0 croak sprintf( 'Invalid digest format: %s', $args{format} );
35             }
36              
37             $args{serializer} //= sub {
38 10     10   33 return JSON->new->canonical(1)->allow_nonref(1)->utf8(1)->pretty(0)
39             ->indent(0)->space_before(0)->space_after(0)->allow_blessed(1)
40             ->convert_blessed(1)->encode( $_[0] );
41 10   33     122 };
42              
43 10         134 my $digest = Crypt::Digest->new( $args{digest} );
44 10         26 $digest->add( &{ $args{serializer} }( $args{data} ) );
  10         24  
45              
46 10 50       238 if ( my $method = $digest->can( $args{format} ) ) {
47 10 100       49 my $prefix = $args{prefix} ? ( $args{digest} . ':' ) : '';
48 10         217 return $prefix . $digest->$method;
49             } else {
50             croak sprintf( 'Unexpected error with digest format: %s',
51 0           $args{format} );
52             }
53             }
54              
55              
56             1;
57              
58             __END__