1use 5.006;
2use strict;
3use warnings;
4package CPAN::Meta::Validator;
5
6our $VERSION = '2.150010';
7
8#pod =head1 SYNOPSIS
9#pod
10#pod   my $struct = decode_json_file('META.json');
11#pod
12#pod   my $cmv = CPAN::Meta::Validator->new( $struct );
13#pod
14#pod   unless ( $cmv->is_valid ) {
15#pod     my $msg = "Invalid META structure.  Errors found:\n";
16#pod     $msg .= join( "\n", $cmv->errors );
17#pod     die $msg;
18#pod   }
19#pod
20#pod =head1 DESCRIPTION
21#pod
22#pod This module validates a CPAN Meta structure against the version of the
23#pod the specification claimed in the C<meta-spec> field of the structure.
24#pod
25#pod =cut
26
27#--------------------------------------------------------------------------#
28# This code copied and adapted from Test::CPAN::Meta
29# by Barbie, <barbie@cpan.org> for Miss Barbell Productions,
30# L<http://www.missbarbell.co.uk>
31#--------------------------------------------------------------------------#
32
33#--------------------------------------------------------------------------#
34# Specification Definitions
35#--------------------------------------------------------------------------#
36
37my %known_specs = (
38    '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
39    '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
40    '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
41    '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
42    '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
43);
44my %known_urls = map {$known_specs{$_} => $_} keys %known_specs;
45
46my $module_map1 = { 'map' => { ':key' => { name => \&module, value => \&exversion } } };
47
48my $module_map2 = { 'map' => { ':key' => { name => \&module, value => \&version   } } };
49
50my $no_index_2 = {
51    'map'       => { file       => { list => { value => \&string } },
52                     directory  => { list => { value => \&string } },
53                     'package'  => { list => { value => \&string } },
54                     namespace  => { list => { value => \&string } },
55                    ':key'      => { name => \&custom_2, value => \&anything },
56    }
57};
58
59my $no_index_1_3 = {
60    'map'       => { file       => { list => { value => \&string } },
61                     directory  => { list => { value => \&string } },
62                     'package'  => { list => { value => \&string } },
63                     namespace  => { list => { value => \&string } },
64                     ':key'     => { name => \&string, value => \&anything },
65    }
66};
67
68my $no_index_1_2 = {
69    'map'       => { file       => { list => { value => \&string } },
70                     dir        => { list => { value => \&string } },
71                     'package'  => { list => { value => \&string } },
72                     namespace  => { list => { value => \&string } },
73                     ':key'     => { name => \&string, value => \&anything },
74    }
75};
76
77my $no_index_1_1 = {
78    'map'       => { ':key'     => { name => \&string, list => { value => \&string } },
79    }
80};
81
82my $prereq_map = {
83  map => {
84    ':key' => {
85      name => \&phase,
86      'map' => {
87        ':key'  => {
88          name => \&relation,
89          %$module_map1,
90        },
91      },
92    }
93  },
94};
95
96my %definitions = (
97  '2' => {
98    # REQUIRED
99    'abstract'            => { mandatory => 1, value => \&string  },
100    'author'              => { mandatory => 1, list => { value => \&string } },
101    'dynamic_config'      => { mandatory => 1, value => \&boolean },
102    'generated_by'        => { mandatory => 1, value => \&string  },
103    'license'             => { mandatory => 1, list => { value => \&license } },
104    'meta-spec' => {
105      mandatory => 1,
106      'map' => {
107        version => { mandatory => 1, value => \&version},
108        url     => { value => \&url },
109        ':key' => { name => \&custom_2, value => \&anything },
110      }
111    },
112    'name'                => { mandatory => 1, value => \&string  },
113    'release_status'      => { mandatory => 1, value => \&release_status },
114    'version'             => { mandatory => 1, value => \&version },
115
116    # OPTIONAL
117    'description' => { value => \&string },
118    'keywords'    => { list => { value => \&string } },
119    'no_index'    => $no_index_2,
120    'optional_features'   => {
121      'map'       => {
122        ':key'  => {
123          name => \&string,
124          'map'   => {
125            description        => { value => \&string },
126            prereqs => $prereq_map,
127            ':key' => { name => \&custom_2, value => \&anything },
128          }
129        }
130      }
131    },
132    'prereqs' => $prereq_map,
133    'provides'    => {
134      'map'       => {
135        ':key' => {
136          name  => \&module,
137          'map' => {
138            file    => { mandatory => 1, value => \&file },
139            version => { value => \&version },
140            ':key' => { name => \&custom_2, value => \&anything },
141          }
142        }
143      }
144    },
145    'resources'   => {
146      'map'       => {
147        license    => { list => { value => \&url } },
148        homepage   => { value => \&url },
149        bugtracker => {
150          'map' => {
151            web => { value => \&url },
152            mailto => { value => \&string},
153            ':key' => { name => \&custom_2, value => \&anything },
154          }
155        },
156        repository => {
157          'map' => {
158            web => { value => \&url },
159            url => { value => \&url },
160            type => { value => \&string },
161            ':key' => { name => \&custom_2, value => \&anything },
162          }
163        },
164        ':key'     => { value => \&string, name => \&custom_2 },
165      }
166    },
167
168    # CUSTOM -- additional user defined key/value pairs
169    # note we can only validate the key name, as the structure is user defined
170    ':key'        => { name => \&custom_2, value => \&anything },
171  },
172
173'1.4' => {
174  'meta-spec'           => {
175    mandatory => 1,
176    'map' => {
177      version => { mandatory => 1, value => \&version},
178      url     => { mandatory => 1, value => \&urlspec },
179      ':key'  => { name => \&string, value => \&anything },
180    },
181  },
182
183  'name'                => { mandatory => 1, value => \&string  },
184  'version'             => { mandatory => 1, value => \&version },
185  'abstract'            => { mandatory => 1, value => \&string  },
186  'author'              => { mandatory => 1, list  => { value => \&string } },
187  'license'             => { mandatory => 1, value => \&license },
188  'generated_by'        => { mandatory => 1, value => \&string  },
189
190  'distribution_type'   => { value => \&string  },
191  'dynamic_config'      => { value => \&boolean },
192
193  'requires'            => $module_map1,
194  'recommends'          => $module_map1,
195  'build_requires'      => $module_map1,
196  'configure_requires'  => $module_map1,
197  'conflicts'           => $module_map2,
198
199  'optional_features'   => {
200    'map'       => {
201        ':key'  => { name => \&string,
202            'map'   => { description        => { value => \&string },
203                         requires           => $module_map1,
204                         recommends         => $module_map1,
205                         build_requires     => $module_map1,
206                         conflicts          => $module_map2,
207                         ':key'  => { name => \&string, value => \&anything },
208            }
209        }
210     }
211  },
212
213  'provides'    => {
214    'map'       => {
215      ':key' => { name  => \&module,
216        'map' => {
217          file    => { mandatory => 1, value => \&file },
218          version => { value => \&version },
219          ':key'  => { name => \&string, value => \&anything },
220        }
221      }
222    }
223  },
224
225  'no_index'    => $no_index_1_3,
226  'private'     => $no_index_1_3,
227
228  'keywords'    => { list => { value => \&string } },
229
230  'resources'   => {
231    'map'       => { license    => { value => \&url },
232                     homepage   => { value => \&url },
233                     bugtracker => { value => \&url },
234                     repository => { value => \&url },
235                     ':key'     => { value => \&string, name => \&custom_1 },
236    }
237  },
238
239  # additional user defined key/value pairs
240  # note we can only validate the key name, as the structure is user defined
241  ':key'        => { name => \&string, value => \&anything },
242},
243
244'1.3' => {
245  'meta-spec'           => {
246    mandatory => 1,
247    'map' => {
248      version => { mandatory => 1, value => \&version},
249      url     => { mandatory => 1, value => \&urlspec },
250      ':key'  => { name => \&string, value => \&anything },
251    },
252  },
253
254  'name'                => { mandatory => 1, value => \&string  },
255  'version'             => { mandatory => 1, value => \&version },
256  'abstract'            => { mandatory => 1, value => \&string  },
257  'author'              => { mandatory => 1, list  => { value => \&string } },
258  'license'             => { mandatory => 1, value => \&license },
259  'generated_by'        => { mandatory => 1, value => \&string  },
260
261  'distribution_type'   => { value => \&string  },
262  'dynamic_config'      => { value => \&boolean },
263
264  'requires'            => $module_map1,
265  'recommends'          => $module_map1,
266  'build_requires'      => $module_map1,
267  'conflicts'           => $module_map2,
268
269  'optional_features'   => {
270    'map'       => {
271        ':key'  => { name => \&string,
272            'map'   => { description        => { value => \&string },
273                         requires           => $module_map1,
274                         recommends         => $module_map1,
275                         build_requires     => $module_map1,
276                         conflicts          => $module_map2,
277                         ':key'  => { name => \&string, value => \&anything },
278            }
279        }
280     }
281  },
282
283  'provides'    => {
284    'map'       => {
285      ':key' => { name  => \&module,
286        'map' => {
287          file    => { mandatory => 1, value => \&file },
288          version => { value => \&version },
289          ':key'  => { name => \&string, value => \&anything },
290        }
291      }
292    }
293  },
294
295
296  'no_index'    => $no_index_1_3,
297  'private'     => $no_index_1_3,
298
299  'keywords'    => { list => { value => \&string } },
300
301  'resources'   => {
302    'map'       => { license    => { value => \&url },
303                     homepage   => { value => \&url },
304                     bugtracker => { value => \&url },
305                     repository => { value => \&url },
306                     ':key'     => { value => \&string, name => \&custom_1 },
307    }
308  },
309
310  # additional user defined key/value pairs
311  # note we can only validate the key name, as the structure is user defined
312  ':key'        => { name => \&string, value => \&anything },
313},
314
315# v1.2 is misleading, it seems to assume that a number of fields where created
316# within v1.1, when they were created within v1.2. This may have been an
317# original mistake, and that a v1.1 was retro fitted into the timeline, when
318# v1.2 was originally slated as v1.1. But I could be wrong ;)
319'1.2' => {
320  'meta-spec'           => {
321    mandatory => 1,
322    'map' => {
323      version => { mandatory => 1, value => \&version},
324      url     => { mandatory => 1, value => \&urlspec },
325      ':key'  => { name => \&string, value => \&anything },
326    },
327  },
328
329
330  'name'                => { mandatory => 1, value => \&string  },
331  'version'             => { mandatory => 1, value => \&version },
332  'license'             => { mandatory => 1, value => \&license },
333  'generated_by'        => { mandatory => 1, value => \&string  },
334  'author'              => { mandatory => 1, list => { value => \&string } },
335  'abstract'            => { mandatory => 1, value => \&string  },
336
337  'distribution_type'   => { value => \&string  },
338  'dynamic_config'      => { value => \&boolean },
339
340  'keywords'            => { list => { value => \&string } },
341
342  'private'             => $no_index_1_2,
343  '$no_index'           => $no_index_1_2,
344
345  'requires'            => $module_map1,
346  'recommends'          => $module_map1,
347  'build_requires'      => $module_map1,
348  'conflicts'           => $module_map2,
349
350  'optional_features'   => {
351    'map'       => {
352        ':key'  => { name => \&string,
353            'map'   => { description        => { value => \&string },
354                         requires           => $module_map1,
355                         recommends         => $module_map1,
356                         build_requires     => $module_map1,
357                         conflicts          => $module_map2,
358                         ':key'  => { name => \&string, value => \&anything },
359            }
360        }
361     }
362  },
363
364  'provides'    => {
365    'map'       => {
366      ':key' => { name  => \&module,
367        'map' => {
368          file    => { mandatory => 1, value => \&file },
369          version => { value => \&version },
370          ':key'  => { name => \&string, value => \&anything },
371        }
372      }
373    }
374  },
375
376  'resources'   => {
377    'map'       => { license    => { value => \&url },
378                     homepage   => { value => \&url },
379                     bugtracker => { value => \&url },
380                     repository => { value => \&url },
381                     ':key'     => { value => \&string, name => \&custom_1 },
382    }
383  },
384
385  # additional user defined key/value pairs
386  # note we can only validate the key name, as the structure is user defined
387  ':key'        => { name => \&string, value => \&anything },
388},
389
390# note that the 1.1 spec only specifies 'version' as mandatory
391'1.1' => {
392  'name'                => { value => \&string  },
393  'version'             => { mandatory => 1, value => \&version },
394  'license'             => { value => \&license },
395  'generated_by'        => { value => \&string  },
396
397  'license_uri'         => { value => \&url },
398  'distribution_type'   => { value => \&string  },
399  'dynamic_config'      => { value => \&boolean },
400
401  'private'             => $no_index_1_1,
402
403  'requires'            => $module_map1,
404  'recommends'          => $module_map1,
405  'build_requires'      => $module_map1,
406  'conflicts'           => $module_map2,
407
408  # additional user defined key/value pairs
409  # note we can only validate the key name, as the structure is user defined
410  ':key'        => { name => \&string, value => \&anything },
411},
412
413# note that the 1.0 spec doesn't specify optional or mandatory fields
414# but we will treat version as mandatory since otherwise META 1.0 is
415# completely arbitrary and pointless
416'1.0' => {
417  'name'                => { value => \&string  },
418  'version'             => { mandatory => 1, value => \&version },
419  'license'             => { value => \&license },
420  'generated_by'        => { value => \&string  },
421
422  'license_uri'         => { value => \&url },
423  'distribution_type'   => { value => \&string  },
424  'dynamic_config'      => { value => \&boolean },
425
426  'requires'            => $module_map1,
427  'recommends'          => $module_map1,
428  'build_requires'      => $module_map1,
429  'conflicts'           => $module_map2,
430
431  # additional user defined key/value pairs
432  # note we can only validate the key name, as the structure is user defined
433  ':key'        => { name => \&string, value => \&anything },
434},
435);
436
437#--------------------------------------------------------------------------#
438# Code
439#--------------------------------------------------------------------------#
440
441#pod =method new
442#pod
443#pod   my $cmv = CPAN::Meta::Validator->new( $struct )
444#pod
445#pod The constructor must be passed a metadata structure.
446#pod
447#pod =cut
448
449sub new {
450  my ($class,$data) = @_;
451
452  # create an attributes hash
453  my $self = {
454    'data'    => $data,
455    'spec'    => eval { $data->{'meta-spec'}{'version'} } || "1.0",
456    'errors'  => undef,
457  };
458
459  # create the object
460  return bless $self, $class;
461}
462
463#pod =method is_valid
464#pod
465#pod   if ( $cmv->is_valid ) {
466#pod     ...
467#pod   }
468#pod
469#pod Returns a boolean value indicating whether the metadata provided
470#pod is valid.
471#pod
472#pod =cut
473
474sub is_valid {
475    my $self = shift;
476    my $data = $self->{data};
477    my $spec_version = $self->{spec};
478    $self->check_map($definitions{$spec_version},$data);
479    return ! $self->errors;
480}
481
482#pod =method errors
483#pod
484#pod   warn( join "\n", $cmv->errors );
485#pod
486#pod Returns a list of errors seen during validation.
487#pod
488#pod =cut
489
490sub errors {
491    my $self = shift;
492    return ()   unless(defined $self->{errors});
493    return @{$self->{errors}};
494}
495
496#pod =begin :internals
497#pod
498#pod =head2 Check Methods
499#pod
500#pod =over
501#pod
502#pod =item *
503#pod
504#pod check_map($spec,$data)
505#pod
506#pod Checks whether a map (or hash) part of the data structure conforms to the
507#pod appropriate specification definition.
508#pod
509#pod =item *
510#pod
511#pod check_list($spec,$data)
512#pod
513#pod Checks whether a list (or array) part of the data structure conforms to
514#pod the appropriate specification definition.
515#pod
516#pod =item *
517#pod
518#pod =back
519#pod
520#pod =cut
521
522my $spec_error = "Missing validation action in specification. "
523  . "Must be one of 'map', 'list', or 'value'";
524
525sub check_map {
526    my ($self,$spec,$data) = @_;
527
528    if(ref($spec) ne 'HASH') {
529        $self->_error( "Unknown META specification, cannot validate." );
530        return;
531    }
532
533    if(ref($data) ne 'HASH') {
534        $self->_error( "Expected a map structure from string or file." );
535        return;
536    }
537
538    for my $key (keys %$spec) {
539        next    unless($spec->{$key}->{mandatory});
540        next    if(defined $data->{$key});
541        push @{$self->{stack}}, $key;
542        $self->_error( "Missing mandatory field, '$key'" );
543        pop @{$self->{stack}};
544    }
545
546    for my $key (keys %$data) {
547        push @{$self->{stack}}, $key;
548        if($spec->{$key}) {
549            if($spec->{$key}{value}) {
550                $spec->{$key}{value}->($self,$key,$data->{$key});
551            } elsif($spec->{$key}{'map'}) {
552                $self->check_map($spec->{$key}{'map'},$data->{$key});
553            } elsif($spec->{$key}{'list'}) {
554                $self->check_list($spec->{$key}{'list'},$data->{$key});
555            } else {
556                $self->_error( "$spec_error for '$key'" );
557            }
558
559        } elsif ($spec->{':key'}) {
560            $spec->{':key'}{name}->($self,$key,$key);
561            if($spec->{':key'}{value}) {
562                $spec->{':key'}{value}->($self,$key,$data->{$key});
563            } elsif($spec->{':key'}{'map'}) {
564                $self->check_map($spec->{':key'}{'map'},$data->{$key});
565            } elsif($spec->{':key'}{'list'}) {
566                $self->check_list($spec->{':key'}{'list'},$data->{$key});
567            } else {
568                $self->_error( "$spec_error for ':key'" );
569            }
570
571
572        } else {
573            $self->_error( "Unknown key, '$key', found in map structure" );
574        }
575        pop @{$self->{stack}};
576    }
577}
578
579sub check_list {
580    my ($self,$spec,$data) = @_;
581
582    if(ref($data) ne 'ARRAY') {
583        $self->_error( "Expected a list structure" );
584        return;
585    }
586
587    if(defined $spec->{mandatory}) {
588        if(!defined $data->[0]) {
589            $self->_error( "Missing entries from mandatory list" );
590        }
591    }
592
593    for my $value (@$data) {
594        push @{$self->{stack}}, $value || "<undef>";
595        if(defined $spec->{value}) {
596            $spec->{value}->($self,'list',$value);
597        } elsif(defined $spec->{'map'}) {
598            $self->check_map($spec->{'map'},$value);
599        } elsif(defined $spec->{'list'}) {
600            $self->check_list($spec->{'list'},$value);
601        } elsif ($spec->{':key'}) {
602            $self->check_map($spec,$value);
603        } else {
604          $self->_error( "$spec_error associated with '$self->{stack}[-2]'" );
605        }
606        pop @{$self->{stack}};
607    }
608}
609
610#pod =head2 Validator Methods
611#pod
612#pod =over
613#pod
614#pod =item *
615#pod
616#pod header($self,$key,$value)
617#pod
618#pod Validates that the header is valid.
619#pod
620#pod Note: No longer used as we now read the data structure, not the file.
621#pod
622#pod =item *
623#pod
624#pod url($self,$key,$value)
625#pod
626#pod Validates that a given value is in an acceptable URL format
627#pod
628#pod =item *
629#pod
630#pod urlspec($self,$key,$value)
631#pod
632#pod Validates that the URL to a META specification is a known one.
633#pod
634#pod =item *
635#pod
636#pod string_or_undef($self,$key,$value)
637#pod
638#pod Validates that the value is either a string or an undef value. Bit of a
639#pod catchall function for parts of the data structure that are completely user
640#pod defined.
641#pod
642#pod =item *
643#pod
644#pod string($self,$key,$value)
645#pod
646#pod Validates that a string exists for the given key.
647#pod
648#pod =item *
649#pod
650#pod file($self,$key,$value)
651#pod
652#pod Validate that a file is passed for the given key. This may be made more
653#pod thorough in the future. For now it acts like \&string.
654#pod
655#pod =item *
656#pod
657#pod exversion($self,$key,$value)
658#pod
659#pod Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'.
660#pod
661#pod =item *
662#pod
663#pod version($self,$key,$value)
664#pod
665#pod Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
666#pod are both valid. A leading 'v' like 'v1.2.3' is also valid.
667#pod
668#pod =item *
669#pod
670#pod boolean($self,$key,$value)
671#pod
672#pod Validates for a boolean value: a defined value that is either "1" or "0" or
673#pod stringifies to those values.
674#pod
675#pod =item *
676#pod
677#pod license($self,$key,$value)
678#pod
679#pod Validates that a value is given for the license. Returns 1 if an known license
680#pod type, or 2 if a value is given but the license type is not a recommended one.
681#pod
682#pod =item *
683#pod
684#pod custom_1($self,$key,$value)
685#pod
686#pod Validates that the given key is in CamelCase, to indicate a user defined
687#pod keyword and only has characters in the class [-_a-zA-Z].  In version 1.X
688#pod of the spec, this was only explicitly stated for 'resources'.
689#pod
690#pod =item *
691#pod
692#pod custom_2($self,$key,$value)
693#pod
694#pod Validates that the given key begins with 'x_' or 'X_', to indicate a user
695#pod defined keyword and only has characters in the class [-_a-zA-Z]
696#pod
697#pod =item *
698#pod
699#pod identifier($self,$key,$value)
700#pod
701#pod Validates that key is in an acceptable format for the META specification,
702#pod for an identifier, i.e. any that matches the regular expression
703#pod qr/[a-z][a-z_]/i.
704#pod
705#pod =item *
706#pod
707#pod module($self,$key,$value)
708#pod
709#pod Validates that a given key is in an acceptable module name format, e.g.
710#pod 'Test::CPAN::Meta::Version'.
711#pod
712#pod =back
713#pod
714#pod =end :internals
715#pod
716#pod =cut
717
718sub header {
719    my ($self,$key,$value) = @_;
720    if(defined $value) {
721        return 1    if($value && $value =~ /^--- #YAML:1.0/);
722    }
723    $self->_error( "file does not have a valid YAML header." );
724    return 0;
725}
726
727sub release_status {
728  my ($self,$key,$value) = @_;
729  if(defined $value) {
730    my $version = $self->{data}{version} || '';
731    if ( $version =~ /_/ ) {
732      return 1 if ( $value =~ /\A(?:testing|unstable)\z/ );
733      $self->_error( "'$value' for '$key' is invalid for version '$version'" );
734    }
735    else {
736      return 1 if ( $value =~ /\A(?:stable|testing|unstable)\z/ );
737      $self->_error( "'$value' for '$key' is invalid" );
738    }
739  }
740  else {
741    $self->_error( "'$key' is not defined" );
742  }
743  return 0;
744}
745
746# _uri_split taken from URI::Split by Gisle Aas, Copyright 2003
747sub _uri_split {
748     return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
749}
750
751sub url {
752    my ($self,$key,$value) = @_;
753    if(defined $value) {
754      my ($scheme, $auth, $path, $query, $frag) = _uri_split($value);
755      unless ( defined $scheme && length $scheme ) {
756        $self->_error( "'$value' for '$key' does not have a URL scheme" );
757        return 0;
758      }
759      unless ( defined $auth && length $auth ) {
760        $self->_error( "'$value' for '$key' does not have a URL authority" );
761        return 0;
762      }
763      return 1;
764    }
765    $value ||= '';
766    $self->_error( "'$value' for '$key' is not a valid URL." );
767    return 0;
768}
769
770sub urlspec {
771    my ($self,$key,$value) = @_;
772    if(defined $value) {
773        return 1    if($value && $known_specs{$self->{spec}} eq $value);
774        if($value && $known_urls{$value}) {
775            $self->_error( 'META specification URL does not match version' );
776            return 0;
777        }
778    }
779    $self->_error( 'Unknown META specification' );
780    return 0;
781}
782
783sub anything { return 1 }
784
785sub string {
786    my ($self,$key,$value) = @_;
787    if(defined $value) {
788        return 1    if($value || $value =~ /^0$/);
789    }
790    $self->_error( "value is an undefined string" );
791    return 0;
792}
793
794sub string_or_undef {
795    my ($self,$key,$value) = @_;
796    return 1    unless(defined $value);
797    return 1    if($value || $value =~ /^0$/);
798    $self->_error( "No string defined for '$key'" );
799    return 0;
800}
801
802sub file {
803    my ($self,$key,$value) = @_;
804    return 1    if(defined $value);
805    $self->_error( "No file defined for '$key'" );
806    return 0;
807}
808
809sub exversion {
810    my ($self,$key,$value) = @_;
811    if(defined $value && ($value || $value =~ /0/)) {
812        my $pass = 1;
813        for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); }
814        return $pass;
815    }
816    $value = '<undef>'  unless(defined $value);
817    $self->_error( "'$value' for '$key' is not a valid version." );
818    return 0;
819}
820
821sub version {
822    my ($self,$key,$value) = @_;
823    if(defined $value) {
824        return 0    unless($value || $value =~ /0/);
825        return 1    if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/);
826    } else {
827        $value = '<undef>';
828    }
829    $self->_error( "'$value' for '$key' is not a valid version." );
830    return 0;
831}
832
833sub boolean {
834    my ($self,$key,$value) = @_;
835    if(defined $value) {
836        return 1    if($value =~ /^(0|1)$/);
837    } else {
838        $value = '<undef>';
839    }
840    $self->_error( "'$value' for '$key' is not a boolean value." );
841    return 0;
842}
843
844my %v1_licenses = (
845    'perl'         => 'http://dev.perl.org/licenses/',
846    'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
847    'apache'       => 'http://apache.org/licenses/LICENSE-2.0',
848    'artistic'     => 'http://opensource.org/licenses/artistic-license.php',
849    'artistic_2'   => 'http://opensource.org/licenses/artistic-license-2.0.php',
850    'lgpl'         => 'http://www.opensource.org/licenses/lgpl-license.php',
851    'bsd'          => 'http://www.opensource.org/licenses/bsd-license.php',
852    'gpl'          => 'http://www.opensource.org/licenses/gpl-license.php',
853    'mit'          => 'http://opensource.org/licenses/mit-license.php',
854    'mozilla'      => 'http://opensource.org/licenses/mozilla1.1.php',
855    'open_source'  => undef,
856    'unrestricted' => undef,
857    'restrictive'  => undef,
858    'unknown'      => undef,
859);
860
861my %v2_licenses = map { $_ => 1 } qw(
862  agpl_3
863  apache_1_1
864  apache_2_0
865  artistic_1
866  artistic_2
867  bsd
868  freebsd
869  gfdl_1_2
870  gfdl_1_3
871  gpl_1
872  gpl_2
873  gpl_3
874  lgpl_2_1
875  lgpl_3_0
876  mit
877  mozilla_1_0
878  mozilla_1_1
879  openssl
880  perl_5
881  qpl_1_0
882  ssleay
883  sun
884  zlib
885  open_source
886  restricted
887  unrestricted
888  unknown
889);
890
891sub license {
892    my ($self,$key,$value) = @_;
893    my $licenses = $self->{spec} < 2 ? \%v1_licenses : \%v2_licenses;
894    if(defined $value) {
895        return 1    if($value && exists $licenses->{$value});
896    } else {
897        $value = '<undef>';
898    }
899    $self->_error( "License '$value' is invalid" );
900    return 0;
901}
902
903sub custom_1 {
904    my ($self,$key) = @_;
905    if(defined $key) {
906        # a valid user defined key should be alphabetic
907        # and contain at least one capital case letter.
908        return 1    if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/);
909    } else {
910        $key = '<undef>';
911    }
912    $self->_error( "Custom resource '$key' must be in CamelCase." );
913    return 0;
914}
915
916sub custom_2 {
917    my ($self,$key) = @_;
918    if(defined $key) {
919        return 1    if($key && $key =~ /^x_/i);  # user defined
920    } else {
921        $key = '<undef>';
922    }
923    $self->_error( "Custom key '$key' must begin with 'x_' or 'X_'." );
924    return 0;
925}
926
927sub identifier {
928    my ($self,$key) = @_;
929    if(defined $key) {
930        return 1    if($key && $key =~ /^([a-z][_a-z]+)$/i);    # spec 2.0 defined
931    } else {
932        $key = '<undef>';
933    }
934    $self->_error( "Key '$key' is not a legal identifier." );
935    return 0;
936}
937
938sub module {
939    my ($self,$key) = @_;
940    if(defined $key) {
941        return 1    if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/);
942    } else {
943        $key = '<undef>';
944    }
945    $self->_error( "Key '$key' is not a legal module name." );
946    return 0;
947}
948
949my @valid_phases = qw/ configure build test runtime develop /;
950sub phase {
951    my ($self,$key) = @_;
952    if(defined $key) {
953        return 1 if( length $key && grep { $key eq $_ } @valid_phases );
954        return 1 if $key =~ /x_/i;
955    } else {
956        $key = '<undef>';
957    }
958    $self->_error( "Key '$key' is not a legal phase." );
959    return 0;
960}
961
962my @valid_relations = qw/ requires recommends suggests conflicts /;
963sub relation {
964    my ($self,$key) = @_;
965    if(defined $key) {
966        return 1 if( length $key && grep { $key eq $_ } @valid_relations );
967        return 1 if $key =~ /x_/i;
968    } else {
969        $key = '<undef>';
970    }
971    $self->_error( "Key '$key' is not a legal prereq relationship." );
972    return 0;
973}
974
975sub _error {
976    my $self = shift;
977    my $mess = shift;
978
979    $mess .= ' ('.join(' -> ',@{$self->{stack}}).')'  if($self->{stack});
980    $mess .= " [Validation: $self->{spec}]";
981
982    push @{$self->{errors}}, $mess;
983}
984
9851;
986
987# ABSTRACT: validate CPAN distribution metadata structures
988
989=pod
990
991=encoding UTF-8
992
993=head1 NAME
994
995CPAN::Meta::Validator - validate CPAN distribution metadata structures
996
997=head1 VERSION
998
999version 2.150010
1000
1001=head1 SYNOPSIS
1002
1003  my $struct = decode_json_file('META.json');
1004
1005  my $cmv = CPAN::Meta::Validator->new( $struct );
1006
1007  unless ( $cmv->is_valid ) {
1008    my $msg = "Invalid META structure.  Errors found:\n";
1009    $msg .= join( "\n", $cmv->errors );
1010    die $msg;
1011  }
1012
1013=head1 DESCRIPTION
1014
1015This module validates a CPAN Meta structure against the version of the
1016the specification claimed in the C<meta-spec> field of the structure.
1017
1018=head1 METHODS
1019
1020=head2 new
1021
1022  my $cmv = CPAN::Meta::Validator->new( $struct )
1023
1024The constructor must be passed a metadata structure.
1025
1026=head2 is_valid
1027
1028  if ( $cmv->is_valid ) {
1029    ...
1030  }
1031
1032Returns a boolean value indicating whether the metadata provided
1033is valid.
1034
1035=head2 errors
1036
1037  warn( join "\n", $cmv->errors );
1038
1039Returns a list of errors seen during validation.
1040
1041=begin :internals
1042
1043=head2 Check Methods
1044
1045=over
1046
1047=item *
1048
1049check_map($spec,$data)
1050
1051Checks whether a map (or hash) part of the data structure conforms to the
1052appropriate specification definition.
1053
1054=item *
1055
1056check_list($spec,$data)
1057
1058Checks whether a list (or array) part of the data structure conforms to
1059the appropriate specification definition.
1060
1061=item *
1062
1063=back
1064
1065=head2 Validator Methods
1066
1067=over
1068
1069=item *
1070
1071header($self,$key,$value)
1072
1073Validates that the header is valid.
1074
1075Note: No longer used as we now read the data structure, not the file.
1076
1077=item *
1078
1079url($self,$key,$value)
1080
1081Validates that a given value is in an acceptable URL format
1082
1083=item *
1084
1085urlspec($self,$key,$value)
1086
1087Validates that the URL to a META specification is a known one.
1088
1089=item *
1090
1091string_or_undef($self,$key,$value)
1092
1093Validates that the value is either a string or an undef value. Bit of a
1094catchall function for parts of the data structure that are completely user
1095defined.
1096
1097=item *
1098
1099string($self,$key,$value)
1100
1101Validates that a string exists for the given key.
1102
1103=item *
1104
1105file($self,$key,$value)
1106
1107Validate that a file is passed for the given key. This may be made more
1108thorough in the future. For now it acts like \&string.
1109
1110=item *
1111
1112exversion($self,$key,$value)
1113
1114Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'.
1115
1116=item *
1117
1118version($self,$key,$value)
1119
1120Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
1121are both valid. A leading 'v' like 'v1.2.3' is also valid.
1122
1123=item *
1124
1125boolean($self,$key,$value)
1126
1127Validates for a boolean value: a defined value that is either "1" or "0" or
1128stringifies to those values.
1129
1130=item *
1131
1132license($self,$key,$value)
1133
1134Validates that a value is given for the license. Returns 1 if an known license
1135type, or 2 if a value is given but the license type is not a recommended one.
1136
1137=item *
1138
1139custom_1($self,$key,$value)
1140
1141Validates that the given key is in CamelCase, to indicate a user defined
1142keyword and only has characters in the class [-_a-zA-Z].  In version 1.X
1143of the spec, this was only explicitly stated for 'resources'.
1144
1145=item *
1146
1147custom_2($self,$key,$value)
1148
1149Validates that the given key begins with 'x_' or 'X_', to indicate a user
1150defined keyword and only has characters in the class [-_a-zA-Z]
1151
1152=item *
1153
1154identifier($self,$key,$value)
1155
1156Validates that key is in an acceptable format for the META specification,
1157for an identifier, i.e. any that matches the regular expression
1158qr/[a-z][a-z_]/i.
1159
1160=item *
1161
1162module($self,$key,$value)
1163
1164Validates that a given key is in an acceptable module name format, e.g.
1165'Test::CPAN::Meta::Version'.
1166
1167=back
1168
1169=end :internals
1170
1171=for Pod::Coverage anything boolean check_list custom_1 custom_2 exversion file
1172identifier license module phase relation release_status string string_or_undef
1173url urlspec version header check_map
1174
1175=head1 BUGS
1176
1177Please report any bugs or feature using the CPAN Request Tracker.
1178Bugs can be submitted through the web interface at
1179L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
1180
1181When submitting a bug or request, please include a test-file or a patch to an
1182existing test-file that illustrates the bug or desired feature.
1183
1184=head1 AUTHORS
1185
1186=over 4
1187
1188=item *
1189
1190David Golden <dagolden@cpan.org>
1191
1192=item *
1193
1194Ricardo Signes <rjbs@cpan.org>
1195
1196=item *
1197
1198Adam Kennedy <adamk@cpan.org>
1199
1200=back
1201
1202=head1 COPYRIGHT AND LICENSE
1203
1204This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
1205
1206This is free software; you can redistribute it and/or modify it under
1207the same terms as the Perl 5 programming language system itself.
1208
1209=cut
1210
1211__END__
1212
1213
1214# vim: ts=2 sts=2 sw=2 et :
1215