File Coverage

lib/XML/Compile/WSS/Sign.pm
Criterion Covered Total %
statement 18 38 47.3
branch 0 10 0.0
condition 0 8 0.0
subroutine 6 10 60.0
pod 3 4 75.0
total 27 70 38.5


line stmt bran cond sub pod time code
1             # Copyrights 2012-2016 by [Mark Overmeer].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5 1     1   3 use warnings;
  1         1  
  1         35  
6 1     1   3 use strict;
  1         1  
  1         23  
7              
8             package XML::Compile::WSS::Sign;
9 1     1   2 use vars '$VERSION';
  1         1  
  1         37  
10             $VERSION = '2.02';
11              
12              
13 1     1   4 use Log::Report 'xml-compile-wss-sig';
  1         0  
  1         4  
14              
15 1     1   157 use XML::Compile::WSS::Util qw/:wss11 :dsig/;
  1         1  
  1         142  
16 1     1   4 use Scalar::Util qw/blessed/;
  1         1  
  1         261  
17              
18             my ($signs, $sigmns) = (DSIG_NS, DSIG_MORE_NS);
19              
20              
21             sub new(@)
22 0     0 1   { my $class = shift;
23 0 0         my $args = @_==1 ? shift : {@_};
24              
25 0   0       $args->{sign_method} ||= delete $args->{type}; # pre 2.00
26 0   0       my $algo = $args->{sign_method} ||= DSIG_RSA_SHA1;
27              
28 0 0         if($class eq __PACKAGE__)
29 0 0         { if($algo =~ qr/^(?:\Q$signs\E|\Q$sigmns\E)([a-z0-9]+)\-([a-z0-9]+)$/)
30 0           { my $algo = uc $1;;
31 0   0       $args->{hashing} ||= uc $2;
32 0           $class .= '::'.$algo;
33             }
34             else
35 0           { error __x"unsupported sign algorithm `{algo}'", algo => $algo;
36             }
37 0 0         eval "require $class"; panic $@ if $@;
  0            
38             }
39              
40 0           (bless {}, $class)->init($args);
41             }
42              
43             sub init($)
44 0     0 0   { my ($self, $args) = @_;
45 0           $self->{XCWS_sign_method} = $args->{sign_method};
46 0           $self;
47             }
48              
49              
50             sub fromConfig($)
51 0     0 1   { my $class = shift;
52 0 0         $class->new(@_==1 ? %{$_[0]} : @_);
  0            
53             }
54              
55             #-----------------
56              
57 0     0 1   sub signMethod() {shift->{XCWS_sign_method}}
58              
59             #-----------------
60              
61             #-----------------
62              
63             1;