File Coverage

lib/Crypt/Perl/X509/Extension/policyMappings.pm
Criterion Covered Total %
statement 29 29 100.0
branch 1 2 50.0
condition 4 6 66.6
subroutine 7 7 100.0
pod 0 1 0.0
total 41 45 91.1


line stmt bran cond sub pod time code
1             package Crypt::Perl::X509::Extension::policyMappings;
2              
3 1     1   453 use strict;
  1         1  
  1         27  
4 1     1   4 use warnings;
  1         2  
  1         30  
5              
6             =encoding utf-8
7              
8             =head1 NAME
9              
10             Crypt::Perl::X509::Extension::policyMappings - X.509 policyMappings extension
11              
12             =head1 SEE ALSO
13              
14             L
15              
16             =cut
17              
18 1     1   15 use parent qw( Crypt::Perl::X509::Extension );
  1         2  
  1         5  
19              
20             use constant {
21 1         86 OID => '2.5.29.33',
22             OID_anyPolicy => '2.5.29.32.0',
23             CRITICAL => 1,
24 1     1   65 };
  1         2  
25              
26 1     1   6 use constant ASN1 => <
  1         2  
  1         227  
27             policyMappings ::= SEQUENCE OF SEQUENCE {
28             issuerDomainPolicy OBJECT IDENTIFIER,
29             subjectDomainPolicy OBJECT IDENTIFIER
30             }
31             END
32              
33             sub new {
34 6     6 0 25 my ($class, @mappings) = @_;
35              
36 6         15 my @self;
37              
38 6         39 for my $m_hr (@mappings) {
39 12         52 my %cur;
40              
41 12         24 for my $k ( qw( issuer subject ) ) {
42 24 50       66 next if !defined $m_hr->{$k};
43              
44 24         143 my $oid = $class->can("OID_$m_hr->{$k}");
45 24   66     120 $oid &&= $oid->();
46 24   66     101 $oid ||= $m_hr->{$k};
47              
48 24         93 $cur{"${k}DomainPolicy"} = $oid;
49             }
50              
51 12         33 push @self, \%cur;
52             }
53              
54 6         28 return bless \@self, $class;
55             }
56              
57             sub _encode_params {
58 6     6   27 my ($self) = @_;
59              
60 6         29 return [ @$self ];
61             }
62              
63             1;