File Coverage

blib/lib/Object/Signature/Portable.pm
Criterion Covered Total %
statement 35 37 94.5
branch 6 8 75.0
condition 5 6 83.3
subroutine 9 9 100.0
pod 1 1 100.0
total 56 61 91.8


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   534 use v5.10;
  1         2  
6              
7 1     1   3 use strict;
  1         2  
  1         14  
8 1     1   4 use warnings;
  1         1  
  1         16  
9              
10 1     1   3 use Carp;
  1         1  
  1         39  
11 1     1   309 use Crypt::Digest;
  1         2288  
  1         36  
12 1     1   6 use Exporter 5.57 qw/ import /;
  1         11  
  1         21  
13 1     1   4 use JSON::MaybeXS;
  1         2  
  1         276  
14              
15             our $VERSION = 'v1.1.2';
16              
17             our @EXPORT = qw/ signature /;
18             our @EXPORT_OK = @EXPORT;
19              
20              
21             sub signature {
22 10     10 1 387 my %args;
23              
24 10 100       21 if ( scalar(@_) <= 1 ) {
25 6         8 $args{data} = $_[0];
26             } else {
27 4         10 %args = @_;
28             }
29              
30 10   100     32 $args{digest} //= 'MD5';
31              
32 10   100     27 $args{format} //= 'hexdigest';
33 10 50       40 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   22 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   50     55 };
42              
43 10         52 my $digest = Crypt::Digest->new( $args{digest} );
44 10         14 $digest->add( &{ $args{serializer} }( $args{data} ) );
  10         14  
45              
46 10 50       117 if ( my $method = $digest->can( $args{format} ) ) {
47 10 100       25 my $prefix = $args{prefix} ? ( $args{digest} . ':' ) : '';
48 10         99 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__