File Coverage

blib/lib/Module/Install/Admin/Metadata.pm
Criterion Covered Total %
statement 14 110 12.7
branch 0 48 0.0
condition 0 18 0.0
subroutine 5 11 45.4
pod 0 6 0.0
total 19 193 9.8


line stmt bran cond sub pod time code
1             package Module::Install::Admin::Metadata;
2              
3 1     1   880 use strict;
  1         1  
  1         22  
4 1     1   539 use YAML::Tiny ();
  1         4175  
  1         22  
5 1     1   6 use Module::Install::Base;
  1         1  
  1         21  
6              
7 1     1   3 use vars qw{$VERSION @ISA};
  1         1  
  1         54  
8             BEGIN {
9 1     1   1 $VERSION = '1.18';
10 1         940 @ISA = 'Module::Install::Base';
11             }
12              
13             sub read_meta {
14 0     0 0   (YAML::Tiny::LoadFile('META.yml'))[0];
15             }
16              
17             sub meta_generated_by_us {
18 0     0 0   my $meta = $_[0]->read_meta;
19 0           my $want = ref($_[0]->_top);
20 0 0         if ( defined $_[1] ) {
21 0           $want .= " version $_[1]";
22             }
23 0           return $meta->{generated_by} =~ /^\Q$want\E/;
24             }
25              
26             sub remove_meta {
27 0     0 0   my $self = shift;
28 0           my $ver = $self->_top->VERSION;
29 0 0         return unless -f 'META.yml';
30 0 0         return unless $self->meta_generated_by_us($ver);
31 0 0         unless ( -w 'META.yml' ) {
32 0           warn "Can't remove META.yml file. Not writable.\n";
33 0           return;
34             }
35             # warn "Removing auto-generated META.yml\n";
36 0 0         unless ( unlink 'META.yml' ) {
37 0           die "Couldn't unlink META.yml:\n$!";
38             }
39 0           return;
40             }
41              
42             sub write_meta {
43 0     0 0   my $self = shift;
44 0 0         if ( -f "META.yml" ) {
45 0 0         return unless $self->meta_generated_by_us();
46             } else {
47 0           $self->clean_files('META.yml');
48             }
49 0           print "Writing META.yml\n";
50 0           Module::Install::_write("META.yml", $self->dump_meta);
51 0           return;
52             }
53              
54             sub dump_meta {
55 0     0 0   my $self = shift;
56 0           my $pkg = ref( $self->_top );
57 0           my $ver = $self->_top->VERSION;
58 0           my $val = $self->Meta->{values};
59              
60 0           delete $val->{sign};
61              
62             # Dependencies MUST be assumed to be dynamic unless indicated
63             # otherwise, otherwise a negligent author who accidentally forgets
64             # to say which will release modules that break on some platforms.
65 0 0         unless ( defined $val->{dynamic_config} ) {
66 0           $val->{dynamic_config} = 1;
67             }
68              
69 0           my $perl_version = delete $val->{perl_version};
70 0 0         if ( $perl_version ) {
71 0   0       $val->{requires} ||= [];
72 0           my $requires = $val->{requires};
73              
74             # Issue warnings for unversioned core modules that are
75             # already satisfied by the Perl version dependency.
76 0           require Module::CoreList;
77 0           my $corelist = $Module::CoreList::version{$perl_version};
78 0 0         if ( $corelist ) {
79 0           my @bad = grep { exists $corelist->{$_} }
80 0           map { $_->[0] }
81 0           grep { ! $_->[1] }
  0            
82             @$requires;
83 0           foreach ( @bad ) {
84             # print "WARNING: Unversioned dependency on '$_' is pointless when Perl minimum version is $perl_version\n";
85             }
86             }
87              
88             # Canonicalize to three-dot version after Perl 5.6
89 0 0         if ( $perl_version >= 5.006 ) {
90 0   0       $perl_version =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
  0   0        
91             }
92 0           unshift @$requires, [ perl => $perl_version ];
93             }
94              
95             # Set a default 'unknown' license
96 0 0         unless ( $val->{license} ) {
97 0           warn "No license specified, setting license = 'unknown'\n";
98 0           $val->{license} = 'unknown';
99             }
100              
101             # Most distributions are modules
102 0   0       $val->{distribution_type} ||= 'module';
103              
104             # Check and derive names
105 0 0         if ( $val->{name} =~ /::/ ) {
106 0           my $name = $val->{name};
107 0           $name =~ s/::/-/g;
108 0           die "Error in name(): '$val->{name}' should be '$name'!\n";
109             }
110 0 0 0       if ( $val->{module_name} and ! $val->{name} ) {
111 0           $val->{name} = $val->{module_name};
112 0           $val->{name} =~ s/::/-/g;
113             }
114              
115             # Apply default no_index entries
116 0   0       $val->{no_index} ||= {};
117 0   0       $val->{no_index}->{directory} ||= [];
118             SCOPE: {
119 0           my %seen = ();
  0            
120             $val->{no_index}->{directory} = [
121             sort
122 0           grep { not $seen{$_}++ }
123 0           grep { -d $_ } (
124 0           @{$val->{no_index}->{directory}},
  0            
125             qw{
126             share inc t xt test
127             example examples demo
128             },
129             )
130             ];
131             }
132              
133             # Generate the structure we'll be dumping
134             my $meta = {
135             resources => {},
136             license => $val->{license},
137             dynamic_config => $val->{dynamic_config},
138 0           };
139 0           foreach my $key ( $self->Meta_ScalarKeys ) {
140 0 0         next if $key eq 'installdirs';
141 0 0         next if $key eq 'tests';
142 0 0         $meta->{$key} = $val->{$key} if exists $val->{$key};
143             }
144 0           foreach my $key ( $self->Meta_ArrayKeys ) {
145 0 0         $meta->{$key} = $val->{$key} if exists $val->{$key};
146             }
147 0           foreach my $key ( $self->Meta_TupleKeys ) {
148 0 0         next unless exists $val->{$key};
149 0           $meta->{$key} = { map { @$_ } @{ $val->{$key} } };
  0            
  0            
150             }
151              
152 0 0         if ( $self->_cmp( $meta->{configure_requires}->{'ExtUtils::MakeMaker'}, '6.36' ) > 0 ) {
153             # After this version ExtUtils::MakeMaker requires perl 5.6
154 0 0 0       unless ( $perl_version && $self->perl_version($perl_version) >= 5.006 ) {
155 0           $meta->{requires}->{perl} = '5.006';
156             }
157             }
158              
159 0 0         $meta->{provides} = $val->{provides} if $val->{provides};
160 0           $meta->{no_index} = $val->{no_index};
161 0           $meta->{generated_by} = "$pkg version $ver";
162 0           $meta->{'meta-spec'} = {
163             version => 1.4,
164             url => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
165             };
166 0 0         unless ( scalar keys %{$meta->{resources}} ) {
  0            
167 0           delete $meta->{resources};
168             }
169              
170             # Support version.pm versions
171 0 0         if ( UNIVERSAL::isa($meta->{version}, 'version') ) {
172 0           $meta->{version} = $meta->{version}->numify;
173             }
174              
175             # extra metadata
176 0           foreach my $key (grep /^x_/, keys %$val) {
177 0           $meta->{$key} = $val->{$key};
178             }
179              
180 0           YAML::Tiny::Dump($meta);
181             }
182              
183              
184              
185              
186              
187             ######################################################################
188             # MYMETA.yml Support
189              
190             sub WriteMyMeta {
191 0     0 0   my $self = shift;
192 0           $self->configure_requires( 'YAML::Tiny' => 1.36 );
193 0           $self->write_mymeta;
194 0           return 1;
195             }
196              
197             1;