File Coverage

lib/Web/Components/Util.pm
Criterion Covered Total %
statement 62 62 100.0
branch 15 16 100.0
condition 21 22 100.0
subroutine 14 14 100.0
pod 6 6 100.0
total 118 120 100.0


line stmt bran cond sub pod time code
1             package Web::Components::Util;
2              
3 1     1   107069 use strictures;
  1         3  
  1         5  
4 1     1   124 use parent 'Exporter::Tiny';
  1         2  
  1         7  
5              
6 1     1   3255 use Module::Pluggable::Object;
  1         3473  
  1         28  
7 1     1   4 use Scalar::Util qw( blessed );
  1         2  
  1         47  
8 1     1   481 use Web::ComposableRequest::Constants qw( EXCEPTION_CLASS TRUE );
  1         130045  
  1         9  
9 1     1   720 use Web::ComposableRequest::Util qw( is_hashref );
  1         27105  
  1         10  
10 1     1   265 use Unexpected::Functions qw( Unspecified );
  1         1  
  1         9  
11 1     1   233 use Moo::Role ();
  1         1  
  1         604  
12              
13             our @EXPORT_OK = qw( deref exception first_char
14             is_arrayref load_components throw );
15              
16             # Private functions
17             my $_qualify = sub {
18             my ($appclass, $roles) = @_; $roles //= [];
19              
20             for (my $i = 0, my $len = @{ $roles }; $i < $len; $i++) {
21             if (first_char( $roles->[ $i ] ) eq '+') {
22             $roles->[ $i ] = substr $roles->[ $i ], 1;
23             }
24             else { $roles->[ $i ] = "${appclass}::".$roles->[ $i ] }
25             }
26              
27             return $roles;
28             };
29              
30             my $_setup_component = sub {
31             my ($compos, $comp_cfg, $opts, $appclass, $class, $composite) = @_;
32              
33             $composite //= $class;
34              
35             (my $klass = $class) =~ s{ \A $appclass :: }{}mx;
36             my $attr = { %{ $comp_cfg->{ $klass } // {} }, %{ $opts } };
37             my $comp = $composite->new( $attr );
38              
39             $compos->{ $comp->moniker } = $comp;
40             return;
41             };
42              
43             # Public functions
44             sub deref ($$;$) {
45 21     21 1 138 my ($x, $k, $default) = @_; my $r = $default;
  21         18  
46              
47 21 100 100     152 if (blessed $x and $x->can( $k )) { $r = $x->$k() // $default }
  13 100 100     76  
48 6   100     38 elsif (is_hashref $x) { $r = $x->{ $k } // $default }
49              
50 21         112 return $r;
51             }
52              
53             sub exception (;@) {
54 2     2 1 8600 return EXCEPTION_CLASS->caught( @_ );
55             }
56              
57             sub first_char ($) {
58 5     5 1 20 return substr $_[ 0 ], 0, 1;
59             }
60              
61             sub is_arrayref (;$) {
62 7 100 100 7 1 753 return $_[ 0 ] && ref $_[ 0 ] eq 'ARRAY' ? 1 : 0;
63             }
64              
65             sub load_components ($;@) {
66 5 100   5 1 493 my $base = shift; my $opts = (is_hashref $_[ 0 ]) ? $_[ 0 ] : { @_ };
  5         19  
67              
68 5 100       45 $base or throw( Unspecified, [ 'component base' ] );
69              
70 4         8 my $app = $opts->{application};
71             # If the app object is defined it must have a config attribute
72             # uncoverable condition false
73 4   66     55 my $config = $opts->{config} // $app->config;
74 4         25525 my $appclass = deref $config, 'appclass';
75             # The config object/hash ref is required. It must have an appclass attribute
76             # uncoverable branch true
77 4 50       10 $appclass or throw( Unspecified, [ 'config appclass' ] ); my $search_path;
  4         6  
78              
79 4 100       10 if (first_char $base eq '+') { $search_path = $base = substr $base, 1 }
  1         3  
80 3         7 else { $search_path = "${appclass}::${base}" }
81              
82 4         15 my $depth = () = split m{ :: }mx, $search_path, -1; $depth += 1;
  4         6  
83 4         32 my $finder = Module::Pluggable::Object->new
84             ( max_depth => $depth, min_depth => $depth,
85             search_path => [ $search_path ], require => TRUE, );
86 4   100     45 my $compos = $opts->{components} //= {}; # Dependency injection
87 4   100     9 my $comp_cfg = (deref $config, 'components') // {};
88              
89 4         13 for my $class ($finder->plugins) {
90 3         1526 $_setup_component->( $compos, $comp_cfg, $opts, $appclass, $class );
91             }
92              
93 4         408 my $cfgcomps = deref $config, 'config_comps';
94              
95 4 100 100     94 ($cfgcomps and $cfgcomps = $cfgcomps->{ $base }) or return $compos;
96              
97 1         1 for my $moniker (keys %{ $cfgcomps }) {
  1         5  
98 1         5 my $class = "${base}::".(ucfirst $moniker);
99 1         2 my @roles = @{ $_qualify->( $appclass, $cfgcomps->{ $moniker } ) };
  1         4  
100 1         9 my $cwr = Moo::Role->create_class_with_roles( $search_path, @roles );
101              
102 1         1471 $_setup_component->( $compos, $comp_cfg, $opts, $appclass, $class, $cwr );
103             }
104              
105 1         26 return $compos;
106             }
107              
108             sub throw (;@) {
109 2     2 1 479 EXCEPTION_CLASS->throw( @_ );
110             }
111              
112             1;
113              
114             __END__
115              
116             =pod
117              
118             =encoding utf-8
119              
120             =head1 Name
121              
122             Web::Components::Util - Functions used in this distribution
123              
124             =head1 Synopsis
125              
126             use Web::Components::Util qw( load_components );
127              
128             =head1 Description
129              
130             Functions used in this distribution
131              
132             =head1 Configuration and Environment
133              
134             Defines no attributes
135              
136             =head1 Subroutines/Methods
137              
138             =head2 C<deref>
139              
140             $value = deref $object_or_hash_ref, $key, $optional_default;
141              
142             Returns the value associated with the supplied key. Accepts either an object
143             or hash reference as the first argument. Returns the default if the result
144             is otherwise undefined
145              
146             =head2 C<exception>
147              
148             $e = exception $error;
149              
150             Expose the C<catch> method in the exception
151             class L<Class::Usul::Exception>. Returns a new error object
152              
153             =head2 C<first_char>
154              
155             $single_char = first_char $some_string;
156              
157             Returns the first character of C<$string>
158              
159             =head2 C<is_arrayref>
160              
161             $bool = is_arrayref $scalar_variable;
162              
163             Tests to see if the scalar variable is an array ref
164              
165             =head2 C<load_components>
166              
167             $hash_ref_of_objects = load_components $search_path, @options_list;
168              
169             Load and instantiates MVC components. The search path is appended to the
170             applications classname to define the package namespace that is searched for
171             components
172              
173             The options list is a list of keys and values. Either C<application> or,
174             C<config> and C<log> must be specified. If C<application> is specified it
175             must define C<config> and C<log> attributes
176              
177             The configuration object or hash reference must define the C<appclass> and
178             C<components> attributes
179              
180             The C<components> attribute (one of the collection references held by
181             L<Web::Components::Loader>) is passed to the component constructor method and
182             is used by a component to discover it's dependencies
183              
184             An adaptor pattern is possible using the C<config_comps> attribute
185              
186             =head2 C<throw>
187              
188             throw 'message', [ 'arg1', 'arg2' ];
189              
190             Expose L<Web::ComposableRequest::Util/throw>.
191             L<Web::ComposableRequest::Constants> has a class attribute I<Exception_Class>
192             which can be set change the class of the thrown exception
193              
194             =head1 Diagnostics
195              
196             None
197              
198             =head1 Dependencies
199              
200             =over 3
201              
202             =item L<Module::Pluggable>
203              
204             =item L<Web::ComposableRequest>
205              
206             =item L<Unexpected>
207              
208             =back
209              
210             =head1 Incompatibilities
211              
212             There are no known incompatibilities in this module
213              
214             =head1 Bugs and Limitations
215              
216             There are no known bugs in this module. Please report problems to
217             http://rt.cpan.org/NoAuth/Bugs.html?Dist=Web-Components.
218             Patches are welcome
219              
220             =head1 Acknowledgements
221              
222             Larry Wall - For the Perl programming language
223              
224             =head1 Author
225              
226             Peter Flanigan, C<< <pjfl@cpan.org> >>
227              
228             =head1 License and Copyright
229              
230             Copyright (c) 2017 Peter Flanigan. All rights reserved
231              
232             This program is free software; you can redistribute it and/or modify it
233             under the same terms as Perl itself. See L<perlartistic>
234              
235             This program is distributed in the hope that it will be useful,
236             but WITHOUT WARRANTY; without even the implied warranty of
237             MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
238              
239             =cut
240              
241             # Local Variables:
242             # mode: perl
243             # tab-width: 3
244             # End:
245             # vim: expandtab shiftwidth=3: