File Coverage

lib/Dist/Zilla/Util/PluginLoader.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1 1     1   962 use 5.008; # utf8
  1         2  
  1         33  
2 1     1   4 use strict;
  1         2  
  1         25  
3 1     1   4 use warnings;
  1         1  
  1         27  
4 1     1   775 use utf8;
  1         8  
  1         7  
5              
6             package Dist::Zilla::Util::PluginLoader;
7              
8             our $VERSION = '0.001001';
9              
10             # ABSTRACT: Inflate a Legal Dist::Zilla Plugin from basic parts
11              
12             our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY
13              
14 1     1   64 use Carp qw( croak );
  1         1  
  1         120  
15 1     1   377 use Moose qw( has );
  0            
  0            
16             use Dist::Zilla::Util;
17              
18             has sequence => ( is => ro =>, required => 1 );
19             has assembler => ( is => ro =>, lazy_build => 1 );
20             has section_class => ( is => ro =>, lazy_build => 1 );
21              
22             sub _build_assembler {
23             my ($self) = @_;
24             return $self->sequence->assembler;
25             }
26              
27             sub _build_section_class {
28             my ($self) = @_;
29             return $self->assembler->section_class;
30             }
31              
32             sub _split_ini_token {
33             my ( undef, $token ) = @_;
34             my ( $key, $value ) = $token =~ /\A\s*([^=]+?)\s*=\s*(.+?)\s*\z/msx;
35             return ( $key, $value );
36             }
37              
38             sub _check_array {
39             my ( undef, $array ) = @_;
40             croak 'Attributes must be an arrayref' unless 'ARRAY' eq ref $array;
41             for ( @{$array} ) {
42             croak 'Attributes ArrayRef must contain no refs' if ref;
43             }
44             return $array;
45             }
46              
47             sub _auto_attrs {
48             my $nargs = ( my ( $self, $package, $name, $attrs ) = @_ );
49              
50             croak 'Not enough arguments to load()' if $nargs < 2;
51              
52             croak 'Argument <package> may not be a ref' if ref $package;
53              
54             if ( 2 == $nargs ) {
55             return ( $package, $package, [] );
56             }
57             if ( 3 == $nargs ) {
58             if ( 'ARRAY' eq ref $name ) {
59             return ( $package, $package, $self->_check_array($name) );
60             }
61             return ( $package, $name, [] );
62             }
63             if ( 4 == $nargs ) {
64             if ( not defined $name ) {
65             return ( $package, $package, $self->_check_array($attrs) );
66             }
67             if ( ref $name ) {
68             croak "Illegal value $name for <name>";
69             }
70             return ( $package, $name, $self->_check_array($attrs) );
71             }
72             croak 'Too many arguments to load()';
73             }
74              
75             sub load {
76             my ( $self, @args ) = @_;
77             my ( $package, $name, $attrs ) = $self->_auto_attrs(@args);
78              
79             croak 'Not an even number of attribute values, should be a key => value sequence.' if ( scalar @{$attrs} % 2 ) != 0;
80              
81             my $child_section = $self->section_class->new(
82             name => $name,
83             package => Dist::Zilla::Util->expand_config_package_name($package),
84             );
85             my @xattrs = @{$attrs};
86             while (@xattrs) {
87             my ( $key, $value ) = splice @xattrs, 0, 2, ();
88             $child_section->add_value( $key, $value );
89             }
90             $self->sequence->add_section($child_section);
91             $child_section->finalize unless $child_section->is_finalized;
92             return;
93             }
94              
95             sub load_ini {
96             my ( $self, @args ) = @_;
97             my ( $package, $name, $attrs ) = $self->_auto_attrs(@args);
98             return $self->load( $package, $name, [ map { $self->_split_ini_token($_) } @{$attrs} ] );
99             }
100              
101             no Moose;
102             __PACKAGE__->meta->make_immutable;
103              
104             1;
105              
106             __END__
107              
108             =pod
109              
110             =encoding UTF-8
111              
112             =head1 NAME
113              
114             Dist::Zilla::Util::PluginLoader - Inflate a Legal Dist::Zilla Plugin from basic parts
115              
116             =head1 VERSION
117              
118             version 0.001001
119              
120             =head1 SYNOPSIS
121              
122             use Dist::Zilla::Util::PluginLoader;
123              
124             my $loader = Dist::Zilla::Util::PluginLoader->new( sequence => $sequence );
125             $loader->load( $plugin, $name, [ key => value , key => value ]);
126             $loader->load_ini( $plugin, $name, [ 'key = value', 'key = value' ] );
127              
128             =head1 METHODS
129              
130             =head2 C<load>
131              
132             Load a Dist::Zilla plugin meeting specification.
133              
134             Signatures:
135              
136             void load( $self, $plugin )
137             void load( $self, $plugin, \@args );
138             void load( $self, $plugin, $name );
139             void load( $self, $plugin, $name, \@args );
140              
141             $plugin is Str ( Dist::Zilla Plugin )
142             $name is Str ( Dist::Zilla Section Name )
143             @args is ArrayRef
144             num items == even
145             key => value pairs of scalars.
146              
147             Constructs an instance of C<$plugin>, using C<$name> where possible,
148             and uses C<@args> to populate the C<MVP> properties for that C<$plugin>,
149             and then injects it to the C<< ->sequence >> passed earlier.
150              
151             =head2 C<load_ini>
152              
153             Load a Dist::Zilla plugin meeting specification with unparsed
154             C<INI> C<key = value> strings.
155              
156             Signatures:
157              
158             void load( $self, $plugin )
159             void load( $self, $plugin, \@args );
160             void load( $self, $plugin, $name );
161             void load( $self, $plugin, $name, \@args );
162              
163             $plugin is Str ( Dist::Zilla Plugin )
164             $name is Str ( Dist::Zilla Section Name )
165             @args is ArrayRef of Str
166             each Str is 'key = value'
167              
168             Constructs an instance of C<$plugin>, using C<$name> where possible,
169             and parses and uses C<@args> to populate the C<MVP> properties for that C<$plugin>,
170             and then injects it to the C<< ->sequence >> passed earlier.
171              
172             =head1 ATTRIBUTES
173              
174             =head2 C<sequence>
175              
176             A C<Config::MVP::Sequence> object.
177              
178             The easiest way to get one of those is:
179              
180             around plugin_from_config {
181             my ($orig,$self,$name,$arg, $section ) = @_;
182             ^^^^^^^^
183             }
184              
185             =head2 C<assembler>
186              
187             A C<Config::MVP::Assembler>
188              
189             Defaults to C<< sequence->assembler >>
190              
191             =head2 C<section_class>
192              
193             Defaults to C<< assembler->section_class >>
194              
195             =head1 AUTHOR
196              
197             Kent Fredric <kentfredric@gmail.com>
198              
199             =head1 COPYRIGHT AND LICENSE
200              
201             This software is copyright (c) 2014 by Kent Fredric <kentfredric@gmail.com>.
202              
203             This is free software; you can redistribute it and/or modify it under
204             the same terms as the Perl 5 programming language system itself.
205              
206             =cut