← Index
NYTProf Performance Profile   « line view »
For test.pl
  Run on Mon Apr 5 14:31:27 2021
Reported on Mon Apr 5 14:31:40 2021

Filename/home/leont/perl5/perlbrew/perls/perl-5.32.0/lib/5.32.0/CPAN/Meta/Converter.pm
StatementsExecuted 75 statements in 4.00ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
1112.38ms2.40msCPAN::Meta::Converter::::BEGIN@26CPAN::Meta::Converter::BEGIN@26
111564µs623µsCPAN::Meta::Converter::::BEGIN@28CPAN::Meta::Converter::BEGIN@28
11125µs31µsCPAN::Meta::Converter::::BEGIN@491CPAN::Meta::Converter::BEGIN@491
11116µs19µsCPAN::Meta::Converter::::BEGIN@36CPAN::Meta::Converter::BEGIN@36
1119µs9µsCPAN::Meta::Converter::::CORE:sortCPAN::Meta::Converter::CORE:sort (opcode)
1117µs7µsCPAN::Meta::::BEGIN@1.3 CPAN::Meta::BEGIN@1.3
1114µs5µsCPAN::Meta::Converter::::BEGIN@27CPAN::Meta::Converter::BEGIN@27
4114µs4µsCPAN::Meta::Converter::::CORE:regcompCPAN::Meta::Converter::CORE:regcomp (opcode)
1114µs10µsCPAN::Meta::Converter::::BEGIN@506CPAN::Meta::Converter::BEGIN@506
1113µs4µsCPAN::Meta::::BEGIN@2.4 CPAN::Meta::BEGIN@2.4
1113µs11µsCPAN::Meta::::BEGIN@3.5 CPAN::Meta::BEGIN@3.5
4112µs2µsCPAN::Meta::Converter::::CORE:qrCPAN::Meta::Converter::CORE:qr (opcode)
221900ns900nsCPAN::Meta::Converter::::__ANON__CPAN::Meta::Converter::__ANON__ (xsub)
0000s0sCPAN::Meta::Converter::::__ANON__[:44]CPAN::Meta::Converter::__ANON__[:44]
0000s0sCPAN::Meta::Converter::::__ANON__[:507]CPAN::Meta::Converter::__ANON__[:507]
0000s0sCPAN::Meta::Converter::::__ANON__[:641]CPAN::Meta::Converter::__ANON__[:641]
0000s0sCPAN::Meta::Converter::::__ANON__[:649]CPAN::Meta::Converter::__ANON__[:649]
0000s0sCPAN::Meta::Converter::::__ANON__[:650]CPAN::Meta::Converter::__ANON__[:650]
0000s0sCPAN::Meta::Converter::::__ANON__[:687]CPAN::Meta::Converter::__ANON__[:687]
0000s0sCPAN::Meta::Converter::::__ANON__[:688]CPAN::Meta::Converter::__ANON__[:688]
0000s0sCPAN::Meta::Converter::::__ANON__[:726]CPAN::Meta::Converter::__ANON__[:726]
0000s0sCPAN::Meta::Converter::::__ANON__[:728]CPAN::Meta::Converter::__ANON__[:728]
0000s0sCPAN::Meta::Converter::::__ANON__[:729]CPAN::Meta::Converter::__ANON__[:729]
0000s0sCPAN::Meta::Converter::::_author_listCPAN::Meta::Converter::_author_list
0000s0sCPAN::Meta::Converter::::_bad_version_hookCPAN::Meta::Converter::_bad_version_hook
0000s0sCPAN::Meta::Converter::::_change_meta_specCPAN::Meta::Converter::_change_meta_spec
0000s0sCPAN::Meta::Converter::::_clean_versionCPAN::Meta::Converter::_clean_version
0000s0sCPAN::Meta::Converter::::_cleanup_optional_features_2CPAN::Meta::Converter::_cleanup_optional_features_2
0000s0sCPAN::Meta::Converter::::_cleanup_prereqsCPAN::Meta::Converter::_cleanup_prereqs
0000s0sCPAN::Meta::Converter::::_cleanup_resources_2CPAN::Meta::Converter::_cleanup_resources_2
0000s0sCPAN::Meta::Converter::::_convertCPAN::Meta::Converter::_convert
0000s0sCPAN::Meta::Converter::::_dcloneCPAN::Meta::Converter::_dclone
0000s0sCPAN::Meta::Converter::::_downgrade_licenseCPAN::Meta::Converter::_downgrade_license
0000s0sCPAN::Meta::Converter::::_downgrade_optional_featuresCPAN::Meta::Converter::_downgrade_optional_features
0000s0sCPAN::Meta::Converter::::_downgrade_resourcesCPAN::Meta::Converter::_downgrade_resources
0000s0sCPAN::Meta::Converter::::_extract_prereqsCPAN::Meta::Converter::_extract_prereqs
0000s0sCPAN::Meta::Converter::::_extract_spec_versionCPAN::Meta::Converter::_extract_spec_version
0000s0sCPAN::Meta::Converter::::_feature_2CPAN::Meta::Converter::_feature_2
0000s0sCPAN::Meta::Converter::::_generated_byCPAN::Meta::Converter::_generated_by
0000s0sCPAN::Meta::Converter::::_get_build_requiresCPAN::Meta::Converter::_get_build_requires
0000s0sCPAN::Meta::Converter::::_is_module_nameCPAN::Meta::Converter::_is_module_name
0000s0sCPAN::Meta::Converter::::_is_urlishCPAN::Meta::Converter::_is_urlish
0000s0sCPAN::Meta::Converter::::_keepCPAN::Meta::Converter::_keep
0000s0sCPAN::Meta::Converter::::_keep_or_oneCPAN::Meta::Converter::_keep_or_one
0000s0sCPAN::Meta::Converter::::_keep_or_unknownCPAN::Meta::Converter::_keep_or_unknown
0000s0sCPAN::Meta::Converter::::_keep_or_zeroCPAN::Meta::Converter::_keep_or_zero
0000s0sCPAN::Meta::Converter::::_license_1CPAN::Meta::Converter::_license_1
0000s0sCPAN::Meta::Converter::::_license_2CPAN::Meta::Converter::_license_2
0000s0sCPAN::Meta::Converter::::_listifyCPAN::Meta::Converter::_listify
0000s0sCPAN::Meta::Converter::::_no_index_1_2CPAN::Meta::Converter::_no_index_1_2
0000s0sCPAN::Meta::Converter::::_no_index_directoryCPAN::Meta::Converter::_no_index_directory
0000s0sCPAN::Meta::Converter::::_no_prefix_ucfirst_customCPAN::Meta::Converter::_no_prefix_ucfirst_custom
0000s0sCPAN::Meta::Converter::::_optional_features_1_4CPAN::Meta::Converter::_optional_features_1_4
0000s0sCPAN::Meta::Converter::::_optional_features_as_mapCPAN::Meta::Converter::_optional_features_as_map
0000s0sCPAN::Meta::Converter::::_prefix_customCPAN::Meta::Converter::_prefix_custom
0000s0sCPAN::Meta::Converter::::_prereqs_from_1CPAN::Meta::Converter::_prereqs_from_1
0000s0sCPAN::Meta::Converter::::_prereqs_relCPAN::Meta::Converter::_prereqs_rel
0000s0sCPAN::Meta::Converter::::_providesCPAN::Meta::Converter::_provides
0000s0sCPAN::Meta::Converter::::_release_statusCPAN::Meta::Converter::_release_status
0000s0sCPAN::Meta::Converter::::_release_status_from_versionCPAN::Meta::Converter::_release_status_from_version
0000s0sCPAN::Meta::Converter::::_repo_typeCPAN::Meta::Converter::_repo_type
0000s0sCPAN::Meta::Converter::::_resources_1_2CPAN::Meta::Converter::_resources_1_2
0000s0sCPAN::Meta::Converter::::_resources_1_3CPAN::Meta::Converter::_resources_1_3
0000s0sCPAN::Meta::Converter::::_ucfirst_customCPAN::Meta::Converter::_ucfirst_custom
0000s0sCPAN::Meta::Converter::::_upgrade_optional_featuresCPAN::Meta::Converter::_upgrade_optional_features
0000s0sCPAN::Meta::Converter::::_upgrade_resources_2CPAN::Meta::Converter::_upgrade_resources_2
0000s0sCPAN::Meta::Converter::::_url_listCPAN::Meta::Converter::_url_list
0000s0sCPAN::Meta::Converter::::_url_or_dropCPAN::Meta::Converter::_url_or_drop
0000s0sCPAN::Meta::Converter::::_version_mapCPAN::Meta::Converter::_version_map
0000s0sCPAN::Meta::Converter::::convertCPAN::Meta::Converter::convert
0000s0sCPAN::Meta::Converter::::newCPAN::Meta::Converter::new
0000s0sCPAN::Meta::Converter::::upgrade_fragmentCPAN::Meta::Converter::upgrade_fragment
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1220µs17µ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
use 5.006;
# spent 7µs making 1 call to CPAN::Meta::BEGIN@1.3
2210µs26µ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
use strict;
# spent 4µs making 1 call to CPAN::Meta::BEGIN@2.4 # spent 1µs making 1 call to strict::import
3228µs219µ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
use warnings;
# spent 11µs making 1 call to CPAN::Meta::BEGIN@3.5 # spent 8µs making 1 call to warnings::import
4package CPAN::Meta::Converter;
5
61300nsour $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
26267µs22.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
use CPAN::Meta::Validator;
# spent 2.40ms making 1 call to CPAN::Meta::Converter::BEGIN@26 # spent 700ns making 1 call to CPAN::Meta::Converter::__ANON__
27215µs25µ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
use CPAN::Meta::Requirements;
# spent 5µs making 1 call to CPAN::Meta::Converter::BEGIN@27 # spent 200ns making 1 call to CPAN::Meta::Converter::__ANON__
28362µs2628µ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
use Parse::CPAN::Meta 1.4400 ();
# 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
BEGIN {
37112µ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.
3812µs if ( my $err = $@ ) {
39 eval "use ExtUtils::MakeMaker::version" or die $err; ## no critic
40 }
4111.14ms119µ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
4416µs11µ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.
501100nsour $DCLONE_MAXDEPTH = 1024;
51our $_CLONE_DEPTH;
52
53sub _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
7812µsmy %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
87112µs19µsmy @spec_list = sort { $a <=> $b } keys %known_specs;
# spent 9µs making 1 call to CPAN::Meta::Converter::CORE:sort
881600nsmy ($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
99sub _keep { $_[0] }
100
101sub _keep_or_one { defined($_[0]) ? $_[0] : 1 }
102
103sub _keep_or_zero { defined($_[0]) ? $_[0] : 0 }
104
105sub _keep_or_unknown { defined($_[0]) && length($_[0]) ? $_[0] : "unknown" }
106
107sub _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
116sub _listify { ! defined $_[0] ? undef : ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]] }
117
118sub _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
126sub _ucfirst_custom {
127 my $key = shift;
128 $key = ucfirst $key unless $key =~ /[A-Z]/;
129 return $key;
130}
131
132sub _no_prefix_ucfirst_custom {
133 my $key = shift;
134 $key =~ s/^x_//;
135 return _ucfirst_custom($key);
136}
137
138sub _change_meta_spec {
139 my ($element, undef, undef, $version) = @_;
140 return {
141 version => $version,
142 url => $known_specs{$version},
143 };
144}
145
1461700nsmy @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
16014µsmy %is_open_source = map {; $_ => 1 } @open_source;
161
1621600nsmy @valid_licenses_1 = (
163 @open_source,
164 'unrestricted',
165 'restrictive',
166 'unknown',
167);
168
169my %license_map_1 = (
17013µs ( map { $_ => $_ } @valid_licenses_1 ),
171 artistic2 => 'artistic_2',
172);
173
174sub _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
18511µsmy @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.
218my %license_map_2 = (
21916µ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
230sub _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
24413µsmy %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
274sub _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
29811µsmy $no_index_spec_1_2 = {
299 'file' => \&_listify,
300 'dir' => \&_listify,
301 'package' => \&_listify,
302 'namespace' => \&_listify,
303};
304
3051600nsmy $no_index_spec_1_3 = {
306 'file' => \&_listify,
307 'directory' => \&_listify,
308 'package' => \&_listify,
309 'namespace' => \&_listify,
310};
311
3121600nsmy $no_index_spec_2 = {
313 'file' => \&_listify,
314 'directory' => \&_listify,
315 'package' => \&_listify,
316 'namespace' => \&_listify,
317 ':custom' => \&_prefix_custom,
318};
319
320sub _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
346sub _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
375sub _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
381sub _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
403sub _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
412sub _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
446sub _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
4611800nsmy $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
4701800nsmy $relation_spec = {
471 requires => \&_version_map,
472 recommends => \&_version_map,
473 suggests => \&_version_map,
474 conflicts => \&_version_map,
475 ':custom' => \&_prefix_custom,
476};
477
478sub _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
484sub _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
BEGIN {
4921700ns my @old_prereqs = qw(
493 requires
494 configure_requires
495 recommends
496 conflicts
497 );
498
49912µs for ( @old_prereqs ) {
5004800ns my $sub = "_get_$_";
501418µs86µ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
5024600ns if ( ! defined $type ) {
5033400ns $type = $phase;
5043400ns $phase = 'runtime';
505 }
506239µs216µ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
no strict 'refs';
# spent 10µs making 1 call to CPAN::Meta::Converter::BEGIN@506 # spent 6µs making 1 call to strict::unimport
50748µs *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) };
508 }
50912.42ms131µs}
# spent 31µs making 1 call to CPAN::Meta::Converter::BEGIN@491
510
511sub _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
523sub _extract_prereqs {
524 my ($prereqs, $phase, $type) = @_;
525 return unless ref $prereqs eq 'HASH';
526 return scalar _version_map($prereqs->{$phase}{$type});
527}
528
529sub _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
550sub _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
5651600nsmy $optional_features_2_spec = {
566 description => \&_keep,
567 prereqs => \&_cleanup_prereqs,
568 ':custom' => \&_prefix_custom,
569};
570
571sub _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
577sub _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
588sub _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
600sub _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
614sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i }
615
616sub _url_or_drop {
617 my ($element) = @_;
618 return $element if _is_urlish($element);
619 return;
620}
621
622sub _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
631sub _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
640my $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 },
65112µs ':custom' => \&_prefix_custom,
652};
653
654sub _upgrade_resources_2 {
655 my (undef, undef, $meta, $version) = @_;
656 return unless exists $meta->{resources};
657 return _convert($meta->{resources}, $resource2_upgrade);
658}
659
6601500nsmy $bugtracker2_spec = {
661 web => \&_url_or_drop,
662 mailto => \&_keep,
663 ':custom' => \&_prefix_custom,
664};
665
666sub _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
6771600nsmy $repository2_spec = {
678 web => \&_url_or_drop,
679 url => \&_url_or_drop,
680 type => \&_repo_type,
681 ':custom' => \&_prefix_custom,
682};
683
684my $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 },
68912µs ':custom' => \&_prefix_custom,
690};
691
692sub _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
6981600nsmy $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
706sub _resources_1_3 {
707 my (undef, undef, $meta, $version) = @_;
708 return unless exists $meta->{resources};
709 return _convert($meta->{resources}, $resource1_spec);
710}
711
7121900ns*_resources_1_4 = *_resources_1_3;
713
714sub _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
725my $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} },
73012µs ':custom' => \&_no_prefix_ucfirst_custom,
731};
732
733sub _downgrade_resources {
734 my (undef, undef, $meta, $version) = @_;
735 return unless exists $meta->{resources};
736 return _convert($meta->{resources}, $resource_downgrade_spec);
737}
738
739sub _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
745sub _release_status_from_version {
746 my (undef, undef, $meta) = @_;
747 my $version = $meta->{version} || '';
748 return ( $version =~ /_/ ) ? 'testing' : 'stable';
749}
750
7511400nsmy $provides_spec = {
752 file => \&_keep,
753 version => \&_keep,
754};
755
7561500nsmy $provides_spec_2 = {
757 file => \&_keep,
758 version => \&_keep,
759 ':custom' => \&_prefix_custom,
760};
761
762sub _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
775sub _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
809114µsmy %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
969111µsmy %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
1108113µsmy %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
127214µsmy %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
131312µ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
1336sub 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
1349sub _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
1417sub 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
1486sub 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
1502165µs1;
1503
1504# ABSTRACT: Convert CPAN distribution metadata structures
1505
1506=pod
1507
1508=encoding UTF-8
1509
1510=head1 NAME
1511
1512CPAN::Meta::Converter - Convert CPAN distribution metadata structures
1513
1514=head1 VERSION
1515
1516version 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
1528This module converts CPAN Meta structures from one form to another. The
1529primary use is to convert older structures to the most modern version of
1530the specification, but other transformations may be implemented in the
1531future as needed. (E.g. stripping all custom fields or stripping all
1532optional fields.)
1533
1534=head1 METHODS
1535
1536=head2 new
1537
1538 my $cmc = CPAN::Meta::Converter->new( $struct );
1539
1540The constructor should be passed a valid metadata structure but invalid
1541structures are accepted. If no meta-spec version is provided, version 1.0 will
1542be assumed.
1543
1544Optionally, 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
1548This is only needed when converting a metadata fragment that does not include a
1549C<meta-spec> field.
1550
1551=head2 convert
1552
1553 my $new_struct = $cmc->convert( version => "2" );
1554
1555Returns a new hash reference with the metadata converted to a different form.
1556C<convert> will die if any conversion/standardization still results in an
1557invalid structure.
1558
1559Valid parameters include:
1560
1561=over
1562
1563=item *
1564
1565C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2").
1566Defaults to the latest version of the CPAN Meta Spec.
1567
1568=back
1569
1570Conversion proceeds through each version in turn. For example, a version 1.2
1571structure might be converted to 1.3 then 1.4 then finally to version 2. The
1572conversion process attempts to clean-up simple errors and standardize data.
1573For example, if C<author> is given as a scalar, it will converted to an array
1574reference containing the item. (Converting a structure to its own version will
1575also clean-up and standardize.)
1576
1577When data are cleaned and standardized, missing or invalid fields will be
1578replaced with sensible defaults when possible. This may be lossy or imprecise.
1579For example, some badly structured META.yml files on CPAN have prerequisite
1580modules listed as both keys and values:
1581
1582 requires => { 'Foo::Bar' => 'Bam::Baz' }
1583
1584These would be split and each converted to a prerequisite with a minimum
1585version of zero.
1586
1587When some mandatory fields are missing or invalid, the conversion will attempt
1588to provide a sensible default or will fill them with a value of 'unknown'. For
1589example a missing or unrecognized C<license> field will result in a C<license>
1590field of 'unknown'. Fields that may get an 'unknown' include:
1591
1592=over 4
1593
1594=item *
1595
1596abstract
1597
1598=item *
1599
1600author
1601
1602=item *
1603
1604license
1605
1606=back
1607
1608=head2 upgrade_fragment
1609
1610 my $new_struct = $cmc->upgrade_fragment;
1611
1612Returns a new hash reference with the metadata converted to the latest version
1613of the CPAN Meta Spec. No validation is done on the result -- you must
1614validate after merging fragments into a complete metadata document.
1615
1616Available since version 2.141170.
1617
1618=head1 BUGS
1619
1620Please report any bugs or feature using the CPAN Request Tracker.
1621Bugs can be submitted through the web interface at
1622L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta>
1623
1624When submitting a bug or request, please include a test-file or a patch to an
1625existing test-file that illustrates the bug or desired feature.
1626
1627=head1 AUTHORS
1628
1629=over 4
1630
1631=item *
1632
1633David Golden <dagolden@cpan.org>
1634
1635=item *
1636
1637Ricardo Signes <rjbs@cpan.org>
1638
1639=item *
1640
1641Adam Kennedy <adamk@cpan.org>
1642
1643=back
1644
1645=head1 COPYRIGHT AND LICENSE
1646
1647This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors.
1648
1649This is free software; you can redistribute it and/or modify it under
1650the 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
sub CPAN::Meta::Converter::CORE:qr; # opcode
# 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
sub CPAN::Meta::Converter::CORE:regcomp; # opcode
# 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::CORE:sort; # opcode
# spent 900ns within CPAN::Meta::Converter::__ANON__ which was called 2 times, avg 450ns/call: # once (700ns+0s) by CPAN::Meta::Converter::BEGIN@26 at line 26 # once (200ns+0s) by CPAN::Meta::Converter::BEGIN@27 at line 27
sub CPAN::Meta::Converter::__ANON__; # xsub