File Coverage

blib/lib/URI/Signature/Tiny.pm
Criterion Covered Total %
statement 33 33 100.0
branch 14 14 100.0
condition n/a
subroutine 9 9 100.0
pod 4 4 100.0
total 60 60 100.0


line stmt bran cond sub pod time code
1 2     2   133391 use strict; use warnings;
  2     2   12  
  2         73  
  2         9  
  2         3  
  2         107  
2              
3             package URI::Signature::Tiny;
4              
5             our $VERSION = '1.003';
6              
7 2     2   888 use Digest::SHA ();
  2         5428  
  2         42  
8 2     2   13 use Carp ();
  2         4  
  2         22  
9 2     2   8 use Scalar::Util ();
  2         4  
  2         967  
10              
11             my @defaults = (
12             sort_params => 1,
13             recode_base64 => 1,
14             after_sign => sub { Carp::croak( 'No after_sign callback specified' ) },
15             before_verify => sub { Carp::croak( 'No before_verify callback specified' ) },
16             function => \&Digest::SHA::hmac_sha256_base64,
17             );
18              
19             sub new {
20 25     25 1 3730 my $class = shift;
21 25         101 my $self = bless { @defaults, @_ }, $class;
22 25 100       247 Carp::croak( "Missing secret for $class" ) unless defined $self->{'secret'};
23 24         89 $self;
24             }
25              
26             sub signature {
27 23     23 1 8234 my ( $self, $uri ) = ( shift, @_ );
28              
29 23 100       193 Carp::croak( 'Cannot compute the signature of an undefined value' ) unless defined $uri;
30              
31 21 100       111 $uri = $uri->isa( 'URI::WithBase' ) ? $uri->abs->as_string : $uri->as_string
    100          
32             if Scalar::Util::blessed( $uri );
33              
34 21 100       600 $uri =~ m[ \A [^?#]* \? ]xgc and $uri =~ s[ \G ([^#]+) ]{
35 9         36 my @qp = split /[&;]/, "$1";
36 9 100       51 join ';', $self->{'sort_params'} ? sort @qp : @qp;
37             }xe;
38              
39 21         186 my $sig = $self->{'function'}->( $uri, $self->{'secret'} );
40              
41 21 100       88 $sig =~ s/=+\z//, $sig =~ y{+/}{-_} if $self->{'recode_base64'};
42              
43 21         101 $sig;
44             }
45              
46             sub sign {
47 3     3 1 6790 my ( $self, $uri ) = ( shift, @_ );
48 3         9 $self->{'after_sign'}->( $uri, $self->signature( $uri ) );
49             }
50              
51             sub verify {
52 3     3 1 162 my $self = shift;
53 3         16 my ( $uri, $sig ) = $self->{'before_verify'}->( @_ );
54 2         182 $sig eq $self->signature( $uri );
55             }
56              
57             1;