File Coverage

blib/lib/Dist/Man/BuilderSet.pm
Criterion Covered Total %
statement 51 52 98.0
branch 10 12 83.3
condition 2 3 66.6
subroutine 12 12 100.0
pod 8 8 100.0
total 83 87 95.4


line stmt bran cond sub pod time code
1             package Dist::Man::BuilderSet;
2             # vi:et:sw=4 ts=4
3              
4 5     5   76368 use strict;
  5         16  
  5         143  
5 5     5   22 use warnings;
  5         7  
  5         126  
6              
7 5     5   20 use Carp qw( carp );
  5         23  
  5         2975  
8              
9             =head1 NAME
10              
11             Dist::Man::BuilderSet - determine builder metadata
12              
13             =head1 VERSION
14              
15             Version 0.0.6
16              
17             =cut
18              
19             our $VERSION = '0.0.8';
20              
21             =head1 SYNOPSIS
22              
23             use Dist::Man::BuilderSet;
24              
25             my $builder_set = Dist::Man::BuilderSet->new;
26             my @supported_builders = $builder_set->supported_builders();
27             my $default_builder = $builder_set->default_builder();
28             my $output_file = $builder_set->file_for_builder($default_builder);
29              
30             my $create_method = $builder_set->method_for_builder($default_builder);
31             Dist::Man::Simple->$create_method($default_builder); # eeew.
32              
33             my @build_commands = $builder_set->instructions_for_builder($default_builder);
34             my @builder_dependencies = $builder_set->deps_for_builder($default_builder);
35             my @compatible_builders = $builder_set->check_compatibility(@builder_list);
36              
37             =head1 DESCRIPTION
38              
39             Dist::Man::BuilderSet is a collection of utility methods used to
40             provide metadata about builders supported by Dist::Man.
41              
42             =head1 CLASS METHODS
43              
44             =head2 C<< new() >>
45              
46             This method initializes and returns an object representing the set of
47             Builders supported by Dist::Man
48              
49             =cut
50              
51             sub new {
52 17     17 1 572 my $class = shift;
53              
54 17         191 my $self =
55             {
56             'Module::Build' =>
57             {
58             file => "Build.PL",
59             build_method => "create_Build_PL",
60             build_deps => [],
61             instructions => [ 'perl Build.PL',
62             './Build',
63             './Build test',
64             './Build install',
65             ],
66             },
67             'Module::Install' =>
68             {
69             file => "Makefile.PL",
70             build_method => "create_MI_Makefile_PL",
71             build_deps => [],
72             instructions => [ 'perl Makefile.PL',
73             'make',
74             'make test',
75             'make install',
76             ],
77             },
78             'ExtUtils::MakeMaker' =>
79             {
80             file => "Makefile.PL",
81             build_method => "create_Makefile_PL",
82             build_deps => [ { command => 'make',
83             aliases => [ 'make', 'gmake' ],
84             },
85             { command => 'chmod',
86             aliases => [ 'chmod' ],
87             },
88             ],
89             instructions => [ 'perl Makefile.PL',
90             'make',
91             'make test',
92             'make install',
93             ],
94             }
95             };
96              
97 17         54 return bless $self, $class;
98             }
99              
100             sub _builder {
101 87     87   102 my $self = shift;
102 87         92 my $builder = shift;
103              
104 87 50       118 $builder = $self->default_builder unless $builder;
105              
106 87 100       138 unless (exists $self->{$builder}) {
107 4         384 carp("Don't know anything about builder '$builder'.");
108 4         207 return;
109             }
110              
111 83         193 return $self->{$builder};
112             }
113              
114             =head2 C<< supported_builders() >>
115              
116             This method returns a list of builders supported by Dist::Man
117              
118             =cut
119              
120             sub supported_builders {
121 5     5 1 1596 my $self = shift;
122              
123 5         20 return keys %$self;
124             }
125              
126             =head2 C<< file_for_builder($builder) >>
127              
128             This method returns the name of the file generated by Dist::Man
129             that will be used to build the generated module
130              
131             =cut
132              
133             sub file_for_builder {
134 40     40 1 54 my $self = shift;
135 40         43 my $builder = shift;
136              
137 40         59 return $self->_builder($builder)->{file};
138             }
139              
140             =head2 C<< method_for_builder($builder) >>
141              
142             This method returns the name of the method in the
143             C package that is called to create the file
144             returned by C
145              
146             =cut
147              
148             sub method_for_builder {
149 11     11 1 23 my $self = shift;
150 11         14 my $builder = shift;
151              
152 11         16 return $self->_builder($builder)->{build_method};
153             }
154              
155             =head2 C<< instructions_for_builder($builder) >>
156              
157             This method returns a list of commands that, when run from the command
158             line (or with C), will cause the generated module to be
159             built, tested and installed.
160              
161             =cut
162              
163             sub instructions_for_builder {
164 11     11 1 23 my $self = shift;
165 11         13 my $builder = shift;
166              
167 11         13 return @{ $self->_builder($builder)->{instructions} };
  11         22  
168             }
169              
170             =head2 C<< deps_for_builder($builder) >>
171              
172             This method returns a list of dependencies in the following format:
173             C<<
174             ( { command => "make",
175             aliases => [ 'make', 'gmake' ],
176             },
177             { command => "another_command",
178             aliases => [ 'alias0', 'alias1', '...' ],
179             },
180             )
181             >>
182              
183             =cut
184              
185             sub deps_for_builder {
186 3     3 1 12 my $self = shift;
187 3         4 my $builder = shift;
188              
189 3         4 return @{ $self->_builder($builder)->{build_deps} };
  3         4  
190             }
191              
192             =head2 C<< check_compatibility(@builders) >>
193              
194             This method accepts a list of builders and filters out the ones that
195             are unsupported or mutually exclusive, returning the builders that
196             passed the filter. If none pass the filter, the default builder is
197             returned.
198              
199             =cut
200              
201             sub check_compatibility {
202 15     15 1 543 my $self = shift;
203 15         33 my @builders = @_;
204              
205             # if we're passed an array reference (or even a list of array
206             # references), de-reference the first one passed and assign
207             # @builders its contents
208              
209 15 50 66     78 @builders = @{$builders[0]} if(@builders && ref $builders[0] eq 'ARRAY');
  0         0  
210              
211             # remove empty and unsupported builders
212 15         28 @builders = grep { $self->_builder($_) } @builders;
  22         42  
213              
214             # if we stripped all of them, use the default
215 15 100       41 push(@builders, $self->default_builder) unless int( @builders ) > 0;
216              
217 15         26 my %uniq;
218             my @good;
219 15         22 foreach my $builder (@builders) {
220             # Builders that generate the same build file are mutually exclusive
221              
222             # If given a list of builder modules that includes mutually
223             # exclusive modules, we'll use the first in the list
224              
225 21         89 my $file = $self->file_for_builder($builder);
226 21 100       46 if (exists $uniq{$file}) {
227             # don't print a warning if the same builder was listed twice.
228             # Otherwise, inform the caller that these builders are mutually
229             # exclusive
230             carp("Builders '$builder' and '$uniq{$file}' are mutually exclusive.".
231             " Using '$uniq{$file}'."
232 4 100       190 ) unless $builder eq $uniq{$file};
233             } else {
234 17         47 $uniq{$file} = $builder;
235 17         41 push(@good, $uniq{$file});
236             }
237             }
238              
239 15         158 return( @good );
240             }
241              
242             =head2 C<< default_builder() >>
243              
244             This method returns the module name of the default builder.
245              
246             =cut
247              
248             sub default_builder {
249 8     8 1 24 my $self = shift;
250              
251 8         20 return 'ExtUtils::MakeMaker';
252             }
253              
254             =head1 BUGS
255              
256             Please report any bugs or feature requests to
257             C, or through the web interface at
258             L. I will be notified, and then you'll automatically
259             be notified of progress on your bug as I make changes.
260              
261             =head1 AUTHOR
262              
263             C.J. Adams-Collier, C<< >>
264              
265             =head1 Copyright & License
266              
267             =head2 Module::Starter::BuilderSet
268              
269             Copyright 2007 C.J. Adams-Collier, All Rights Reserved.
270              
271             This program is free software; you can redistribute it and/or modify it
272             under the same terms as Perl itself.
273              
274             Please note that these modules are not products of or supported by the
275             employers of the various contributors to the code.
276              
277             =head2 Dist::Man::BuilderSet
278              
279             Modified by Shlomi Fish while disclaiming any explicit or implicit ownership.
280             May be used under the present or future terms of
281             L.
282              
283             =cut
284              
285             1;