File Coverage

blib/lib/ColorThemeBase/Constructor.pm
Criterion Covered Total %
statement 18 20 90.0
branch 10 12 83.3
condition 6 6 100.0
subroutine 2 2 100.0
pod 0 1 0.0
total 36 41 87.8


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