"Fossies" - the Fresh Open Source Software Archive

Member "RT-Extension-Assets-1.05/inc/Module/Install/Metadata.pm" (6 May 2015, 18114 Bytes) of package /linux/misc/RT-Extension-Assets-1.05.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Metadata.pm" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 1.02_vs_1.04.

    1 #line 1
    2 package Module::Install::Metadata;
    3 
    4 use strict 'vars';
    5 use Module::Install::Base ();
    6 
    7 use vars qw{$VERSION @ISA $ISCORE};
    8 BEGIN {
    9     $VERSION = '1.14';
   10     @ISA     = 'Module::Install::Base';
   11     $ISCORE  = 1;
   12 }
   13 
   14 my @boolean_keys = qw{
   15     sign
   16 };
   17 
   18 my @scalar_keys = qw{
   19     name
   20     module_name
   21     abstract
   22     version
   23     distribution_type
   24     tests
   25     installdirs
   26 };
   27 
   28 my @tuple_keys = qw{
   29     configure_requires
   30     build_requires
   31     requires
   32     recommends
   33     bundles
   34     resources
   35 };
   36 
   37 my @resource_keys = qw{
   38     homepage
   39     bugtracker
   40     repository
   41 };
   42 
   43 my @array_keys = qw{
   44     keywords
   45     author
   46 };
   47 
   48 *authors = \&author;
   49 
   50 sub Meta              { shift          }
   51 sub Meta_BooleanKeys  { @boolean_keys  }
   52 sub Meta_ScalarKeys   { @scalar_keys   }
   53 sub Meta_TupleKeys    { @tuple_keys    }
   54 sub Meta_ResourceKeys { @resource_keys }
   55 sub Meta_ArrayKeys    { @array_keys    }
   56 
   57 foreach my $key ( @boolean_keys ) {
   58     *$key = sub {
   59         my $self = shift;
   60         if ( defined wantarray and not @_ ) {
   61             return $self->{values}->{$key};
   62         }
   63         $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
   64         return $self;
   65     };
   66 }
   67 
   68 foreach my $key ( @scalar_keys ) {
   69     *$key = sub {
   70         my $self = shift;
   71         return $self->{values}->{$key} if defined wantarray and !@_;
   72         $self->{values}->{$key} = shift;
   73         return $self;
   74     };
   75 }
   76 
   77 foreach my $key ( @array_keys ) {
   78     *$key = sub {
   79         my $self = shift;
   80         return $self->{values}->{$key} if defined wantarray and !@_;
   81         $self->{values}->{$key} ||= [];
   82         push @{$self->{values}->{$key}}, @_;
   83         return $self;
   84     };
   85 }
   86 
   87 foreach my $key ( @resource_keys ) {
   88     *$key = sub {
   89         my $self = shift;
   90         unless ( @_ ) {
   91             return () unless $self->{values}->{resources};
   92             return map  { $_->[1] }
   93                    grep { $_->[0] eq $key }
   94                    @{ $self->{values}->{resources} };
   95         }
   96         return $self->{values}->{resources}->{$key} unless @_;
   97         my $uri = shift or die(
   98             "Did not provide a value to $key()"
   99         );
  100         $self->resources( $key => $uri );
  101         return 1;
  102     };
  103 }
  104 
  105 foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
  106     *$key = sub {
  107         my $self = shift;
  108         return $self->{values}->{$key} unless @_;
  109         my @added;
  110         while ( @_ ) {
  111             my $module  = shift or last;
  112             my $version = shift || 0;
  113             push @added, [ $module, $version ];
  114         }
  115         push @{ $self->{values}->{$key} }, @added;
  116         return map {@$_} @added;
  117     };
  118 }
  119 
  120 # Resource handling
  121 my %lc_resource = map { $_ => 1 } qw{
  122     homepage
  123     license
  124     bugtracker
  125     repository
  126 };
  127 
  128 sub resources {
  129     my $self = shift;
  130     while ( @_ ) {
  131         my $name  = shift or last;
  132         my $value = shift or next;
  133         if ( $name eq lc $name and ! $lc_resource{$name} ) {
  134             die("Unsupported reserved lowercase resource '$name'");
  135         }
  136         $self->{values}->{resources} ||= [];
  137         push @{ $self->{values}->{resources} }, [ $name, $value ];
  138     }
  139     $self->{values}->{resources};
  140 }
  141 
  142 # Aliases for build_requires that will have alternative
  143 # meanings in some future version of META.yml.
  144 sub test_requires     { shift->build_requires(@_) }
  145 sub install_requires  { shift->build_requires(@_) }
  146 
  147 # Aliases for installdirs options
  148 sub install_as_core   { $_[0]->installdirs('perl')   }
  149 sub install_as_cpan   { $_[0]->installdirs('site')   }
  150 sub install_as_site   { $_[0]->installdirs('site')   }
  151 sub install_as_vendor { $_[0]->installdirs('vendor') }
  152 
  153 sub dynamic_config {
  154     my $self  = shift;
  155     my $value = @_ ? shift : 1;
  156     if ( $self->{values}->{dynamic_config} ) {
  157         # Once dynamic we never change to static, for safety
  158         return 0;
  159     }
  160     $self->{values}->{dynamic_config} = $value ? 1 : 0;
  161     return 1;
  162 }
  163 
  164 # Convenience command
  165 sub static_config {
  166     shift->dynamic_config(0);
  167 }
  168 
  169 sub perl_version {
  170     my $self = shift;
  171     return $self->{values}->{perl_version} unless @_;
  172     my $version = shift or die(
  173         "Did not provide a value to perl_version()"
  174     );
  175 
  176     # Normalize the version
  177     $version = $self->_perl_version($version);
  178 
  179     # We don't support the really old versions
  180     unless ( $version >= 5.005 ) {
  181         die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
  182     }
  183 
  184     $self->{values}->{perl_version} = $version;
  185 }
  186 
  187 sub all_from {
  188     my ( $self, $file ) = @_;
  189 
  190     unless ( defined($file) ) {
  191         my $name = $self->name or die(
  192             "all_from called with no args without setting name() first"
  193         );
  194         $file = join('/', 'lib', split(/-/, $name)) . '.pm';
  195         $file =~ s{.*/}{} unless -e $file;
  196         unless ( -e $file ) {
  197             die("all_from cannot find $file from $name");
  198         }
  199     }
  200     unless ( -f $file ) {
  201         die("The path '$file' does not exist, or is not a file");
  202     }
  203 
  204     $self->{values}{all_from} = $file;
  205 
  206     # Some methods pull from POD instead of code.
  207     # If there is a matching .pod, use that instead
  208     my $pod = $file;
  209     $pod =~ s/\.pm$/.pod/i;
  210     $pod = $file unless -e $pod;
  211 
  212     # Pull the different values
  213     $self->name_from($file)         unless $self->name;
  214     $self->version_from($file)      unless $self->version;
  215     $self->perl_version_from($file) unless $self->perl_version;
  216     $self->author_from($pod)        unless @{$self->author || []};
  217     $self->license_from($pod)       unless $self->license;
  218     $self->abstract_from($pod)      unless $self->abstract;
  219 
  220     return 1;
  221 }
  222 
  223 sub provides {
  224     my $self     = shift;
  225     my $provides = ( $self->{values}->{provides} ||= {} );
  226     %$provides = (%$provides, @_) if @_;
  227     return $provides;
  228 }
  229 
  230 sub auto_provides {
  231     my $self = shift;
  232     return $self unless $self->is_admin;
  233     unless (-e 'MANIFEST') {
  234         warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
  235         return $self;
  236     }
  237     # Avoid spurious warnings as we are not checking manifest here.
  238     local $SIG{__WARN__} = sub {1};
  239     require ExtUtils::Manifest;
  240     local *ExtUtils::Manifest::manicheck = sub { return };
  241 
  242     require Module::Build;
  243     my $build = Module::Build->new(
  244         dist_name    => $self->name,
  245         dist_version => $self->version,
  246         license      => $self->license,
  247     );
  248     $self->provides( %{ $build->find_dist_packages || {} } );
  249 }
  250 
  251 sub feature {
  252     my $self     = shift;
  253     my $name     = shift;
  254     my $features = ( $self->{values}->{features} ||= [] );
  255     my $mods;
  256 
  257     if ( @_ == 1 and ref( $_[0] ) ) {
  258         # The user used ->feature like ->features by passing in the second
  259         # argument as a reference.  Accomodate for that.
  260         $mods = $_[0];
  261     } else {
  262         $mods = \@_;
  263     }
  264 
  265     my $count = 0;
  266     push @$features, (
  267         $name => [
  268             map {
  269                 ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
  270             } @$mods
  271         ]
  272     );
  273 
  274     return @$features;
  275 }
  276 
  277 sub features {
  278     my $self = shift;
  279     while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
  280         $self->feature( $name, @$mods );
  281     }
  282     return $self->{values}->{features}
  283         ? @{ $self->{values}->{features} }
  284         : ();
  285 }
  286 
  287 sub no_index {
  288     my $self = shift;
  289     my $type = shift;
  290     push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
  291     return $self->{values}->{no_index};
  292 }
  293 
  294 sub read {
  295     my $self = shift;
  296     $self->include_deps( 'YAML::Tiny', 0 );
  297 
  298     require YAML::Tiny;
  299     my $data = YAML::Tiny::LoadFile('META.yml');
  300 
  301     # Call methods explicitly in case user has already set some values.
  302     while ( my ( $key, $value ) = each %$data ) {
  303         next unless $self->can($key);
  304         if ( ref $value eq 'HASH' ) {
  305             while ( my ( $module, $version ) = each %$value ) {
  306                 $self->can($key)->($self, $module => $version );
  307             }
  308         } else {
  309             $self->can($key)->($self, $value);
  310         }
  311     }
  312     return $self;
  313 }
  314 
  315 sub write {
  316     my $self = shift;
  317     return $self unless $self->is_admin;
  318     $self->admin->write_meta;
  319     return $self;
  320 }
  321 
  322 sub version_from {
  323     require ExtUtils::MM_Unix;
  324     my ( $self, $file ) = @_;
  325     $self->version( ExtUtils::MM_Unix->parse_version($file) );
  326 
  327     # for version integrity check
  328     $self->makemaker_args( VERSION_FROM => $file );
  329 }
  330 
  331 sub abstract_from {
  332     require ExtUtils::MM_Unix;
  333     my ( $self, $file ) = @_;
  334     $self->abstract(
  335         bless(
  336             { DISTNAME => $self->name },
  337             'ExtUtils::MM_Unix'
  338         )->parse_abstract($file)
  339     );
  340 }
  341 
  342 # Add both distribution and module name
  343 sub name_from {
  344     my ($self, $file) = @_;
  345     if (
  346         Module::Install::_read($file) =~ m/
  347         ^ \s*
  348         package \s*
  349         ([\w:]+)
  350         [\s|;]*
  351         /ixms
  352     ) {
  353         my ($name, $module_name) = ($1, $1);
  354         $name =~ s{::}{-}g;
  355         $self->name($name);
  356         unless ( $self->module_name ) {
  357             $self->module_name($module_name);
  358         }
  359     } else {
  360         die("Cannot determine name from $file\n");
  361     }
  362 }
  363 
  364 sub _extract_perl_version {
  365     if (
  366         $_[0] =~ m/
  367         ^\s*
  368         (?:use|require) \s*
  369         v?
  370         ([\d_\.]+)
  371         \s* ;
  372         /ixms
  373     ) {
  374         my $perl_version = $1;
  375         $perl_version =~ s{_}{}g;
  376         return $perl_version;
  377     } else {
  378         return;
  379     }
  380 }
  381 
  382 sub perl_version_from {
  383     my $self = shift;
  384     my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
  385     if ($perl_version) {
  386         $self->perl_version($perl_version);
  387     } else {
  388         warn "Cannot determine perl version info from $_[0]\n";
  389         return;
  390     }
  391 }
  392 
  393 sub author_from {
  394     my $self    = shift;
  395     my $content = Module::Install::_read($_[0]);
  396     if ($content =~ m/
  397         =head \d \s+ (?:authors?)\b \s*
  398         ([^\n]*)
  399         |
  400         =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
  401         .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
  402         ([^\n]*)
  403     /ixms) {
  404         my $author = $1 || $2;
  405 
  406         # XXX: ugly but should work anyway...
  407         if (eval "require Pod::Escapes; 1") {
  408             # Pod::Escapes has a mapping table.
  409             # It's in core of perl >= 5.9.3, and should be installed
  410             # as one of the Pod::Simple's prereqs, which is a prereq
  411             # of Pod::Text 3.x (see also below).
  412             $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
  413             {
  414                 defined $2
  415                 ? chr($2)
  416                 : defined $Pod::Escapes::Name2character_number{$1}
  417                 ? chr($Pod::Escapes::Name2character_number{$1})
  418                 : do {
  419                     warn "Unknown escape: E<$1>";
  420                     "E<$1>";
  421                 };
  422             }gex;
  423         }
  424         elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
  425             # Pod::Text < 3.0 has yet another mapping table,
  426             # though the table name of 2.x and 1.x are different.
  427             # (1.x is in core of Perl < 5.6, 2.x is in core of
  428             # Perl < 5.9.3)
  429             my $mapping = ($Pod::Text::VERSION < 2)
  430                 ? \%Pod::Text::HTML_Escapes
  431                 : \%Pod::Text::ESCAPES;
  432             $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
  433             {
  434                 defined $2
  435                 ? chr($2)
  436                 : defined $mapping->{$1}
  437                 ? $mapping->{$1}
  438                 : do {
  439                     warn "Unknown escape: E<$1>";
  440                     "E<$1>";
  441                 };
  442             }gex;
  443         }
  444         else {
  445             $author =~ s{E<lt>}{<}g;
  446             $author =~ s{E<gt>}{>}g;
  447         }
  448         $self->author($author);
  449     } else {
  450         warn "Cannot determine author info from $_[0]\n";
  451     }
  452 }
  453 
  454 #Stolen from M::B
  455 my %license_urls = (
  456     perl         => 'http://dev.perl.org/licenses/',
  457     apache       => 'http://apache.org/licenses/LICENSE-2.0',
  458     apache_1_1   => 'http://apache.org/licenses/LICENSE-1.1',
  459     artistic     => 'http://opensource.org/licenses/artistic-license.php',
  460     artistic_2   => 'http://opensource.org/licenses/artistic-license-2.0.php',
  461     lgpl         => 'http://opensource.org/licenses/lgpl-license.php',
  462     lgpl2        => 'http://opensource.org/licenses/lgpl-2.1.php',
  463     lgpl3        => 'http://opensource.org/licenses/lgpl-3.0.html',
  464     bsd          => 'http://opensource.org/licenses/bsd-license.php',
  465     gpl          => 'http://opensource.org/licenses/gpl-license.php',
  466     gpl2         => 'http://opensource.org/licenses/gpl-2.0.php',
  467     gpl3         => 'http://opensource.org/licenses/gpl-3.0.html',
  468     mit          => 'http://opensource.org/licenses/mit-license.php',
  469     mozilla      => 'http://opensource.org/licenses/mozilla1.1.php',
  470     open_source  => undef,
  471     unrestricted => undef,
  472     restrictive  => undef,
  473     unknown      => undef,
  474 );
  475 
  476 sub license {
  477     my $self = shift;
  478     return $self->{values}->{license} unless @_;
  479     my $license = shift or die(
  480         'Did not provide a value to license()'
  481     );
  482     $license = __extract_license($license) || lc $license;
  483     $self->{values}->{license} = $license;
  484 
  485     # Automatically fill in license URLs
  486     if ( $license_urls{$license} ) {
  487         $self->resources( license => $license_urls{$license} );
  488     }
  489 
  490     return 1;
  491 }
  492 
  493 sub _extract_license {
  494     my $pod = shift;
  495     my $matched;
  496     return __extract_license(
  497         ($matched) = $pod =~ m/
  498             (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
  499             (=head \d.*|=cut.*|)\z
  500         /xms
  501     ) || __extract_license(
  502         ($matched) = $pod =~ m/
  503             (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
  504             (=head \d.*|=cut.*|)\z
  505         /xms
  506     );
  507 }
  508 
  509 sub __extract_license {
  510     my $license_text = shift or return;
  511     my @phrases      = (
  512         '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
  513         '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
  514         'Artistic and GPL'                   => 'perl',         1,
  515         'GNU general public license'         => 'gpl',          1,
  516         'GNU public license'                 => 'gpl',          1,
  517         'GNU lesser general public license'  => 'lgpl',         1,
  518         'GNU lesser public license'          => 'lgpl',         1,
  519         'GNU library general public license' => 'lgpl',         1,
  520         'GNU library public license'         => 'lgpl',         1,
  521         'GNU Free Documentation license'     => 'unrestricted', 1,
  522         'GNU Affero General Public License'  => 'open_source',  1,
  523         '(?:Free)?BSD license'               => 'bsd',          1,
  524         'Artistic license 2\.0'              => 'artistic_2',   1,
  525         'Artistic license'                   => 'artistic',     1,
  526         'Apache (?:Software )?license'       => 'apache',       1,
  527         'GPL'                                => 'gpl',          1,
  528         'LGPL'                               => 'lgpl',         1,
  529         'BSD'                                => 'bsd',          1,
  530         'Artistic'                           => 'artistic',     1,
  531         'MIT'                                => 'mit',          1,
  532         'Mozilla Public License'             => 'mozilla',      1,
  533         'Q Public License'                   => 'open_source',  1,
  534         'OpenSSL License'                    => 'unrestricted', 1,
  535         'SSLeay License'                     => 'unrestricted', 1,
  536         'zlib License'                       => 'open_source',  1,
  537         'proprietary'                        => 'proprietary',  0,
  538     );
  539     while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
  540         $pattern =~ s#\s+#\\s+#gs;
  541         if ( $license_text =~ /\b$pattern\b/i ) {
  542             return $license;
  543         }
  544     }
  545     return '';
  546 }
  547 
  548 sub license_from {
  549     my $self = shift;
  550     if (my $license=_extract_license(Module::Install::_read($_[0]))) {
  551         $self->license($license);
  552     } else {
  553         warn "Cannot determine license info from $_[0]\n";
  554         return 'unknown';
  555     }
  556 }
  557 
  558 sub _extract_bugtracker {
  559     my @links   = $_[0] =~ m#L<(
  560      https?\Q://rt.cpan.org/\E[^>]+|
  561      https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
  562      https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
  563      )>#gx;
  564     my %links;
  565     @links{@links}=();
  566     @links=keys %links;
  567     return @links;
  568 }
  569 
  570 sub bugtracker_from {
  571     my $self    = shift;
  572     my $content = Module::Install::_read($_[0]);
  573     my @links   = _extract_bugtracker($content);
  574     unless ( @links ) {
  575         warn "Cannot determine bugtracker info from $_[0]\n";
  576         return 0;
  577     }
  578     if ( @links > 1 ) {
  579         warn "Found more than one bugtracker link in $_[0]\n";
  580         return 0;
  581     }
  582 
  583     # Set the bugtracker
  584     bugtracker( $links[0] );
  585     return 1;
  586 }
  587 
  588 sub requires_from {
  589     my $self     = shift;
  590     my $content  = Module::Install::_readperl($_[0]);
  591     my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
  592     while ( @requires ) {
  593         my $module  = shift @requires;
  594         my $version = shift @requires;
  595         $self->requires( $module => $version );
  596     }
  597 }
  598 
  599 sub test_requires_from {
  600     my $self     = shift;
  601     my $content  = Module::Install::_readperl($_[0]);
  602     my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
  603     while ( @requires ) {
  604         my $module  = shift @requires;
  605         my $version = shift @requires;
  606         $self->test_requires( $module => $version );
  607     }
  608 }
  609 
  610 # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
  611 # numbers (eg, 5.006001 or 5.008009).
  612 # Also, convert double-part versions (eg, 5.8)
  613 sub _perl_version {
  614     my $v = $_[-1];
  615     $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
  616     $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
  617     $v =~ s/(\.\d\d\d)000$/$1/;
  618     $v =~ s/_.+$//;
  619     if ( ref($v) ) {
  620         # Numify
  621         $v = $v + 0;
  622     }
  623     return $v;
  624 }
  625 
  626 sub add_metadata {
  627     my $self = shift;
  628     my %hash = @_;
  629     for my $key (keys %hash) {
  630         warn "add_metadata: $key is not prefixed with 'x_'.\n" .
  631              "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
  632         $self->{values}->{$key} = $hash{$key};
  633     }
  634 }
  635 
  636 
  637 ######################################################################
  638 # MYMETA Support
  639 
  640 sub WriteMyMeta {
  641     die "WriteMyMeta has been deprecated";
  642 }
  643 
  644 sub write_mymeta_yaml {
  645     my $self = shift;
  646 
  647     # We need YAML::Tiny to write the MYMETA.yml file
  648     unless ( eval { require YAML::Tiny; 1; } ) {
  649         return 1;
  650     }
  651 
  652     # Generate the data
  653     my $meta = $self->_write_mymeta_data or return 1;
  654 
  655     # Save as the MYMETA.yml file
  656     print "Writing MYMETA.yml\n";
  657     YAML::Tiny::DumpFile('MYMETA.yml', $meta);
  658 }
  659 
  660 sub write_mymeta_json {
  661     my $self = shift;
  662 
  663     # We need JSON to write the MYMETA.json file
  664     unless ( eval { require JSON; 1; } ) {
  665         return 1;
  666     }
  667 
  668     # Generate the data
  669     my $meta = $self->_write_mymeta_data or return 1;
  670 
  671     # Save as the MYMETA.yml file
  672     print "Writing MYMETA.json\n";
  673     Module::Install::_write(
  674         'MYMETA.json',
  675         JSON->new->pretty(1)->canonical->encode($meta),
  676     );
  677 }
  678 
  679 sub _write_mymeta_data {
  680     my $self = shift;
  681 
  682     # If there's no existing META.yml there is nothing we can do
  683     return undef unless -f 'META.yml';
  684 
  685     # We need Parse::CPAN::Meta to load the file
  686     unless ( eval { require Parse::CPAN::Meta; 1; } ) {
  687         return undef;
  688     }
  689 
  690     # Merge the perl version into the dependencies
  691     my $val  = $self->Meta->{values};
  692     my $perl = delete $val->{perl_version};
  693     if ( $perl ) {
  694         $val->{requires} ||= [];
  695         my $requires = $val->{requires};
  696 
  697         # Canonize to three-dot version after Perl 5.6
  698         if ( $perl >= 5.006 ) {
  699             $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
  700         }
  701         unshift @$requires, [ perl => $perl ];
  702     }
  703 
  704     # Load the advisory META.yml file
  705     my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
  706     my $meta = $yaml[0];
  707 
  708     # Overwrite the non-configure dependency hashes
  709     delete $meta->{requires};
  710     delete $meta->{build_requires};
  711     delete $meta->{recommends};
  712     if ( exists $val->{requires} ) {
  713         $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
  714     }
  715     if ( exists $val->{build_requires} ) {
  716         $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
  717     }
  718 
  719     return $meta;
  720 }
  721 
  722 1;