package Module::Install::Admin::Metadata; use Module::Install::Base; @ISA = 'Module::Install::Base'; $VERSION = '0.67'; use strict; sub remove_meta { my $self = shift; my $package = ref($self->_top); my $version = $self->_top->VERSION; return unless -f 'META.yml'; open META, 'META.yml' or die "Can't open META.yml for output:\n$!"; my $meta = do {local $/; }; close META; return unless $meta =~ /^generated_by: $package version $version/m; unless (-w 'META.yml') { warn "Can't remove META.yml file. Not writable.\n"; return; } warn "Removing auto-generated META.yml\n"; unlink 'META.yml' or die "Couldn't unlink META.yml:\n$!"; } sub write_meta { my $self = shift; META_NOT_OURS: { local *FH; if ( open FH, "META.yml" ) { while () { last META_NOT_OURS if /^generated_by: Module::Install\b/; } return if -s FH; } } print "Writing META.yml\n"; local *META; open META, "> META.yml" or warn "Cannot write to META.yml: $!"; print META $self->dump_meta; close META; return; } sub dump_meta { my $self = shift; my $package = ref( $self->_top ); my $version = $self->_top->VERSION; my %values = %{ $self->Meta->{'values'} }; delete $values{sign}; if ( my $perl_version = delete $values{perl_version} ) { # Always canonical to three-dot version $perl_version =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e if $perl_version >= 5.006; $values{requires} = [ [ perl => $perl_version ], @{ $values{requires} || [] }, ]; } # Set a default 'unknown' license unless ( $values{license} ) { warn "No license specified, setting license = 'unknown'\n"; $values{license} = 'unknown'; } $values{distribution_type} ||= 'module'; # Guess a name if needed, derived from the module_name if ( $values{module_name} and ! $values{name} ) { $values{name} = $values{module_name}; $values{name} =~ s/::/-/g; } if ( $values{name} =~ /::/ ) { my $name = $values{name}; $name =~ s/::/-/g; die "Error in name(): '$values{name}' should be '$name'!\n"; } my %dump; foreach my $key ($self->Meta_ScalarKeys) { $dump{$key} = $values{$key} if exists $values{$key}; } foreach my $key ($self->Meta_TupleKeys) { next unless exists $values{$key}; $dump{$key} = { map { @$_ } @{ $values{$key} } }; } if ( my $provides = $values{provides} ) { $dump{provides} = $provides; } my $no_index = $values{no_index} ||= {}; push @{ $no_index->{'directory'} ||= [] }, 'inc', 't'; $dump{no_index} = $no_index; $dump{generated_by} = "$package version $version"; # Add mention of the META spec $dump{"meta-spec"} = { version => 1.3, url => 'http://module-build.sourceforge.net/META-spec-v1.3.html', }; local $@; if (eval { require YAML::Syck }) { # Why no header? It is required by the spec! # local $YAML::Syck::Headless = 1; return YAML::Syck::Dump(\%dump); } elsif (eval { require YAML::Tiny }) { return YAML::Tiny::Dump(\%dump); } else { require YAML; # Why no header? It is required by the spec! # local $YAML::UseHeader = 0; return YAML::Dump(\%dump); } } 1;