File Coverage

lib/Context/Singleton/Frame/Builder/Base.pm
Criterion Covered Total %
statement 40 40 100.0
branch 4 4 100.0
condition 4 6 66.6
subroutine 11 11 100.0
pod 0 7 0.0
total 59 68 86.7


line stmt bran cond sub pod time code
1              
2 7     7   339909 use strict;
  7         29  
  7         207  
3 7     7   59 use warnings;
  7         34  
  7         404  
4              
5             package Context::Singleton::Frame::Builder::Base;
6              
7             our $VERSION = v1.0.4;
8              
9 7     7   4499 use List::MoreUtils;
  7         85260  
  7         67  
10              
11             sub new {
12 335     335 0 121782 my ($class, %params) = @_;
13              
14 335   100     1520 $params{default} //= {};
15              
16 335         661 my $self = bless \%params, $class;
17              
18 335         924 $self->{required} = [ List::MoreUtils::uniq $self->_build_required ];
19              
20 335         1209 return $self;
21             }
22              
23             sub _build_required {
24 335     335   599 my ($self) = @_;
25              
26 335         1282 return grep defined, $self->{this};
27             }
28              
29             sub dep {
30 282     282 0 17058 my ($self) = @_;
31 282         2008 return $self->{dep};
32             }
33              
34             sub required {
35 98     98 0 35992 my ($self) = @_;
36              
37 98         149 return @{ $self->{required} };
  98         387  
38             }
39              
40             sub unresolved {
41 14     14 0 25580 my ($self, $resolved) = @_;
42 14         43 my $default = $self->{default};
43 14   50     98 $resolved //= {};
44              
45             return
46             grep ! exists $default->{$_},
47 14         72 grep ! exists $resolved->{$_},
48             $self->required
49             ;
50             }
51              
52             sub default {
53 74     74 0 4741 my ($self) = @_;
54              
55 74         115 return %{ $self->{default} };
  74         254  
56             }
57              
58             sub build {
59 17     17 0 4964 my ($self, $resolved) = @_;
60              
61 17   50     43 $resolved = { %{ $self->{default} }, %{ $resolved // {} } };
  17         48  
  17         94  
62 17         74 my @args = $self->build_callback_args ($resolved);
63              
64             return $self->{as}->(@args)
65 17 100       102 if $self->{as};
66              
67 2         5 my $this = shift @args;
68              
69             return $this->can ($self->{call})->(@args)
70 2 100       18 if exists $self->{call};
71              
72 1         3 return $this->${\ $self->{builder} } (@args);
  1         6  
73             }
74              
75             sub build_callback_args {
76 29     29 0 13384 my ($self, $resolved) = @_;
77              
78 29         139 return map $resolved->{$_}, grep $_, $self->{this};
79             }
80              
81             1;
82