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   825 use v5.10;
  1         3  
6              
7 1     1   6 use strict;
  1         2  
  1         20  
8 1     1   4 use warnings;
  1         2  
  1         21  
9              
10 1     1   5 use Carp;
  1         2  
  1         57  
11 1     1   502 use Crypt::Digest;
  1         3472  
  1         45  
12 1     1   442 use Exporter::Lite;
  1         730  
  1         7  
13 1     1   99 use JSON::MaybeXS;
  1         2  
  1         351  
14              
15             our $VERSION = 'v0.2.0';
16              
17             our @EXPORT = qw/ signature /;
18             our @EXPORT_OK = @EXPORT;
19              
20              
21             sub signature {
22 10     10 1 608 my %args;
23              
24 10 100       29 if ( scalar(@_) <= 1 ) {
25 6         13 $args{data} = $_[0];
26             } else {
27 4         18 %args = @_;
28             }
29              
30 10   100     44 $args{digest} //= 'MD5';
31              
32 10   100     38 $args{format} //= 'hexdigest';
33 10 50       59 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   31 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     71 };
42              
43 10         73 my $digest = Crypt::Digest->new( $args{digest} );
44 10         21 $digest->add( &{ $args{serializer} }( $args{data} ) );
  10         24  
45              
46 10 50       160 if ( my $method = $digest->can( $args{format} ) ) {
47 10 100       35 my $prefix = $args{prefix} ? ( $args{digest} . ':' ) : '';
48 10         145 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__