File Coverage

blib/lib/Module/Build/Bundle.pm
Criterion Covered Total %
statement 109 176 61.9
branch 27 76 35.5
condition 7 24 29.1
subroutine 14 17 82.3
pod 5 5 100.0
total 162 298 54.3


line stmt bran cond sub pod time code
1             package Module::Build::Bundle;
2              
3 1     1   4401 use 5.008; #$^V
  1         3  
4 1     1   5 use strict;
  1         1  
  1         20  
5 1     1   4 use warnings;
  1         2  
  1         31  
6 1     1   5 use Carp qw(croak);
  1         2  
  1         51  
7 1     1   4 use Cwd qw(getcwd);
  1         1  
  1         41  
8 1     1   786 use Tie::IxHash;
  1         2958  
  1         31  
9 1     1   729 use English qw( -no_match_vars );
  1         787  
  1         5  
10 1     1   429 use File::Slurp; #read_file
  1         1  
  1         92  
11 1     1   5 use base qw(Module::Build::Base);
  1         2  
  1         1476  
12 1     1   71370 use utf8;
  1         11  
  1         14  
13              
14 1     1   39 use constant EXTENDED_POD_LINK_VERSION => 5.12.0;
  1         2  
  1         2070  
15              
16             our $VERSION = '0.16';
17              
18             #HACK: we need a writable copy for testing purposes
19             ## no critic qw(Variables::ProhibitPackageVars Variables::ProhibitPunctuationVars)
20             our $myPERL_VERSION = $^V;
21              
22             sub ACTION_build {
23 0     0 1 0 my $self = shift;
24              
25 0 0       0 if ( !$self->{'_completed_actions'}{'contents'} ) {
26 0         0 $self->ACTION_contents();
27             }
28              
29 0         0 return Module::Build::Base::ACTION_build($self);
30             }
31              
32             sub ACTION_contents {
33 4     4 1 212792 my $self = shift;
34              
35             #Fetching requirements from Build.PL
36 4         10 my @list = %{ $self->requires() };
  4         16  
37              
38 4   100     46 my $section_header = $self->notes('section_header') || 'CONTENTS';
39              
40 4         188 my $sorted = 'Tie::IxHash'->new(@list);
41 4         211 $sorted->SortByKey();
42              
43 4         164 my $pod = "=head1 $section_header\n\n=over\n\n";
44 4         20 foreach ( $sorted->Keys ) {
45 7         55 my ( $module, $version ) = $sorted->Shift();
46              
47 7         104 my $dist = $module;
48 7         37 $dist =~ s/::/\-/g;
49              
50 7         9 my $module_path = $module;
51 7         32 $module_path =~ s[::][/]g;
52 7         10 $module_path .= '.pm';
53              
54 7 100       21 if ( $myPERL_VERSION ge EXTENDED_POD_LINK_VERSION ) {
55 3 100       19 if ($version) {
56 1         11 $pod .= "=item * L<$module|$module>, "
57             . "L<$version|http://search.cpan.org/dist/$dist-$version/lib/$module_path>\n\n";
58             } else {
59 2         53 $pod .= "=item * L<$module|$module>\n\n";
60             }
61             } else {
62 4 100       14 if ($version) {
63 2         16 $pod .= "=item * L<$module|$module>, $version\n\n";
64             } else {
65 2         9 $pod .= "=item * L<$module|$module>\n\n";
66             }
67             }
68             }
69 4         10 $pod .= "=back\n\n=head1";
70              
71 4         20 my $cwd = getcwd();
72              
73             my @path = split /::/, $self->{properties}->{module_name}
74 4   33     28 || $self->{properties}->{module_name};
75              
76             #HACK: induced from test suite
77 4 50       11 my $dir = $self->notes('temp_wd') ? $self->notes('temp_wd') : $cwd .'/t/';
78              
79             ## no critic qw(ValuesAndExpressions::ProhibitNoisyQuotes)
80 4         113 my $file = ( join '/', ( $dir, @path ) ) . '.pm';
81              
82 4 50       37 my $contents = read_file($file) or croak "Unable to read file: $file - $!";
83              
84 3         331 my $rv = $contents =~ s/=head1\s*$section_header\s*.*=head1/$pod/s;
85              
86 3 50       11 if ( !$rv ) {
87 0         0 croak "No $section_header section replaced";
88             }
89              
90 3 50       188 open my $fout, '>', $file
91             or croak "Unable to open file: $file - $!";
92              
93 3         16 print $fout $contents;
94              
95 3 50       90 close $fout or croak "Unable to close file: $file - $!";
96              
97 3         49 return 1;
98             }
99              
100             #Lifted from Module::Build::Base
101             sub do_create_metafile {
102 1     1 1 76965 my $self = shift;
103 1 50       14 return if $self->{wrote_metadata};
104 1         10 my $p = $self->{properties};
105              
106 1 50       11 unless ($p->{license}) {
107 0         0 $self->log_warn("No license specified, setting license = 'unknown'\n");
108 0         0 $p->{license} = 'unknown';
109             }
110              
111 1         19 my @metafiles = ( $self->metafile, $self->metafile2 );
112             # If we're in the distdir, the metafile may exist and be non-writable.
113 1         53 $self->delete_filetree($_) for @metafiles;
114              
115             # Since we're building ourself, we have to do some special stuff
116             # here: the ConfigData module is found in blib/lib.
117 1         158 local @INC = @INC;
118 1 50 50     12 if (($self->module_name || '') eq 'Module::Build') {
119 0         0 $self->depends_on('config_data');
120 0         0 push @INC, File::Spec->catdir($self->blib, 'lib');
121             }
122              
123 1         59 my $meta_obj = $self->_get_meta_object(
124             quiet => 0, fatal => 1, auto => 1
125             );
126              
127             #JONASBN: Changed file parameter
128 1         607 my @created = $self->_write_meta_files( $meta_obj, $self->metafile );
129              
130 1 50       25647 if ( @created ) {
131 1         11 $self->{wrote_metadata} = 1;
132 1         8 $self->_add_to_manifest('MANIFEST', $_) for @created;
133             }
134 1         265 return 1;
135             }
136              
137             #lifted from Module::Build::Base, sets generated_by
138             sub get_metadata {
139 1     1 1 443 my ($self, %args) = @_;
140              
141 1   50     7 my $fatal = $args{fatal} || 0;
142 1         2 my $p = $self->{properties};
143              
144 1 50       17 $self->auto_config_requires if $args{auto};
145              
146             # validate required fields
147 1         234 foreach my $f (qw(dist_name dist_version dist_author dist_abstract license)) {
148 5         37 my $field = $self->$f();
149 5 50 33     77 unless ( defined $field and length $field ) {
150 0         0 my $err = "ERROR: Missing required field '$f' for metafile\n";
151 0 0       0 if ( $fatal ) {
152 0         0 die $err;
153             }
154             else {
155 0         0 $self->log_warn($err);
156             }
157             }
158             }
159              
160             my %metadata = (
161             name => $self->dist_name,
162             version => $self->normalize_version($self->dist_version),
163             author => $self->dist_author,
164             abstract => $self->dist_abstract,
165             #JONASBN changed the generated_by
166             generated_by => "Module::Build::Bundle version $Module::Build::Bundle::VERSION",
167             'meta-spec' => {
168             version => '2',
169             url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec',
170             },
171 1 50       8 dynamic_config => exists $p->{dynamic_config} ? $p->{dynamic_config} : 1,
172             release_status => $self->release_status,
173             );
174              
175 1         131 my ($meta_license, $meta_license_url) = $self->_get_license;
176 1         45561 $metadata{license} = [ $meta_license ];
177 1 50       6 $metadata{resources}{license} = [ $meta_license_url ] if defined $meta_license_url;
178              
179 1         14 $metadata{prereqs} = $self->_normalize_prereqs;
180              
181 1 50       108 if (exists $p->{no_index}) {
    50          
182 0         0 $metadata{no_index} = $p->{no_index};
183 1         42 } elsif (my $pkgs = eval { $self->find_dist_packages }) {
184 1 50       8792 $metadata{provides} = $pkgs if %$pkgs;
185             } else {
186 0         0 $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" .
187             "Nothing to enter for 'provides' field in metafile.\n");
188             }
189              
190 1 50       19 if (my $add = $self->meta_add) {
191 1 50 33     17 if (not exists $add->{'meta-spec'} or $add->{'meta-spec'}{version} != 2) {
192 1         8 require CPAN::Meta::Converter;
193 1 50       27 if (CPAN::Meta::Converter->VERSION('2.141170')) {
194 1         13 $add = CPAN::Meta::Converter->new($add)->upgrade_fragment;
195 1         1713 delete $add->{prereqs}; # XXX this would now overwrite all prereqs
196             }
197             else {
198 0         0 $self->log_warn("Can't meta_add without CPAN::Meta 2.141170");
199             }
200             }
201              
202 1         9 while (my($k, $v) = each %{$add}) {
  2         10  
203 1         4 $metadata{$k} = $v;
204             }
205             }
206              
207 1 50       8 if (my $merge = $self->meta_merge) {
208 1 50       10 if (eval { require CPAN::Meta::Merge }) {
  1         1883  
209 1         1926 %metadata = %{ CPAN::Meta::Merge->new(default_version => '1.4')->merge(\%metadata, $merge) };
  1         5  
210             }
211             else {
212 0         0 $self->log_warn("Can't merge without CPAN::Meta::Merge");
213             }
214             }
215              
216 1         6566 return \%metadata;
217             }
218              
219             #lifted from Module::Build::Base, added package and version resolution and
220             # addition to configure requires
221             sub prepare_metadata {
222 0     0 1   my ($self, $node, $keys) = @_;
223 0           my $p = $self->{properties};
224              
225             #JONASBN: Added package resolution
226 0           my $package = ref $self;
227 0           my $version = $package::VERSION;
228              
229             # A little helper sub
230             my $add_node = sub {
231 0     0     my ($name, $val) = @_;
232 0           $node->{$name} = $val;
233 0 0         push @$keys, $name if $keys;
234 0           };
235              
236 0           foreach (qw(dist_name dist_version dist_author dist_abstract license)) {
237 0           (my $name = $_) =~ s/^dist_//;
238 0           $add_node->($name, $self->$_());
239             die "ERROR: Missing required field '$_' for META.yml\n"
240 0 0 0       unless defined($node->{$name}) && length($node->{$name});
241             }
242 0           $node->{version} = $self->normalize_version($node->{version});
243              
244 0 0         if (defined( my $l = $self->license )) {
245             die "Unknown license string '$l'"
246 0 0         unless exists $self->valid_licenses->{ $l };
247              
248 0 0         if (my $key = $self->valid_licenses->{ $l }) {
249 0           my $class = "Software::License::$key";
250 0 0         if (eval "use $class; 1") {
251             # S::L requires a 'holder' key
252 0           $node->{resources}{license} = $class->new({holder=>"nobody"})->url;
253             }
254             else {
255 0           $node->{resources}{license} = $self->_license_url($l);
256             }
257             }
258             # XXX we are silently omitting the url for any unknown license
259             }
260              
261             # copy prereq data structures so we can modify them before writing to META
262 0           my %prereq_types;
263 0           for my $type ( 'configure_requires', @{$self->prereq_action_types} ) {
  0            
264 0 0         if (exists $p->{$type}) {
265 0           for my $mod ( keys %{ $p->{$type} } ) {
  0            
266             $prereq_types{$type}{$mod} =
267 0           $self->normalize_version($p->{$type}{$mod});
268             }
269             }
270             }
271              
272             # add current Module::Build to configure_requires if there
273             # isn't one already specified (but not ourself, so we're not circular)
274 0 0 0       if ( $self->dist_name ne 'Module-Build'
      0        
275             && $self->auto_configure_requires
276             && ! exists $prereq_types{'configure_requires'}{'Module::Build'}
277             ) {
278 0           $prereq_types{configure_requires}{'Module::Build'} = $VERSION;
279             #JONASBN added configure requires
280 0           $prereq_types{configure_requires}{$package} = $version;
281             }
282              
283 0           for my $t ( keys %prereq_types ) {
284 0           $add_node->($t, $prereq_types{$t});
285             }
286              
287 0 0         if (exists $p->{dynamic_config}) {
288 0           $add_node->('dynamic_config', $p->{dynamic_config});
289             }
290 0           my $pkgs = eval { $self->find_dist_packages };
  0            
291 0 0         if ($@) {
292 0           $self->log_warn("$@\nWARNING: Possible missing or corrupt 'MANIFEST' file.\n" .
293             "Nothing to enter for 'provides' field in META.yml\n");
294             } else {
295 0 0         $node->{provides} = $pkgs if %$pkgs;
296             }
297             ;
298 0 0         if (exists $p->{no_index}) {
299 0           $add_node->('no_index', $p->{no_index});
300             }
301              
302 0           $add_node->('generated_by', "$package version $version");
303              
304 0           $add_node->('meta-spec',
305             {version => '1.4',
306             url => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
307             });
308              
309 0           while (my($k, $v) = each %{$self->meta_add}) {
  0            
310 0           $add_node->($k, $v);
311             }
312              
313 0           while (my($k, $v) = each %{$self->meta_merge}) {
  0            
314 0           $self->_hash_merge($node, $k, $v);
315             }
316              
317 0           return $node;
318             }
319              
320             1;
321              
322             __END__