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
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;
61 return $self->{'values'}{'sign'} if defined wantarray and !@_;
62 $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 );
69 warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n";
72 $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0;
77 my ( $self, $file ) = @_;
79 unless ( defined($file) ) {
80 my $name = $self->name
81 or die "all_from called with no args without setting name() first";
82 $file = join('/', 'lib', split(/-/, $name)) . '.pm';
83 $file =~ s{.*/}{} unless -e $file;
84 die "all_from: cannot find $file from $name" unless -e $file;
87 $self->version_from($file) unless $self->version;
88 $self->perl_version_from($file) unless $self->perl_version;
90 # The remaining probes read from POD sections; if the file
91 # has an accompanying .pod, use that instead
93 if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) {
97 $self->author_from($file) unless $self->author;
98 $self->license_from($file) unless $self->license;
99 $self->abstract_from($file) unless $self->abstract;
104 my $provides = ( $self->{values}{provides} ||= {} );
105 %$provides = (%$provides, @_) if @_;
111 return $self unless $self->is_admin;
113 unless (-e 'MANIFEST') {
114 warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
118 # Avoid spurious warnings as we are not checking manifest here.
120 local $SIG{__WARN__} = sub {1};
121 require ExtUtils::Manifest;
122 local *ExtUtils::Manifest::manicheck = sub { return };
124 require Module::Build;
125 my $build = Module::Build->new(
126 dist_name => $self->name,
127 dist_version => $self->version,
128 license => $self->license,
130 $self->provides(%{ $build->find_dist_packages || {} });
136 my $features = ( $self->{values}{features} ||= [] );
140 if ( @_ == 1 and ref( $_[0] ) ) {
141 # The user used ->feature like ->features by passing in the second
142 # argument as a reference. Accomodate for that.
152 ref($_) ? ( ref($_) eq 'HASH' ) ? %$_
164 while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
165 $self->feature( $name, @$mods );
167 return $self->{values}->{features}
168 ? @{ $self->{values}->{features} }
175 push @{ $self->{values}{no_index}{$type} }, @_ if $type;
176 return $self->{values}{no_index};
181 $self->include_deps( 'YAML', 0 );
184 my $data = YAML::LoadFile('META.yml');
186 # Call methods explicitly in case user has already set some values.
187 while ( my ( $key, $value ) = each %$data ) {
188 next unless $self->can($key);
189 if ( ref $value eq 'HASH' ) {
190 while ( my ( $module, $version ) = each %$value ) {
191 $self->can($key)->($self, $module => $version );
195 $self->can($key)->($self, $value);
203 return $self unless $self->is_admin;
204 $self->admin->write_meta;
209 my ( $self, $file ) = @_;
210 require ExtUtils::MM_Unix;
211 $self->version( ExtUtils::MM_Unix->parse_version($file) );
215 my ( $self, $file ) = @_;
216 require ExtUtils::MM_Unix;
219 { DISTNAME => $self->name },
221 )->parse_abstract($file)
226 my ( $self, $file ) = @_;
229 open FH, "< $file" or die "Cannot open $file.pod: $!";
230 do { local $/; <FH> };
233 sub perl_version_from {
234 my ( $self, $file ) = @_;
237 $self->_slurp($file) =~ m/
248 $self->perl_version($1);
251 warn "Cannot determine perl version info from $file\n";
257 my ( $self, $file ) = @_;
258 my $content = $self->_slurp($file);
260 =head \d \s+ (?:authors?)\b \s*
263 =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
264 .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
267 my $author = $1 || $2;
268 $author =~ s{E<lt>}{<}g;
269 $author =~ s{E<gt>}{>}g;
270 $self->author($author);
273 warn "Cannot determine author info from $file\n";
278 my ( $self, $file ) = @_;
281 $self->_slurp($file) =~ m/
283 (?:licen[cs]e|licensing|copyright|legal)\b
290 my $license_text = $1;
292 'under the same (?:terms|license) as perl itself' => 'perl',
293 'GNU public license' => 'gpl',
294 'GNU lesser public license' => 'gpl',
295 'BSD license' => 'bsd',
296 'Artistic license' => 'artistic',
300 'Artistic' => 'artistic',
302 while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) {
303 $pattern =~ s{\s+}{\\s+}g;
304 if ( $license_text =~ /\b$pattern\b/i ) {
305 $self->license($license);
311 warn "Cannot determine license info from $file\n";