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   533 use strict;
  1         4  
  1         29  
4 1     1   6 use warnings;
  1         5  
  1         29  
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   5 use parent qw( Crypt::Perl::X509::Extension );
  1         3  
  1         6  
19              
20             use constant {
21 1         98 OID => '2.5.29.33',
22             OID_anyPolicy => '2.5.29.32.0',
23             CRITICAL => 1,
24 1     1   79 };
  1         2  
25              
26 1     1   7 use constant ASN1 => <
  1         2  
  1         265  
27             policyMappings ::= SEQUENCE OF SEQUENCE {
28             issuerDomainPolicy OBJECT IDENTIFIER,
29             subjectDomainPolicy OBJECT IDENTIFIER
30             }
31             END
32              
33             sub new {
34 6     6 0 35 my ($class, @mappings) = @_;
35              
36 6         12 my @self;
37              
38 6         35 for my $m_hr (@mappings) {
39 12         26 my %cur;
40              
41 12         21 for my $k ( qw( issuer subject ) ) {
42 24 50       68 next if !defined $m_hr->{$k};
43              
44 24         147 my $oid = $class->can("OID_$m_hr->{$k}");
45 24   66     86 $oid &&= $oid->();
46 24   66     84 $oid ||= $m_hr->{$k};
47              
48 24         82 $cur{"${k}DomainPolicy"} = $oid;
49             }
50              
51 12         31 push @self, \%cur;
52             }
53              
54 6         39 return bless \@self, $class;
55             }
56              
57             sub _encode_params {
58 6     6   25 my ($self) = @_;
59              
60 6         27 return [ @$self ];
61             }
62              
63             1;