File Coverage

blib/lib/BorderStyleBase/Constructor.pm
Criterion Covered Total %
statement 21 23 91.3
branch 8 12 66.6
condition 3 6 50.0
subroutine 3 3 100.0
pod 0 1 0.0
total 35 45 77.7


line stmt bran cond sub pod time code
1             package BorderStyleBase::Constructor;
2              
3 1     1   438 use strict 'subs', 'vars';
  1         4  
  1         45  
4 1     1   8 use warnings;
  1         2  
  1         469  
5              
6             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
7             our $DATE = '2022-01-24'; # DATE
8             our $DIST = 'BorderStyleBase'; # DIST
9             our $VERSION = '0.010'; # VERSION
10              
11             sub new {
12 7     7 0 15481 my $class = shift;
13              
14             # check that %BORDER exists
15 7         15 my $bs_hash = \%{"$class\::BORDER"};
  7         40  
16 7 50       32 unless (defined $bs_hash->{v}) {
17 0         0 die "Class $class does not define \%BORDER with 'v' key";
18             }
19 7 50       21 unless ($bs_hash->{v} == 2) {
20 0         0 die "\%$class\::BORDER's v is $bs_hash->{v}, I only support v=2";
21             }
22              
23             # check for known and required arguments
24 7         22 my %args = @_;
25             {
26 7         17 my $args_spec = $bs_hash->{args};
  7         12  
27 7 100       21 last unless $args_spec;
28 5         19 for my $arg_name (keys %args) {
29 5 100       26 die "Unknown argument '$arg_name'" unless $args_spec->{$arg_name};
30             }
31 4         15 for my $arg_name (keys %$args_spec) {
32             die "Missing required argument '$arg_name'"
33 4 100 66     43 if $args_spec->{$arg_name}{req} && !exists($args{$arg_name});
34             # apply default
35             $args{$arg_name} = $args_spec->{$arg_name}{default}
36             if !defined($args{$arg_name}) &&
37 3 0 33     16 exists $args_spec->{$arg_name}{default};
38             }
39             }
40              
41             bless {
42 5         29 args => \%args,
43              
44             # we store this because applying roles to object will rebless the object
45             # into some other package.
46             orig_class => $class,
47             }, $class;
48             }
49              
50             1;
51             # ABSTRACT: Provide new()
52              
53             __END__