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