Filename | /home/leont/perl5/perlbrew/perls/perl-5.32.0/lib/5.32.0/CPAN/Meta/Converter.pm |
Statements | Executed 75 statements in 4.00ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 2.38ms | 2.40ms | BEGIN@26 | CPAN::Meta::Converter::
1 | 1 | 1 | 564µs | 623µs | BEGIN@28 | CPAN::Meta::Converter::
1 | 1 | 1 | 25µs | 31µs | BEGIN@491 | CPAN::Meta::Converter::
1 | 1 | 1 | 16µs | 19µs | BEGIN@36 | CPAN::Meta::Converter::
1 | 1 | 1 | 9µs | 9µs | CORE:sort (opcode) | CPAN::Meta::Converter::
1 | 1 | 1 | 7µs | 7µs | BEGIN@1.3 | CPAN::Meta::
1 | 1 | 1 | 4µs | 5µs | BEGIN@27 | CPAN::Meta::Converter::
4 | 1 | 1 | 4µs | 4µs | CORE:regcomp (opcode) | CPAN::Meta::Converter::
1 | 1 | 1 | 4µs | 10µs | BEGIN@506 | CPAN::Meta::Converter::
1 | 1 | 1 | 3µs | 4µs | BEGIN@2.4 | CPAN::Meta::
1 | 1 | 1 | 3µs | 11µs | BEGIN@3.5 | CPAN::Meta::
4 | 1 | 1 | 2µs | 2µs | CORE:qr (opcode) | CPAN::Meta::Converter::
2 | 2 | 1 | 900ns | 900ns | __ANON__ (xsub) | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:44] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:507] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:641] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:649] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:650] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:687] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:688] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:726] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:728] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | __ANON__[:729] | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _author_list | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _bad_version_hook | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _change_meta_spec | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _clean_version | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _cleanup_optional_features_2 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _cleanup_prereqs | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _cleanup_resources_2 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _convert | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _dclone | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _downgrade_license | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _downgrade_optional_features | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _downgrade_resources | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _extract_prereqs | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _extract_spec_version | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _feature_2 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _generated_by | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _get_build_requires | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _is_module_name | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _is_urlish | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _keep | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _keep_or_one | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _keep_or_unknown | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _keep_or_zero | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _license_1 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _license_2 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _listify | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _no_index_1_2 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _no_index_directory | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _no_prefix_ucfirst_custom | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _optional_features_1_4 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _optional_features_as_map | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _prefix_custom | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _prereqs_from_1 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _prereqs_rel | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _provides | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _release_status | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _release_status_from_version | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _repo_type | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _resources_1_2 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _resources_1_3 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _ucfirst_custom | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _upgrade_optional_features | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _upgrade_resources_2 | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _url_list | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _url_or_drop | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | _version_map | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | convert | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | new | CPAN::Meta::Converter::
0 | 0 | 0 | 0s | 0s | upgrade_fragment | CPAN::Meta::Converter::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | 2 | 20µs | 1 | 7µs | # spent 7µs within CPAN::Meta::BEGIN@1.3 which was called:
# once (7µs+0s) by CPAN::Meta::BEGIN@59 at line 1 # spent 7µs making 1 call to CPAN::Meta::BEGIN@1.3 |
2 | 2 | 10µs | 2 | 6µs | # spent 4µs (3+1) within CPAN::Meta::BEGIN@2.4 which was called:
# once (3µs+1µs) by CPAN::Meta::BEGIN@59 at line 2 # spent 4µs making 1 call to CPAN::Meta::BEGIN@2.4
# spent 1µs making 1 call to strict::import |
3 | 2 | 28µs | 2 | 19µs | # spent 11µs (3+8) within CPAN::Meta::BEGIN@3.5 which was called:
# once (3µs+8µs) by CPAN::Meta::BEGIN@59 at line 3 # spent 11µs making 1 call to CPAN::Meta::BEGIN@3.5
# spent 8µs making 1 call to warnings::import |
4 | package CPAN::Meta::Converter; | ||||
5 | |||||
6 | 1 | 300ns | our $VERSION = '2.150010'; | ||
7 | |||||
8 | #pod =head1 SYNOPSIS | ||||
9 | #pod | ||||
10 | #pod my $struct = decode_json_file('META.json'); | ||||
11 | #pod | ||||
12 | #pod my $cmc = CPAN::Meta::Converter->new( $struct ); | ||||
13 | #pod | ||||
14 | #pod my $new_struct = $cmc->convert( version => "2" ); | ||||
15 | #pod | ||||
16 | #pod =head1 DESCRIPTION | ||||
17 | #pod | ||||
18 | #pod This module converts CPAN Meta structures from one form to another. The | ||||
19 | #pod primary use is to convert older structures to the most modern version of | ||||
20 | #pod the specification, but other transformations may be implemented in the | ||||
21 | #pod future as needed. (E.g. stripping all custom fields or stripping all | ||||
22 | #pod optional fields.) | ||||
23 | #pod | ||||
24 | #pod =cut | ||||
25 | |||||
26 | 2 | 67µs | 2 | 2.40ms | # spent 2.40ms (2.38+20µs) within CPAN::Meta::Converter::BEGIN@26 which was called:
# once (2.38ms+20µs) by CPAN::Meta::BEGIN@59 at line 26 # spent 2.40ms making 1 call to CPAN::Meta::Converter::BEGIN@26
# spent 700ns making 1 call to CPAN::Meta::Converter::__ANON__ |
27 | 2 | 15µs | 2 | 5µs | # spent 5µs (4+200ns) within CPAN::Meta::Converter::BEGIN@27 which was called:
# once (4µs+200ns) by CPAN::Meta::BEGIN@59 at line 27 # spent 5µs making 1 call to CPAN::Meta::Converter::BEGIN@27
# spent 200ns making 1 call to CPAN::Meta::Converter::__ANON__ |
28 | 3 | 62µs | 2 | 628µs | # spent 623µs (564+59) within CPAN::Meta::Converter::BEGIN@28 which was called:
# once (564µs+59µs) by CPAN::Meta::BEGIN@59 at line 28 # spent 623µs making 1 call to CPAN::Meta::Converter::BEGIN@28
# spent 5µs making 1 call to UNIVERSAL::VERSION |
29 | |||||
30 | # To help ExtUtils::MakeMaker bootstrap CPAN::Meta::Requirements on perls | ||||
31 | # before 5.10, we fall back to the EUMM bundled compatibility version module if | ||||
32 | # that's the only thing available. This shouldn't ever happen in a normal CPAN | ||||
33 | # install of CPAN::Meta::Requirements, as version.pm will be picked up from | ||||
34 | # prereqs and be available at runtime. | ||||
35 | |||||
36 | # spent 19µs (16+2) within CPAN::Meta::Converter::BEGIN@36 which was called:
# once (16µs+2µs) by CPAN::Meta::BEGIN@59 at line 41 | ||||
37 | 1 | 12µs | eval "use version ()"; ## no critic # spent 5µs executing statements in string eval # includes 2µs spent executing 1 call to 1 sub defined therein. | ||
38 | 1 | 2µs | if ( my $err = $@ ) { | ||
39 | eval "use ExtUtils::MakeMaker::version" or die $err; ## no critic | ||||
40 | } | ||||
41 | 1 | 1.14ms | 1 | 19µs | } # spent 19µs making 1 call to CPAN::Meta::Converter::BEGIN@36 |
42 | |||||
43 | # Perl 5.10.0 didn't have "is_qv" in version.pm | ||||
44 | 1 | 6µs | 1 | 1µs | *_is_qv = version->can('is_qv') ? sub { $_[0]->is_qv } : sub { exists $_[0]->{qv} }; # spent 1µs making 1 call to UNIVERSAL::can |
45 | |||||
46 | # We limit cloning to a maximum depth to bail out on circular data | ||||
47 | # structures. While actual cycle detection might be technically better, | ||||
48 | # we expect circularity in META data structures to be rare and generally | ||||
49 | # the result of user error. Therefore, a depth counter is lower overhead. | ||||
50 | 1 | 100ns | our $DCLONE_MAXDEPTH = 1024; | ||
51 | our $_CLONE_DEPTH; | ||||
52 | |||||
53 | sub _dclone { | ||||
54 | my ( $ref ) = @_; | ||||
55 | return $ref unless my $reftype = ref $ref; | ||||
56 | |||||
57 | local $_CLONE_DEPTH = defined $_CLONE_DEPTH ? $_CLONE_DEPTH - 1 : $DCLONE_MAXDEPTH; | ||||
58 | die "Depth Limit $DCLONE_MAXDEPTH Exceeded" if $_CLONE_DEPTH == 0; | ||||
59 | |||||
60 | return [ map { _dclone( $_ ) } @{$ref} ] if 'ARRAY' eq $reftype; | ||||
61 | return { map { $_ => _dclone( $ref->{$_} ) } keys %{$ref} } if 'HASH' eq $reftype; | ||||
62 | |||||
63 | if ( 'SCALAR' eq $reftype ) { | ||||
64 | my $new = _dclone(${$ref}); | ||||
65 | return \$new; | ||||
66 | } | ||||
67 | |||||
68 | # We can't know if TO_JSON gives us cloned data, so refs must recurse | ||||
69 | if ( eval { $ref->can('TO_JSON') } ) { | ||||
70 | my $data = $ref->TO_JSON; | ||||
71 | return ref $data ? _dclone( $data ) : $data; | ||||
72 | } | ||||
73 | |||||
74 | # Just stringify everything else | ||||
75 | return "$ref"; | ||||
76 | } | ||||
77 | |||||
78 | 1 | 2µs | my %known_specs = ( | ||
79 | '2' => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', | ||||
80 | '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html', | ||||
81 | '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html', | ||||
82 | '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html', | ||||
83 | '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html', | ||||
84 | '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html' | ||||
85 | ); | ||||
86 | |||||
87 | 1 | 12µs | 1 | 9µs | my @spec_list = sort { $a <=> $b } keys %known_specs; # spent 9µs making 1 call to CPAN::Meta::Converter::CORE:sort |
88 | 1 | 600ns | my ($LOWEST, $HIGHEST) = @spec_list[0,-1]; | ||
89 | |||||
90 | #--------------------------------------------------------------------------# | ||||
91 | # converters | ||||
92 | # | ||||
93 | # called as $converter->($element, $field_name, $full_meta, $to_version) | ||||
94 | # | ||||
95 | # defined return value used for field | ||||
96 | # undef return value means field is skipped | ||||
97 | #--------------------------------------------------------------------------# | ||||
98 | |||||
99 | sub _keep { $_[0] } | ||||
100 | |||||
101 | sub _keep_or_one { defined($_[0]) ? $_[0] : 1 } | ||||
102 | |||||
103 | sub _keep_or_zero { defined($_[0]) ? $_[0] : 0 } | ||||
104 | |||||
105 | sub _keep_or_unknown { defined($_[0]) && length($_[0]) ? $_[0] : "unknown" } | ||||
106 | |||||
107 | sub _generated_by { | ||||
108 | my $gen = shift; | ||||
109 | my $sig = __PACKAGE__ . " version " . (__PACKAGE__->VERSION || "<dev>"); | ||||
110 | |||||
111 | return $sig unless defined $gen and length $gen; | ||||
112 | return $gen if $gen =~ /\Q$sig/; | ||||
113 | return "$gen, $sig"; | ||||
114 | } | ||||
115 | |||||
116 | sub _listify { ! defined $_[0] ? undef : ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]] } | ||||
117 | |||||
118 | sub _prefix_custom { | ||||
119 | my $key = shift; | ||||
120 | $key =~ s/^(?!x_) # Unless it already starts with x_ | ||||
121 | (?:x-?)? # Remove leading x- or x (if present) | ||||
122 | /x_/ix; # and prepend x_ | ||||
123 | return $key; | ||||
124 | } | ||||
125 | |||||
126 | sub _ucfirst_custom { | ||||
127 | my $key = shift; | ||||
128 | $key = ucfirst $key unless $key =~ /[A-Z]/; | ||||
129 | return $key; | ||||
130 | } | ||||
131 | |||||
132 | sub _no_prefix_ucfirst_custom { | ||||
133 | my $key = shift; | ||||
134 | $key =~ s/^x_//; | ||||
135 | return _ucfirst_custom($key); | ||||
136 | } | ||||
137 | |||||
138 | sub _change_meta_spec { | ||||
139 | my ($element, undef, undef, $version) = @_; | ||||
140 | return { | ||||
141 | version => $version, | ||||
142 | url => $known_specs{$version}, | ||||
143 | }; | ||||
144 | } | ||||
145 | |||||
146 | 1 | 700ns | my @open_source = ( | ||
147 | 'perl', | ||||
148 | 'gpl', | ||||
149 | 'apache', | ||||
150 | 'artistic', | ||||
151 | 'artistic_2', | ||||
152 | 'lgpl', | ||||
153 | 'bsd', | ||||
154 | 'gpl', | ||||
155 | 'mit', | ||||
156 | 'mozilla', | ||||
157 | 'open_source', | ||||
158 | ); | ||||
159 | |||||
160 | 1 | 4µs | my %is_open_source = map {; $_ => 1 } @open_source; | ||
161 | |||||
162 | 1 | 600ns | my @valid_licenses_1 = ( | ||
163 | @open_source, | ||||
164 | 'unrestricted', | ||||
165 | 'restrictive', | ||||
166 | 'unknown', | ||||
167 | ); | ||||
168 | |||||
169 | my %license_map_1 = ( | ||||
170 | 1 | 3µs | ( map { $_ => $_ } @valid_licenses_1 ), | ||
171 | artistic2 => 'artistic_2', | ||||
172 | ); | ||||
173 | |||||
174 | sub _license_1 { | ||||
175 | my ($element) = @_; | ||||
176 | return 'unknown' unless defined $element; | ||||
177 | if ( $license_map_1{lc $element} ) { | ||||
178 | return $license_map_1{lc $element}; | ||||
179 | } | ||||
180 | else { | ||||
181 | return 'unknown'; | ||||
182 | } | ||||
183 | } | ||||
184 | |||||
185 | 1 | 1µs | my @valid_licenses_2 = qw( | ||
186 | agpl_3 | ||||
187 | apache_1_1 | ||||
188 | apache_2_0 | ||||
189 | artistic_1 | ||||
190 | artistic_2 | ||||
191 | bsd | ||||
192 | freebsd | ||||
193 | gfdl_1_2 | ||||
194 | gfdl_1_3 | ||||
195 | gpl_1 | ||||
196 | gpl_2 | ||||
197 | gpl_3 | ||||
198 | lgpl_2_1 | ||||
199 | lgpl_3_0 | ||||
200 | mit | ||||
201 | mozilla_1_0 | ||||
202 | mozilla_1_1 | ||||
203 | openssl | ||||
204 | perl_5 | ||||
205 | qpl_1_0 | ||||
206 | ssleay | ||||
207 | sun | ||||
208 | zlib | ||||
209 | open_source | ||||
210 | restricted | ||||
211 | unrestricted | ||||
212 | unknown | ||||
213 | ); | ||||
214 | |||||
215 | # The "old" values were defined by Module::Build, and were often vague. I have | ||||
216 | # made the decisions below based on reading Module::Build::API and how clearly | ||||
217 | # it specifies the version of the license. | ||||
218 | my %license_map_2 = ( | ||||
219 | 1 | 6µs | (map { $_ => $_ } @valid_licenses_2), | ||
220 | apache => 'apache_2_0', # clearly stated as 2.0 | ||||
221 | artistic => 'artistic_1', # clearly stated as 1 | ||||
222 | artistic2 => 'artistic_2', # clearly stated as 2 | ||||
223 | gpl => 'open_source', # we don't know which GPL; punt | ||||
224 | lgpl => 'open_source', # we don't know which LGPL; punt | ||||
225 | mozilla => 'open_source', # we don't know which MPL; punt | ||||
226 | perl => 'perl_5', # clearly Perl 5 | ||||
227 | restrictive => 'restricted', | ||||
228 | ); | ||||
229 | |||||
230 | sub _license_2 { | ||||
231 | my ($element) = @_; | ||||
232 | return [ 'unknown' ] unless defined $element; | ||||
233 | $element = [ $element ] unless ref $element eq 'ARRAY'; | ||||
234 | my @new_list; | ||||
235 | for my $lic ( @$element ) { | ||||
236 | next unless defined $lic; | ||||
237 | if ( my $new = $license_map_2{lc $lic} ) { | ||||
238 | push @new_list, $new; | ||||
239 | } | ||||
240 | } | ||||
241 | return @new_list ? \@new_list : [ 'unknown' ]; | ||||
242 | } | ||||
243 | |||||
244 | 1 | 3µs | my %license_downgrade_map = qw( | ||
245 | agpl_3 open_source | ||||
246 | apache_1_1 apache | ||||
247 | apache_2_0 apache | ||||
248 | artistic_1 artistic | ||||
249 | artistic_2 artistic_2 | ||||
250 | bsd bsd | ||||
251 | freebsd open_source | ||||
252 | gfdl_1_2 open_source | ||||
253 | gfdl_1_3 open_source | ||||
254 | gpl_1 gpl | ||||
255 | gpl_2 gpl | ||||
256 | gpl_3 gpl | ||||
257 | lgpl_2_1 lgpl | ||||
258 | lgpl_3_0 lgpl | ||||
259 | mit mit | ||||
260 | mozilla_1_0 mozilla | ||||
261 | mozilla_1_1 mozilla | ||||
262 | openssl open_source | ||||
263 | perl_5 perl | ||||
264 | qpl_1_0 open_source | ||||
265 | ssleay open_source | ||||
266 | sun open_source | ||||
267 | zlib open_source | ||||
268 | open_source open_source | ||||
269 | restricted restrictive | ||||
270 | unrestricted unrestricted | ||||
271 | unknown unknown | ||||
272 | ); | ||||
273 | |||||
274 | sub _downgrade_license { | ||||
275 | my ($element) = @_; | ||||
276 | if ( ! defined $element ) { | ||||
277 | return "unknown"; | ||||
278 | } | ||||
279 | elsif( ref $element eq 'ARRAY' ) { | ||||
280 | if ( @$element > 1) { | ||||
281 | if (grep { !$is_open_source{ $license_downgrade_map{lc $_} || 'unknown' } } @$element) { | ||||
282 | return 'unknown'; | ||||
283 | } | ||||
284 | else { | ||||
285 | return 'open_source'; | ||||
286 | } | ||||
287 | } | ||||
288 | elsif ( @$element == 1 ) { | ||||
289 | return $license_downgrade_map{lc $element->[0]} || "unknown"; | ||||
290 | } | ||||
291 | } | ||||
292 | elsif ( ! ref $element ) { | ||||
293 | return $license_downgrade_map{lc $element} || "unknown"; | ||||
294 | } | ||||
295 | return "unknown"; | ||||
296 | } | ||||
297 | |||||
298 | 1 | 1µs | my $no_index_spec_1_2 = { | ||
299 | 'file' => \&_listify, | ||||
300 | 'dir' => \&_listify, | ||||
301 | 'package' => \&_listify, | ||||
302 | 'namespace' => \&_listify, | ||||
303 | }; | ||||
304 | |||||
305 | 1 | 600ns | my $no_index_spec_1_3 = { | ||
306 | 'file' => \&_listify, | ||||
307 | 'directory' => \&_listify, | ||||
308 | 'package' => \&_listify, | ||||
309 | 'namespace' => \&_listify, | ||||
310 | }; | ||||
311 | |||||
312 | 1 | 600ns | my $no_index_spec_2 = { | ||
313 | 'file' => \&_listify, | ||||
314 | 'directory' => \&_listify, | ||||
315 | 'package' => \&_listify, | ||||
316 | 'namespace' => \&_listify, | ||||
317 | ':custom' => \&_prefix_custom, | ||||
318 | }; | ||||
319 | |||||
320 | sub _no_index_1_2 { | ||||
321 | my (undef, undef, $meta) = @_; | ||||
322 | my $no_index = $meta->{no_index} || $meta->{private}; | ||||
323 | return unless $no_index; | ||||
324 | |||||
325 | # cleanup wrong format | ||||
326 | if ( ! ref $no_index ) { | ||||
327 | my $item = $no_index; | ||||
328 | $no_index = { dir => [ $item ], file => [ $item ] }; | ||||
329 | } | ||||
330 | elsif ( ref $no_index eq 'ARRAY' ) { | ||||
331 | my $list = $no_index; | ||||
332 | $no_index = { dir => [ @$list ], file => [ @$list ] }; | ||||
333 | } | ||||
334 | |||||
335 | # common mistake: files -> file | ||||
336 | if ( exists $no_index->{files} ) { | ||||
337 | $no_index->{file} = delete $no_index->{files}; | ||||
338 | } | ||||
339 | # common mistake: modules -> module | ||||
340 | if ( exists $no_index->{modules} ) { | ||||
341 | $no_index->{module} = delete $no_index->{modules}; | ||||
342 | } | ||||
343 | return _convert($no_index, $no_index_spec_1_2); | ||||
344 | } | ||||
345 | |||||
346 | sub _no_index_directory { | ||||
347 | my ($element, $key, $meta, $version) = @_; | ||||
348 | return unless $element; | ||||
349 | |||||
350 | # clean up wrong format | ||||
351 | if ( ! ref $element ) { | ||||
352 | my $item = $element; | ||||
353 | $element = { directory => [ $item ], file => [ $item ] }; | ||||
354 | } | ||||
355 | elsif ( ref $element eq 'ARRAY' ) { | ||||
356 | my $list = $element; | ||||
357 | $element = { directory => [ @$list ], file => [ @$list ] }; | ||||
358 | } | ||||
359 | |||||
360 | if ( exists $element->{dir} ) { | ||||
361 | $element->{directory} = delete $element->{dir}; | ||||
362 | } | ||||
363 | # common mistake: files -> file | ||||
364 | if ( exists $element->{files} ) { | ||||
365 | $element->{file} = delete $element->{files}; | ||||
366 | } | ||||
367 | # common mistake: modules -> module | ||||
368 | if ( exists $element->{modules} ) { | ||||
369 | $element->{module} = delete $element->{modules}; | ||||
370 | } | ||||
371 | my $spec = $version == 2 ? $no_index_spec_2 : $no_index_spec_1_3; | ||||
372 | return _convert($element, $spec); | ||||
373 | } | ||||
374 | |||||
375 | sub _is_module_name { | ||||
376 | my $mod = shift; | ||||
377 | return unless defined $mod && length $mod; | ||||
378 | return $mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$}; | ||||
379 | } | ||||
380 | |||||
381 | sub _clean_version { | ||||
382 | my ($element) = @_; | ||||
383 | return 0 if ! defined $element; | ||||
384 | |||||
385 | $element =~ s{^\s*}{}; | ||||
386 | $element =~ s{\s*$}{}; | ||||
387 | $element =~ s{^\.}{0.}; | ||||
388 | |||||
389 | return 0 if ! length $element; | ||||
390 | return 0 if ( $element eq 'undef' || $element eq '<undef>' ); | ||||
391 | |||||
392 | my $v = eval { version->new($element) }; | ||||
393 | # XXX check defined $v and not just $v because version objects leak memory | ||||
394 | # in boolean context -- dagolden, 2012-02-03 | ||||
395 | if ( defined $v ) { | ||||
396 | return _is_qv($v) ? $v->normal : $element; | ||||
397 | } | ||||
398 | else { | ||||
399 | return 0; | ||||
400 | } | ||||
401 | } | ||||
402 | |||||
403 | sub _bad_version_hook { | ||||
404 | my ($v) = @_; | ||||
405 | $v =~ s{^\s*}{}; | ||||
406 | $v =~ s{\s*$}{}; | ||||
407 | $v =~ s{[a-z]+$}{}; # strip trailing alphabetics | ||||
408 | my $vobj = eval { version->new($v) }; | ||||
409 | return defined($vobj) ? $vobj : version->new(0); # or give up | ||||
410 | } | ||||
411 | |||||
412 | sub _version_map { | ||||
413 | my ($element) = @_; | ||||
414 | return unless defined $element; | ||||
415 | if ( ref $element eq 'HASH' ) { | ||||
416 | # XXX turn this into CPAN::Meta::Requirements with bad version hook | ||||
417 | # and then turn it back into a hash | ||||
418 | my $new_map = CPAN::Meta::Requirements->new( | ||||
419 | { bad_version_hook => \&_bad_version_hook } # punt | ||||
420 | ); | ||||
421 | while ( my ($k,$v) = each %$element ) { | ||||
422 | next unless _is_module_name($k); | ||||
423 | if ( !defined($v) || !length($v) || $v eq 'undef' || $v eq '<undef>' ) { | ||||
424 | $v = 0; | ||||
425 | } | ||||
426 | # some weird, old META have bad yml with module => module | ||||
427 | # so check if value is like a module name and not like a version | ||||
428 | if ( _is_module_name($v) && ! version::is_lax($v) ) { | ||||
429 | $new_map->add_minimum($k => 0); | ||||
430 | $new_map->add_minimum($v => 0); | ||||
431 | } | ||||
432 | $new_map->add_string_requirement($k => $v); | ||||
433 | } | ||||
434 | return $new_map->as_string_hash; | ||||
435 | } | ||||
436 | elsif ( ref $element eq 'ARRAY' ) { | ||||
437 | my $hashref = { map { $_ => 0 } @$element }; | ||||
438 | return _version_map($hashref); # clean up any weird stuff | ||||
439 | } | ||||
440 | elsif ( ref $element eq '' && length $element ) { | ||||
441 | return { $element => 0 } | ||||
442 | } | ||||
443 | return; | ||||
444 | } | ||||
445 | |||||
446 | sub _prereqs_from_1 { | ||||
447 | my (undef, undef, $meta) = @_; | ||||
448 | my $prereqs = {}; | ||||
449 | for my $phase ( qw/build configure/ ) { | ||||
450 | my $key = "${phase}_requires"; | ||||
451 | $prereqs->{$phase}{requires} = _version_map($meta->{$key}) | ||||
452 | if $meta->{$key}; | ||||
453 | } | ||||
454 | for my $rel ( qw/requires recommends conflicts/ ) { | ||||
455 | $prereqs->{runtime}{$rel} = _version_map($meta->{$rel}) | ||||
456 | if $meta->{$rel}; | ||||
457 | } | ||||
458 | return $prereqs; | ||||
459 | } | ||||
460 | |||||
461 | 1 | 800ns | my $prereqs_spec = { | ||
462 | configure => \&_prereqs_rel, | ||||
463 | build => \&_prereqs_rel, | ||||
464 | test => \&_prereqs_rel, | ||||
465 | runtime => \&_prereqs_rel, | ||||
466 | develop => \&_prereqs_rel, | ||||
467 | ':custom' => \&_prefix_custom, | ||||
468 | }; | ||||
469 | |||||
470 | 1 | 800ns | my $relation_spec = { | ||
471 | requires => \&_version_map, | ||||
472 | recommends => \&_version_map, | ||||
473 | suggests => \&_version_map, | ||||
474 | conflicts => \&_version_map, | ||||
475 | ':custom' => \&_prefix_custom, | ||||
476 | }; | ||||
477 | |||||
478 | sub _cleanup_prereqs { | ||||
479 | my ($prereqs, $key, $meta, $to_version) = @_; | ||||
480 | return unless $prereqs && ref $prereqs eq 'HASH'; | ||||
481 | return _convert( $prereqs, $prereqs_spec, $to_version ); | ||||
482 | } | ||||
483 | |||||
484 | sub _prereqs_rel { | ||||
485 | my ($relation, $key, $meta, $to_version) = @_; | ||||
486 | return unless $relation && ref $relation eq 'HASH'; | ||||
487 | return _convert( $relation, $relation_spec, $to_version ); | ||||
488 | } | ||||
489 | |||||
490 | |||||
491 | # spent 31µs (25+6) within CPAN::Meta::Converter::BEGIN@491 which was called:
# once (25µs+6µs) by CPAN::Meta::BEGIN@59 at line 509 | ||||
492 | 1 | 700ns | my @old_prereqs = qw( | ||
493 | requires | ||||
494 | configure_requires | ||||
495 | recommends | ||||
496 | conflicts | ||||
497 | ); | ||||
498 | |||||
499 | 1 | 2µs | for ( @old_prereqs ) { | ||
500 | 4 | 800ns | my $sub = "_get_$_"; | ||
501 | 4 | 18µs | 8 | 6µs | my ($phase,$type) = split qr/_/, $_; # spent 4µs making 4 calls to CPAN::Meta::Converter::CORE:regcomp, avg 1µs/call
# spent 2µs making 4 calls to CPAN::Meta::Converter::CORE:qr, avg 400ns/call |
502 | 4 | 600ns | if ( ! defined $type ) { | ||
503 | 3 | 400ns | $type = $phase; | ||
504 | 3 | 400ns | $phase = 'runtime'; | ||
505 | } | ||||
506 | 2 | 39µs | 2 | 16µs | # spent 10µs (4+6) within CPAN::Meta::Converter::BEGIN@506 which was called:
# once (4µs+6µs) by CPAN::Meta::BEGIN@59 at line 506 # spent 10µs making 1 call to CPAN::Meta::Converter::BEGIN@506
# spent 6µs making 1 call to strict::unimport |
507 | 4 | 8µs | *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) }; | ||
508 | } | ||||
509 | 1 | 2.42ms | 1 | 31µs | } # spent 31µs making 1 call to CPAN::Meta::Converter::BEGIN@491 |
510 | |||||
511 | sub _get_build_requires { | ||||
512 | my ($data, $key, $meta) = @_; | ||||
513 | |||||
514 | my $test_h = _extract_prereqs($_[2]->{prereqs}, qw(test requires)) || {}; | ||||
515 | my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {}; | ||||
516 | |||||
517 | my $test_req = CPAN::Meta::Requirements->from_string_hash($test_h); | ||||
518 | my $build_req = CPAN::Meta::Requirements->from_string_hash($build_h); | ||||
519 | |||||
520 | $test_req->add_requirements($build_req)->as_string_hash; | ||||
521 | } | ||||
522 | |||||
523 | sub _extract_prereqs { | ||||
524 | my ($prereqs, $phase, $type) = @_; | ||||
525 | return unless ref $prereqs eq 'HASH'; | ||||
526 | return scalar _version_map($prereqs->{$phase}{$type}); | ||||
527 | } | ||||
528 | |||||
529 | sub _downgrade_optional_features { | ||||
530 | my (undef, undef, $meta) = @_; | ||||
531 | return unless exists $meta->{optional_features}; | ||||
532 | my $origin = $meta->{optional_features}; | ||||
533 | my $features = {}; | ||||
534 | for my $name ( keys %$origin ) { | ||||
535 | $features->{$name} = { | ||||
536 | description => $origin->{$name}{description}, | ||||
537 | requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','requires'), | ||||
538 | configure_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'), | ||||
539 | build_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'), | ||||
540 | recommends => _extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'), | ||||
541 | conflicts => _extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'), | ||||
542 | }; | ||||
543 | for my $k (keys %{$features->{$name}} ) { | ||||
544 | delete $features->{$name}{$k} unless defined $features->{$name}{$k}; | ||||
545 | } | ||||
546 | } | ||||
547 | return $features; | ||||
548 | } | ||||
549 | |||||
550 | sub _upgrade_optional_features { | ||||
551 | my (undef, undef, $meta) = @_; | ||||
552 | return unless exists $meta->{optional_features}; | ||||
553 | my $origin = $meta->{optional_features}; | ||||
554 | my $features = {}; | ||||
555 | for my $name ( keys %$origin ) { | ||||
556 | $features->{$name} = { | ||||
557 | description => $origin->{$name}{description}, | ||||
558 | prereqs => _prereqs_from_1(undef, undef, $origin->{$name}), | ||||
559 | }; | ||||
560 | delete $features->{$name}{prereqs}{configure}; | ||||
561 | } | ||||
562 | return $features; | ||||
563 | } | ||||
564 | |||||
565 | 1 | 600ns | my $optional_features_2_spec = { | ||
566 | description => \&_keep, | ||||
567 | prereqs => \&_cleanup_prereqs, | ||||
568 | ':custom' => \&_prefix_custom, | ||||
569 | }; | ||||
570 | |||||
571 | sub _feature_2 { | ||||
572 | my ($element, $key, $meta, $to_version) = @_; | ||||
573 | return unless $element && ref $element eq 'HASH'; | ||||
574 | _convert( $element, $optional_features_2_spec, $to_version ); | ||||
575 | } | ||||
576 | |||||
577 | sub _cleanup_optional_features_2 { | ||||
578 | my ($element, $key, $meta, $to_version) = @_; | ||||
579 | return unless $element && ref $element eq 'HASH'; | ||||
580 | my $new_data = {}; | ||||
581 | for my $k ( keys %$element ) { | ||||
582 | $new_data->{$k} = _feature_2( $element->{$k}, $k, $meta, $to_version ); | ||||
583 | } | ||||
584 | return unless keys %$new_data; | ||||
585 | return $new_data; | ||||
586 | } | ||||
587 | |||||
588 | sub _optional_features_1_4 { | ||||
589 | my ($element) = @_; | ||||
590 | return unless $element; | ||||
591 | $element = _optional_features_as_map($element); | ||||
592 | for my $name ( keys %$element ) { | ||||
593 | for my $drop ( qw/requires_packages requires_os excluded_os/ ) { | ||||
594 | delete $element->{$name}{$drop}; | ||||
595 | } | ||||
596 | } | ||||
597 | return $element; | ||||
598 | } | ||||
599 | |||||
600 | sub _optional_features_as_map { | ||||
601 | my ($element) = @_; | ||||
602 | return unless $element; | ||||
603 | if ( ref $element eq 'ARRAY' ) { | ||||
604 | my %map; | ||||
605 | for my $feature ( @$element ) { | ||||
606 | my (@parts) = %$feature; | ||||
607 | $map{$parts[0]} = $parts[1]; | ||||
608 | } | ||||
609 | $element = \%map; | ||||
610 | } | ||||
611 | return $element; | ||||
612 | } | ||||
613 | |||||
614 | sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i } | ||||
615 | |||||
616 | sub _url_or_drop { | ||||
617 | my ($element) = @_; | ||||
618 | return $element if _is_urlish($element); | ||||
619 | return; | ||||
620 | } | ||||
621 | |||||
622 | sub _url_list { | ||||
623 | my ($element) = @_; | ||||
624 | return unless $element; | ||||
625 | $element = _listify( $element ); | ||||
626 | $element = [ grep { _is_urlish($_) } @$element ]; | ||||
627 | return unless @$element; | ||||
628 | return $element; | ||||
629 | } | ||||
630 | |||||
631 | sub _author_list { | ||||
632 | my ($element) = @_; | ||||
633 | return [ 'unknown' ] unless $element; | ||||
634 | $element = _listify( $element ); | ||||
635 | $element = [ map { defined $_ && length $_ ? $_ : 'unknown' } @$element ]; | ||||
636 | return [ 'unknown' ] unless @$element; | ||||
637 | return $element; | ||||
638 | } | ||||
639 | |||||
640 | my $resource2_upgrade = { | ||||
641 | license => sub { return _is_urlish($_[0]) ? _listify( $_[0] ) : undef }, | ||||
642 | homepage => \&_url_or_drop, | ||||
643 | bugtracker => sub { | ||||
644 | my ($item) = @_; | ||||
645 | return unless $item; | ||||
646 | if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } } | ||||
647 | elsif( _is_urlish($item) ) { return { web => $item } } | ||||
648 | else { return } | ||||
649 | }, | ||||
650 | repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef }, | ||||
651 | 1 | 2µs | ':custom' => \&_prefix_custom, | ||
652 | }; | ||||
653 | |||||
654 | sub _upgrade_resources_2 { | ||||
655 | my (undef, undef, $meta, $version) = @_; | ||||
656 | return unless exists $meta->{resources}; | ||||
657 | return _convert($meta->{resources}, $resource2_upgrade); | ||||
658 | } | ||||
659 | |||||
660 | 1 | 500ns | my $bugtracker2_spec = { | ||
661 | web => \&_url_or_drop, | ||||
662 | mailto => \&_keep, | ||||
663 | ':custom' => \&_prefix_custom, | ||||
664 | }; | ||||
665 | |||||
666 | sub _repo_type { | ||||
667 | my ($element, $key, $meta, $to_version) = @_; | ||||
668 | return $element if defined $element; | ||||
669 | return unless exists $meta->{url}; | ||||
670 | my $repo_url = $meta->{url}; | ||||
671 | for my $type ( qw/git svn/ ) { | ||||
672 | return $type if $repo_url =~ m{\A$type}; | ||||
673 | } | ||||
674 | return; | ||||
675 | } | ||||
676 | |||||
677 | 1 | 600ns | my $repository2_spec = { | ||
678 | web => \&_url_or_drop, | ||||
679 | url => \&_url_or_drop, | ||||
680 | type => \&_repo_type, | ||||
681 | ':custom' => \&_prefix_custom, | ||||
682 | }; | ||||
683 | |||||
684 | my $resources2_cleanup = { | ||||
685 | license => \&_url_list, | ||||
686 | homepage => \&_url_or_drop, | ||||
687 | bugtracker => sub { ref $_[0] ? _convert( $_[0], $bugtracker2_spec ) : undef }, | ||||
688 | repository => sub { my $data = shift; ref $data ? _convert( $data, $repository2_spec ) : undef }, | ||||
689 | 1 | 2µs | ':custom' => \&_prefix_custom, | ||
690 | }; | ||||
691 | |||||
692 | sub _cleanup_resources_2 { | ||||
693 | my ($resources, $key, $meta, $to_version) = @_; | ||||
694 | return unless $resources && ref $resources eq 'HASH'; | ||||
695 | return _convert($resources, $resources2_cleanup, $to_version); | ||||
696 | } | ||||
697 | |||||
698 | 1 | 600ns | my $resource1_spec = { | ||
699 | license => \&_url_or_drop, | ||||
700 | homepage => \&_url_or_drop, | ||||
701 | bugtracker => \&_url_or_drop, | ||||
702 | repository => \&_url_or_drop, | ||||
703 | ':custom' => \&_keep, | ||||
704 | }; | ||||
705 | |||||
706 | sub _resources_1_3 { | ||||
707 | my (undef, undef, $meta, $version) = @_; | ||||
708 | return unless exists $meta->{resources}; | ||||
709 | return _convert($meta->{resources}, $resource1_spec); | ||||
710 | } | ||||
711 | |||||
712 | 1 | 900ns | *_resources_1_4 = *_resources_1_3; | ||
713 | |||||
714 | sub _resources_1_2 { | ||||
715 | my (undef, undef, $meta) = @_; | ||||
716 | my $resources = $meta->{resources} || {}; | ||||
717 | if ( $meta->{license_url} && ! $resources->{license} ) { | ||||
718 | $resources->{license} = $meta->{license_url} | ||||
719 | if _is_urlish($meta->{license_url}); | ||||
720 | } | ||||
721 | return unless keys %$resources; | ||||
722 | return _convert($resources, $resource1_spec); | ||||
723 | } | ||||
724 | |||||
725 | my $resource_downgrade_spec = { | ||||
726 | license => sub { return ref $_[0] ? $_[0]->[0] : $_[0] }, | ||||
727 | homepage => \&_url_or_drop, | ||||
728 | bugtracker => sub { return $_[0]->{web} }, | ||||
729 | repository => sub { return $_[0]->{url} || $_[0]->{web} }, | ||||
730 | 1 | 2µs | ':custom' => \&_no_prefix_ucfirst_custom, | ||
731 | }; | ||||
732 | |||||
733 | sub _downgrade_resources { | ||||
734 | my (undef, undef, $meta, $version) = @_; | ||||
735 | return unless exists $meta->{resources}; | ||||
736 | return _convert($meta->{resources}, $resource_downgrade_spec); | ||||
737 | } | ||||
738 | |||||
739 | sub _release_status { | ||||
740 | my ($element, undef, $meta) = @_; | ||||
741 | return $element if $element && $element =~ m{\A(?:stable|testing|unstable)\z}; | ||||
742 | return _release_status_from_version(undef, undef, $meta); | ||||
743 | } | ||||
744 | |||||
745 | sub _release_status_from_version { | ||||
746 | my (undef, undef, $meta) = @_; | ||||
747 | my $version = $meta->{version} || ''; | ||||
748 | return ( $version =~ /_/ ) ? 'testing' : 'stable'; | ||||
749 | } | ||||
750 | |||||
751 | 1 | 400ns | my $provides_spec = { | ||
752 | file => \&_keep, | ||||
753 | version => \&_keep, | ||||
754 | }; | ||||
755 | |||||
756 | 1 | 500ns | my $provides_spec_2 = { | ||
757 | file => \&_keep, | ||||
758 | version => \&_keep, | ||||
759 | ':custom' => \&_prefix_custom, | ||||
760 | }; | ||||
761 | |||||
762 | sub _provides { | ||||
763 | my ($element, $key, $meta, $to_version) = @_; | ||||
764 | return unless defined $element && ref $element eq 'HASH'; | ||||
765 | my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec; | ||||
766 | my $new_data = {}; | ||||
767 | for my $k ( keys %$element ) { | ||||
768 | $new_data->{$k} = _convert($element->{$k}, $spec, $to_version); | ||||
769 | $new_data->{$k}{version} = _clean_version($element->{$k}{version}) | ||||
770 | if exists $element->{$k}{version}; | ||||
771 | } | ||||
772 | return $new_data; | ||||
773 | } | ||||
774 | |||||
775 | sub _convert { | ||||
776 | my ($data, $spec, $to_version, $is_fragment) = @_; | ||||
777 | |||||
778 | my $new_data = {}; | ||||
779 | for my $key ( keys %$spec ) { | ||||
780 | next if $key eq ':custom' || $key eq ':drop'; | ||||
781 | next unless my $fcn = $spec->{$key}; | ||||
782 | if ( $is_fragment && $key eq 'generated_by' ) { | ||||
783 | $fcn = \&_keep; | ||||
784 | } | ||||
785 | die "spec for '$key' is not a coderef" | ||||
786 | unless ref $fcn && ref $fcn eq 'CODE'; | ||||
787 | my $new_value = $fcn->($data->{$key}, $key, $data, $to_version); | ||||
788 | $new_data->{$key} = $new_value if defined $new_value; | ||||
789 | } | ||||
790 | |||||
791 | my $drop_list = $spec->{':drop'}; | ||||
792 | my $customizer = $spec->{':custom'} || \&_keep; | ||||
793 | |||||
794 | for my $key ( keys %$data ) { | ||||
795 | next if $drop_list && grep { $key eq $_ } @$drop_list; | ||||
796 | next if exists $spec->{$key}; # we handled it | ||||
797 | $new_data->{ $customizer->($key) } = $data->{$key}; | ||||
798 | } | ||||
799 | |||||
800 | return $new_data; | ||||
801 | } | ||||
802 | |||||
803 | #--------------------------------------------------------------------------# | ||||
804 | # define converters for each conversion | ||||
805 | #--------------------------------------------------------------------------# | ||||
806 | |||||
807 | # each converts from prior version | ||||
808 | # special ":custom" field is used for keys not recognized in spec | ||||
809 | 1 | 14µs | my %up_convert = ( | ||
810 | '2-from-1.4' => { | ||||
811 | # PRIOR MANDATORY | ||||
812 | 'abstract' => \&_keep_or_unknown, | ||||
813 | 'author' => \&_author_list, | ||||
814 | 'generated_by' => \&_generated_by, | ||||
815 | 'license' => \&_license_2, | ||||
816 | 'meta-spec' => \&_change_meta_spec, | ||||
817 | 'name' => \&_keep, | ||||
818 | 'version' => \&_keep, | ||||
819 | # CHANGED TO MANDATORY | ||||
820 | 'dynamic_config' => \&_keep_or_one, | ||||
821 | # ADDED MANDATORY | ||||
822 | 'release_status' => \&_release_status, | ||||
823 | # PRIOR OPTIONAL | ||||
824 | 'keywords' => \&_keep, | ||||
825 | 'no_index' => \&_no_index_directory, | ||||
826 | 'optional_features' => \&_upgrade_optional_features, | ||||
827 | 'provides' => \&_provides, | ||||
828 | 'resources' => \&_upgrade_resources_2, | ||||
829 | # ADDED OPTIONAL | ||||
830 | 'description' => \&_keep, | ||||
831 | 'prereqs' => \&_prereqs_from_1, | ||||
832 | |||||
833 | # drop these deprecated fields, but only after we convert | ||||
834 | ':drop' => [ qw( | ||||
835 | build_requires | ||||
836 | configure_requires | ||||
837 | conflicts | ||||
838 | distribution_type | ||||
839 | license_url | ||||
840 | private | ||||
841 | recommends | ||||
842 | requires | ||||
843 | ) ], | ||||
844 | |||||
845 | # other random keys need x_ prefixing | ||||
846 | ':custom' => \&_prefix_custom, | ||||
847 | }, | ||||
848 | '1.4-from-1.3' => { | ||||
849 | # PRIOR MANDATORY | ||||
850 | 'abstract' => \&_keep_or_unknown, | ||||
851 | 'author' => \&_author_list, | ||||
852 | 'generated_by' => \&_generated_by, | ||||
853 | 'license' => \&_license_1, | ||||
854 | 'meta-spec' => \&_change_meta_spec, | ||||
855 | 'name' => \&_keep, | ||||
856 | 'version' => \&_keep, | ||||
857 | # PRIOR OPTIONAL | ||||
858 | 'build_requires' => \&_version_map, | ||||
859 | 'conflicts' => \&_version_map, | ||||
860 | 'distribution_type' => \&_keep, | ||||
861 | 'dynamic_config' => \&_keep_or_one, | ||||
862 | 'keywords' => \&_keep, | ||||
863 | 'no_index' => \&_no_index_directory, | ||||
864 | 'optional_features' => \&_optional_features_1_4, | ||||
865 | 'provides' => \&_provides, | ||||
866 | 'recommends' => \&_version_map, | ||||
867 | 'requires' => \&_version_map, | ||||
868 | 'resources' => \&_resources_1_4, | ||||
869 | # ADDED OPTIONAL | ||||
870 | 'configure_requires' => \&_keep, | ||||
871 | |||||
872 | # drop these deprecated fields, but only after we convert | ||||
873 | ':drop' => [ qw( | ||||
874 | license_url | ||||
875 | private | ||||
876 | )], | ||||
877 | |||||
878 | # other random keys are OK if already valid | ||||
879 | ':custom' => \&_keep | ||||
880 | }, | ||||
881 | '1.3-from-1.2' => { | ||||
882 | # PRIOR MANDATORY | ||||
883 | 'abstract' => \&_keep_or_unknown, | ||||
884 | 'author' => \&_author_list, | ||||
885 | 'generated_by' => \&_generated_by, | ||||
886 | 'license' => \&_license_1, | ||||
887 | 'meta-spec' => \&_change_meta_spec, | ||||
888 | 'name' => \&_keep, | ||||
889 | 'version' => \&_keep, | ||||
890 | # PRIOR OPTIONAL | ||||
891 | 'build_requires' => \&_version_map, | ||||
892 | 'conflicts' => \&_version_map, | ||||
893 | 'distribution_type' => \&_keep, | ||||
894 | 'dynamic_config' => \&_keep_or_one, | ||||
895 | 'keywords' => \&_keep, | ||||
896 | 'no_index' => \&_no_index_directory, | ||||
897 | 'optional_features' => \&_optional_features_as_map, | ||||
898 | 'provides' => \&_provides, | ||||
899 | 'recommends' => \&_version_map, | ||||
900 | 'requires' => \&_version_map, | ||||
901 | 'resources' => \&_resources_1_3, | ||||
902 | |||||
903 | # drop these deprecated fields, but only after we convert | ||||
904 | ':drop' => [ qw( | ||||
905 | license_url | ||||
906 | private | ||||
907 | )], | ||||
908 | |||||
909 | # other random keys are OK if already valid | ||||
910 | ':custom' => \&_keep | ||||
911 | }, | ||||
912 | '1.2-from-1.1' => { | ||||
913 | # PRIOR MANDATORY | ||||
914 | 'version' => \&_keep, | ||||
915 | # CHANGED TO MANDATORY | ||||
916 | 'license' => \&_license_1, | ||||
917 | 'name' => \&_keep, | ||||
918 | 'generated_by' => \&_generated_by, | ||||
919 | # ADDED MANDATORY | ||||
920 | 'abstract' => \&_keep_or_unknown, | ||||
921 | 'author' => \&_author_list, | ||||
922 | 'meta-spec' => \&_change_meta_spec, | ||||
923 | # PRIOR OPTIONAL | ||||
924 | 'build_requires' => \&_version_map, | ||||
925 | 'conflicts' => \&_version_map, | ||||
926 | 'distribution_type' => \&_keep, | ||||
927 | 'dynamic_config' => \&_keep_or_one, | ||||
928 | 'recommends' => \&_version_map, | ||||
929 | 'requires' => \&_version_map, | ||||
930 | # ADDED OPTIONAL | ||||
931 | 'keywords' => \&_keep, | ||||
932 | 'no_index' => \&_no_index_1_2, | ||||
933 | 'optional_features' => \&_optional_features_as_map, | ||||
934 | 'provides' => \&_provides, | ||||
935 | 'resources' => \&_resources_1_2, | ||||
936 | |||||
937 | # drop these deprecated fields, but only after we convert | ||||
938 | ':drop' => [ qw( | ||||
939 | license_url | ||||
940 | private | ||||
941 | )], | ||||
942 | |||||
943 | # other random keys are OK if already valid | ||||
944 | ':custom' => \&_keep | ||||
945 | }, | ||||
946 | '1.1-from-1.0' => { | ||||
947 | # CHANGED TO MANDATORY | ||||
948 | 'version' => \&_keep, | ||||
949 | # IMPLIED MANDATORY | ||||
950 | 'name' => \&_keep, | ||||
951 | # PRIOR OPTIONAL | ||||
952 | 'build_requires' => \&_version_map, | ||||
953 | 'conflicts' => \&_version_map, | ||||
954 | 'distribution_type' => \&_keep, | ||||
955 | 'dynamic_config' => \&_keep_or_one, | ||||
956 | 'generated_by' => \&_generated_by, | ||||
957 | 'license' => \&_license_1, | ||||
958 | 'recommends' => \&_version_map, | ||||
959 | 'requires' => \&_version_map, | ||||
960 | # ADDED OPTIONAL | ||||
961 | 'license_url' => \&_url_or_drop, | ||||
962 | 'private' => \&_keep, | ||||
963 | |||||
964 | # other random keys are OK if already valid | ||||
965 | ':custom' => \&_keep | ||||
966 | }, | ||||
967 | ); | ||||
968 | |||||
969 | 1 | 11µs | my %down_convert = ( | ||
970 | '1.4-from-2' => { | ||||
971 | # MANDATORY | ||||
972 | 'abstract' => \&_keep_or_unknown, | ||||
973 | 'author' => \&_author_list, | ||||
974 | 'generated_by' => \&_generated_by, | ||||
975 | 'license' => \&_downgrade_license, | ||||
976 | 'meta-spec' => \&_change_meta_spec, | ||||
977 | 'name' => \&_keep, | ||||
978 | 'version' => \&_keep, | ||||
979 | # OPTIONAL | ||||
980 | 'build_requires' => \&_get_build_requires, | ||||
981 | 'configure_requires' => \&_get_configure_requires, | ||||
982 | 'conflicts' => \&_get_conflicts, | ||||
983 | 'distribution_type' => \&_keep, | ||||
984 | 'dynamic_config' => \&_keep_or_one, | ||||
985 | 'keywords' => \&_keep, | ||||
986 | 'no_index' => \&_no_index_directory, | ||||
987 | 'optional_features' => \&_downgrade_optional_features, | ||||
988 | 'provides' => \&_provides, | ||||
989 | 'recommends' => \&_get_recommends, | ||||
990 | 'requires' => \&_get_requires, | ||||
991 | 'resources' => \&_downgrade_resources, | ||||
992 | |||||
993 | # drop these unsupported fields (after conversion) | ||||
994 | ':drop' => [ qw( | ||||
995 | description | ||||
996 | prereqs | ||||
997 | release_status | ||||
998 | )], | ||||
999 | |||||
1000 | # custom keys will be left unchanged | ||||
1001 | ':custom' => \&_keep | ||||
1002 | }, | ||||
1003 | '1.3-from-1.4' => { | ||||
1004 | # MANDATORY | ||||
1005 | 'abstract' => \&_keep_or_unknown, | ||||
1006 | 'author' => \&_author_list, | ||||
1007 | 'generated_by' => \&_generated_by, | ||||
1008 | 'license' => \&_license_1, | ||||
1009 | 'meta-spec' => \&_change_meta_spec, | ||||
1010 | 'name' => \&_keep, | ||||
1011 | 'version' => \&_keep, | ||||
1012 | # OPTIONAL | ||||
1013 | 'build_requires' => \&_version_map, | ||||
1014 | 'conflicts' => \&_version_map, | ||||
1015 | 'distribution_type' => \&_keep, | ||||
1016 | 'dynamic_config' => \&_keep_or_one, | ||||
1017 | 'keywords' => \&_keep, | ||||
1018 | 'no_index' => \&_no_index_directory, | ||||
1019 | 'optional_features' => \&_optional_features_as_map, | ||||
1020 | 'provides' => \&_provides, | ||||
1021 | 'recommends' => \&_version_map, | ||||
1022 | 'requires' => \&_version_map, | ||||
1023 | 'resources' => \&_resources_1_3, | ||||
1024 | |||||
1025 | # drop these unsupported fields, but only after we convert | ||||
1026 | ':drop' => [ qw( | ||||
1027 | configure_requires | ||||
1028 | )], | ||||
1029 | |||||
1030 | # other random keys are OK if already valid | ||||
1031 | ':custom' => \&_keep, | ||||
1032 | }, | ||||
1033 | '1.2-from-1.3' => { | ||||
1034 | # MANDATORY | ||||
1035 | 'abstract' => \&_keep_or_unknown, | ||||
1036 | 'author' => \&_author_list, | ||||
1037 | 'generated_by' => \&_generated_by, | ||||
1038 | 'license' => \&_license_1, | ||||
1039 | 'meta-spec' => \&_change_meta_spec, | ||||
1040 | 'name' => \&_keep, | ||||
1041 | 'version' => \&_keep, | ||||
1042 | # OPTIONAL | ||||
1043 | 'build_requires' => \&_version_map, | ||||
1044 | 'conflicts' => \&_version_map, | ||||
1045 | 'distribution_type' => \&_keep, | ||||
1046 | 'dynamic_config' => \&_keep_or_one, | ||||
1047 | 'keywords' => \&_keep, | ||||
1048 | 'no_index' => \&_no_index_1_2, | ||||
1049 | 'optional_features' => \&_optional_features_as_map, | ||||
1050 | 'provides' => \&_provides, | ||||
1051 | 'recommends' => \&_version_map, | ||||
1052 | 'requires' => \&_version_map, | ||||
1053 | 'resources' => \&_resources_1_3, | ||||
1054 | |||||
1055 | # other random keys are OK if already valid | ||||
1056 | ':custom' => \&_keep, | ||||
1057 | }, | ||||
1058 | '1.1-from-1.2' => { | ||||
1059 | # MANDATORY | ||||
1060 | 'version' => \&_keep, | ||||
1061 | # IMPLIED MANDATORY | ||||
1062 | 'name' => \&_keep, | ||||
1063 | 'meta-spec' => \&_change_meta_spec, | ||||
1064 | # OPTIONAL | ||||
1065 | 'build_requires' => \&_version_map, | ||||
1066 | 'conflicts' => \&_version_map, | ||||
1067 | 'distribution_type' => \&_keep, | ||||
1068 | 'dynamic_config' => \&_keep_or_one, | ||||
1069 | 'generated_by' => \&_generated_by, | ||||
1070 | 'license' => \&_license_1, | ||||
1071 | 'private' => \&_keep, | ||||
1072 | 'recommends' => \&_version_map, | ||||
1073 | 'requires' => \&_version_map, | ||||
1074 | |||||
1075 | # drop unsupported fields | ||||
1076 | ':drop' => [ qw( | ||||
1077 | abstract | ||||
1078 | author | ||||
1079 | provides | ||||
1080 | no_index | ||||
1081 | keywords | ||||
1082 | resources | ||||
1083 | )], | ||||
1084 | |||||
1085 | # other random keys are OK if already valid | ||||
1086 | ':custom' => \&_keep, | ||||
1087 | }, | ||||
1088 | '1.0-from-1.1' => { | ||||
1089 | # IMPLIED MANDATORY | ||||
1090 | 'name' => \&_keep, | ||||
1091 | 'meta-spec' => \&_change_meta_spec, | ||||
1092 | 'version' => \&_keep, | ||||
1093 | # PRIOR OPTIONAL | ||||
1094 | 'build_requires' => \&_version_map, | ||||
1095 | 'conflicts' => \&_version_map, | ||||
1096 | 'distribution_type' => \&_keep, | ||||
1097 | 'dynamic_config' => \&_keep_or_one, | ||||
1098 | 'generated_by' => \&_generated_by, | ||||
1099 | 'license' => \&_license_1, | ||||
1100 | 'recommends' => \&_version_map, | ||||
1101 | 'requires' => \&_version_map, | ||||
1102 | |||||
1103 | # other random keys are OK if already valid | ||||
1104 | ':custom' => \&_keep, | ||||
1105 | }, | ||||
1106 | ); | ||||
1107 | |||||
1108 | 1 | 13µs | my %cleanup = ( | ||
1109 | '2' => { | ||||
1110 | # PRIOR MANDATORY | ||||
1111 | 'abstract' => \&_keep_or_unknown, | ||||
1112 | 'author' => \&_author_list, | ||||
1113 | 'generated_by' => \&_generated_by, | ||||
1114 | 'license' => \&_license_2, | ||||
1115 | 'meta-spec' => \&_change_meta_spec, | ||||
1116 | 'name' => \&_keep, | ||||
1117 | 'version' => \&_keep, | ||||
1118 | # CHANGED TO MANDATORY | ||||
1119 | 'dynamic_config' => \&_keep_or_one, | ||||
1120 | # ADDED MANDATORY | ||||
1121 | 'release_status' => \&_release_status, | ||||
1122 | # PRIOR OPTIONAL | ||||
1123 | 'keywords' => \&_keep, | ||||
1124 | 'no_index' => \&_no_index_directory, | ||||
1125 | 'optional_features' => \&_cleanup_optional_features_2, | ||||
1126 | 'provides' => \&_provides, | ||||
1127 | 'resources' => \&_cleanup_resources_2, | ||||
1128 | # ADDED OPTIONAL | ||||
1129 | 'description' => \&_keep, | ||||
1130 | 'prereqs' => \&_cleanup_prereqs, | ||||
1131 | |||||
1132 | # drop these deprecated fields, but only after we convert | ||||
1133 | ':drop' => [ qw( | ||||
1134 | build_requires | ||||
1135 | configure_requires | ||||
1136 | conflicts | ||||
1137 | distribution_type | ||||
1138 | license_url | ||||
1139 | private | ||||
1140 | recommends | ||||
1141 | requires | ||||
1142 | ) ], | ||||
1143 | |||||
1144 | # other random keys need x_ prefixing | ||||
1145 | ':custom' => \&_prefix_custom, | ||||
1146 | }, | ||||
1147 | '1.4' => { | ||||
1148 | # PRIOR MANDATORY | ||||
1149 | 'abstract' => \&_keep_or_unknown, | ||||
1150 | 'author' => \&_author_list, | ||||
1151 | 'generated_by' => \&_generated_by, | ||||
1152 | 'license' => \&_license_1, | ||||
1153 | 'meta-spec' => \&_change_meta_spec, | ||||
1154 | 'name' => \&_keep, | ||||
1155 | 'version' => \&_keep, | ||||
1156 | # PRIOR OPTIONAL | ||||
1157 | 'build_requires' => \&_version_map, | ||||
1158 | 'conflicts' => \&_version_map, | ||||
1159 | 'distribution_type' => \&_keep, | ||||
1160 | 'dynamic_config' => \&_keep_or_one, | ||||
1161 | 'keywords' => \&_keep, | ||||
1162 | 'no_index' => \&_no_index_directory, | ||||
1163 | 'optional_features' => \&_optional_features_1_4, | ||||
1164 | 'provides' => \&_provides, | ||||
1165 | 'recommends' => \&_version_map, | ||||
1166 | 'requires' => \&_version_map, | ||||
1167 | 'resources' => \&_resources_1_4, | ||||
1168 | # ADDED OPTIONAL | ||||
1169 | 'configure_requires' => \&_keep, | ||||
1170 | |||||
1171 | # other random keys are OK if already valid | ||||
1172 | ':custom' => \&_keep | ||||
1173 | }, | ||||
1174 | '1.3' => { | ||||
1175 | # PRIOR MANDATORY | ||||
1176 | 'abstract' => \&_keep_or_unknown, | ||||
1177 | 'author' => \&_author_list, | ||||
1178 | 'generated_by' => \&_generated_by, | ||||
1179 | 'license' => \&_license_1, | ||||
1180 | 'meta-spec' => \&_change_meta_spec, | ||||
1181 | 'name' => \&_keep, | ||||
1182 | 'version' => \&_keep, | ||||
1183 | # PRIOR OPTIONAL | ||||
1184 | 'build_requires' => \&_version_map, | ||||
1185 | 'conflicts' => \&_version_map, | ||||
1186 | 'distribution_type' => \&_keep, | ||||
1187 | 'dynamic_config' => \&_keep_or_one, | ||||
1188 | 'keywords' => \&_keep, | ||||
1189 | 'no_index' => \&_no_index_directory, | ||||
1190 | 'optional_features' => \&_optional_features_as_map, | ||||
1191 | 'provides' => \&_provides, | ||||
1192 | 'recommends' => \&_version_map, | ||||
1193 | 'requires' => \&_version_map, | ||||
1194 | 'resources' => \&_resources_1_3, | ||||
1195 | |||||
1196 | # other random keys are OK if already valid | ||||
1197 | ':custom' => \&_keep | ||||
1198 | }, | ||||
1199 | '1.2' => { | ||||
1200 | # PRIOR MANDATORY | ||||
1201 | 'version' => \&_keep, | ||||
1202 | # CHANGED TO MANDATORY | ||||
1203 | 'license' => \&_license_1, | ||||
1204 | 'name' => \&_keep, | ||||
1205 | 'generated_by' => \&_generated_by, | ||||
1206 | # ADDED MANDATORY | ||||
1207 | 'abstract' => \&_keep_or_unknown, | ||||
1208 | 'author' => \&_author_list, | ||||
1209 | 'meta-spec' => \&_change_meta_spec, | ||||
1210 | # PRIOR OPTIONAL | ||||
1211 | 'build_requires' => \&_version_map, | ||||
1212 | 'conflicts' => \&_version_map, | ||||
1213 | 'distribution_type' => \&_keep, | ||||
1214 | 'dynamic_config' => \&_keep_or_one, | ||||
1215 | 'recommends' => \&_version_map, | ||||
1216 | 'requires' => \&_version_map, | ||||
1217 | # ADDED OPTIONAL | ||||
1218 | 'keywords' => \&_keep, | ||||
1219 | 'no_index' => \&_no_index_1_2, | ||||
1220 | 'optional_features' => \&_optional_features_as_map, | ||||
1221 | 'provides' => \&_provides, | ||||
1222 | 'resources' => \&_resources_1_2, | ||||
1223 | |||||
1224 | # other random keys are OK if already valid | ||||
1225 | ':custom' => \&_keep | ||||
1226 | }, | ||||
1227 | '1.1' => { | ||||
1228 | # CHANGED TO MANDATORY | ||||
1229 | 'version' => \&_keep, | ||||
1230 | # IMPLIED MANDATORY | ||||
1231 | 'name' => \&_keep, | ||||
1232 | 'meta-spec' => \&_change_meta_spec, | ||||
1233 | # PRIOR OPTIONAL | ||||
1234 | 'build_requires' => \&_version_map, | ||||
1235 | 'conflicts' => \&_version_map, | ||||
1236 | 'distribution_type' => \&_keep, | ||||
1237 | 'dynamic_config' => \&_keep_or_one, | ||||
1238 | 'generated_by' => \&_generated_by, | ||||
1239 | 'license' => \&_license_1, | ||||
1240 | 'recommends' => \&_version_map, | ||||
1241 | 'requires' => \&_version_map, | ||||
1242 | # ADDED OPTIONAL | ||||
1243 | 'license_url' => \&_url_or_drop, | ||||
1244 | 'private' => \&_keep, | ||||
1245 | |||||
1246 | # other random keys are OK if already valid | ||||
1247 | ':custom' => \&_keep | ||||
1248 | }, | ||||
1249 | '1.0' => { | ||||
1250 | # IMPLIED MANDATORY | ||||
1251 | 'name' => \&_keep, | ||||
1252 | 'meta-spec' => \&_change_meta_spec, | ||||
1253 | 'version' => \&_keep, | ||||
1254 | # IMPLIED OPTIONAL | ||||
1255 | 'build_requires' => \&_version_map, | ||||
1256 | 'conflicts' => \&_version_map, | ||||
1257 | 'distribution_type' => \&_keep, | ||||
1258 | 'dynamic_config' => \&_keep_or_one, | ||||
1259 | 'generated_by' => \&_generated_by, | ||||
1260 | 'license' => \&_license_1, | ||||
1261 | 'recommends' => \&_version_map, | ||||
1262 | 'requires' => \&_version_map, | ||||
1263 | |||||
1264 | # other random keys are OK if already valid | ||||
1265 | ':custom' => \&_keep, | ||||
1266 | }, | ||||
1267 | ); | ||||
1268 | |||||
1269 | # for a given field in a spec version, what fields will it feed | ||||
1270 | # into in the *latest* spec (i.e. v2); meta-spec omitted because | ||||
1271 | # we always expect a meta-spec to be generated | ||||
1272 | 1 | 4µs | my %fragments_generate = ( | ||
1273 | '2' => { | ||||
1274 | 'abstract' => 'abstract', | ||||
1275 | 'author' => 'author', | ||||
1276 | 'generated_by' => 'generated_by', | ||||
1277 | 'license' => 'license', | ||||
1278 | 'name' => 'name', | ||||
1279 | 'version' => 'version', | ||||
1280 | 'dynamic_config' => 'dynamic_config', | ||||
1281 | 'release_status' => 'release_status', | ||||
1282 | 'keywords' => 'keywords', | ||||
1283 | 'no_index' => 'no_index', | ||||
1284 | 'optional_features' => 'optional_features', | ||||
1285 | 'provides' => 'provides', | ||||
1286 | 'resources' => 'resources', | ||||
1287 | 'description' => 'description', | ||||
1288 | 'prereqs' => 'prereqs', | ||||
1289 | }, | ||||
1290 | '1.4' => { | ||||
1291 | 'abstract' => 'abstract', | ||||
1292 | 'author' => 'author', | ||||
1293 | 'generated_by' => 'generated_by', | ||||
1294 | 'license' => 'license', | ||||
1295 | 'name' => 'name', | ||||
1296 | 'version' => 'version', | ||||
1297 | 'build_requires' => 'prereqs', | ||||
1298 | 'conflicts' => 'prereqs', | ||||
1299 | 'distribution_type' => 'distribution_type', | ||||
1300 | 'dynamic_config' => 'dynamic_config', | ||||
1301 | 'keywords' => 'keywords', | ||||
1302 | 'no_index' => 'no_index', | ||||
1303 | 'optional_features' => 'optional_features', | ||||
1304 | 'provides' => 'provides', | ||||
1305 | 'recommends' => 'prereqs', | ||||
1306 | 'requires' => 'prereqs', | ||||
1307 | 'resources' => 'resources', | ||||
1308 | 'configure_requires' => 'prereqs', | ||||
1309 | }, | ||||
1310 | ); | ||||
1311 | # this is not quite true but will work well enough | ||||
1312 | # as 1.4 is a superset of earlier ones | ||||
1313 | 1 | 2µs | $fragments_generate{$_} = $fragments_generate{'1.4'} for qw/1.3 1.2 1.1 1.0/; | ||
1314 | |||||
1315 | #--------------------------------------------------------------------------# | ||||
1316 | # Code | ||||
1317 | #--------------------------------------------------------------------------# | ||||
1318 | |||||
1319 | #pod =method new | ||||
1320 | #pod | ||||
1321 | #pod my $cmc = CPAN::Meta::Converter->new( $struct ); | ||||
1322 | #pod | ||||
1323 | #pod The constructor should be passed a valid metadata structure but invalid | ||||
1324 | #pod structures are accepted. If no meta-spec version is provided, version 1.0 will | ||||
1325 | #pod be assumed. | ||||
1326 | #pod | ||||
1327 | #pod Optionally, you can provide a C<default_version> argument after C<$struct>: | ||||
1328 | #pod | ||||
1329 | #pod my $cmc = CPAN::Meta::Converter->new( $struct, default_version => "1.4" ); | ||||
1330 | #pod | ||||
1331 | #pod This is only needed when converting a metadata fragment that does not include a | ||||
1332 | #pod C<meta-spec> field. | ||||
1333 | #pod | ||||
1334 | #pod =cut | ||||
1335 | |||||
1336 | sub new { | ||||
1337 | my ($class,$data,%args) = @_; | ||||
1338 | |||||
1339 | # create an attributes hash | ||||
1340 | my $self = { | ||||
1341 | 'data' => $data, | ||||
1342 | 'spec' => _extract_spec_version($data, $args{default_version}), | ||||
1343 | }; | ||||
1344 | |||||
1345 | # create the object | ||||
1346 | return bless $self, $class; | ||||
1347 | } | ||||
1348 | |||||
1349 | sub _extract_spec_version { | ||||
1350 | my ($data, $default) = @_; | ||||
1351 | my $spec = $data->{'meta-spec'}; | ||||
1352 | |||||
1353 | # is meta-spec there and valid? | ||||
1354 | return( $default || "1.0" ) unless defined $spec && ref $spec eq 'HASH'; # before meta-spec? | ||||
1355 | |||||
1356 | # does the version key look like a valid version? | ||||
1357 | my $v = $spec->{version}; | ||||
1358 | if ( defined $v && $v =~ /^\d+(?:\.\d+)?$/ ) { | ||||
1359 | return $v if defined $v && grep { $v eq $_ } keys %known_specs; # known spec | ||||
1360 | return $v+0 if defined $v && grep { $v == $_ } keys %known_specs; # 2.0 => 2 | ||||
1361 | } | ||||
1362 | |||||
1363 | # otherwise, use heuristics: look for 1.x vs 2.0 fields | ||||
1364 | return "2" if exists $data->{prereqs}; | ||||
1365 | return "1.4" if exists $data->{configure_requires}; | ||||
1366 | return( $default || "1.2" ); # when meta-spec was first defined | ||||
1367 | } | ||||
1368 | |||||
1369 | #pod =method convert | ||||
1370 | #pod | ||||
1371 | #pod my $new_struct = $cmc->convert( version => "2" ); | ||||
1372 | #pod | ||||
1373 | #pod Returns a new hash reference with the metadata converted to a different form. | ||||
1374 | #pod C<convert> will die if any conversion/standardization still results in an | ||||
1375 | #pod invalid structure. | ||||
1376 | #pod | ||||
1377 | #pod Valid parameters include: | ||||
1378 | #pod | ||||
1379 | #pod =over | ||||
1380 | #pod | ||||
1381 | #pod =item * | ||||
1382 | #pod | ||||
1383 | #pod C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2"). | ||||
1384 | #pod Defaults to the latest version of the CPAN Meta Spec. | ||||
1385 | #pod | ||||
1386 | #pod =back | ||||
1387 | #pod | ||||
1388 | #pod Conversion proceeds through each version in turn. For example, a version 1.2 | ||||
1389 | #pod structure might be converted to 1.3 then 1.4 then finally to version 2. The | ||||
1390 | #pod conversion process attempts to clean-up simple errors and standardize data. | ||||
1391 | #pod For example, if C<author> is given as a scalar, it will converted to an array | ||||
1392 | #pod reference containing the item. (Converting a structure to its own version will | ||||
1393 | #pod also clean-up and standardize.) | ||||
1394 | #pod | ||||
1395 | #pod When data are cleaned and standardized, missing or invalid fields will be | ||||
1396 | #pod replaced with sensible defaults when possible. This may be lossy or imprecise. | ||||
1397 | #pod For example, some badly structured META.yml files on CPAN have prerequisite | ||||
1398 | #pod modules listed as both keys and values: | ||||
1399 | #pod | ||||
1400 | #pod requires => { 'Foo::Bar' => 'Bam::Baz' } | ||||
1401 | #pod | ||||
1402 | #pod These would be split and each converted to a prerequisite with a minimum | ||||
1403 | #pod version of zero. | ||||
1404 | #pod | ||||
1405 | #pod When some mandatory fields are missing or invalid, the conversion will attempt | ||||
1406 | #pod to provide a sensible default or will fill them with a value of 'unknown'. For | ||||
1407 | #pod example a missing or unrecognized C<license> field will result in a C<license> | ||||
1408 | #pod field of 'unknown'. Fields that may get an 'unknown' include: | ||||
1409 | #pod | ||||
1410 | #pod =for :list | ||||
1411 | #pod * abstract | ||||
1412 | #pod * author | ||||
1413 | #pod * license | ||||
1414 | #pod | ||||
1415 | #pod =cut | ||||
1416 | |||||
1417 | sub convert { | ||||
1418 | my ($self, %args) = @_; | ||||
1419 | my $args = { %args }; | ||||
1420 | |||||
1421 | my $new_version = $args->{version} || $HIGHEST; | ||||
1422 | my $is_fragment = $args->{is_fragment}; | ||||
1423 | |||||
1424 | my ($old_version) = $self->{spec}; | ||||
1425 | my $converted = _dclone($self->{data}); | ||||
1426 | |||||
1427 | if ( $old_version == $new_version ) { | ||||
1428 | $converted = _convert( $converted, $cleanup{$old_version}, $old_version, $is_fragment ); | ||||
1429 | unless ( $args->{is_fragment} ) { | ||||
1430 | my $cmv = CPAN::Meta::Validator->new( $converted ); | ||||
1431 | unless ( $cmv->is_valid ) { | ||||
1432 | my $errs = join("\n", $cmv->errors); | ||||
1433 | die "Failed to clean-up $old_version metadata. Errors:\n$errs\n"; | ||||
1434 | } | ||||
1435 | } | ||||
1436 | return $converted; | ||||
1437 | } | ||||
1438 | elsif ( $old_version > $new_version ) { | ||||
1439 | my @vers = sort { $b <=> $a } keys %known_specs; | ||||
1440 | for my $i ( 0 .. $#vers-1 ) { | ||||
1441 | next if $vers[$i] > $old_version; | ||||
1442 | last if $vers[$i+1] < $new_version; | ||||
1443 | my $spec_string = "$vers[$i+1]-from-$vers[$i]"; | ||||
1444 | $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1], $is_fragment ); | ||||
1445 | unless ( $args->{is_fragment} ) { | ||||
1446 | my $cmv = CPAN::Meta::Validator->new( $converted ); | ||||
1447 | unless ( $cmv->is_valid ) { | ||||
1448 | my $errs = join("\n", $cmv->errors); | ||||
1449 | die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n"; | ||||
1450 | } | ||||
1451 | } | ||||
1452 | } | ||||
1453 | return $converted; | ||||
1454 | } | ||||
1455 | else { | ||||
1456 | my @vers = sort { $a <=> $b } keys %known_specs; | ||||
1457 | for my $i ( 0 .. $#vers-1 ) { | ||||
1458 | next if $vers[$i] < $old_version; | ||||
1459 | last if $vers[$i+1] > $new_version; | ||||
1460 | my $spec_string = "$vers[$i+1]-from-$vers[$i]"; | ||||
1461 | $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1], $is_fragment ); | ||||
1462 | unless ( $args->{is_fragment} ) { | ||||
1463 | my $cmv = CPAN::Meta::Validator->new( $converted ); | ||||
1464 | unless ( $cmv->is_valid ) { | ||||
1465 | my $errs = join("\n", $cmv->errors); | ||||
1466 | die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n"; | ||||
1467 | } | ||||
1468 | } | ||||
1469 | } | ||||
1470 | return $converted; | ||||
1471 | } | ||||
1472 | } | ||||
1473 | |||||
1474 | #pod =method upgrade_fragment | ||||
1475 | #pod | ||||
1476 | #pod my $new_struct = $cmc->upgrade_fragment; | ||||
1477 | #pod | ||||
1478 | #pod Returns a new hash reference with the metadata converted to the latest version | ||||
1479 | #pod of the CPAN Meta Spec. No validation is done on the result -- you must | ||||
1480 | #pod validate after merging fragments into a complete metadata document. | ||||
1481 | #pod | ||||
1482 | #pod Available since version 2.141170. | ||||
1483 | #pod | ||||
1484 | #pod =cut | ||||
1485 | |||||
1486 | sub upgrade_fragment { | ||||
1487 | my ($self) = @_; | ||||
1488 | my ($old_version) = $self->{spec}; | ||||
1489 | my %expected = | ||||
1490 | map {; $_ => 1 } | ||||
1491 | grep { defined } | ||||
1492 | map { $fragments_generate{$old_version}{$_} } | ||||
1493 | keys %{ $self->{data} }; | ||||
1494 | my $converted = $self->convert( version => $HIGHEST, is_fragment => 1 ); | ||||
1495 | for my $key ( keys %$converted ) { | ||||
1496 | next if $key =~ /^x_/i || $key eq 'meta-spec'; | ||||
1497 | delete $converted->{$key} unless $expected{$key}; | ||||
1498 | } | ||||
1499 | return $converted; | ||||
1500 | } | ||||
1501 | |||||
1502 | 1 | 65µs | 1; | ||
1503 | |||||
1504 | # ABSTRACT: Convert CPAN distribution metadata structures | ||||
1505 | |||||
1506 | =pod | ||||
1507 | |||||
1508 | =encoding UTF-8 | ||||
1509 | |||||
1510 | =head1 NAME | ||||
1511 | |||||
1512 | CPAN::Meta::Converter - Convert CPAN distribution metadata structures | ||||
1513 | |||||
1514 | =head1 VERSION | ||||
1515 | |||||
1516 | version 2.150010 | ||||
1517 | |||||
1518 | =head1 SYNOPSIS | ||||
1519 | |||||
1520 | my $struct = decode_json_file('META.json'); | ||||
1521 | |||||
1522 | my $cmc = CPAN::Meta::Converter->new( $struct ); | ||||
1523 | |||||
1524 | my $new_struct = $cmc->convert( version => "2" ); | ||||
1525 | |||||
1526 | =head1 DESCRIPTION | ||||
1527 | |||||
1528 | This module converts CPAN Meta structures from one form to another. The | ||||
1529 | primary use is to convert older structures to the most modern version of | ||||
1530 | the specification, but other transformations may be implemented in the | ||||
1531 | future as needed. (E.g. stripping all custom fields or stripping all | ||||
1532 | optional fields.) | ||||
1533 | |||||
1534 | =head1 METHODS | ||||
1535 | |||||
1536 | =head2 new | ||||
1537 | |||||
1538 | my $cmc = CPAN::Meta::Converter->new( $struct ); | ||||
1539 | |||||
1540 | The constructor should be passed a valid metadata structure but invalid | ||||
1541 | structures are accepted. If no meta-spec version is provided, version 1.0 will | ||||
1542 | be assumed. | ||||
1543 | |||||
1544 | Optionally, you can provide a C<default_version> argument after C<$struct>: | ||||
1545 | |||||
1546 | my $cmc = CPAN::Meta::Converter->new( $struct, default_version => "1.4" ); | ||||
1547 | |||||
1548 | This is only needed when converting a metadata fragment that does not include a | ||||
1549 | C<meta-spec> field. | ||||
1550 | |||||
1551 | =head2 convert | ||||
1552 | |||||
1553 | my $new_struct = $cmc->convert( version => "2" ); | ||||
1554 | |||||
1555 | Returns a new hash reference with the metadata converted to a different form. | ||||
1556 | C<convert> will die if any conversion/standardization still results in an | ||||
1557 | invalid structure. | ||||
1558 | |||||
1559 | Valid parameters include: | ||||
1560 | |||||
1561 | =over | ||||
1562 | |||||
1563 | =item * | ||||
1564 | |||||
1565 | C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2"). | ||||
1566 | Defaults to the latest version of the CPAN Meta Spec. | ||||
1567 | |||||
1568 | =back | ||||
1569 | |||||
1570 | Conversion proceeds through each version in turn. For example, a version 1.2 | ||||
1571 | structure might be converted to 1.3 then 1.4 then finally to version 2. The | ||||
1572 | conversion process attempts to clean-up simple errors and standardize data. | ||||
1573 | For example, if C<author> is given as a scalar, it will converted to an array | ||||
1574 | reference containing the item. (Converting a structure to its own version will | ||||
1575 | also clean-up and standardize.) | ||||
1576 | |||||
1577 | When data are cleaned and standardized, missing or invalid fields will be | ||||
1578 | replaced with sensible defaults when possible. This may be lossy or imprecise. | ||||
1579 | For example, some badly structured META.yml files on CPAN have prerequisite | ||||
1580 | modules listed as both keys and values: | ||||
1581 | |||||
1582 | requires => { 'Foo::Bar' => 'Bam::Baz' } | ||||
1583 | |||||
1584 | These would be split and each converted to a prerequisite with a minimum | ||||
1585 | version of zero. | ||||
1586 | |||||
1587 | When some mandatory fields are missing or invalid, the conversion will attempt | ||||
1588 | to provide a sensible default or will fill them with a value of 'unknown'. For | ||||
1589 | example a missing or unrecognized C<license> field will result in a C<license> | ||||
1590 | field of 'unknown'. Fields that may get an 'unknown' include: | ||||
1591 | |||||
1592 | =over 4 | ||||
1593 | |||||
1594 | =item * | ||||
1595 | |||||
1596 | abstract | ||||
1597 | |||||
1598 | =item * | ||||
1599 | |||||
1600 | author | ||||
1601 | |||||
1602 | =item * | ||||
1603 | |||||
1604 | license | ||||
1605 | |||||
1606 | =back | ||||
1607 | |||||
1608 | =head2 upgrade_fragment | ||||
1609 | |||||
1610 | my $new_struct = $cmc->upgrade_fragment; | ||||
1611 | |||||
1612 | Returns a new hash reference with the metadata converted to the latest version | ||||
1613 | of the CPAN Meta Spec. No validation is done on the result -- you must | ||||
1614 | validate after merging fragments into a complete metadata document. | ||||
1615 | |||||
1616 | Available since version 2.141170. | ||||
1617 | |||||
1618 | =head1 BUGS | ||||
1619 | |||||
1620 | Please report any bugs or feature using the CPAN Request Tracker. | ||||
1621 | Bugs can be submitted through the web interface at | ||||
1622 | L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta> | ||||
1623 | |||||
1624 | When submitting a bug or request, please include a test-file or a patch to an | ||||
1625 | existing test-file that illustrates the bug or desired feature. | ||||
1626 | |||||
1627 | =head1 AUTHORS | ||||
1628 | |||||
1629 | =over 4 | ||||
1630 | |||||
1631 | =item * | ||||
1632 | |||||
1633 | David Golden <dagolden@cpan.org> | ||||
1634 | |||||
1635 | =item * | ||||
1636 | |||||
1637 | Ricardo Signes <rjbs@cpan.org> | ||||
1638 | |||||
1639 | =item * | ||||
1640 | |||||
1641 | Adam Kennedy <adamk@cpan.org> | ||||
1642 | |||||
1643 | =back | ||||
1644 | |||||
1645 | =head1 COPYRIGHT AND LICENSE | ||||
1646 | |||||
1647 | This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors. | ||||
1648 | |||||
1649 | This is free software; you can redistribute it and/or modify it under | ||||
1650 | the same terms as the Perl 5 programming language system itself. | ||||
1651 | |||||
1652 | =cut | ||||
1653 | |||||
1654 | __END__ | ||||
# spent 2µs within CPAN::Meta::Converter::CORE:qr which was called 4 times, avg 400ns/call:
# 4 times (2µs+0s) by CPAN::Meta::Converter::BEGIN@491 at line 501, avg 400ns/call | |||||
# spent 4µs within CPAN::Meta::Converter::CORE:regcomp which was called 4 times, avg 1µs/call:
# 4 times (4µs+0s) by CPAN::Meta::Converter::BEGIN@491 at line 501, avg 1µs/call | |||||
# spent 9µs within CPAN::Meta::Converter::CORE:sort which was called:
# once (9µs+0s) by CPAN::Meta::BEGIN@59 at line 87 | |||||
sub CPAN::Meta::Converter::__ANON__; # xsub |