File Coverage

blib/lib/CVSS.pm
Criterion Covered Total %
statement 36 43 83.7
branch 1 8 12.5
condition 1 2 50.0
subroutine 11 15 73.3
pod 5 5 100.0
total 54 73 73.9


line stmt bran cond sub pod time code
1             package CVSS;
2              
3 2     2   254202 use feature ':5.10';
  2         4  
  2         321  
4 2     2   13 use strict;
  2         3  
  2         93  
5 2     2   806 use utf8;
  2         420  
  2         13  
6 2     2   71 use warnings;
  2         3  
  2         87  
7              
8 2     2   17 use Carp ();
  2         3  
  2         50  
9 2     2   8 use Exporter qw(import);
  2         3  
  2         104  
10              
11 2     2   13 use constant DEBUG => $ENV{CVSS_DEBUG};
  2         4  
  2         166  
12              
13 2     2   1069 use CVSS::v2;
  2         5  
  2         28  
14 2     2   1155 use CVSS::v3;
  2         5  
  2         16  
15 2     2   1326 use CVSS::v4;
  2         7  
  2         14  
16              
17             our @EXPORT = qw(encode_cvss decode_cvss cvss_to_xml);
18              
19             our $VERSION = '1.15';
20             $VERSION =~ tr/_//d; ## no critic
21              
22             my $CVSS_CLASSES = {'2.0' => 'CVSS::v2', '3.0' => 'CVSS::v3', '3.1' => 'CVSS::v3', '4.0' => 'CVSS::v4'};
23              
24 0     0 1 0 sub encode_cvss { __PACKAGE__->new(@_)->to_string }
25 0     0 1 0 sub decode_cvss { __PACKAGE__->from_vector_string(shift) }
26              
27 0 0   0 1 0 sub cvss_to_xml { @_ > 1 ? __PACKAGE__->new(@_)->to_xml : __PACKAGE__->from_vector_string(shift)->to_xml }
28              
29             sub new {
30              
31 0     0 1 0 my ($class, %params) = @_;
32 0 0       0 Carp::croak 'Missing CVSS version' unless $params{version};
33              
34 0 0       0 my $cvss_class = $CVSS_CLASSES->{$params{version}} or Carp::croak 'Unknown CVSS version';
35 0         0 return $cvss_class->new(%params);
36              
37             }
38              
39             sub from_vector_string {
40              
41 2     2 1 4 my ($class, $vector_string) = @_;
42              
43 2         24 my %metrics = split /[\/:]/, $vector_string;
44 2   50     6 my $version = delete $metrics{CVSS} || '2.0';
45 2 50       28 my $cvss_class = $CVSS_CLASSES->{$version} or Carp::croak 'Unknown CVSS version';
46              
47 2         3 DEBUG and say STDERR "-- CVSS v$version -- Vector String: $vector_string";
48              
49 2         34 return $cvss_class->new(version => sprintf('%.1f', $version), metrics => \%metrics,
50             vector_string => $vector_string);
51              
52             }
53              
54             1;
55              
56             __END__