File Coverage

blib/lib/BorderStyleBase/Constructor.pm
Criterion Covered Total %
statement 18 20 90.0
branch 8 12 66.6
condition 3 6 50.0
subroutine 2 2 100.0
pod 0 1 0.0
total 31 41 75.6


line stmt bran cond sub pod time code
1             package BorderStyleBase::Constructor;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2021-02-06'; # DATE
5             our $DIST = 'BorderStyleBase'; # DIST
6             our $VERSION = '0.009'; # VERSION
7              
8 1     1   467 use strict 'subs', 'vars';
  1         2  
  1         314  
9             #use warnings;
10              
11             sub new {
12 7     7 0 9954 my $class = shift;
13              
14             # check that %BORDER exists
15 7         13 my $bs_hash = \%{"$class\::BORDER"};
  7         29  
16 7 50       22 unless (defined $bs_hash->{v}) {
17 0         0 die "Class $class does not define \%BORDER with 'v' key";
18             }
19 7 50       17 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         21 my %args = @_;
25             {
26 7         8 my $args_spec = $bs_hash->{args};
  7         14  
27 7 100       15 last unless $args_spec;
28 5         16 for my $arg_name (keys %args) {
29 4 100       20 die "Unknown argument '$arg_name'" unless $args_spec->{$arg_name};
30             }
31 4         11 for my $arg_name (keys %$args_spec) {
32             die "Missing required argument '$arg_name'"
33 4 100 66     32 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     12 exists $args_spec->{$arg_name}{default};
38             }
39             }
40              
41             bless {
42 5         23 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__