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