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   834 use v5.10;
  1         4  
6              
7 1     1   6 use strict;
  1         1  
  1         20  
8 1     1   5 use warnings;
  1         2  
  1         21  
9              
10 1     1   5 use Carp;
  1         2  
  1         114  
11 1     1   508 use Crypt::Digest;
  1         3825  
  1         48  
12 1     1   506 use Exporter::Lite;
  1         776  
  1         6  
13 1     1   89 use JSON::MaybeXS;
  1         2  
  1         383  
14              
15             our $VERSION = 'v1.0.0';
16              
17             our @EXPORT = qw/ signature /;
18             our @EXPORT_OK = @EXPORT;
19              
20              
21             sub signature {
22 10     10 1 708 my %args;
23              
24 10 100       28 if ( scalar(@_) <= 1 ) {
25 6         13 $args{data} = $_[0];
26             } else {
27 4         13 %args = @_;
28             }
29              
30 10   100     45 $args{digest} //= 'MD5';
31              
32 10   100     40 $args{format} //= 'hexdigest';
33 10 50       63 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   34 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     74 };
42              
43 10         85 my $digest = Crypt::Digest->new( $args{digest} );
44 10         64 $digest->add( &{ $args{serializer} }( $args{data} ) );
  10         37  
45              
46 10 50       182 if ( my $method = $digest->can( $args{format} ) ) {
47 10 100       37 my $prefix = $args{prefix} ? ( $args{digest} . ':' ) : '';
48 10         138 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__