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