File Coverage

blib/lib/portable/loader.pm
Criterion Covered Total %
statement 64 77 83.1
branch 11 18 61.1
condition 5 15 33.3
subroutine 13 16 81.2
pod 0 8 0.0
total 93 134 69.4


line stmt bran cond sub pod time code
1 3     3   58559 use 5.008008;
  3         8  
2 3     3   12 use strict;
  3         4  
  3         47  
3 3     3   13 use warnings;
  3         3  
  3         136  
4              
5             package portable::loader;
6              
7             our $AUTHORITY = 'cpan:TOBYINK';
8             our $VERSION = '0.002';
9              
10 3     3   981 use portable::lib;
  3         13  
  3         15  
11              
12             use Module::Pluggable (
13 3         19 search_path => ['portable::loader'],
14             sub_name => '_plugins',
15             require => 1,
16 3     3   1285 );
  3         27524  
17              
18             {
19             my @loaders;
20             sub loaders {
21 0     0 0 0 my $me = shift;
22 0         0 @loaders;
23             }
24             sub add_loader {
25 9     9 0 5916 my $me = shift;
26 9         14 for my $loader (@_) {
27 9 50       76 $loader->init($me) if $loader->can('init');
28 9         22 push @loaders, $loader;
29             }
30             }
31             }
32              
33             {
34             my %extensions;
35             sub extensions {
36 7     7 0 34 %extensions;
37             }
38             sub register_extension {
39 12   33 12 0 48 $extensions{$_[1]} = $_[2] || caller;
40             }
41             }
42              
43             sub _croak {
44 0     0   0 my $me = shift;
45 0         0 my ($msg, @args) = @_;
46 0         0 require Carp;
47 0         0 Carp::croak(sprintf($msg, @args));
48             }
49              
50             sub _read {
51 0     0   0 my $me = shift;
52 0         0 my ($collection) = @_;
53 0         0 for my $loader ($me->loaders) {
54 0         0 my ($fn, $loaded) = $loader->load($collection);
55 0 0       0 return ($fn, $loaded) if $loaded;
56             }
57 0         0 $me->_croak('Could not load portable collection %s', $collection);
58             }
59              
60             {
61             my $i = 0;
62             sub _mint_prefix {
63 3     3   9 ++$i;
64 3         15 "portable::collection::Collection$i";
65             }
66             }
67              
68             sub load {
69 4     4 0 2513 my $me = shift;
70 4         10 my ($collection) = @_;
71              
72 4         12 my $file = $me->find_collection($collection);
73 4 50       18 $me->_croak("Could not load collection $collection")
74             unless defined $file;
75            
76             # method call preserving caller
77 4         26 my $next = $me->can('load_from_filename');
78 4         11 @_ = ($me, $file);
79 4         13 goto $next;
80             }
81              
82             sub find_collection {
83 4     4 0 9 my $me = shift;
84 4         8 my ($collection) = @_;
85 4         13 my %exts = $me->extensions;
86 4         15 DIR: for my $dir (@portable::INC) {
87 8         31 EXT: for my $ext (sort keys %exts) {
88 26         63 my $qualified = "$dir/$collection.$ext";
89 26 100       324 return $qualified if -f $qualified;
90             }
91             }
92 0         0 return;
93             }
94              
95             sub load_from_filename {
96 4     4 0 9 my $me = shift;
97 4         10 my ($filename, $handler) = @_;
98            
99             return $portable::INC{$filename}
100 4 100       15 if $portable::INC{$filename};
101            
102 3 50       8 unless (defined $handler) {
103 3         8 my %exts = $me->extensions;
104 3         13 for my $ext (sort keys %exts) {
105 12         22 my $qext = quotemeta $ext;
106 12 100       161 if ($filename =~ /$qext\z/) {
107 3         10 $handler = $exts{$ext};
108             }
109             }
110 3 50       16 $me->_croak("Could not find plugin to load file $filename")
111             unless $handler;
112             }
113            
114 3         16 my $hashref = $handler->parse($filename);
115 3         8 $hashref->{____source____} = $filename;
116            
117             # method call preserving caller
118 3         21 my $next = $me->can('load_from_hashref');
119 3         9 @_ = ($me, $hashref);
120 3         10 goto $next;
121             }
122              
123             sub load_from_hashref {
124 3     3 0 1510 require MooX::Press;
125 3         283168 'MooX::Press'->VERSION('0.011');
126 3         31 my $me = shift;
127 3         8 my %opts = %{ $_[0] };
  3         23  
128 3   33     41 $opts{prefix} ||= $me->_mint_prefix;
129 3   33     19 $opts{factory_package} ||= $opts{prefix};
130 3   33     18 $opts{caller} ||= caller;
131 3         17 'MooX::Press'->import(%opts);
132 3   33     388472 my $return = $opts{factory_package} || $opts{caller};
133 3 50       12 if ($opts{____source____}) {
134 3         10 $portable::INC{$opts{____source____}} = $return;
135             }
136 3         40 $return;
137             }
138              
139             # init
140             __PACKAGE__->add_loader($_) for __PACKAGE__->_plugins;
141              
142             1;
143              
144             __END__
145              
146             =pod
147              
148             =encoding utf-8
149              
150             =head1 NAME
151              
152             portable::loader - load classes and roles which can be moved around your namespace
153              
154             =head1 SYNOPSIS
155              
156             Define some classes:
157              
158             ## Nature.portable
159             ##
160             version = 1.0
161             toolkit = "Moo"
162            
163             [class:Tree.has]
164             leaf = { is = "lazy", type = "ArrayRef[Leaf]" }
165            
166             [class:Tree.can]
167             add_leaf = {{{
168             my $self = shift;
169             push @{ $self->leaf }, @_;
170             return $self; # for chaining
171             }}}
172             _build_leaf = {{{
173             return [];
174             }}}
175            
176             [class:Leaf.has]
177             colour = { type = "Str", default = "green" }
178            
179             [class:Maple]
180             extends = "Tree"
181              
182             Use the classes:
183              
184             ## script.pl
185             ##
186             use portable::lib '/var/lib/portable-libs';
187             use portable::alias 'Nature';
188            
189             my $tree = Nature->new_maple;
190             $tree->add_leaf( Nature->new_leaf );
191            
192             # 'Nature' isn't really a Perl package.
193             # It's just a sub that returns a string.
194              
195             =head1 DESCRIPTION
196              
197             The intent of portable::loader is for classes and roles to be portable around
198             your namespace. The idea is for classes and roles to not know their package
199             names and not care about their package names. And for them to also not know
200             or care about the package names of their "friends".
201              
202             (When I say their friends, I'm talking about a user-agent object which needs
203             to be able to consume HTTP request objects and return HTTP response objects,
204             maybe write to a cookie jar object, etc.)
205              
206             Typically in Perl code, package names are the one thing that is hard-coded
207             everywhere and this can make things like dependency injection, and API
208             versioning really difficult to do. Like if you need to make some major
209             changes to your class's API, do you create an entirely new package with
210             a different namespace, then wait for your consumers to update? Or do
211             you keep the old namespace and deal with breakages.
212              
213             What if instead of doing this:
214              
215             use YourAPI::Tree;
216             use YourAPI::Leaf;
217            
218             my $tree = YourAPI::Tree->new;
219             $tree->add_leaf(YourAPI::Leaf->new);
220              
221             People could do this?
222              
223             use portable::loader;
224             my $api = portable::loader->load("YourAPI");
225            
226             my $tree = $api->new_tree;
227             $tree->add_leaf($api->new_leaf);
228              
229             The class names are not hard-coded anywhere. They are not even hard-coded
230             in the definitions of the Leaf and Tree classes.
231              
232             And there's very little runtime overhead in doing this!
233              
234             =head2 Writing a portable library
235              
236             =head3 Syntax
237              
238             Portable libraries are conceptually any hashref suitable for passing to
239             L<MooX::Press>. A structure something like this:
240              
241             {
242             version => 1.0,
243             toolkit => "Moo",
244             "class:Tree" => {
245             has => [
246             "leaf" => { is => "lazy", type => "ArrayRef[Leaf]" },
247             ],
248             can => [
249             "add_leaf" => sub {
250             my $self = shift;
251             push @{ $self->leaf }, @_;
252             return $self; # for chaining
253             },
254             "_build_leaf" => sub {
255             return [];
256             },
257             ],
258             },
259             "class:Leaf" => {
260             has => [
261             "colour" => { type => "Str", default => "green" },
262             ],
263             },
264             "class:Maple" => {
265             extends => "Tree",
266             },
267             }
268              
269             You could save that as "Nature.portable.pl" and portable::loader would
270             be able to load it.
271              
272             But although a library is conceptually a hashref, it can be written in
273             other syntaxes. It could be written in JSON, if L<JSON::Eval> is used to
274             inflate coderefs in the JSON:
275              
276             {
277             "version": 1.0,
278             "toolkit": "Moo",
279             "class:Tree": {
280             "has": [
281             "leaf": { "is": "lazy", "type": "ArrayRef[Leaf]" }
282             ],
283             "can": [
284             "add_leaf": {
285             "$eval": "sub { my $self = shift; push @{ $self->leaf }, @_; return $self; }"
286             },
287             "_build_leaf: {
288             "$eval": "sub { return []; }"
289             }
290             ]
291             },
292             "class:Leaf": {
293             "has": [
294             "colour": { "type": "Str", "default": "green" }
295             ],
296             },
297             "class:Maple": {
298             "extends": "Tree"
299             }
300             }
301              
302             If this is saved at "Nature.portable.json", portable::loader should
303             be able to load it.
304              
305             The default format that L<portable::loader> uses though, is L<TOML>,
306             an INI-like file format. L<portable::loader> adds an extension to
307             TOML allowing C<< {{{ ... }}} >> to represent a coderef with Perl
308             code inside. (The parsing is kind of naive, so don't expect nested
309             coderefs to work and that kind of thing!
310              
311             version = 1.0
312             toolkit = "Moo"
313            
314             [class:Tree.has]
315             leaf = { is = "lazy", type = "ArrayRef[Leaf]" }
316            
317             [class:Tree.can]
318             add_leaf = {{{
319             my $self = shift;
320             push @{ $self->leaf }, @_;
321             return $self; # for chaining
322             }}}
323             _build_leaf = {{{
324             return [];
325             }}}
326            
327             [class:Leaf.has]
328             colour = { type = "Str", default = "green" }
329            
330             [class:Maple]
331             extends = "Tree"
332              
333             =head3 Design considerations
334              
335             When writing a library, the key thing to remember is that you don't
336             know the final package names of any of your classes and roles.
337              
338             You can refer to other classes and roles from your library in type
339             constraints, and that should "just work".
340              
341             Also, you can instantiate other classes in your methods using:
342              
343             [class:Maple.can]
344             grow_red_leaf = {{{
345             my $self = shift;
346             my $leaf = $self->FACTORY->new_leaf(colour => "red");
347             push @{ $self->leaf }, $leaf;
348             return $self;
349             }}}
350              
351             The C<< $self->FACTORY >> method gives you something with a bunch
352             of C<< new_* >> methods for instantiating other objects from your
353             library.
354              
355             You could even do this when defining the Leaf class:
356              
357             [class:Leaf.factory]
358             new_leaf = {{{
359             my ($factory, $class) = (shift, shift);
360             return $class->new(@_);
361             }}}
362             new_red_leaf = {{{
363             my ($factory, $class) = (shift, shift);
364             return $class->new(colour => "red", @_);
365             }}}
366              
367             And then your Maple class can do this:
368              
369             [class:Maple.can]
370             grow_red_leaf = {{{
371             my $self = shift;
372             my $leaf = $self->FACTORY->new_red_leaf;
373             push @{ $self->leaf }, $leaf;
374             return $self;
375             }}}
376              
377             The aim being for your Maple class to know as little as possible about how
378             to build a leaf other than "I can get one from the factory".
379              
380             This makes it easy to override behaviour using L<Class::Method::Modifiers>
381             to wrap the C<new_red_leaf> method of the factory.
382              
383             =head2 Loading a library
384              
385             portable::loader maintains its own version of C<< @INC >> to locate libraries
386             from: C<< @portable::INC >>.
387              
388             You can use L<portable::lib> to push directories onto it:
389              
390             use portable::lib '/var/lib/portable-libs';
391              
392             Or you can manipulate C<< @portable::INC >> directly; it's just an array of
393             strings. You should C<< use portable::lib >> first though because portable::lib
394             will push some default directories onto C<< @portable::INC >> before it loads.
395              
396             Once you've set your search paths, you can load a library like this:
397              
398             use portable::loader;
399             my $lib = portable::loader->load($libname);
400              
401             portable::loader will search for "$libname.portable.pl",
402             "$libname.portable.json", "$libname.portable.toml", or "$libname.portable"
403             (which will be assumed to be TOML). Other formats can be supported through
404             plugins. (API will eventually be documented.)
405              
406             It will be parsed, loaded, classes built, etc, and a string will be returned
407             which can be used
408              
409             If more than one is found, only one will be loaded. The order in which they
410             are checked is currently not guaranteed, but the precedence of directories
411             in C<< @portable::INC >> will be respected.
412              
413             There are also C<load_from_filename> and C<load_from_hashref> methods
414             if you already know the exact filename you want to load, or already have a
415             hashref.
416              
417             =head3 Using portable::alias
418              
419             This:
420              
421             use portable::alias "Foo";
422              
423             Is roughly equivalent to this:
424              
425             use portable::loader;
426             use constant "Foo" => portable::loader->load("Foo");
427              
428             This:
429              
430             use portable::alias "VeryLongName" => "ShortName";
431              
432             Means this:
433              
434             use constant "ShortName" => portable::loader->load("VeryLongName");
435              
436             So you can do:
437              
438             my $thing = Foo->new_someclass(%args);
439              
440             The "constant" exported by portable::alias isn't really a constant though.
441             It accepts arguments. You can do:
442              
443             my $thing = Foo("SomeClass")->new(%args);
444            
445             my $type_constraint = Foo("SomeClass");
446             my $type_constraint = Foo("SomeRole");
447              
448             Using L<portable::alias> is a cleaner-looking alternative to using
449             portable::loader in a lot of cases.
450              
451             =head2 Using a library
452              
453             Use the factory returned by portable::loader to create objects, then use the
454             objects according to the library's documentation.
455              
456             =head1 BUGS
457              
458             Please report any bugs to
459             L<http://rt.cpan.org/Dist/Display.html?Queue=portable-loader>.
460              
461             =head1 SEE ALSO
462              
463             L<MooX::Press>, L<JSON::Eval>, L<TOML>, L<Type::Tiny>, L<Moo>, L<Moose>.
464              
465             =head1 AUTHOR
466              
467             Toby Inkster E<lt>tobyink@cpan.orgE<gt>.
468              
469             =head1 COPYRIGHT AND LICENCE
470              
471             This software is copyright (c) 2019 by Toby Inkster.
472              
473             This is free software; you can redistribute it and/or modify it under
474             the same terms as the Perl 5 programming language system itself.
475              
476             =head1 DISCLAIMER OF WARRANTIES
477              
478             THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
479             WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
480             MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
481