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.130880'; # 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 __END__
 832
 833 =pod
 834
 835 =encoding utf-8
 836
 837 =head1 NAME
 838
 839 CPAN::Meta::Validator - validate CPAN distribution metadata structures
 840
 841 =head1 VERSION
 842
 843 version 2.130880
 844
 845 =head1 SYNOPSIS
 846
 847   my $struct = decode_json_file('META.json');
 848
 849   my $cmv = CPAN::Meta::Validator->new( $struct );
 850
 851   unless ( $cmv->is_valid ) {
 852     my $msg = "Invalid META structure.  Errors found:\n";
 853     $msg .= join( "\n", $cmv->errors );
 854     die $msg;
 855   }
 856
 857 =head1 DESCRIPTION
 858
 859 This module validates a CPAN Meta structure against the version of the
 860 the specification claimed in the C<meta-spec> field of the structure.
 861
 862 =head1 METHODS
 863
 864 =head2 new
 865
 866   my $cmv = CPAN::Meta::Validator->new( $struct )
 867
 868 The constructor must be passed a metadata structure.
 869
 870 =head2 is_valid
 871
 872   if ( $cmv->is_valid ) {
 873     ...
 874   }
 875
 876 Returns a boolean value indicating whether the metadata provided
 877 is valid.
 878
 879 =head2 errors
 880
 881   warn( join "\n", $cmv->errors );
 882
 883 Returns a list of errors seen during validation.
 884
 885 =begin :internals
 886
 887 =head2 Check Methods
 888
 889 =over
 890
 891 =item *
 892
 893 check_map($spec,$data)
 894
 895 Checks whether a map (or hash) part of the data structure conforms to the
 896 appropriate specification definition.
 897
 898 =item *
 899
 900 check_list($spec,$data)
 901
 902 Checks whether a list (or array) part of the data structure conforms to
 903 the appropriate specification definition.
 904
 905 =item *
 906
 907 check_lazylist($spec,$data)
 908
 909 Checks whether a list conforms, but converts strings to a single-element list
 910
 911 =back
 912
 913 =head2 Validator Methods
 914
 915 =over
 916
 917 =item *
 918
 919 header($self,$key,$value)
 920
 921 Validates that the header is valid.
 922
 923 Note: No longer used as we now read the data structure, not the file.
 924
 925 =item *
 926
 927 url($self,$key,$value)
 928
 929 Validates that a given value is in an acceptable URL format
 930
 931 =item *
 932
 933 urlspec($self,$key,$value)
 934
 935 Validates that the URL to a META specification is a known one.
 936
 937 =item *
 938
 939 string_or_undef($self,$key,$value)
 940
 941 Validates that the value is either a string or an undef value. Bit of a
 942 catchall function for parts of the data structure that are completely user
 943 defined.
 944
 945 =item *
 946
 947 string($self,$key,$value)
 948
 949 Validates that a string exists for the given key.
 950
 951 =item *
 952
 953 file($self,$key,$value)
 954
 955 Validate that a file is passed for the given key. This may be made more
 956 thorough in the future. For now it acts like \&string.
 957
 958 =item *
 959
 960 exversion($self,$key,$value)
 961
 962 Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'.
 963
 964 =item *
 965
 966 version($self,$key,$value)
 967
 968 Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
 969 are both valid. A leading 'v' like 'v1.2.3' is also valid.
 970
 971 =item *
 972
 973 boolean($self,$key,$value)
 974
 975 Validates for a boolean value. Currently these values are '1', '0', 'true',
 976 'false', however the latter 2 may be removed.
 977
 978 =item *
 979
 980 license($self,$key,$value)
 981
 982 Validates that a value is given for the license. Returns 1 if an known license
 983 type, or 2 if a value is given but the license type is not a recommended one.
 984
 985 =item *
 986
 987 custom_1($self,$key,$value)
 988
 989 Validates that the given key is in CamelCase, to indicate a user defined
 990 keyword and only has characters in the class [-_a-zA-Z].  In version 1.X
 991 of the spec, this was only explicitly stated for 'resources'.
 992
 993 =item *
 994
 995 custom_2($self,$key,$value)
 996
 997 Validates that the given key begins with 'x_' or 'X_', to indicate a user
 998 defined keyword and only has characters in the class [-_a-zA-Z]
 999
1000 =item *
1001
1002 identifier($self,$key,$value)
1003
1004 Validates that key is in an acceptable format for the META specification,
1005 for an identifier, i.e. any that matches the regular expression
1006 qr/[a-z][a-z_]/i.
1007
1008 =item *
1009
1010 module($self,$key,$value)
1011
1012 Validates that a given key is in an acceptable module name format, e.g.
1013 'Test::CPAN::Meta::Version'.
1014
1015 =back
1016
1017 =end :internals
1018
1019 =for Pod::Coverage anything boolean check_lazylist check_list custom_1 custom_2 exversion file
1020 identifier license module phase relation release_status string string_or_undef
1021 url urlspec version header check_map
1022
1023 =head1 BUGS
1024
1025 Please report any bugs or feature using the CPAN Request Tracker.
1026 Bugs can be submitted through the web interface at
1027 L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
1028
1029 When submitting a bug or request, please include a test-file or a patch to an
1030 existing test-file that illustrates the bug or desired feature.
1031
1032 =head1 AUTHORS
1033
1034 =over 4
1035
1036 =item *
1037
1038 David Golden <dagolden@cpan.org>
1039
1040 =item *
1041
1042 Ricardo Signes <rjbs@cpan.org>
1043
1044 =back
1045
1046 =head1 CONTRIBUTORS
1047
1048 =over 4
1049
1050 =item *
1051
1052 Ansgar Burchardt <ansgar@cpan.org>
1053
1054 =item *
1055
1056 Michael G. Schwern <mschwern@cpan.org>
1057
1058 =item *
1059
1060 Randy Sims <randys@thepierianspring.org>
1061
1062 =item *
1063
1064 Ævar Arnfjörð Bjarmason <avar@cpan.org>
1065
1066 =item *
1067
1068 Christopher J. Madsen <cjm@cpan.org>
1069
1070 =item *
1071
1072 Cory G Watson <gphat@cpan.org>
1073
1074 =item *
1075
1076 Damyan Ivanov <dam@cpan.org>
1077
1078 =item *
1079
1080 Eric Wilhelm <ewilhelm@cpan.org>
1081
1082 =item *
1083
1084 Gregor Hermann <gregoa@debian.org>
1085
1086 =item *
1087
1088 Ken Williams <kwilliams@cpan.org>
1089
1090 =item *
1091
1092 Lars Dɪᴇᴄᴋᴏᴡ 迪拉斯 <daxim@cpan.org>
1093
1094 =item *
1095
1096 Leon Timmermans <leont@cpan.org>
1097
1098 =item *
1099
1100 Mark Fowler <markf@cpan.org>
1101
1102 =back
1103
1104 =head1 COPYRIGHT AND LICENSE
1105
1106 This software is copyright (c) 2010 by David Golden and Ricardo Signes.
1107
1108 This is free software; you can redistribute it and/or modify it under
1109 the same terms as the Perl 5 programming language system itself.
1110
1111 =cut