2 package Module::Install::Metadata;
5 use Module::Install::Base;
7 use vars qw{$VERSION $ISCORE @ISA};
11 @ISA = qw{Module::Install::Base};
15 name module_name abstract author version license
16 distribution_type perl_version tests installdirs
20 build_requires requires recommends bundles
24 sub Meta_ScalarKeys { @scalar_keys }
25 sub Meta_TupleKeys { @tuple_keys }
27 foreach my $key (@scalar_keys) {
30 return $self->{values}{$key} if defined wantarray and !@_;
31 $self->{values}{$key} = shift;
36 foreach my $key (@tuple_keys) {
39 return $self->{values}{$key} unless @_;
43 my $module = shift or last;
44 my $version = shift || 0;
45 if ( $module eq 'perl' ) {
46 $version =~ s{^(\d+)\.(\d+)\.(\d+)}
47 {$1 + $2/1_000 + $3/1_000_000}e;
48 $self->perl_version($version);
51 my $rv = [ $module, $version ];
54 push @{ $self->{values}{$key} }, @rv;
59 # configure_requires is currently a null-op
60 sub configure_requires { 1 }
62 # Aliases for build_requires that will have alternative
63 # meanings in some future version of META.yml.
64 sub test_requires { shift->build_requires(@_) }
65 sub install_requires { shift->build_requires(@_) }
67 # Aliases for installdirs options
68 sub install_as_core { $_[0]->installdirs('perl') }
69 sub install_as_cpan { $_[0]->installdirs('site') }
70 sub install_as_site { $_[0]->installdirs('site') }
71 sub install_as_vendor { $_[0]->installdirs('vendor') }
75 return $self->{'values'}{'sign'} if defined wantarray and ! @_;
76 $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
83 warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n";
86 $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0;
91 my ( $self, $file ) = @_;
93 unless ( defined($file) ) {
94 my $name = $self->name
95 or die "all_from called with no args without setting name() first";
96 $file = join('/', 'lib', split(/-/, $name)) . '.pm';
97 $file =~ s{.*/}{} unless -e $file;
98 die "all_from: cannot find $file from $name" unless -e $file;
101 $self->version_from($file) unless $self->version;
102 $self->perl_version_from($file) unless $self->perl_version;
104 # The remaining probes read from POD sections; if the file
105 # has an accompanying .pod, use that instead
107 if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
111 $self->author_from($file) unless $self->author;
112 $self->license_from($file) unless $self->license;
113 $self->abstract_from($file) unless $self->abstract;
118 my $provides = ( $self->{values}{provides} ||= {} );
119 %$provides = (%$provides, @_) if @_;
125 return $self unless $self->is_admin;
127 unless (-e 'MANIFEST') {
128 warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
132 # Avoid spurious warnings as we are not checking manifest here.
134 local $SIG{__WARN__} = sub {1};
135 require ExtUtils::Manifest;
136 local *ExtUtils::Manifest::manicheck = sub { return };
138 require Module::Build;
139 my $build = Module::Build->new(
140 dist_name => $self->name,
141 dist_version => $self->version,
142 license => $self->license,
144 $self->provides(%{ $build->find_dist_packages || {} });
150 my $features = ( $self->{values}{features} ||= [] );
154 if ( @_ == 1 and ref( $_[0] ) ) {
155 # The user used ->feature like ->features by passing in the second
156 # argument as a reference. Accomodate for that.
166 ref($_) ? ( ref($_) eq 'HASH' ) ? %$_
178 while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
179 $self->feature( $name, @$mods );
181 return $self->{values}->{features}
182 ? @{ $self->{values}->{features} }
189 push @{ $self->{values}{no_index}{$type} }, @_ if $type;
190 return $self->{values}{no_index};
195 $self->include_deps( 'YAML', 0 );
198 my $data = YAML::LoadFile('META.yml');
200 # Call methods explicitly in case user has already set some values.
201 while ( my ( $key, $value ) = each %$data ) {
202 next unless $self->can($key);
203 if ( ref $value eq 'HASH' ) {
204 while ( my ( $module, $version ) = each %$value ) {
205 $self->can($key)->($self, $module => $version );
209 $self->can($key)->($self, $value);
217 return $self unless $self->is_admin;
218 $self->admin->write_meta;
223 my ( $self, $file ) = @_;
224 require ExtUtils::MM_Unix;
225 $self->version( ExtUtils::MM_Unix->parse_version($file) );
229 my ( $self, $file ) = @_;
230 require ExtUtils::MM_Unix;
233 { DISTNAME => $self->name },
235 )->parse_abstract($file)
240 my ( $self, $file ) = @_;
243 open FH, "< $file" or die "Cannot open $file.pod: $!";
244 do { local $/; <FH> };
247 sub perl_version_from {
248 my ( $self, $file ) = @_;
251 $self->_slurp($file) =~ m/
262 $self->perl_version($1);
265 warn "Cannot determine perl version info from $file\n";
271 my ( $self, $file ) = @_;
272 my $content = $self->_slurp($file);
274 =head \d \s+ (?:authors?)\b \s*
277 =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
278 .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
281 my $author = $1 || $2;
282 $author =~ s{E<lt>}{<}g;
283 $author =~ s{E<gt>}{>}g;
284 $self->author($author);
287 warn "Cannot determine author info from $file\n";
292 my ( $self, $file ) = @_;
295 $self->_slurp($file) =~ m/
298 (?:licen[cs]e|licensing|copyright|legal)\b
306 my $license_text = $1;
308 'under the same (?:terms|license) as perl itself' => 'perl', 1,
309 'GNU public license' => 'gpl', 1,
310 'GNU lesser public license' => 'gpl', 1,
311 'BSD license' => 'bsd', 1,
312 'Artistic license' => 'artistic', 1,
316 'Artistic' => 'artistic', 1,
318 'proprietary' => 'proprietary', 0,
320 while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
321 $pattern =~ s{\s+}{\\s+}g;
322 if ( $license_text =~ /\b$pattern\b/i ) {
323 if ( $osi and $license_text =~ /All rights reserved/i ) {
324 warn "LEGAL WARNING: 'All rights reserved' may invalidate Open Source licenses. Consider removing it.";
326 $self->license($license);
332 warn "Cannot determine license info from $file\n";