line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::CPAN::Meta::Version; |
2
|
|
|
|
|
|
|
|
3
|
10
|
|
|
10
|
|
28394
|
use warnings; |
|
10
|
|
|
|
|
11
|
|
|
10
|
|
|
|
|
262
|
|
4
|
10
|
|
|
10
|
|
33
|
use strict; |
|
10
|
|
|
|
|
12
|
|
|
10
|
|
|
|
|
229
|
|
5
|
|
|
|
|
|
|
|
6
|
10
|
|
|
10
|
|
30
|
use vars qw($VERSION); |
|
10
|
|
|
|
|
9
|
|
|
10
|
|
|
|
|
23936
|
|
7
|
|
|
|
|
|
|
$VERSION = '0.25'; |
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
|
69279
|
my ($class,%hash) = @_; |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
# create an attributes hash |
332
|
49
|
|
|
|
|
119
|
my $atts = { |
333
|
|
|
|
|
|
|
'spec' => $hash{spec}, |
334
|
|
|
|
|
|
|
'data' => $hash{data}, |
335
|
|
|
|
|
|
|
}; |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
# create the object |
338
|
49
|
|
|
|
|
123
|
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
|
82
|
my $self = shift; |
364
|
48
|
|
|
|
|
61
|
my $data = $self->{data}; |
365
|
|
|
|
|
|
|
|
366
|
48
|
100
|
|
|
|
93
|
unless($self->{spec}) { |
367
|
23
|
100
|
66
|
|
|
116
|
$self->{spec} = $data->{'meta-spec'} && $data->{'meta-spec'}{'version'} ? $data->{'meta-spec'}{'version'} : '1.0'; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
48
|
|
|
|
|
96
|
$self->check_map($definitions{$self->{spec}},$data); |
371
|
48
|
100
|
|
|
|
152
|
return defined $self->{errors} ? 1 : 0; |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
sub errors { |
375
|
45
|
|
|
45
|
1
|
92
|
my $self = shift; |
376
|
45
|
100
|
|
|
|
92
|
return () unless($self->{errors}); |
377
|
23
|
|
|
|
|
14
|
return @{$self->{errors}}; |
|
23
|
|
|
|
|
53
|
|
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
|
645
|
my ($self,$spec,$data) = @_; |
400
|
|
|
|
|
|
|
|
401
|
368
|
100
|
|
|
|
505
|
if(ref($spec) ne 'HASH') { |
402
|
1
|
|
|
|
|
2
|
$self->_error( "Unknown META.yml specification, cannot validate." ); |
403
|
1
|
|
|
|
|
1
|
return; |
404
|
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
367
|
100
|
|
|
|
419
|
if(ref($data) ne 'HASH') { |
407
|
3
|
|
|
|
|
7
|
$self->_error( "Expected a map structure from data string or file." ); |
408
|
3
|
|
|
|
|
5
|
return; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
364
|
|
|
|
|
599
|
for my $key (keys %$spec) { |
412
|
1460
|
100
|
|
|
|
2164
|
next unless($spec->{$key}->{mandatory}); |
413
|
455
|
100
|
|
|
|
661
|
next if(defined $data->{$key}); |
414
|
4
|
|
|
|
|
2
|
push @{$self->{stack}}, $key; |
|
4
|
|
|
|
|
8
|
|
415
|
4
|
|
|
|
|
14
|
$self->_error( "Missing mandatory field, '$key'" ); |
416
|
4
|
|
|
|
|
3
|
pop @{$self->{stack}}; |
|
4
|
|
|
|
|
8
|
|
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
364
|
|
|
|
|
681
|
for my $key (keys %$data) { |
420
|
1287
|
|
|
|
|
756
|
push @{$self->{stack}}, $key; |
|
1287
|
|
|
|
|
1254
|
|
421
|
1287
|
100
|
|
|
|
1784
|
if($spec->{$key}) { |
|
|
50
|
|
|
|
|
|
422
|
837
|
100
|
|
|
|
1296
|
if($spec->{$key}{value}) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
423
|
512
|
|
|
|
|
695
|
$spec->{$key}{value}->($self,$key,$data->{$key}); |
424
|
|
|
|
|
|
|
} elsif($spec->{$key}{'map'}) { |
425
|
248
|
|
|
|
|
387
|
$self->check_map($spec->{$key}{'map'},$data->{$key}); |
426
|
|
|
|
|
|
|
} elsif($spec->{$key}{'list'}) { |
427
|
77
|
|
|
|
|
127
|
$self->check_list($spec->{$key}{'list'},$data->{$key}); |
428
|
|
|
|
|
|
|
} |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
} elsif ($spec->{':key'}) { |
431
|
450
|
|
|
|
|
507
|
$spec->{':key'}{name}->($self,$key,$key); |
432
|
450
|
100
|
|
|
|
566
|
if($spec->{':key'}{value}) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
433
|
380
|
|
|
|
|
532
|
$spec->{':key'}{value}->($self,$key,$data->{$key}); |
434
|
|
|
|
|
|
|
} elsif($spec->{':key'}{'map'}) { |
435
|
70
|
|
|
|
|
123
|
$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
|
|
|
|
|
765
|
pop @{$self->{stack}}; |
|
1286
|
|
|
|
|
1481
|
|
444
|
|
|
|
|
|
|
} |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
sub check_list { |
448
|
79
|
|
|
79
|
1
|
748
|
my ($self,$spec,$data) = @_; |
449
|
|
|
|
|
|
|
|
450
|
79
|
100
|
|
|
|
114
|
if(ref($data) ne 'ARRAY') { |
451
|
3
|
|
|
|
|
7
|
$self->_error( "Expected a list structure" ); |
452
|
3
|
|
|
|
|
4
|
return; |
453
|
|
|
|
|
|
|
} |
454
|
|
|
|
|
|
|
|
455
|
76
|
50
|
|
|
|
110
|
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
|
|
|
|
|
69
|
for my $value (@$data) { |
462
|
111
|
|
|
|
|
65
|
push @{$self->{stack}}, $value; |
|
111
|
|
|
|
|
110
|
|
463
|
111
|
50
|
|
|
|
129
|
if(defined $spec->{value}) { |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
464
|
111
|
|
|
|
|
132
|
$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
|
|
|
|
|
63
|
pop @{$self->{stack}}; |
|
109
|
|
|
|
|
156
|
|
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
|
8
|
my ($self,$key,$value) = @_; |
569
|
4
|
100
|
|
|
|
8
|
if(defined $value) { |
570
|
3
|
100
|
100
|
|
|
19
|
return 1 if($value && $value =~ /^--- #YAML:1.0/); |
571
|
|
|
|
|
|
|
} |
572
|
3
|
|
|
|
|
6
|
$self->_error( "file does not have a valid YAML header." ); |
573
|
3
|
|
|
|
|
8
|
return 0; |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
sub _uri_split { |
577
|
28
|
|
|
28
|
|
113
|
return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,; |
578
|
|
|
|
|
|
|
} |
579
|
|
|
|
|
|
|
|
580
|
|
|
|
|
|
|
sub url { |
581
|
30
|
|
|
30
|
1
|
37
|
my ($self,$key,$value) = @_; |
582
|
30
|
100
|
|
|
|
42
|
if($value) { |
583
|
28
|
|
|
|
|
38
|
my ($scheme, $auth, $path, $query, $frag) = _uri_split($value); |
584
|
|
|
|
|
|
|
|
585
|
28
|
100
|
|
|
|
50
|
unless ( $scheme ) { |
586
|
2
|
|
|
|
|
8
|
$self->_error( "'$value' for '$key' does not have a URL scheme" ); |
587
|
2
|
|
|
|
|
7
|
return 0; |
588
|
|
|
|
|
|
|
} |
589
|
26
|
100
|
|
|
|
35
|
unless ( $auth ) { |
590
|
4
|
|
|
|
|
17
|
$self->_error( "'$value' for '$key' does not have a URL authority" ); |
591
|
4
|
|
|
|
|
10
|
return 0; |
592
|
|
|
|
|
|
|
} |
593
|
22
|
|
|
|
|
27
|
return 1; |
594
|
|
|
|
|
|
|
} else { |
595
|
2
|
|
|
|
|
4
|
$value = ''; |
596
|
|
|
|
|
|
|
} |
597
|
2
|
|
|
|
|
10
|
$self->_error( "'$value' for '$key' is not a valid URL." ); |
598
|
2
|
|
|
|
|
10
|
return 0; |
599
|
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
sub urlspec { |
602
|
44
|
|
|
44
|
1
|
51
|
my ($self,$key,$value) = @_; |
603
|
44
|
100
|
|
|
|
62
|
if(defined $value) { |
604
|
43
|
100
|
100
|
|
|
174
|
return 1 if($value && $known_specs{$self->{spec}} eq $value); |
605
|
8
|
100
|
100
|
|
|
32
|
if($value && $known_urls{$value}) { |
606
|
6
|
|
|
|
|
332
|
$self->_error( 'META.yml specification URL does not match version' ); |
607
|
6
|
|
|
|
|
10
|
return 0; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
} |
610
|
3
|
|
|
|
|
6
|
$self->_error( 'Unknown META.yml specification' ); |
611
|
3
|
|
|
|
|
8
|
return 0; |
612
|
|
|
|
|
|
|
} |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
sub string { |
615
|
299
|
|
|
299
|
1
|
327
|
my ($self,$key,$value) = @_; |
616
|
299
|
100
|
|
|
|
344
|
if(defined $value) { |
617
|
298
|
100
|
100
|
|
|
510
|
return 1 if($value || $value =~ /^0$/); |
618
|
|
|
|
|
|
|
} |
619
|
2
|
|
|
|
|
4
|
$self->_error( "value is an undefined string" ); |
620
|
2
|
|
|
|
|
6
|
return 0; |
621
|
|
|
|
|
|
|
} |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
sub string_or_undef { |
624
|
4
|
|
|
4
|
1
|
5
|
my ($self,$key,$value) = @_; |
625
|
4
|
100
|
|
|
|
11
|
return 1 unless(defined $value); |
626
|
3
|
100
|
100
|
|
|
15
|
return 1 if($value || $value =~ /^0$/); |
627
|
1
|
|
|
|
|
4
|
$self->_error( "No string defined for '$key'" ); |
628
|
1
|
|
|
|
|
3
|
return 0; |
629
|
|
|
|
|
|
|
} |
630
|
|
|
|
|
|
|
|
631
|
|
|
|
|
|
|
sub file { |
632
|
69
|
|
|
69
|
1
|
63
|
my ($self,$key,$value) = @_; |
633
|
69
|
100
|
|
|
|
122
|
return 1 if(defined $value); |
634
|
1
|
|
|
|
|
4
|
$self->_error( "No file defined for '$key'" ); |
635
|
1
|
|
|
|
|
3
|
return 0; |
636
|
|
|
|
|
|
|
} |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
sub exversion { |
639
|
313
|
|
|
313
|
1
|
291
|
my ($self,$key,$value) = @_; |
640
|
313
|
100
|
100
|
|
|
776
|
if(defined $value && ($value || $value =~ /0/)) { |
|
|
|
66
|
|
|
|
|
641
|
310
|
|
|
|
|
212
|
my $pass = 1; |
642
|
310
|
100
|
|
|
|
428
|
for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); } |
|
315
|
|
|
|
|
331
|
|
643
|
310
|
|
|
|
|
335
|
return $pass; |
644
|
|
|
|
|
|
|
} |
645
|
3
|
100
|
|
|
|
6
|
$value = '' unless(defined $value); |
646
|
3
|
|
|
|
|
10
|
$self->_error( "'$value' for '$key' is not a valid version." ); |
647
|
3
|
|
|
|
|
9
|
return 0; |
648
|
|
|
|
|
|
|
} |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
sub version { |
651
|
479
|
|
|
479
|
1
|
445
|
my ($self,$key,$value) = @_; |
652
|
479
|
100
|
|
|
|
474
|
if(defined $value) { |
653
|
477
|
100
|
100
|
|
|
756
|
return 0 unless($value || $value =~ /0/); |
654
|
476
|
100
|
|
|
|
1765
|
return 1 if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/); |
655
|
|
|
|
|
|
|
} else { |
656
|
2
|
|
|
|
|
3
|
$value = ''; |
657
|
|
|
|
|
|
|
} |
658
|
6
|
|
|
|
|
21
|
$self->_error( "'$value' for '$key' is not a valid version." ); |
659
|
6
|
|
|
|
|
15
|
return 0; |
660
|
|
|
|
|
|
|
} |
661
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
sub boolean { |
663
|
8
|
|
|
8
|
1
|
13
|
my ($self,$key,$value) = @_; |
664
|
8
|
100
|
|
|
|
14
|
if(defined $value) { |
665
|
6
|
100
|
|
|
|
31
|
return 1 if($value =~ /^(0|1|true|false)$/); |
666
|
|
|
|
|
|
|
} else { |
667
|
2
|
|
|
|
|
2
|
$value = ''; |
668
|
|
|
|
|
|
|
} |
669
|
4
|
|
|
|
|
16
|
$self->_error( "'$value' for '$key' is not a boolean value." ); |
670
|
4
|
|
|
|
|
12
|
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
|
5582
|
my ($self,$key,$value) = @_; |
693
|
65
|
100
|
|
|
|
83
|
if(defined $value) { |
694
|
64
|
100
|
100
|
|
|
295
|
return 1 if($value && exists $licenses{$value}); |
695
|
4
|
100
|
|
|
|
12
|
return 2 if($value); |
696
|
|
|
|
|
|
|
} else { |
697
|
1
|
|
|
|
|
2
|
$value = ''; |
698
|
|
|
|
|
|
|
} |
699
|
2
|
|
|
|
|
10
|
$self->_error( "License '$value' is unknown" ); |
700
|
2
|
|
|
|
|
7
|
return 0; |
701
|
|
|
|
|
|
|
} |
702
|
|
|
|
|
|
|
|
703
|
|
|
|
|
|
|
sub resource { |
704
|
7
|
|
|
7
|
1
|
13
|
my ($self,$key) = @_; |
705
|
7
|
100
|
|
|
|
16
|
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
|
|
|
68
|
return 1 if($key && $key =~ /^[a-z]+$/i && $key =~ /[A-Z]/); |
|
|
|
100
|
|
|
|
|
709
|
|
|
|
|
|
|
} else { |
710
|
1
|
|
|
|
|
2
|
$key = ''; |
711
|
|
|
|
|
|
|
} |
712
|
3
|
|
|
|
|
11
|
$self->_error( "Resource '$key' must be in CamelCase." ); |
713
|
3
|
|
|
|
|
9
|
return 0; |
714
|
|
|
|
|
|
|
} |
715
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
sub keyword { |
717
|
82
|
|
|
82
|
1
|
3594
|
my ($self,$key) = @_; |
718
|
82
|
100
|
|
|
|
101
|
if(defined $key) { |
719
|
81
|
100
|
100
|
|
|
373
|
return 1 if($key && $key =~ /^([a-z][-_a-z]*)$/); # spec defined |
720
|
6
|
100
|
100
|
|
|
27
|
return 1 if($key && $key =~ /^x_([a-z][-_a-z]*)$/i); # user defined |
721
|
|
|
|
|
|
|
} else { |
722
|
1
|
|
|
|
|
2
|
$key = ''; |
723
|
|
|
|
|
|
|
} |
724
|
6
|
|
|
|
|
20
|
$self->_error( "Key '$key' is not a legal keyword." ); |
725
|
6
|
|
|
|
|
17
|
return 0; |
726
|
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
|
|
728
|
|
|
|
|
|
|
sub identifier { |
729
|
13
|
|
|
13
|
1
|
3141
|
my ($self,$key) = @_; |
730
|
13
|
100
|
|
|
|
23
|
if(defined $key) { |
731
|
12
|
100
|
100
|
|
|
88
|
return 1 if($key && $key =~ /^([a-z][_a-z]+)$/i); # spec 2.0 defined |
732
|
|
|
|
|
|
|
} else { |
733
|
1
|
|
|
|
|
2
|
$key = ''; |
734
|
|
|
|
|
|
|
} |
735
|
5
|
|
|
|
|
14
|
$self->_error( "Key '$key' is not a legal identifier." ); |
736
|
5
|
|
|
|
|
14
|
return 0; |
737
|
|
|
|
|
|
|
} |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
sub module { |
740
|
382
|
|
|
382
|
1
|
321
|
my ($self,$key) = @_; |
741
|
382
|
100
|
|
|
|
512
|
if(defined $key) { |
742
|
381
|
100
|
100
|
|
|
1711
|
return 1 if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/); |
743
|
|
|
|
|
|
|
} else { |
744
|
1
|
|
|
|
|
2
|
$key = ''; |
745
|
|
|
|
|
|
|
} |
746
|
9
|
|
|
|
|
26
|
$self->_error( "Key '$key' is not a legal module name." ); |
747
|
9
|
|
|
|
|
13
|
return 0; |
748
|
|
|
|
|
|
|
} |
749
|
|
|
|
|
|
|
|
750
|
71
|
|
|
71
|
1
|
58
|
sub anything { return 1 } |
751
|
|
|
|
|
|
|
|
752
|
|
|
|
|
|
|
sub _error { |
753
|
73
|
|
|
73
|
|
61
|
my $self = shift; |
754
|
73
|
|
|
|
|
62
|
my $mess = shift; |
755
|
|
|
|
|
|
|
|
756
|
73
|
100
|
|
|
|
244
|
$mess .= ' ('.join(' -> ',@{$self->{stack}}).')' if($self->{stack}); |
|
25
|
|
|
|
|
63
|
|
757
|
73
|
|
|
|
|
130
|
$mess .= " [Validation: $self->{spec}]"; |
758
|
|
|
|
|
|
|
|
759
|
73
|
|
|
|
|
56
|
push @{$self->{errors}}, $mess; |
|
73
|
|
|
|
|
138
|
|
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
q( "Before software can be reusable it first has to be usable." - Ralph Johnson ); |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
__END__ |