File Coverage

blib/lib/Test/CPAN/Meta/Version.pm
Criterion Covered Total %
statement 166 174 95.4
branch 99 114 86.8
condition 45 48 93.7
subroutine 25 25 100.0
pod 20 20 100.0
total 355 381 93.1


line stmt bran cond sub pod time code
1             package Test::CPAN::Meta::Version;
2              
3 10     10   33519 use warnings;
  10         16  
  10         328  
4 10     10   44 use strict;
  10         10  
  10         293  
5              
6 10     10   38 use vars qw($VERSION);
  10         12  
  10         28497  
7             $VERSION = '0.24';
8              
9             #----------------------------------------------------------------------------
10              
11             =head1 NAME
12              
13             Test::CPAN::Meta::Version - Validate CPAN META data against the specification
14              
15             =head1 SYNOPSIS
16              
17             use Test::CPAN::Meta::Version;
18              
19             =head1 DESCRIPTION
20              
21             This distribution was written to ensure that a META.yml file, provided with a
22             standard distribution uploaded to CPAN, meets the specifications that are
23             slowly being introduced to module uploads, via the use of package makers and
24             installers such as L, L and
25             L.
26              
27             This module is meant to be used together with L, however
28             the code is self contained enough that you can access it directly.
29              
30             See L for further details of the CPAN Meta Specification.
31              
32             =cut
33              
34             #----------------------------------------------------------------------------
35              
36             #############################################################################
37             #Specification Definitions #
38             #############################################################################
39              
40             my %known_specs = (
41             '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html',
42             '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html',
43             '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html',
44             '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html',
45             '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html'
46             );
47             my %known_urls = map {$known_specs{$_} => $_} keys %known_specs;
48              
49             my $module_map1 = { 'map' => { ':key' => { name => \&module, value => \&exversion } } };
50             my $module_map2 = { 'map' => { ':key' => { name => \&module, value => \&version } } };
51             my $no_index_1_3 = {
52             'map' => { file => { list => { value => \&string } },
53             directory => { list => { value => \&string } },
54             'package' => { list => { value => \&string } },
55             namespace => { list => { value => \&string } },
56             }
57             };
58             my $no_index_1_2 = {
59             'map' => { file => { list => { value => \&string } },
60             dir => { list => { value => \&string } },
61             'package' => { list => { value => \&string } },
62             namespace => { list => { value => \&string } },
63             }
64             };
65             my $no_index_1_1 = {
66             'map' => { ':key' => { name => \&keyword, list => { value => \&string } },
67             }
68             };
69              
70             my %definitions = (
71             '1.4' => {
72             # 'header' => { mandatory => 1, value => \&header },
73             'meta-spec' => { mandatory => 1, 'map' => { version => { mandatory => 1, value => \&version},
74             url => { mandatory => 1, value => \&urlspec } } },
75              
76             'name' => { mandatory => 1, value => \&string },
77             'version' => { mandatory => 1, value => \&version },
78             'abstract' => { mandatory => 1, value => \&string },
79             'author' => { mandatory => 1, list => { value => \&string } },
80             'license' => { mandatory => 1, value => \&license },
81             'generated_by' => { mandatory => 1, value => \&string },
82              
83             'distribution_type' => { value => \&string },
84             'dynamic_config' => { value => \&boolean },
85              
86             'requires' => $module_map1,
87             'recommends' => $module_map1,
88             'build_requires' => $module_map1,
89             'configure_requires' => $module_map1,
90             'conflicts' => $module_map2,
91              
92             'optional_features' => {
93             'map' => {
94             ':key' => { name => \&identifier,
95             'map' => { description => { value => \&string },
96             requires_packages => { value => \&string },
97             requires_os => { value => \&string },
98             excludes_os => { value => \&string },
99             requires => $module_map1,
100             recommends => $module_map1,
101             build_requires => $module_map1,
102             conflicts => $module_map2,
103             }
104             }
105             }
106             },
107              
108             'provides' => {
109             'map' => { ':key' => { name => \&module,
110             'map' => { file => { mandatory => 1, value => \&file },
111             version => { value => \&version } } } }
112             },
113              
114             'no_index' => $no_index_1_3,
115             'private' => $no_index_1_3,
116              
117             'keywords' => { list => { value => \&string } },
118              
119             'resources' => {
120             'map' => { license => { value => \&url },
121             homepage => { value => \&url },
122             bugtracker => { value => \&url },
123             repository => { value => \&url },
124             ':key' => { value => \&string, name => \&resource },
125             }
126             },
127              
128             # additional user defined key/value pairs
129             # note we can only validate the key name, as the structure is user defined
130             ':key' => { name => \&keyword, value => \&anything },
131             },
132              
133             '1.3' => {
134             # 'header' => { mandatory => 1, value => \&header },
135             'meta-spec' => { mandatory => 1, 'map' => { version => { mandatory => 1, value => \&version},
136             url => { mandatory => 1, value => \&urlspec } } },
137              
138             'name' => { mandatory => 1, value => \&string },
139             'version' => { mandatory => 1, value => \&version },
140             'abstract' => { mandatory => 1, value => \&string },
141             'author' => { mandatory => 1, list => { value => \&string } },
142             'license' => { mandatory => 1, value => \&license },
143             'generated_by' => { mandatory => 1, value => \&string },
144              
145             'distribution_type' => { value => \&string },
146             'dynamic_config' => { value => \&boolean },
147              
148             'requires' => $module_map1,
149             'recommends' => $module_map1,
150             'build_requires' => $module_map1,
151             'conflicts' => $module_map2,
152              
153             'optional_features' => {
154             'map' => {
155             ':key' => { name => \&identifier,
156             'map' => { description => { value => \&string },
157             requires_packages => { value => \&string },
158             requires_os => { value => \&string },
159             excludes_os => { value => \&string },
160             requires => $module_map1,
161             recommends => $module_map1,
162             build_requires => $module_map1,
163             conflicts => $module_map2,
164             }
165             }
166             }
167             },
168              
169             'provides' => {
170             'map' => { ':key' => { name => \&module,
171             'map' => { file => { mandatory => 1, value => \&file },
172             version => { value => \&version } } } }
173             },
174              
175             'no_index' => $no_index_1_3,
176             'private' => $no_index_1_3,
177              
178             'keywords' => { list => { value => \&string } },
179              
180             'resources' => {
181             'map' => { license => { value => \&url },
182             homepage => { value => \&url },
183             bugtracker => { value => \&url },
184             repository => { value => \&url },
185             ':key' => { value => \&string, name => \&resource },
186             }
187             },
188              
189             # additional user defined key/value pairs
190             # note we can only validate the key name, as the structure is user defined
191             ':key' => { name => \&keyword, value => \&anything },
192             },
193              
194             # v1.2 is misleading, it seems to assume that a number of fields where created
195             # within v1.1, when they were created within v1.2. This may have been an
196             # original mistake, and that a v1.1 was retro fitted into the timeline, when
197             # v1.2 was originally slated as v1.1. But I could be wrong ;)
198             '1.2' => {
199             # 'header' => { mandatory => 1, value => \&header },
200             'meta-spec' => { mandatory => 1, 'map' => { version => { mandatory => 1, value => \&version},
201             url => { mandatory => 1, value => \&urlspec } } },
202              
203             'name' => { mandatory => 1, value => \&string },
204             'version' => { mandatory => 1, value => \&version },
205             'license' => { mandatory => 1, value => \&license },
206             'generated_by' => { mandatory => 1, value => \&string },
207             'author' => { mandatory => 1, list => { value => \&string } },
208             'abstract' => { mandatory => 1, value => \&string },
209              
210             'distribution_type' => { value => \&string },
211             'dynamic_config' => { value => \&boolean },
212              
213             'keywords' => { list => { value => \&string } },
214              
215             'private' => $no_index_1_2,
216             '$no_index' => $no_index_1_2,
217              
218             'requires' => $module_map1,
219             'recommends' => $module_map1,
220             'build_requires' => $module_map1,
221             'conflicts' => $module_map2,
222              
223             'optional_features' => {
224             'map' => {
225             ':key' => { name => \&identifier,
226             'map' => { description => { value => \&string },
227             requires_packages => { value => \&string },
228             requires_os => { value => \&string },
229             excludes_os => { value => \&string },
230             requires => $module_map1,
231             recommends => $module_map1,
232             build_requires => $module_map1,
233             conflicts => $module_map2,
234             }
235             }
236             }
237             },
238              
239             'provides' => {
240             'map' => { ':key' => { name => \&module,
241             'map' => { file => { mandatory => 1, value => \&file },
242             version => { value => \&version } } } }
243             },
244              
245             'resources' => {
246             'map' => { license => { value => \&url },
247             homepage => { value => \&url },
248             bugtracker => { value => \&url },
249             repository => { value => \&url },
250             ':key' => { value => \&string, name => \&resource },
251             }
252             },
253              
254             # additional user defined key/value pairs
255             # note we can only validate the key name, as the structure is user defined
256             ':key' => { name => \&keyword, value => \&anything },
257             },
258              
259             # note that the 1.1 spec doesn't specify optional or mandatory fields, what
260             # appears below is assumed from later specifications.
261             '1.1' => {
262             # 'header' => { mandatory => 1, value => \&header },
263             'name' => { mandatory => 1, value => \&string },
264             'version' => { mandatory => 1, value => \&version },
265             'license' => { mandatory => 1, value => \&license },
266             'license_uri' => { mandatory => 0, value => \&url },
267             'generated_by' => { mandatory => 1, value => \&string },
268              
269             'distribution_type' => { value => \&string },
270             'dynamic_config' => { value => \&boolean },
271              
272             'private' => $no_index_1_1,
273              
274             'requires' => $module_map1,
275             'recommends' => $module_map1,
276             'build_requires' => $module_map1,
277             'conflicts' => $module_map2,
278              
279             # additional user defined key/value pairs
280             # note we can only validate the key name, as the structure is user defined
281             ':key' => { name => \&keyword, value => \&anything },
282             },
283              
284             # note that the 1.0 spec doesn't specify optional or mandatory fields, what
285             # appears below is assumed from later specifications.
286             '1.0' => {
287             # 'header' => { mandatory => 1, value => \&header },
288             'name' => { mandatory => 1, value => \&string },
289             'version' => { mandatory => 1, value => \&version },
290             'license' => { mandatory => 1, value => \&license },
291             'generated_by' => { mandatory => 1, value => \&string },
292              
293             'distribution_type' => { value => \&string },
294             'dynamic_config' => { value => \&boolean },
295              
296             'requires' => $module_map1,
297             'recommends' => $module_map1,
298             'build_requires' => $module_map1,
299             'conflicts' => $module_map2,
300              
301             # additional user defined key/value pairs
302             # note we can only validate the key name, as the structure is user defined
303             ':key' => { name => \&keyword, value => \&anything },
304             },
305             );
306              
307             #############################################################################
308             #Code #
309             #############################################################################
310              
311             =head1 CLASS CONSTRUCTOR
312              
313             =over
314              
315             =item * new( data => $data [, spec => $version] )
316              
317             The constructor must be passed a valid data structure.
318              
319             Optionally you may also provide a specification version. This version is then
320             use to ensure that the given data structure meets the respective
321             specification definition. If no version is provided the module will attempt to
322             deduce the appropriate specification version from the data structure itself.
323              
324             =back
325              
326             =cut
327              
328             sub new {
329 49     49 1 89303 my ($class,%hash) = @_;
330              
331             # create an attributes hash
332 49         185 my $atts = {
333             'spec' => $hash{spec},
334             'data' => $hash{data},
335             };
336              
337             # create the object
338 49         159 my $self = bless $atts, $class;
339             }
340              
341             =head1 METHODS
342              
343             =head2 Main Methods
344              
345             =over
346              
347             =item * parse()
348              
349             Using the given data structure provided with the constructor, attempts to
350             parse and validate according to the appropriate specification definition.
351              
352             Returns 1 if any errors found, otherwise returns 0.
353              
354             =item * errors()
355              
356             Returns a list of the errors found during parsing.
357              
358             =back
359              
360             =cut
361              
362             sub parse {
363 48     48 1 121 my $self = shift;
364 48         81 my $data = $self->{data};
365              
366 48 100       124 unless($self->{spec}) {
367 23 100 66     150 $self->{spec} = $data->{'meta-spec'} && $data->{'meta-spec'}{'version'} ? $data->{'meta-spec'}{'version'} : '1.0';
368             }
369              
370 48         127 $self->check_map($definitions{$self->{spec}},$data);
371 48 100       243 return defined $self->{errors} ? 1 : 0;
372             }
373              
374             sub errors {
375 45     45 1 186 my $self = shift;
376 45 100       114 return () unless($self->{errors});
377 23         25 return @{$self->{errors}};
  23         66  
378             }
379              
380             =head2 Check Methods
381              
382             =over
383              
384             =item * check_map($spec,$data)
385              
386             Checks whether a map (or hash) part of the data structure conforms to the
387             appropriate specification definition.
388              
389             =item * check_list($spec,$data)
390              
391             Checks whether a list (or array) part of the data structure conforms to
392             the appropriate specification definition.
393              
394             =back
395              
396             =cut
397              
398             sub check_map {
399 368     368 1 781 my ($self,$spec,$data) = @_;
400              
401 368 100       658 if(ref($spec) ne 'HASH') {
402 1         3 $self->_error( "Unknown META.yml specification, cannot validate." );
403 1         1 return;
404             }
405              
406 367 100       507 if(ref($data) ne 'HASH') {
407 3         9 $self->_error( "Expected a map structure from data string or file." );
408 3         4 return;
409             }
410              
411 364         797 for my $key (keys %$spec) {
412 1460 100       2689 next unless($spec->{$key}->{mandatory});
413 455 100       821 next if(defined $data->{$key});
414 4         6 push @{$self->{stack}}, $key;
  4         8  
415 4         16 $self->_error( "Missing mandatory field, '$key'" );
416 4         5 pop @{$self->{stack}};
  4         6  
417             }
418              
419 364         888 for my $key (keys %$data) {
420 1287         936 push @{$self->{stack}}, $key;
  1287         1537  
421 1287 100       2172 if($spec->{$key}) {
    50          
422 837 100       1712 if($spec->{$key}{value}) {
    100          
    50          
423 512         897 $spec->{$key}{value}->($self,$key,$data->{$key});
424             } elsif($spec->{$key}{'map'}) {
425 248         486 $self->check_map($spec->{$key}{'map'},$data->{$key});
426             } elsif($spec->{$key}{'list'}) {
427 77         167 $self->check_list($spec->{$key}{'list'},$data->{$key});
428             }
429              
430             } elsif ($spec->{':key'}) {
431 450         638 $spec->{':key'}{name}->($self,$key,$key);
432 450 100       691 if($spec->{':key'}{value}) {
    50          
    0          
433 380         721 $spec->{':key'}{value}->($self,$key,$data->{$key});
434             } elsif($spec->{':key'}{'map'}) {
435 70         153 $self->check_map($spec->{':key'}{'map'},$data->{$key});
436             } elsif($spec->{':key'}{'list'}) {
437 0         0 $self->check_list($spec->{':key'}{'list'},$data->{$key});
438             }
439              
440             } else {
441 0         0 $self->_error( "Unknown key, '$key', found in map structure" );
442             }
443 1286         954 pop @{$self->{stack}};
  1286         1853  
444             }
445             }
446              
447             sub check_list {
448 79     79 1 881 my ($self,$spec,$data) = @_;
449              
450 79 100       158 if(ref($data) ne 'ARRAY') {
451 3         8 $self->_error( "Expected a list structure" );
452 3         4 return;
453             }
454              
455 76 50       144 if(defined $spec->{mandatory}) {
456 0 0       0 if(!defined $data->[0]) {
457 0         0 $self->_error( "Missing entries from mandatory list" );
458             }
459             }
460              
461 76         94 for my $value (@$data) {
462 111         92 push @{$self->{stack}}, $value;
  111         155  
463 111 50       157 if(defined $spec->{value}) {
    0          
    0          
    0          
464 111         172 $spec->{value}->($self,'list',$value);
465             } elsif(defined $spec->{'map'}) {
466 0         0 $self->check_map($spec->{'map'},$value);
467             } elsif(defined $spec->{'list'}) {
468 0         0 $self->check_list($spec->{'list'},$value);
469              
470             } elsif ($spec->{':key'}) {
471 0         0 $self->check_map($spec,$value);
472              
473             } else {
474 0         0 $self->_error( "Unknown value type, '$value', found in list structure" );
475             }
476 109         91 pop @{$self->{stack}};
  109         201  
477             }
478             }
479              
480             =head2 Validator Methods
481              
482             =over
483              
484             =item * header($self,$key,$value)
485              
486             Validates that the YAML header is valid.
487              
488             Note: No longer used as we now read the YAML data structure, not the file.
489              
490             =item * url($self,$key,$value)
491              
492             Validates that a given value is in an acceptable URL format
493              
494             =item * urlspec($self,$key,$value)
495              
496             Validates that the URL to a META.yml specification is a known one.
497              
498             =item * string_or_undef($self,$key,$value)
499              
500             Validates that the value is either a string or an undef value. Bit of a
501             catchall function for parts of the data structure that are completely user
502             defined.
503              
504             =item * string($self,$key,$value)
505              
506             Validates that a string exists for the given key.
507              
508             =item * file($self,$key,$value)
509              
510             Validate that a file is passed for the given key. This may be made more
511             thorough in the future. For now it acts like \&string.
512              
513             =item * exversion($self,$key,$value)
514              
515             Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'.
516              
517             =item * version($self,$key,$value)
518              
519             Validates a single version string. Versions of the type '5.8.8' and '0.00_00'
520             are both valid. A leading 'v' like 'v1.2.3' is also valid.
521              
522             =item * boolean($self,$key,$value)
523              
524             Validates for a boolean value. Currently these values are '1', '0', 'true',
525             'false', however the latter 2 may be removed.
526              
527             =item * license($self,$key,$value)
528              
529             Validates that a value is given for the license. Returns 1 if an known license
530             type, or 2 if a value is given but the license type is not a recommended one.
531              
532             =item * resource($self,$key,$value)
533              
534             Validates that the given key is in CamelCase, to indicate a user defined
535             keyword.
536              
537             =item * keyword($self,$key,$value)
538              
539             Validates that key is in an acceptable format for the META.yml specification,
540             i.e. any in the character class [-_a-z].
541              
542             For user defined keys, although not explicitly stated in the specifications
543             (v1.0 - v1.4), the convention is to precede the key with a pattern matching
544             qr{\Ax_}i. Following this any character from the character class [-_a-zA-Z]
545             can be used. This clarification has been added to v2.0 of the specification.
546              
547             =item * identifier($self,$key,$value)
548              
549             Validates that key is in an acceptable format for the META.yml specification,
550             for an identifier, i.e. any that matches the regular expression
551             qr/[a-z][a-z_]/i.
552              
553             =item * module($self,$key,$value)
554              
555             Validates that a given key is in an acceptable module name format, e.g.
556             'Test::CPAN::Meta::Version'.
557              
558             =item * anything($self,$key,$value)
559              
560             Usually reserved for user defined structures, allowing them to be considered
561             valid without a need for a specification definition for the structure.
562              
563             =back
564              
565             =cut
566              
567             sub header {
568 4     4 1 13 my ($self,$key,$value) = @_;
569 4 100       10 if(defined $value) {
570 3 100 100     30 return 1 if($value && $value =~ /^--- #YAML:1.0/);
571             }
572 3         8 $self->_error( "file does not have a valid YAML header." );
573 3         10 return 0;
574             }
575              
576             sub _uri_split {
577 28     28   133 return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
578             }
579              
580             sub url {
581 30     30 1 39 my ($self,$key,$value) = @_;
582 30 100       44 if($value) {
583 28         47 my ($scheme, $auth, $path, $query, $frag) = _uri_split($value);
584              
585 28 100       54 unless ( $scheme ) {
586 2         10 $self->_error( "'$value' for '$key' does not have a URL scheme" );
587 2         10 return 0;
588             }
589 26 100       44 unless ( $auth ) {
590 4         20 $self->_error( "'$value' for '$key' does not have a URL authority" );
591 4         12 return 0;
592             }
593 22         32 return 1;
594             } else {
595 2         3 $value = '';
596             }
597 2         8 $self->_error( "'$value' for '$key' is not a valid URL." );
598 2         6 return 0;
599             }
600              
601             sub urlspec {
602 44     44 1 60 my ($self,$key,$value) = @_;
603 44 100       90 if(defined $value) {
604 43 100 100     235 return 1 if($value && $known_specs{$self->{spec}} eq $value);
605 8 100 100     452 if($value && $known_urls{$value}) {
606 6         17 $self->_error( 'META.yml specification URL does not match version' );
607 6         11 return 0;
608             }
609             }
610 3         5 $self->_error( 'Unknown META.yml specification' );
611 3         9 return 0;
612             }
613              
614             sub string {
615 299     299 1 342 my ($self,$key,$value) = @_;
616 299 100       433 if(defined $value) {
617 298 100 100     591 return 1 if($value || $value =~ /^0$/);
618             }
619 2         6 $self->_error( "value is an undefined string" );
620 2         7 return 0;
621             }
622              
623             sub string_or_undef {
624 4     4 1 9 my ($self,$key,$value) = @_;
625 4 100       11 return 1 unless(defined $value);
626 3 100 100     19 return 1 if($value || $value =~ /^0$/);
627 1         5 $self->_error( "No string defined for '$key'" );
628 1         4 return 0;
629             }
630              
631             sub file {
632 69     69 1 95 my ($self,$key,$value) = @_;
633 69 100       150 return 1 if(defined $value);
634 1         20 $self->_error( "No file defined for '$key'" );
635 1         4 return 0;
636             }
637              
638             sub exversion {
639 313     313 1 341 my ($self,$key,$value) = @_;
640 313 100 100     985 if(defined $value && ($value || $value =~ /0/)) {
      66        
641 310         359 my $pass = 1;
642 310 100       577 for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); }
  315         401  
643 310         396 return $pass;
644             }
645 3 100       9 $value = '' unless(defined $value);
646 3         17 $self->_error( "'$value' for '$key' is not a valid version." );
647 3         13 return 0;
648             }
649              
650             sub version {
651 479     479 1 518 my ($self,$key,$value) = @_;
652 479 100       553 if(defined $value) {
653 477 100 100     912 return 0 unless($value || $value =~ /0/);
654 476 100       2266 return 1 if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/);
655             } else {
656 2         4 $value = '';
657             }
658 6         30 $self->_error( "'$value' for '$key' is not a valid version." );
659 6         23 return 0;
660             }
661              
662             sub boolean {
663 8     8 1 20 my ($self,$key,$value) = @_;
664 8 100       15 if(defined $value) {
665 6 100       45 return 1 if($value =~ /^(0|1|true|false)$/);
666             } else {
667 2         4 $value = '';
668             }
669 4         16 $self->_error( "'$value' for '$key' is not a boolean value." );
670 4         17 return 0;
671             }
672              
673             my %licenses = (
674             'perl' => 'http://dev.perl.org/licenses/',
675             'gpl' => 'http://www.opensource.org/licenses/gpl-license.php',
676             'apache' => 'http://apache.org/licenses/LICENSE-2.0',
677             'artistic' => 'http://opensource.org/licenses/artistic-license.php',
678             'artistic2' => 'http://opensource.org/licenses/artistic-license-2.0.php',
679             'artistic-2.0' => 'http://opensource.org/licenses/artistic-license-2.0.php',
680             'lgpl' => 'http://www.opensource.org/licenses/lgpl-license.phpt',
681             'bsd' => 'http://www.opensource.org/licenses/bsd-license.php',
682             'gpl' => 'http://www.opensource.org/licenses/gpl-license.php',
683             'mit' => 'http://opensource.org/licenses/mit-license.php',
684             'mozilla' => 'http://opensource.org/licenses/mozilla1.1.php',
685             'open_source' => undef,
686             'unrestricted' => undef,
687             'restrictive' => undef,
688             'unknown' => undef,
689             );
690              
691             sub license {
692 65     65 1 7253 my ($self,$key,$value) = @_;
693 65 100       119 if(defined $value) {
694 64 100 100     347 return 1 if($value && exists $licenses{$value});
695 4 100       18 return 2 if($value);
696             } else {
697 1         3 $value = '';
698             }
699 2         13 $self->_error( "License '$value' is unknown" );
700 2         8 return 0;
701             }
702              
703             sub resource {
704 7     7 1 14 my ($self,$key) = @_;
705 7 100       14 if(defined $key) {
706             # a valid user defined key should be alphabetic
707             # and contain at least one capital case letter.
708 6 100 66     73 return 1 if($key && $key =~ /^[a-z]+$/i && $key =~ /[A-Z]/);
      100        
709             } else {
710 1         2 $key = '';
711             }
712 3         12 $self->_error( "Resource '$key' must be in CamelCase." );
713 3         10 return 0;
714             }
715              
716             sub keyword {
717 82     82 1 3886 my ($self,$key) = @_;
718 82 100       114 if(defined $key) {
719 81 100 100     475 return 1 if($key && $key =~ /^([a-z][-_a-z]*)$/); # spec defined
720 6 100 100     30 return 1 if($key && $key =~ /^x_([a-z][-_a-z]*)$/i); # user defined
721             } else {
722 1         3 $key = '';
723             }
724 6         20 $self->_error( "Key '$key' is not a legal keyword." );
725 6         47 return 0;
726             }
727              
728             sub identifier {
729 13     13 1 3740 my ($self,$key) = @_;
730 13 100       30 if(defined $key) {
731 12 100 100     109 return 1 if($key && $key =~ /^([a-z][_a-z]+)$/i); # spec 2.0 defined
732             } else {
733 1         2 $key = '';
734             }
735 5         20 $self->_error( "Key '$key' is not a legal identifier." );
736 5         18 return 0;
737             }
738              
739             sub module {
740 382     382 1 369 my ($self,$key) = @_;
741 382 100       490 if(defined $key) {
742 381 100 100     2116 return 1 if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/);
743             } else {
744 1         2 $key = '';
745             }
746 9         29 $self->_error( "Key '$key' is not a legal module name." );
747 9         15 return 0;
748             }
749              
750 71     71 1 72 sub anything { return 1 }
751              
752             sub _error {
753 73     73   86 my $self = shift;
754 73         77 my $mess = shift;
755              
756 73 100       171 $mess .= ' ('.join(' -> ',@{$self->{stack}}).')' if($self->{stack});
  25         87  
757 73         155 $mess .= " [Validation: $self->{spec}]";
758              
759 73         75 push @{$self->{errors}}, $mess;
  73         163  
760             }
761              
762             q( "Before software can be reusable it first has to be usable." - Ralph Johnson );
763              
764             __END__