summaryrefslogtreecommitdiffstats
path: root/.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm
diff options
context:
space:
mode:
Diffstat (limited to '.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm')
-rw-r--r--.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm1210
1 files changed, 1210 insertions, 0 deletions
diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm
new file mode 100644
index 000000000..eddaa1073
--- /dev/null
+++ b/.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm
@@ -0,0 +1,1210 @@
+use 5.006;
+use strict;
+use warnings;
+package CPAN::Meta::Validator;
+
+our $VERSION = '2.150005';
+
+#pod =head1 SYNOPSIS
+#pod
+#pod my $struct = decode_json_file('META.json');
+#pod
+#pod my $cmv = CPAN::Meta::Validator->new( $struct );
+#pod
+#pod unless ( $cmv->is_valid ) {
+#pod my $msg = "Invalid META structure. Errors found:\n";
+#pod $msg .= join( "\n", $cmv->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<meta-spec> field of the structure.
+#pod
+#pod =cut
+
+#--------------------------------------------------------------------------#
+# This code copied and adapted from Test::CPAN::Meta
+# by Barbie, <barbie@cpan.org> for Miss Barbell Productions,
+# L<http://www.missbarbell.co.uk>
+#--------------------------------------------------------------------------#
+
+#--------------------------------------------------------------------------#
+# Specification Definitions
+#--------------------------------------------------------------------------#
+
+my %known_specs = (
+ '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
+ '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
+ '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
+ '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
+ '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
+);
+my %known_urls = map {$known_specs{$_} => $_} keys %known_specs;
+
+my $module_map1 = { 'map' => { ':key' => { name => \&module, value => \&exversion } } };
+
+my $module_map2 = { 'map' => { ':key' => { name => \&module, value => \&version } } };
+
+my $no_index_2 = {
+ 'map' => { file => { list => { value => \&string } },
+ directory => { list => { value => \&string } },
+ 'package' => { list => { value => \&string } },
+ namespace => { list => { value => \&string } },
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+};
+
+my $no_index_1_3 = {
+ 'map' => { file => { list => { value => \&string } },
+ directory => { list => { value => \&string } },
+ 'package' => { list => { value => \&string } },
+ namespace => { list => { value => \&string } },
+ ':key' => { name => \&string, value => \&anything },
+ }
+};
+
+my $no_index_1_2 = {
+ 'map' => { file => { list => { value => \&string } },
+ dir => { list => { value => \&string } },
+ 'package' => { list => { value => \&string } },
+ namespace => { list => { value => \&string } },
+ ':key' => { name => \&string, value => \&anything },
+ }
+};
+
+my $no_index_1_1 = {
+ 'map' => { ':key' => { name => \&string, list => { value => \&string } },
+ }
+};
+
+my $prereq_map = {
+ map => {
+ ':key' => {
+ name => \&phase,
+ 'map' => {
+ ':key' => {
+ name => \&relation,
+ %$module_map1,
+ },
+ },
+ }
+ },
+};
+
+my %definitions = (
+ '2' => {
+ # REQUIRED
+ 'abstract' => { mandatory => 1, value => \&string },
+ 'author' => { mandatory => 1, list => { value => \&string } },
+ 'dynamic_config' => { mandatory => 1, value => \&boolean },
+ 'generated_by' => { mandatory => 1, value => \&string },
+ 'license' => { mandatory => 1, list => { value => \&license } },
+ 'meta-spec' => {
+ mandatory => 1,
+ 'map' => {
+ version => { mandatory => 1, value => \&version},
+ url => { value => \&url },
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ },
+ 'name' => { mandatory => 1, value => \&string },
+ 'release_status' => { mandatory => 1, value => \&release_status },
+ 'version' => { mandatory => 1, value => \&version },
+
+ # OPTIONAL
+ 'description' => { value => \&string },
+ 'keywords' => { list => { value => \&string } },
+ 'no_index' => $no_index_2,
+ 'optional_features' => {
+ 'map' => {
+ ':key' => {
+ name => \&string,
+ 'map' => {
+ description => { value => \&string },
+ prereqs => $prereq_map,
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ }
+ }
+ },
+ 'prereqs' => $prereq_map,
+ 'provides' => {
+ 'map' => {
+ ':key' => {
+ name => \&module,
+ 'map' => {
+ file => { mandatory => 1, value => \&file },
+ version => { value => \&version },
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ }
+ }
+ },
+ 'resources' => {
+ 'map' => {
+ license => { list => { value => \&url } },
+ homepage => { value => \&url },
+ bugtracker => {
+ 'map' => {
+ web => { value => \&url },
+ mailto => { value => \&string},
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ },
+ repository => {
+ 'map' => {
+ web => { value => \&url },
+ url => { value => \&url },
+ type => { value => \&string },
+ ':key' => { name => \&custom_2, value => \&anything },
+ }
+ },
+ ':key' => { value => \&string, name => \&custom_2 },
+ }
+ },
+
+ # CUSTOM -- additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&custom_2, value => \&anything },
+ },
+
+'1.4' => {
+ 'meta-spec' => {
+ mandatory => 1,
+ 'map' => {
+ version => { mandatory => 1, value => \&version},
+ url => { mandatory => 1, value => \&urlspec },
+ ':key' => { name => \&string, value => \&anything },
+ },
+ },
+
+ 'name' => { mandatory => 1, value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'abstract' => { mandatory => 1, value => \&string },
+ 'author' => { mandatory => 1, list => { value => \&string } },
+ 'license' => { mandatory => 1, value => \&license },
+ 'generated_by' => { mandatory => 1, value => \&string },
+
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'configure_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ 'optional_features' => {
+ 'map' => {
+ ':key' => { name => \&string,
+ 'map' => { description => { value => \&string },
+ requires => $module_map1,
+ recommends => $module_map1,
+ build_requires => $module_map1,
+ conflicts => $module_map2,
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'provides' => {
+ 'map' => {
+ ':key' => { name => \&module,
+ 'map' => {
+ file => { mandatory => 1, value => \&file },
+ version => { value => \&version },
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'no_index' => $no_index_1_3,
+ 'private' => $no_index_1_3,
+
+ 'keywords' => { list => { value => \&string } },
+
+ 'resources' => {
+ 'map' => { license => { value => \&url },
+ homepage => { value => \&url },
+ bugtracker => { value => \&url },
+ repository => { value => \&url },
+ ':key' => { value => \&string, name => \&custom_1 },
+ }
+ },
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&anything },
+},
+
+'1.3' => {
+ 'meta-spec' => {
+ mandatory => 1,
+ 'map' => {
+ version => { mandatory => 1, value => \&version},
+ url => { mandatory => 1, value => \&urlspec },
+ ':key' => { name => \&string, value => \&anything },
+ },
+ },
+
+ 'name' => { mandatory => 1, value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'abstract' => { mandatory => 1, value => \&string },
+ 'author' => { mandatory => 1, list => { value => \&string } },
+ 'license' => { mandatory => 1, value => \&license },
+ 'generated_by' => { mandatory => 1, value => \&string },
+
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ 'optional_features' => {
+ 'map' => {
+ ':key' => { name => \&string,
+ 'map' => { description => { value => \&string },
+ requires => $module_map1,
+ recommends => $module_map1,
+ build_requires => $module_map1,
+ conflicts => $module_map2,
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'provides' => {
+ 'map' => {
+ ':key' => { name => \&module,
+ 'map' => {
+ file => { mandatory => 1, value => \&file },
+ version => { value => \&version },
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+
+ 'no_index' => $no_index_1_3,
+ 'private' => $no_index_1_3,
+
+ 'keywords' => { list => { value => \&string } },
+
+ 'resources' => {
+ 'map' => { license => { value => \&url },
+ homepage => { value => \&url },
+ bugtracker => { value => \&url },
+ repository => { value => \&url },
+ ':key' => { value => \&string, name => \&custom_1 },
+ }
+ },
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&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' => {
+ 'meta-spec' => {
+ mandatory => 1,
+ 'map' => {
+ version => { mandatory => 1, value => \&version},
+ url => { mandatory => 1, value => \&urlspec },
+ ':key' => { name => \&string, value => \&anything },
+ },
+ },
+
+
+ 'name' => { mandatory => 1, value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'license' => { mandatory => 1, value => \&license },
+ 'generated_by' => { mandatory => 1, value => \&string },
+ 'author' => { mandatory => 1, list => { value => \&string } },
+ 'abstract' => { mandatory => 1, value => \&string },
+
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'keywords' => { list => { value => \&string } },
+
+ 'private' => $no_index_1_2,
+ '$no_index' => $no_index_1_2,
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ 'optional_features' => {
+ 'map' => {
+ ':key' => { name => \&string,
+ 'map' => { description => { value => \&string },
+ requires => $module_map1,
+ recommends => $module_map1,
+ build_requires => $module_map1,
+ conflicts => $module_map2,
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'provides' => {
+ 'map' => {
+ ':key' => { name => \&module,
+ 'map' => {
+ file => { mandatory => 1, value => \&file },
+ version => { value => \&version },
+ ':key' => { name => \&string, value => \&anything },
+ }
+ }
+ }
+ },
+
+ 'resources' => {
+ 'map' => { license => { value => \&url },
+ homepage => { value => \&url },
+ bugtracker => { value => \&url },
+ repository => { value => \&url },
+ ':key' => { value => \&string, name => \&custom_1 },
+ }
+ },
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&anything },
+},
+
+# note that the 1.1 spec only specifies 'version' as mandatory
+'1.1' => {
+ 'name' => { value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'license' => { value => \&license },
+ 'generated_by' => { value => \&string },
+
+ 'license_uri' => { value => \&url },
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'private' => $no_index_1_1,
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&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' => {
+ 'name' => { value => \&string },
+ 'version' => { mandatory => 1, value => \&version },
+ 'license' => { value => \&license },
+ 'generated_by' => { value => \&string },
+
+ 'license_uri' => { value => \&url },
+ 'distribution_type' => { value => \&string },
+ 'dynamic_config' => { value => \&boolean },
+
+ 'requires' => $module_map1,
+ 'recommends' => $module_map1,
+ 'build_requires' => $module_map1,
+ 'conflicts' => $module_map2,
+
+ # additional user defined key/value pairs
+ # note we can only validate the key name, as the structure is user defined
+ ':key' => { name => \&string, value => \&anything },
+},
+);
+
+#--------------------------------------------------------------------------#
+# Code
+#--------------------------------------------------------------------------#
+
+#pod =method new
+#pod
+#pod my $cmv = CPAN::Meta::Validator->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' => $data,
+ 'spec' => eval { $data->{'meta-spec'}{'version'} } || "1.0",
+ 'errors' => undef,
+ };
+
+ # create the object
+ return bless $self, $class;
+}
+
+#pod =method is_valid
+#pod
+#pod if ( $cmv->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->{data};
+ my $spec_version = $self->{spec};
+ $self->check_map($definitions{$spec_version},$data);
+ return ! $self->errors;
+}
+
+#pod =method errors
+#pod
+#pod warn( join "\n", $cmv->errors );
+#pod
+#pod Returns a list of errors seen during validation.
+#pod
+#pod =cut
+
+sub errors {
+ my $self = shift;
+ return () unless(defined $self->{errors});
+ return @{$self->{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 = "Missing validation action in specification. "
+ . "Must be one of 'map', 'list', or 'value'";
+
+sub check_map {
+ my ($self,$spec,$data) = @_;
+
+ if(ref($spec) ne 'HASH') {
+ $self->_error( "Unknown META specification, cannot validate." );
+ return;
+ }
+
+ if(ref($data) ne 'HASH') {
+ $self->_error( "Expected a map structure from string or file." );
+ return;
+ }
+
+ for my $key (keys %$spec) {
+ next unless($spec->{$key}->{mandatory});
+ next if(defined $data->{$key});
+ push @{$self->{stack}}, $key;
+ $self->_error( "Missing mandatory field, '$key'" );
+ pop @{$self->{stack}};
+ }
+
+ for my $key (keys %$data) {
+ push @{$self->{stack}}, $key;
+ if($spec->{$key}) {
+ if($spec->{$key}{value}) {
+ $spec->{$key}{value}->($self,$key,$data->{$key});
+ } elsif($spec->{$key}{'map'}) {
+ $self->check_map($spec->{$key}{'map'},$data->{$key});
+ } elsif($spec->{$key}{'list'}) {
+ $self->check_list($spec->{$key}{'list'},$data->{$key});
+ } else {
+ $self->_error( "$spec_error for '$key'" );
+ }
+
+ } elsif ($spec->{':key'}) {
+ $spec->{':key'}{name}->($self,$key,$key);
+ if($spec->{':key'}{value}) {
+ $spec->{':key'}{value}->($self,$key,$data->{$key});
+ } elsif($spec->{':key'}{'map'}) {
+ $self->check_map($spec->{':key'}{'map'},$data->{$key});
+ } elsif($spec->{':key'}{'list'}) {
+ $self->check_list($spec->{':key'}{'list'},$data->{$key});
+ } else {
+ $self->_error( "$spec_error for ':key'" );
+ }
+
+
+ } else {
+ $self->_error( "Unknown key, '$key', found in map structure" );
+ }
+ pop @{$self->{stack}};
+ }
+}
+
+sub check_list {
+ my ($self,$spec,$data) = @_;
+
+ if(ref($data) ne 'ARRAY') {
+ $self->_error( "Expected a list structure" );
+ return;
+ }
+
+ if(defined $spec->{mandatory}) {
+ if(!defined $data->[0]) {
+ $self->_error( "Missing entries from mandatory list" );
+ }
+ }
+
+ for my $value (@$data) {
+ push @{$self->{stack}}, $value || "<undef>";
+ if(defined $spec->{value}) {
+ $spec->{value}->($self,'list',$value);
+ } elsif(defined $spec->{'map'}) {
+ $self->check_map($spec->{'map'},$value);
+ } elsif(defined $spec->{'list'}) {
+ $self->check_list($spec->{'list'},$value);
+ } elsif ($spec->{':key'}) {
+ $self->check_map($spec,$value);
+ } else {
+ $self->_error( "$spec_error associated with '$self->{stack}[-2]'" );
+ }
+ pop @{$self->{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 \&string.
+#pod
+#pod =item *
+#pod
+#pod exversion($self,$key,$value)
+#pod
+#pod Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <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 && $value =~ /^--- #YAML:1.0/);
+ }
+ $self->_error( "file does not have a valid YAML header." );
+ return 0;
+}
+
+sub release_status {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ my $version = $self->{data}{version} || '';
+ if ( $version =~ /_/ ) {
+ return 1 if ( $value =~ /\A(?:testing|unstable)\z/ );
+ $self->_error( "'$value' for '$key' is invalid for version '$version'" );
+ }
+ else {
+ return 1 if ( $value =~ /\A(?:stable|testing|unstable)\z/ );
+ $self->_error( "'$value' for '$key' is invalid" );
+ }
+ }
+ else {
+ $self->_error( "'$key' is not defined" );
+ }
+ 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 && length $scheme ) {
+ $self->_error( "'$value' for '$key' does not have a URL scheme" );
+ return 0;
+ }
+ unless ( defined $auth && length $auth ) {
+ $self->_error( "'$value' for '$key' does not have a URL authority" );
+ return 0;
+ }
+ return 1;
+ }
+ $value ||= '';
+ $self->_error( "'$value' for '$key' is not a valid URL." );
+ return 0;
+}
+
+sub urlspec {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ return 1 if($value && $known_specs{$self->{spec}} eq $value);
+ if($value && $known_urls{$value}) {
+ $self->_error( 'META specification URL does not match version' );
+ return 0;
+ }
+ }
+ $self->_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->_error( "value is an undefined string" );
+ return 0;
+}
+
+sub string_or_undef {
+ my ($self,$key,$value) = @_;
+ return 1 unless(defined $value);
+ return 1 if($value || $value =~ /^0$/);
+ $self->_error( "No string defined for '$key'" );
+ return 0;
+}
+
+sub file {
+ my ($self,$key,$value) = @_;
+ return 1 if(defined $value);
+ $self->_error( "No file defined for '$key'" );
+ return 0;
+}
+
+sub exversion {
+ my ($self,$key,$value) = @_;
+ if(defined $value && ($value || $value =~ /0/)) {
+ my $pass = 1;
+ for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); }
+ return $pass;
+ }
+ $value = '<undef>' unless(defined $value);
+ $self->_error( "'$value' for '$key' is not a valid version." );
+ return 0;
+}
+
+sub version {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ return 0 unless($value || $value =~ /0/);
+ return 1 if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/);
+ } else {
+ $value = '<undef>';
+ }
+ $self->_error( "'$value' for '$key' is not a valid version." );
+ return 0;
+}
+
+sub boolean {
+ my ($self,$key,$value) = @_;
+ if(defined $value) {
+ return 1 if($value =~ /^(0|1|true|false)$/);
+ } else {
+ $value = '<undef>';
+ }
+ $self->_error( "'$value' for '$key' is not a boolean value." );
+ return 0;
+}
+
+my %v1_licenses = (
+ 'perl' => 'http://dev.perl.org/licenses/',
+ 'gpl' => 'http://www.opensource.org/licenses/gpl-license.php',
+ 'apache' => 'http://apache.org/licenses/LICENSE-2.0',
+ 'artistic' => 'http://opensource.org/licenses/artistic-license.php',
+ 'artistic_2' => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ 'lgpl' => 'http://www.opensource.org/licenses/lgpl-license.php',
+ 'bsd' => 'http://www.opensource.org/licenses/bsd-license.php',
+ 'gpl' => 'http://www.opensource.org/licenses/gpl-license.php',
+ 'mit' => 'http://opensource.org/licenses/mit-license.php',
+ 'mozilla' => 'http://opensource.org/licenses/mozilla1.1.php',
+ 'open_source' => undef,
+ 'unrestricted' => undef,
+ 'restrictive' => undef,
+ 'unknown' => undef,
+);
+
+my %v2_licenses = map { $_ => 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->{spec} < 2 ? \%v1_licenses : \%v2_licenses;
+ if(defined $value) {
+ return 1 if($value && exists $licenses->{$value});
+ } else {
+ $value = '<undef>';
+ }
+ $self->_error( "License '$value' is invalid" );
+ 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 && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/);
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Custom resource '$key' must be in CamelCase." );
+ return 0;
+}
+
+sub custom_2 {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if($key && $key =~ /^x_/i); # user defined
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Custom key '$key' must begin with 'x_' or 'X_'." );
+ return 0;
+}
+
+sub identifier {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if($key && $key =~ /^([a-z][_a-z]+)$/i); # spec 2.0 defined
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Key '$key' is not a legal identifier." );
+ return 0;
+}
+
+sub module {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/);
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Key '$key' is not a legal module name." );
+ return 0;
+}
+
+my @valid_phases = qw/ configure build test runtime develop /;
+sub phase {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if( length $key && grep { $key eq $_ } @valid_phases );
+ return 1 if $key =~ /x_/i;
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Key '$key' is not a legal phase." );
+ return 0;
+}
+
+my @valid_relations = qw/ requires recommends suggests conflicts /;
+sub relation {
+ my ($self,$key) = @_;
+ if(defined $key) {
+ return 1 if( length $key && grep { $key eq $_ } @valid_relations );
+ return 1 if $key =~ /x_/i;
+ } else {
+ $key = '<undef>';
+ }
+ $self->_error( "Key '$key' is not a legal prereq relationship." );
+ return 0;
+}
+
+sub _error {
+ my $self = shift;
+ my $mess = shift;
+
+ $mess .= ' ('.join(' -> ',@{$self->{stack}}).')' if($self->{stack});
+ $mess .= " [Validation: $self->{spec}]";
+
+ push @{$self->{errors}}, $mess;
+}
+
+1;
+
+# ABSTRACT: validate CPAN distribution metadata structures
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+CPAN::Meta::Validator - validate CPAN distribution metadata structures
+
+=head1 VERSION
+
+version 2.150005
+
+=head1 SYNOPSIS
+
+ my $struct = decode_json_file('META.json');
+
+ my $cmv = CPAN::Meta::Validator->new( $struct );
+
+ unless ( $cmv->is_valid ) {
+ my $msg = "Invalid META structure. Errors found:\n";
+ $msg .= join( "\n", $cmv->errors );
+ die $msg;
+ }
+
+=head1 DESCRIPTION
+
+This module validates a CPAN Meta structure against the version of the
+the specification claimed in the C<meta-spec> field of the structure.
+
+=head1 METHODS
+
+=head2 new
+
+ my $cmv = CPAN::Meta::Validator->new( $struct )
+
+The constructor must be passed a metadata structure.
+
+=head2 is_valid
+
+ if ( $cmv->is_valid ) {
+ ...
+ }
+
+Returns a boolean value indicating whether the metadata provided
+is valid.
+
+=head2 errors
+
+ warn( join "\n", $cmv->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 \&string.
+
+=item *
+
+exversion($self,$key,$value)
+
+Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <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<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
+
+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 <dagolden@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=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
+
+__END__
+
+
+# vim: ts=2 sts=2 sw=2 et :
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-04-26 18:11:22 +0200