diff options
Diffstat (limited to '.checksetup_lib')
| -rw-r--r-- | .checksetup_lib/lib/perl5/CPAN/Meta.pm | 1156 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/CPAN/Meta/Converter.pm | 1639 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/CPAN/Meta/Feature.pm | 149 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/CPAN/Meta/History.pm | 316 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/CPAN/Meta/Merge.pm | 297 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/CPAN/Meta/Prereqs.pm | 422 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/CPAN/Meta/Spec.pm | 1235 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm | 1210 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/CPAN/Meta/YAML.pm | 951 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/Module/Metadata.pm | 1016 | ||||
| -rw-r--r-- | .checksetup_lib/lib/perl5/Parse/CPAN/Meta.pm | 352 |
11 files changed, 8743 insertions, 0 deletions
diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta.pm b/.checksetup_lib/lib/perl5/CPAN/Meta.pm new file mode 100644 index 000000000..afbb22185 --- /dev/null +++ b/.checksetup_lib/lib/perl5/CPAN/Meta.pm @@ -0,0 +1,1156 @@ +use 5.006; +use strict; +use warnings; +package CPAN::Meta; + +our $VERSION = '2.150005'; + +#pod =head1 SYNOPSIS +#pod +#pod use v5.10; +#pod use strict; +#pod use warnings; +#pod use CPAN::Meta; +#pod use Module::Load; +#pod +#pod my $meta = CPAN::Meta->load_file('META.json'); +#pod +#pod printf "testing requirements for %s version %s\n", +#pod $meta->name, +#pod $meta->version; +#pod +#pod my $prereqs = $meta->effective_prereqs; +#pod +#pod for my $phase ( qw/configure runtime build test/ ) { +#pod say "Requirements for $phase:"; +#pod my $reqs = $prereqs->requirements_for($phase, "requires"); +#pod for my $module ( sort $reqs->required_modules ) { +#pod my $status; +#pod if ( eval { load $module unless $module eq 'perl'; 1 } ) { +#pod my $version = $module eq 'perl' ? $] : $module->VERSION; +#pod $status = $reqs->accepts_module($module, $version) +#pod ? "$version ok" : "$version not ok"; +#pod } else { +#pod $status = "missing" +#pod }; +#pod say " $module ($status)"; +#pod } +#pod } +#pod +#pod =head1 DESCRIPTION +#pod +#pod Software distributions released to the CPAN include a F<META.json> or, for +#pod older distributions, F<META.yml>, which describes the distribution, its +#pod contents, and the requirements for building and installing the distribution. +#pod The data structure stored in the F<META.json> file is described in +#pod L<CPAN::Meta::Spec>. +#pod +#pod CPAN::Meta provides a simple class to represent this distribution metadata (or +#pod I<distmeta>), along with some helpful methods for interrogating that data. +#pod +#pod The documentation below is only for the methods of the CPAN::Meta object. For +#pod information on the meaning of individual fields, consult the spec. +#pod +#pod =cut + +use Carp qw(carp croak); +use CPAN::Meta::Feature; +use CPAN::Meta::Prereqs; +use CPAN::Meta::Converter; +use CPAN::Meta::Validator; +use Parse::CPAN::Meta 1.4414 (); + +BEGIN { *_dclone = \&CPAN::Meta::Converter::_dclone } + +#pod =head1 STRING DATA +#pod +#pod The following methods return a single value, which is the value for the +#pod corresponding entry in the distmeta structure. Values should be either undef +#pod or strings. +#pod +#pod =for :list +#pod * abstract +#pod * description +#pod * dynamic_config +#pod * generated_by +#pod * name +#pod * release_status +#pod * version +#pod +#pod =cut + +BEGIN { + my @STRING_READERS = qw( + abstract + description + dynamic_config + generated_by + name + release_status + version + ); + + no strict 'refs'; + for my $attr (@STRING_READERS) { + *$attr = sub { $_[0]{ $attr } }; + } +} + +#pod =head1 LIST DATA +#pod +#pod These methods return lists of string values, which might be represented in the +#pod distmeta structure as arrayrefs or scalars: +#pod +#pod =for :list +#pod * authors +#pod * keywords +#pod * licenses +#pod +#pod The C<authors> and C<licenses> methods may also be called as C<author> and +#pod C<license>, respectively, to match the field name in the distmeta structure. +#pod +#pod =cut + +BEGIN { + my @LIST_READERS = qw( + author + keywords + license + ); + + no strict 'refs'; + for my $attr (@LIST_READERS) { + *$attr = sub { + my $value = $_[0]{ $attr }; + croak "$attr must be called in list context" + unless wantarray; + return @{ _dclone($value) } if ref $value; + return $value; + }; + } +} + +sub authors { $_[0]->author } +sub licenses { $_[0]->license } + +#pod =head1 MAP DATA +#pod +#pod These readers return hashrefs of arbitrary unblessed data structures, each +#pod described more fully in the specification: +#pod +#pod =for :list +#pod * meta_spec +#pod * resources +#pod * provides +#pod * no_index +#pod * prereqs +#pod * optional_features +#pod +#pod =cut + +BEGIN { + my @MAP_READERS = qw( + meta-spec + resources + provides + no_index + + prereqs + optional_features + ); + + no strict 'refs'; + for my $attr (@MAP_READERS) { + (my $subname = $attr) =~ s/-/_/; + *$subname = sub { + my $value = $_[0]{ $attr }; + return _dclone($value) if $value; + return {}; + }; + } +} + +#pod =head1 CUSTOM DATA +#pod +#pod A list of custom keys are available from the C<custom_keys> method and +#pod particular keys may be retrieved with the C<custom> method. +#pod +#pod say $meta->custom($_) for $meta->custom_keys; +#pod +#pod If a custom key refers to a data structure, a deep clone is returned. +#pod +#pod =cut + +sub custom_keys { + return grep { /^x_/i } keys %{$_[0]}; +} + +sub custom { + my ($self, $attr) = @_; + my $value = $self->{$attr}; + return _dclone($value) if ref $value; + return $value; +} + +#pod =method new +#pod +#pod my $meta = CPAN::Meta->new($distmeta_struct, \%options); +#pod +#pod Returns a valid CPAN::Meta object or dies if the supplied metadata hash +#pod reference fails to validate. Older-format metadata will be up-converted to +#pod version 2 if they validate against the original stated specification. +#pod +#pod It takes an optional hashref of options. Valid options include: +#pod +#pod =over +#pod +#pod =item * +#pod +#pod lazy_validation -- if true, new will attempt to convert the given metadata +#pod to version 2 before attempting to validate it. This means than any +#pod fixable errors will be handled by CPAN::Meta::Converter before validation. +#pod (Note that this might result in invalid optional data being silently +#pod dropped.) The default is false. +#pod +#pod =back +#pod +#pod =cut + +sub _new { + my ($class, $struct, $options) = @_; + my $self; + + if ( $options->{lazy_validation} ) { + # try to convert to a valid structure; if succeeds, then return it + my $cmc = CPAN::Meta::Converter->new( $struct ); + $self = $cmc->convert( version => 2 ); # valid or dies + return bless $self, $class; + } + else { + # validate original struct + my $cmv = CPAN::Meta::Validator->new( $struct ); + unless ( $cmv->is_valid) { + die "Invalid metadata structure. Errors: " + . join(", ", $cmv->errors) . "\n"; + } + } + + # up-convert older spec versions + my $version = $struct->{'meta-spec'}{version} || '1.0'; + if ( $version == 2 ) { + $self = $struct; + } + else { + my $cmc = CPAN::Meta::Converter->new( $struct ); + $self = $cmc->convert( version => 2 ); + } + + return bless $self, $class; +} + +sub new { + my ($class, $struct, $options) = @_; + my $self = eval { $class->_new($struct, $options) }; + croak($@) if $@; + return $self; +} + +#pod =method create +#pod +#pod my $meta = CPAN::Meta->create($distmeta_struct, \%options); +#pod +#pod This is same as C<new()>, except that C<generated_by> and C<meta-spec> fields +#pod will be generated if not provided. This means the metadata structure is +#pod assumed to otherwise follow the latest L<CPAN::Meta::Spec>. +#pod +#pod =cut + +sub create { + my ($class, $struct, $options) = @_; + my $version = __PACKAGE__->VERSION || 2; + $struct->{generated_by} ||= __PACKAGE__ . " version $version" ; + $struct->{'meta-spec'}{version} ||= int($version); + my $self = eval { $class->_new($struct, $options) }; + croak ($@) if $@; + return $self; +} + +#pod =method load_file +#pod +#pod my $meta = CPAN::Meta->load_file($distmeta_file, \%options); +#pod +#pod Given a pathname to a file containing metadata, this deserializes the file +#pod according to its file suffix and constructs a new C<CPAN::Meta> object, just +#pod like C<new()>. It will die if the deserialized version fails to validate +#pod against its stated specification version. +#pod +#pod It takes the same options as C<new()> but C<lazy_validation> defaults to +#pod true. +#pod +#pod =cut + +sub load_file { + my ($class, $file, $options) = @_; + $options->{lazy_validation} = 1 unless exists $options->{lazy_validation}; + + croak "load_file() requires a valid, readable filename" + unless -r $file; + + my $self; + eval { + my $struct = Parse::CPAN::Meta->load_file( $file ); + $self = $class->_new($struct, $options); + }; + croak($@) if $@; + return $self; +} + +#pod =method load_yaml_string +#pod +#pod my $meta = CPAN::Meta->load_yaml_string($yaml, \%options); +#pod +#pod This method returns a new CPAN::Meta object using the first document in the +#pod given YAML string. In other respects it is identical to C<load_file()>. +#pod +#pod =cut + +sub load_yaml_string { + my ($class, $yaml, $options) = @_; + $options->{lazy_validation} = 1 unless exists $options->{lazy_validation}; + + my $self; + eval { + my ($struct) = Parse::CPAN::Meta->load_yaml_string( $yaml ); + $self = $class->_new($struct, $options); + }; + croak($@) if $@; + return $self; +} + +#pod =method load_json_string +#pod +#pod my $meta = CPAN::Meta->load_json_string($json, \%options); +#pod +#pod This method returns a new CPAN::Meta object using the structure represented by +#pod the given JSON string. In other respects it is identical to C<load_file()>. +#pod +#pod =cut + +sub load_json_string { + my ($class, $json, $options) = @_; + $options->{lazy_validation} = 1 unless exists $options->{lazy_validation}; + + my $self; + eval { + my $struct = Parse::CPAN::Meta->load_json_string( $json ); + $self = $class->_new($struct, $options); + }; + croak($@) if $@; + return $self; +} + +#pod =method load_string +#pod +#pod my $meta = CPAN::Meta->load_string($string, \%options); +#pod +#pod If you don't know if a string contains YAML or JSON, this method will use +#pod L<Parse::CPAN::Meta> to guess. In other respects it is identical to +#pod C<load_file()>. +#pod +#pod =cut + +sub load_string { + my ($class, $string, $options) = @_; + $options->{lazy_validation} = 1 unless exists $options->{lazy_validation}; + + my $self; + eval { + my $struct = Parse::CPAN::Meta->load_string( $string ); + $self = $class->_new($struct, $options); + }; + croak($@) if $@; + return $self; +} + +#pod =method save +#pod +#pod $meta->save($distmeta_file, \%options); +#pod +#pod Serializes the object as JSON and writes it to the given file. The only valid +#pod option is C<version>, which defaults to '2'. On Perl 5.8.1 or later, the file +#pod is saved with UTF-8 encoding. +#pod +#pod For C<version> 2 (or higher), the filename should end in '.json'. L<JSON::PP> +#pod is the default JSON backend. Using another JSON backend requires L<JSON> 2.5 or +#pod later and you must set the C<$ENV{PERL_JSON_BACKEND}> to a supported alternate +#pod backend like L<JSON::XS>. +#pod +#pod For C<version> less than 2, the filename should end in '.yml'. +#pod L<CPAN::Meta::Converter> is used to generate an older metadata structure, which +#pod is serialized to YAML. CPAN::Meta::YAML is the default YAML backend. You may +#pod set the C<$ENV{PERL_YAML_BACKEND}> to a supported alternative backend, though +#pod this is not recommended due to subtle incompatibilities between YAML parsers on +#pod CPAN. +#pod +#pod =cut + +sub save { + my ($self, $file, $options) = @_; + + my $version = $options->{version} || '2'; + my $layer = $] ge '5.008001' ? ':utf8' : ''; + + if ( $version ge '2' ) { + carp "'$file' should end in '.json'" + unless $file =~ m{\.json$}; + } + else { + carp "'$file' should end in '.yml'" + unless $file =~ m{\.yml$}; + } + + my $data = $self->as_string( $options ); + open my $fh, ">$layer", $file + or die "Error opening '$file' for writing: $!\n"; + + print {$fh} $data; + close $fh + or die "Error closing '$file': $!\n"; + + return 1; +} + +#pod =method meta_spec_version +#pod +#pod This method returns the version part of the C<meta_spec> entry in the distmeta +#pod structure. It is equivalent to: +#pod +#pod $meta->meta_spec->{version}; +#pod +#pod =cut + +sub meta_spec_version { + my ($self) = @_; + return $self->meta_spec->{version}; +} + +#pod =method effective_prereqs +#pod +#pod my $prereqs = $meta->effective_prereqs; +#pod +#pod my $prereqs = $meta->effective_prereqs( \@feature_identifiers ); +#pod +#pod This method returns a L<CPAN::Meta::Prereqs> object describing all the +#pod prereqs for the distribution. If an arrayref of feature identifiers is given, +#pod the prereqs for the identified features are merged together with the +#pod distribution's core prereqs before the CPAN::Meta::Prereqs object is returned. +#pod +#pod =cut + +sub effective_prereqs { + my ($self, $features) = @_; + $features ||= []; + + my $prereq = CPAN::Meta::Prereqs->new($self->prereqs); + + return $prereq unless @$features; + + my @other = map {; $self->feature($_)->prereqs } @$features; + + return $prereq->with_merged_prereqs(\@other); +} + +#pod =method should_index_file +#pod +#pod ... if $meta->should_index_file( $filename ); +#pod +#pod This method returns true if the given file should be indexed. It decides this +#pod by checking the C<file> and C<directory> keys in the C<no_index> property of +#pod the distmeta structure. Note that neither the version format nor +#pod C<release_status> are considered. +#pod +#pod C<$filename> should be given in unix format. +#pod +#pod =cut + +sub should_index_file { + my ($self, $filename) = @_; + + for my $no_index_file (@{ $self->no_index->{file} || [] }) { + return if $filename eq $no_index_file; + } + + for my $no_index_dir (@{ $self->no_index->{directory} }) { + $no_index_dir =~ s{$}{/} unless $no_index_dir =~ m{/\z}; + return if index($filename, $no_index_dir) == 0; + } + + return 1; +} + +#pod =method should_index_package +#pod +#pod ... if $meta->should_index_package( $package ); +#pod +#pod This method returns true if the given package should be indexed. It decides +#pod this by checking the C<package> and C<namespace> keys in the C<no_index> +#pod property of the distmeta structure. Note that neither the version format nor +#pod C<release_status> are considered. +#pod +#pod =cut + +sub should_index_package { + my ($self, $package) = @_; + + for my $no_index_pkg (@{ $self->no_index->{package} || [] }) { + return if $package eq $no_index_pkg; + } + + for my $no_index_ns (@{ $self->no_index->{namespace} }) { + return if index($package, "${no_index_ns}::") == 0; + } + + return 1; +} + +#pod =method features +#pod +#pod my @feature_objects = $meta->features; +#pod +#pod This method returns a list of L<CPAN::Meta::Feature> objects, one for each +#pod optional feature described by the distribution's metadata. +#pod +#pod =cut + +sub features { + my ($self) = @_; + + my $opt_f = $self->optional_features; + my @features = map {; CPAN::Meta::Feature->new($_ => $opt_f->{ $_ }) } + keys %$opt_f; + + return @features; +} + +#pod =method feature +#pod +#pod my $feature_object = $meta->feature( $identifier ); +#pod +#pod This method returns a L<CPAN::Meta::Feature> object for the optional feature +#pod with the given identifier. If no feature with that identifier exists, an +#pod exception will be raised. +#pod +#pod =cut + +sub feature { + my ($self, $ident) = @_; + + croak "no feature named $ident" + unless my $f = $self->optional_features->{ $ident }; + + return CPAN::Meta::Feature->new($ident, $f); +} + +#pod =method as_struct +#pod +#pod my $copy = $meta->as_struct( \%options ); +#pod +#pod This method returns a deep copy of the object's metadata as an unblessed hash +#pod reference. It takes an optional hashref of options. If the hashref contains +#pod a C<version> argument, the copied metadata will be converted to the version +#pod of the specification and returned. For example: +#pod +#pod my $old_spec = $meta->as_struct( {version => "1.4"} ); +#pod +#pod =cut + +sub as_struct { + my ($self, $options) = @_; + my $struct = _dclone($self); + if ( $options->{version} ) { + my $cmc = CPAN::Meta::Converter->new( $struct ); + $struct = $cmc->convert( version => $options->{version} ); + } + return $struct; +} + +#pod =method as_string +#pod +#pod my $string = $meta->as_string( \%options ); +#pod +#pod This method returns a serialized copy of the object's metadata as a character +#pod string. (The strings are B<not> UTF-8 encoded.) It takes an optional hashref +#pod of options. If the hashref contains a C<version> argument, the copied metadata +#pod will be converted to the version of the specification and returned. For +#pod example: +#pod +#pod my $string = $meta->as_string( {version => "1.4"} ); +#pod +#pod For C<version> greater than or equal to 2, the string will be serialized as +#pod JSON. For C<version> less than 2, the string will be serialized as YAML. In +#pod both cases, the same rules are followed as in the C<save()> method for choosing +#pod a serialization backend. +#pod +#pod The serialized structure will include a C<x_serialization_backend> entry giving +#pod the package and version used to serialize. Any existing key in the given +#pod C<$meta> object will be clobbered. +#pod +#pod =cut + +sub as_string { + my ($self, $options) = @_; + + my $version = $options->{version} || '2'; + + my $struct; + if ( $self->meta_spec_version ne $version ) { + my $cmc = CPAN::Meta::Converter->new( $self->as_struct ); + $struct = $cmc->convert( version => $version ); + } + else { + $struct = $self->as_struct; + } + + my ($data, $backend); + if ( $version ge '2' ) { + $backend = Parse::CPAN::Meta->json_backend(); + local $struct->{x_serialization_backend} = sprintf '%s version %s', + $backend, $backend->VERSION; + $data = $backend->new->pretty->canonical->encode($struct); + } + else { + $backend = Parse::CPAN::Meta->yaml_backend(); + local $struct->{x_serialization_backend} = sprintf '%s version %s', + $backend, $backend->VERSION; + $data = eval { no strict 'refs'; &{"$backend\::Dump"}($struct) }; + if ( $@ ) { + croak $backend->can('errstr') ? $backend->errstr : $@ + } + } + + return $data; +} + +# Used by JSON::PP, etc. for "convert_blessed" +sub TO_JSON { + return { %{ $_[0] } }; +} + +1; + +# ABSTRACT: the distribution metadata for a CPAN dist + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta - the distribution metadata for a CPAN dist + +=head1 VERSION + +version 2.150005 + +=head1 SYNOPSIS + + use v5.10; + use strict; + use warnings; + use CPAN::Meta; + use Module::Load; + + my $meta = CPAN::Meta->load_file('META.json'); + + printf "testing requirements for %s version %s\n", + $meta->name, + $meta->version; + + my $prereqs = $meta->effective_prereqs; + + for my $phase ( qw/configure runtime build test/ ) { + say "Requirements for $phase:"; + my $reqs = $prereqs->requirements_for($phase, "requires"); + for my $module ( sort $reqs->required_modules ) { + my $status; + if ( eval { load $module unless $module eq 'perl'; 1 } ) { + my $version = $module eq 'perl' ? $] : $module->VERSION; + $status = $reqs->accepts_module($module, $version) + ? "$version ok" : "$version not ok"; + } else { + $status = "missing" + }; + say " $module ($status)"; + } + } + +=head1 DESCRIPTION + +Software distributions released to the CPAN include a F<META.json> or, for +older distributions, F<META.yml>, which describes the distribution, its +contents, and the requirements for building and installing the distribution. +The data structure stored in the F<META.json> file is described in +L<CPAN::Meta::Spec>. + +CPAN::Meta provides a simple class to represent this distribution metadata (or +I<distmeta>), along with some helpful methods for interrogating that data. + +The documentation below is only for the methods of the CPAN::Meta object. For +information on the meaning of individual fields, consult the spec. + +=head1 METHODS + +=head2 new + + my $meta = CPAN::Meta->new($distmeta_struct, \%options); + +Returns a valid CPAN::Meta object or dies if the supplied metadata hash +reference fails to validate. Older-format metadata will be up-converted to +version 2 if they validate against the original stated specification. + +It takes an optional hashref of options. Valid options include: + +=over + +=item * + +lazy_validation -- if true, new will attempt to convert the given metadata +to version 2 before attempting to validate it. This means than any +fixable errors will be handled by CPAN::Meta::Converter before validation. +(Note that this might result in invalid optional data being silently +dropped.) The default is false. + +=back + +=head2 create + + my $meta = CPAN::Meta->create($distmeta_struct, \%options); + +This is same as C<new()>, except that C<generated_by> and C<meta-spec> fields +will be generated if not provided. This means the metadata structure is +assumed to otherwise follow the latest L<CPAN::Meta::Spec>. + +=head2 load_file + + my $meta = CPAN::Meta->load_file($distmeta_file, \%options); + +Given a pathname to a file containing metadata, this deserializes the file +according to its file suffix and constructs a new C<CPAN::Meta> object, just +like C<new()>. It will die if the deserialized version fails to validate +against its stated specification version. + +It takes the same options as C<new()> but C<lazy_validation> defaults to +true. + +=head2 load_yaml_string + + my $meta = CPAN::Meta->load_yaml_string($yaml, \%options); + +This method returns a new CPAN::Meta object using the first document in the +given YAML string. In other respects it is identical to C<load_file()>. + +=head2 load_json_string + + my $meta = CPAN::Meta->load_json_string($json, \%options); + +This method returns a new CPAN::Meta object using the structure represented by +the given JSON string. In other respects it is identical to C<load_file()>. + +=head2 load_string + + my $meta = CPAN::Meta->load_string($string, \%options); + +If you don't know if a string contains YAML or JSON, this method will use +L<Parse::CPAN::Meta> to guess. In other respects it is identical to +C<load_file()>. + +=head2 save + + $meta->save($distmeta_file, \%options); + +Serializes the object as JSON and writes it to the given file. The only valid +option is C<version>, which defaults to '2'. On Perl 5.8.1 or later, the file +is saved with UTF-8 encoding. + +For C<version> 2 (or higher), the filename should end in '.json'. L<JSON::PP> +is the default JSON backend. Using another JSON backend requires L<JSON> 2.5 or +later and you must set the C<$ENV{PERL_JSON_BACKEND}> to a supported alternate +backend like L<JSON::XS>. + +For C<version> less than 2, the filename should end in '.yml'. +L<CPAN::Meta::Converter> is used to generate an older metadata structure, which +is serialized to YAML. CPAN::Meta::YAML is the default YAML backend. You may +set the C<$ENV{PERL_YAML_BACKEND}> to a supported alternative backend, though +this is not recommended due to subtle incompatibilities between YAML parsers on +CPAN. + +=head2 meta_spec_version + +This method returns the version part of the C<meta_spec> entry in the distmeta +structure. It is equivalent to: + + $meta->meta_spec->{version}; + +=head2 effective_prereqs + + my $prereqs = $meta->effective_prereqs; + + my $prereqs = $meta->effective_prereqs( \@feature_identifiers ); + +This method returns a L<CPAN::Meta::Prereqs> object describing all the +prereqs for the distribution. If an arrayref of feature identifiers is given, +the prereqs for the identified features are merged together with the +distribution's core prereqs before the CPAN::Meta::Prereqs object is returned. + +=head2 should_index_file + + ... if $meta->should_index_file( $filename ); + +This method returns true if the given file should be indexed. It decides this +by checking the C<file> and C<directory> keys in the C<no_index> property of +the distmeta structure. Note that neither the version format nor +C<release_status> are considered. + +C<$filename> should be given in unix format. + +=head2 should_index_package + + ... if $meta->should_index_package( $package ); + +This method returns true if the given package should be indexed. It decides +this by checking the C<package> and C<namespace> keys in the C<no_index> +property of the distmeta structure. Note that neither the version format nor +C<release_status> are considered. + +=head2 features + + my @feature_objects = $meta->features; + +This method returns a list of L<CPAN::Meta::Feature> objects, one for each +optional feature described by the distribution's metadata. + +=head2 feature + + my $feature_object = $meta->feature( $identifier ); + +This method returns a L<CPAN::Meta::Feature> object for the optional feature +with the given identifier. If no feature with that identifier exists, an +exception will be raised. + +=head2 as_struct + + my $copy = $meta->as_struct( \%options ); + +This method returns a deep copy of the object's metadata as an unblessed hash +reference. It takes an optional hashref of options. If the hashref contains +a C<version> argument, the copied metadata will be converted to the version +of the specification and returned. For example: + + my $old_spec = $meta->as_struct( {version => "1.4"} ); + +=head2 as_string + + my $string = $meta->as_string( \%options ); + +This method returns a serialized copy of the object's metadata as a character +string. (The strings are B<not> UTF-8 encoded.) It takes an optional hashref +of options. If the hashref contains a C<version> argument, the copied metadata +will be converted to the version of the specification and returned. For +example: + + my $string = $meta->as_string( {version => "1.4"} ); + +For C<version> greater than or equal to 2, the string will be serialized as +JSON. For C<version> less than 2, the string will be serialized as YAML. In +both cases, the same rules are followed as in the C<save()> method for choosing +a serialization backend. + +The serialized structure will include a C<x_serialization_backend> entry giving +the package and version used to serialize. Any existing key in the given +C<$meta> object will be clobbered. + +=head1 STRING DATA + +The following methods return a single value, which is the value for the +corresponding entry in the distmeta structure. Values should be either undef +or strings. + +=over 4 + +=item * + +abstract + +=item * + +description + +=item * + +dynamic_config + +=item * + +generated_by + +=item * + +name + +=item * + +release_status + +=item * + +version + +=back + +=head1 LIST DATA + +These methods return lists of string values, which might be represented in the +distmeta structure as arrayrefs or scalars: + +=over 4 + +=item * + +authors + +=item * + +keywords + +=item * + +licenses + +=back + +The C<authors> and C<licenses> methods may also be called as C<author> and +C<license>, respectively, to match the field name in the distmeta structure. + +=head1 MAP DATA + +These readers return hashrefs of arbitrary unblessed data structures, each +described more fully in the specification: + +=over 4 + +=item * + +meta_spec + +=item * + +resources + +=item * + +provides + +=item * + +no_index + +=item * + +prereqs + +=item * + +optional_features + +=back + +=head1 CUSTOM DATA + +A list of custom keys are available from the C<custom_keys> method and +particular keys may be retrieved with the C<custom> method. + + say $meta->custom($_) for $meta->custom_keys; + +If a custom key refers to a data structure, a deep clone is returned. + +=for Pod::Coverage TO_JSON abstract author authors custom custom_keys description dynamic_config +generated_by keywords license licenses meta_spec name no_index +optional_features prereqs provides release_status resources version + +=head1 BUGS + +Please report any bugs or feature using the CPAN Request Tracker. +Bugs can be submitted through the web interface at +L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta> + +When submitting a bug or request, please include a test-file or a patch to an +existing test-file that illustrates the bug or desired feature. + +=head1 SEE ALSO + +=over 4 + +=item * + +L<CPAN::Meta::Converter> + +=item * + +L<CPAN::Meta::Validator> + +=back + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan + +=head1 SUPPORT + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests through the issue tracker +at L<https://github.com/Perl-Toolchain-Gang/CPAN-Meta/issues>. +You will be notified automatically of any progress on your issue. + +=head2 Source Code + +This is open source software. The code repository is available for +public review and contribution under the terms of the license. + +L<https://github.com/Perl-Toolchain-Gang/CPAN-Meta> + + git clone https://github.com/Perl-Toolchain-Gang/CPAN-Meta.git + +=head1 AUTHORS + +=over 4 + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Ricardo Signes <rjbs@cpan.org> + +=back + +=head1 CONTRIBUTORS + +=for stopwords Ansgar Burchardt Avar Arnfjord Bjarmason Christopher J. Madsen Chuck Adams Cory G Watson Damyan Ivanov Eric Wilhelm Graham Knop Gregor Hermann Karen Etheridge Kenichi Ishigaki Ken Williams Lars Dieckow Leon Timmermans majensen Mark Fowler Matt S Trout Michael G. Schwern mohawk2 moznion Niko Tyni Olaf Alders Olivier MenguĂ© Randy Sims Tomohiro Hosaka + +=over 4 + +=item * + +Ansgar Burchardt <ansgar@cpan.org> + +=item * + +Avar Arnfjord Bjarmason <avar@cpan.org> + +=item * + +Christopher J. Madsen <cjm@cpan.org> + +=item * + +Chuck Adams <cja987@gmail.com> + +=item * + +Cory G Watson <gphat@cpan.org> + +=item * + +Damyan Ivanov <dam@cpan.org> + +=item * + +Eric Wilhelm <ewilhelm@cpan.org> + +=item * + +Graham Knop <haarg@haarg.org> + +=item * + +Gregor Hermann <gregoa@debian.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Kenichi Ishigaki <ishigaki@cpan.org> + +=item * + +Ken Williams <kwilliams@cpan.org> + +=item * + +Lars Dieckow <daxim@cpan.org> + +=item * + +Leon Timmermans <leont@cpan.org> + +=item * + +majensen <maj@fortinbras.us> + +=item * + +Mark Fowler <markf@cpan.org> + +=item * + +Matt S Trout <mst@shadowcat.co.uk> + +=item * + +Michael G. Schwern <mschwern@cpan.org> + +=item * + +mohawk2 <mohawk2@users.noreply.github.com> + +=item * + +moznion <moznion@gmail.com> + +=item * + +Niko Tyni <ntyni@debian.org> + +=item * + +Olaf Alders <olaf@wundersolutions.com> + +=item * + +Olivier MenguĂ© <dolmen@cpan.org> + +=item * + +Randy Sims <randys@thepierianspring.org> + +=item * + +Tomohiro Hosaka <bokutin@bokut.in> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by David Golden and Ricardo Signes. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + +__END__ + + +# vim: ts=2 sts=2 sw=2 et : diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta/Converter.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/Converter.pm new file mode 100644 index 000000000..03806bc82 --- /dev/null +++ b/.checksetup_lib/lib/perl5/CPAN/Meta/Converter.pm @@ -0,0 +1,1639 @@ +use 5.006; +use strict; +use warnings; +package CPAN::Meta::Converter; + +our $VERSION = '2.150005'; + +#pod =head1 SYNOPSIS +#pod +#pod my $struct = decode_json_file('META.json'); +#pod +#pod my $cmc = CPAN::Meta::Converter->new( $struct ); +#pod +#pod my $new_struct = $cmc->convert( version => "2" ); +#pod +#pod =head1 DESCRIPTION +#pod +#pod This module converts CPAN Meta structures from one form to another. The +#pod primary use is to convert older structures to the most modern version of +#pod the specification, but other transformations may be implemented in the +#pod future as needed. (E.g. stripping all custom fields or stripping all +#pod optional fields.) +#pod +#pod =cut + +use CPAN::Meta::Validator; +use CPAN::Meta::Requirements; +use Parse::CPAN::Meta 1.4400 (); + +# To help ExtUtils::MakeMaker bootstrap CPAN::Meta::Requirements on perls +# before 5.10, we fall back to the EUMM bundled compatibility version module if +# that's the only thing available. This shouldn't ever happen in a normal CPAN +# install of CPAN::Meta::Requirements, as version.pm will be picked up from +# prereqs and be available at runtime. + +BEGIN { + eval "use version ()"; ## no critic + if ( my $err = $@ ) { + eval "use ExtUtils::MakeMaker::version" or die $err; ## no critic + } +} + +# Perl 5.10.0 didn't have "is_qv" in version.pm +*_is_qv = version->can('is_qv') ? sub { $_[0]->is_qv } : sub { exists $_[0]->{qv} }; + +sub _dclone { + my $ref = shift; + + # if an object is in the data structure and doesn't specify how to + # turn itself into JSON, we just stringify the object. That does the + # right thing for typical things that might be there, like version objects, + # Path::Class objects, etc. + no warnings 'once'; + no warnings 'redefine'; + local *UNIVERSAL::TO_JSON = sub { "$_[0]" }; + + my $json = Parse::CPAN::Meta->json_backend()->new + ->utf8 + ->allow_blessed + ->convert_blessed; + $json->decode($json->encode($ref)) +} + +my %known_specs = ( + '2' => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', + '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html', + '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html', + '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html', + '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html', + '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html' +); + +my @spec_list = sort { $a <=> $b } keys %known_specs; +my ($LOWEST, $HIGHEST) = @spec_list[0,-1]; + +#--------------------------------------------------------------------------# +# converters +# +# called as $converter->($element, $field_name, $full_meta, $to_version) +# +# defined return value used for field +# undef return value means field is skipped +#--------------------------------------------------------------------------# + +sub _keep { $_[0] } + +sub _keep_or_one { defined($_[0]) ? $_[0] : 1 } + +sub _keep_or_zero { defined($_[0]) ? $_[0] : 0 } + +sub _keep_or_unknown { defined($_[0]) && length($_[0]) ? $_[0] : "unknown" } + +sub _generated_by { + my $gen = shift; + my $sig = __PACKAGE__ . " version " . (__PACKAGE__->VERSION || "<dev>"); + + return $sig unless defined $gen and length $gen; + return $gen if $gen =~ /\Q$sig/; + return "$gen, $sig"; +} + +sub _listify { ! defined $_[0] ? undef : ref $_[0] eq 'ARRAY' ? $_[0] : [$_[0]] } + +sub _prefix_custom { + my $key = shift; + $key =~ s/^(?!x_) # Unless it already starts with x_ + (?:x-?)? # Remove leading x- or x (if present) + /x_/ix; # and prepend x_ + return $key; +} + +sub _ucfirst_custom { + my $key = shift; + $key = ucfirst $key unless $key =~ /[A-Z]/; + return $key; +} + +sub _no_prefix_ucfirst_custom { + my $key = shift; + $key =~ s/^x_//; + return _ucfirst_custom($key); +} + +sub _change_meta_spec { + my ($element, undef, undef, $version) = @_; + return { + version => $version, + url => $known_specs{$version}, + }; +} + +my @open_source = ( + 'perl', + 'gpl', + 'apache', + 'artistic', + 'artistic_2', + 'lgpl', + 'bsd', + 'gpl', + 'mit', + 'mozilla', + 'open_source', +); + +my %is_open_source = map {; $_ => 1 } @open_source; + +my @valid_licenses_1 = ( + @open_source, + 'unrestricted', + 'restrictive', + 'unknown', +); + +my %license_map_1 = ( + ( map { $_ => $_ } @valid_licenses_1 ), + artistic2 => 'artistic_2', +); + +sub _license_1 { + my ($element) = @_; + return 'unknown' unless defined $element; + if ( $license_map_1{lc $element} ) { + return $license_map_1{lc $element}; + } + else { + return 'unknown'; + } +} + +my @valid_licenses_2 = qw( + agpl_3 + apache_1_1 + apache_2_0 + artistic_1 + artistic_2 + bsd + freebsd + gfdl_1_2 + gfdl_1_3 + gpl_1 + gpl_2 + gpl_3 + lgpl_2_1 + lgpl_3_0 + mit + mozilla_1_0 + mozilla_1_1 + openssl + perl_5 + qpl_1_0 + ssleay + sun + zlib + open_source + restricted + unrestricted + unknown +); + +# The "old" values were defined by Module::Build, and were often vague. I have +# made the decisions below based on reading Module::Build::API and how clearly +# it specifies the version of the license. +my %license_map_2 = ( + (map { $_ => $_ } @valid_licenses_2), + apache => 'apache_2_0', # clearly stated as 2.0 + artistic => 'artistic_1', # clearly stated as 1 + artistic2 => 'artistic_2', # clearly stated as 2 + gpl => 'open_source', # we don't know which GPL; punt + lgpl => 'open_source', # we don't know which LGPL; punt + mozilla => 'open_source', # we don't know which MPL; punt + perl => 'perl_5', # clearly Perl 5 + restrictive => 'restricted', +); + +sub _license_2 { + my ($element) = @_; + return [ 'unknown' ] unless defined $element; + $element = [ $element ] unless ref $element eq 'ARRAY'; + my @new_list; + for my $lic ( @$element ) { + next unless defined $lic; + if ( my $new = $license_map_2{lc $lic} ) { + push @new_list, $new; + } + } + return @new_list ? \@new_list : [ 'unknown' ]; +} + +my %license_downgrade_map = qw( + agpl_3 open_source + apache_1_1 apache + apache_2_0 apache + artistic_1 artistic + artistic_2 artistic_2 + bsd bsd + freebsd open_source + gfdl_1_2 open_source + gfdl_1_3 open_source + gpl_1 gpl + gpl_2 gpl + gpl_3 gpl + lgpl_2_1 lgpl + lgpl_3_0 lgpl + mit mit + mozilla_1_0 mozilla + mozilla_1_1 mozilla + openssl open_source + perl_5 perl + qpl_1_0 open_source + ssleay open_source + sun open_source + zlib open_source + open_source open_source + restricted restrictive + unrestricted unrestricted + unknown unknown +); + +sub _downgrade_license { + my ($element) = @_; + if ( ! defined $element ) { + return "unknown"; + } + elsif( ref $element eq 'ARRAY' ) { + if ( @$element > 1) { + if (grep { !$is_open_source{ $license_downgrade_map{lc $_} || 'unknown' } } @$element) { + return 'unknown'; + } + else { + return 'open_source'; + } + } + elsif ( @$element == 1 ) { + return $license_downgrade_map{lc $element->[0]} || "unknown"; + } + } + elsif ( ! ref $element ) { + return $license_downgrade_map{lc $element} || "unknown"; + } + return "unknown"; +} + +my $no_index_spec_1_2 = { + 'file' => \&_listify, + 'dir' => \&_listify, + 'package' => \&_listify, + 'namespace' => \&_listify, +}; + +my $no_index_spec_1_3 = { + 'file' => \&_listify, + 'directory' => \&_listify, + 'package' => \&_listify, + 'namespace' => \&_listify, +}; + +my $no_index_spec_2 = { + 'file' => \&_listify, + 'directory' => \&_listify, + 'package' => \&_listify, + 'namespace' => \&_listify, + ':custom' => \&_prefix_custom, +}; + +sub _no_index_1_2 { + my (undef, undef, $meta) = @_; + my $no_index = $meta->{no_index} || $meta->{private}; + return unless $no_index; + + # cleanup wrong format + if ( ! ref $no_index ) { + my $item = $no_index; + $no_index = { dir => [ $item ], file => [ $item ] }; + } + elsif ( ref $no_index eq 'ARRAY' ) { + my $list = $no_index; + $no_index = { dir => [ @$list ], file => [ @$list ] }; + } + + # common mistake: files -> file + if ( exists $no_index->{files} ) { + $no_index->{file} = delete $no_index->{files}; + } + # common mistake: modules -> module + if ( exists $no_index->{modules} ) { + $no_index->{module} = delete $no_index->{modules}; + } + return _convert($no_index, $no_index_spec_1_2); +} + +sub _no_index_directory { + my ($element, $key, $meta, $version) = @_; + return unless $element; + + # cleanup wrong format + if ( ! ref $element ) { + my $item = $element; + $element = { directory => [ $item ], file => [ $item ] }; + } + elsif ( ref $element eq 'ARRAY' ) { + my $list = $element; + $element = { directory => [ @$list ], file => [ @$list ] }; + } + + if ( exists $element->{dir} ) { + $element->{directory} = delete $element->{dir}; + } + # common mistake: files -> file + if ( exists $element->{files} ) { + $element->{file} = delete $element->{files}; + } + # common mistake: modules -> module + if ( exists $element->{modules} ) { + $element->{module} = delete $element->{modules}; + } + my $spec = $version == 2 ? $no_index_spec_2 : $no_index_spec_1_3; + return _convert($element, $spec); +} + +sub _is_module_name { + my $mod = shift; + return unless defined $mod && length $mod; + return $mod =~ m{^[A-Za-z][A-Za-z0-9_]*(?:::[A-Za-z0-9_]+)*$}; +} + +sub _clean_version { + my ($element) = @_; + return 0 if ! defined $element; + + $element =~ s{^\s*}{}; + $element =~ s{\s*$}{}; + $element =~ s{^\.}{0.}; + + return 0 if ! length $element; + return 0 if ( $element eq 'undef' || $element eq '<undef>' ); + + my $v = eval { version->new($element) }; + # XXX check defined $v and not just $v because version objects leak memory + # in boolean context -- dagolden, 2012-02-03 + if ( defined $v ) { + return _is_qv($v) ? $v->normal : $element; + } + else { + return 0; + } +} + +sub _bad_version_hook { + my ($v) = @_; + $v =~ s{^\s*}{}; + $v =~ s{\s*$}{}; + $v =~ s{[a-z]+$}{}; # strip trailing alphabetics + my $vobj = eval { version->new($v) }; + return defined($vobj) ? $vobj : version->new(0); # or give up +} + +sub _version_map { + my ($element) = @_; + return unless defined $element; + if ( ref $element eq 'HASH' ) { + # XXX turn this into CPAN::Meta::Requirements with bad version hook + # and then turn it back into a hash + my $new_map = CPAN::Meta::Requirements->new( + { bad_version_hook => \&_bad_version_hook } # punt + ); + while ( my ($k,$v) = each %$element ) { + next unless _is_module_name($k); + if ( !defined($v) || !length($v) || $v eq 'undef' || $v eq '<undef>' ) { + $v = 0; + } + # some weird, old META have bad yml with module => module + # so check if value is like a module name and not like a version + if ( _is_module_name($v) && ! version::is_lax($v) ) { + $new_map->add_minimum($k => 0); + $new_map->add_minimum($v => 0); + } + $new_map->add_string_requirement($k => $v); + } + return $new_map->as_string_hash; + } + elsif ( ref $element eq 'ARRAY' ) { + my $hashref = { map { $_ => 0 } @$element }; + return _version_map($hashref); # cleanup any weird stuff + } + elsif ( ref $element eq '' && length $element ) { + return { $element => 0 } + } + return; +} + +sub _prereqs_from_1 { + my (undef, undef, $meta) = @_; + my $prereqs = {}; + for my $phase ( qw/build configure/ ) { + my $key = "${phase}_requires"; + $prereqs->{$phase}{requires} = _version_map($meta->{$key}) + if $meta->{$key}; + } + for my $rel ( qw/requires recommends conflicts/ ) { + $prereqs->{runtime}{$rel} = _version_map($meta->{$rel}) + if $meta->{$rel}; + } + return $prereqs; +} + +my $prereqs_spec = { + configure => \&_prereqs_rel, + build => \&_prereqs_rel, + test => \&_prereqs_rel, + runtime => \&_prereqs_rel, + develop => \&_prereqs_rel, + ':custom' => \&_prefix_custom, +}; + +my $relation_spec = { + requires => \&_version_map, + recommends => \&_version_map, + suggests => \&_version_map, + conflicts => \&_version_map, + ':custom' => \&_prefix_custom, +}; + +sub _cleanup_prereqs { + my ($prereqs, $key, $meta, $to_version) = @_; + return unless $prereqs && ref $prereqs eq 'HASH'; + return _convert( $prereqs, $prereqs_spec, $to_version ); +} + +sub _prereqs_rel { + my ($relation, $key, $meta, $to_version) = @_; + return unless $relation && ref $relation eq 'HASH'; + return _convert( $relation, $relation_spec, $to_version ); +} + + +BEGIN { + my @old_prereqs = qw( + requires + configure_requires + recommends + conflicts + ); + + for ( @old_prereqs ) { + my $sub = "_get_$_"; + my ($phase,$type) = split qr/_/, $_; + if ( ! defined $type ) { + $type = $phase; + $phase = 'runtime'; + } + no strict 'refs'; + *{$sub} = sub { _extract_prereqs($_[2]->{prereqs},$phase,$type) }; + } +} + +sub _get_build_requires { + my ($data, $key, $meta) = @_; + + my $test_h = _extract_prereqs($_[2]->{prereqs}, qw(test requires)) || {}; + my $build_h = _extract_prereqs($_[2]->{prereqs}, qw(build requires)) || {}; + + my $test_req = CPAN::Meta::Requirements->from_string_hash($test_h); + my $build_req = CPAN::Meta::Requirements->from_string_hash($build_h); + + $test_req->add_requirements($build_req)->as_string_hash; +} + +sub _extract_prereqs { + my ($prereqs, $phase, $type) = @_; + return unless ref $prereqs eq 'HASH'; + return scalar _version_map($prereqs->{$phase}{$type}); +} + +sub _downgrade_optional_features { + my (undef, undef, $meta) = @_; + return unless exists $meta->{optional_features}; + my $origin = $meta->{optional_features}; + my $features = {}; + for my $name ( keys %$origin ) { + $features->{$name} = { + description => $origin->{$name}{description}, + requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','requires'), + configure_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','configure_requires'), + build_requires => _extract_prereqs($origin->{$name}{prereqs},'runtime','build_requires'), + recommends => _extract_prereqs($origin->{$name}{prereqs},'runtime','recommends'), + conflicts => _extract_prereqs($origin->{$name}{prereqs},'runtime','conflicts'), + }; + for my $k (keys %{$features->{$name}} ) { + delete $features->{$name}{$k} unless defined $features->{$name}{$k}; + } + } + return $features; +} + +sub _upgrade_optional_features { + my (undef, undef, $meta) = @_; + return unless exists $meta->{optional_features}; + my $origin = $meta->{optional_features}; + my $features = {}; + for my $name ( keys %$origin ) { + $features->{$name} = { + description => $origin->{$name}{description}, + prereqs => _prereqs_from_1(undef, undef, $origin->{$name}), + }; + delete $features->{$name}{prereqs}{configure}; + } + return $features; +} + +my $optional_features_2_spec = { + description => \&_keep, + prereqs => \&_cleanup_prereqs, + ':custom' => \&_prefix_custom, +}; + +sub _feature_2 { + my ($element, $key, $meta, $to_version) = @_; + return unless $element && ref $element eq 'HASH'; + _convert( $element, $optional_features_2_spec, $to_version ); +} + +sub _cleanup_optional_features_2 { + my ($element, $key, $meta, $to_version) = @_; + return unless $element && ref $element eq 'HASH'; + my $new_data = {}; + for my $k ( keys %$element ) { + $new_data->{$k} = _feature_2( $element->{$k}, $k, $meta, $to_version ); + } + return unless keys %$new_data; + return $new_data; +} + +sub _optional_features_1_4 { + my ($element) = @_; + return unless $element; + $element = _optional_features_as_map($element); + for my $name ( keys %$element ) { + for my $drop ( qw/requires_packages requires_os excluded_os/ ) { + delete $element->{$name}{$drop}; + } + } + return $element; +} + +sub _optional_features_as_map { + my ($element) = @_; + return unless $element; + if ( ref $element eq 'ARRAY' ) { + my %map; + for my $feature ( @$element ) { + my (@parts) = %$feature; + $map{$parts[0]} = $parts[1]; + } + $element = \%map; + } + return $element; +} + +sub _is_urlish { defined $_[0] && $_[0] =~ m{\A[-+.a-z0-9]+:.+}i } + +sub _url_or_drop { + my ($element) = @_; + return $element if _is_urlish($element); + return; +} + +sub _url_list { + my ($element) = @_; + return unless $element; + $element = _listify( $element ); + $element = [ grep { _is_urlish($_) } @$element ]; + return unless @$element; + return $element; +} + +sub _author_list { + my ($element) = @_; + return [ 'unknown' ] unless $element; + $element = _listify( $element ); + $element = [ map { defined $_ && length $_ ? $_ : 'unknown' } @$element ]; + return [ 'unknown' ] unless @$element; + return $element; +} + +my $resource2_upgrade = { + license => sub { return _is_urlish($_[0]) ? _listify( $_[0] ) : undef }, + homepage => \&_url_or_drop, + bugtracker => sub { + my ($item) = @_; + return unless $item; + if ( $item =~ m{^mailto:(.*)$} ) { return { mailto => $1 } } + elsif( _is_urlish($item) ) { return { web => $item } } + else { return } + }, + repository => sub { return _is_urlish($_[0]) ? { url => $_[0] } : undef }, + ':custom' => \&_prefix_custom, +}; + +sub _upgrade_resources_2 { + my (undef, undef, $meta, $version) = @_; + return unless exists $meta->{resources}; + return _convert($meta->{resources}, $resource2_upgrade); +} + +my $bugtracker2_spec = { + web => \&_url_or_drop, + mailto => \&_keep, + ':custom' => \&_prefix_custom, +}; + +sub _repo_type { + my ($element, $key, $meta, $to_version) = @_; + return $element if defined $element; + return unless exists $meta->{url}; + my $repo_url = $meta->{url}; + for my $type ( qw/git svn/ ) { + return $type if $repo_url =~ m{\A$type}; + } + return; +} + +my $repository2_spec = { + web => \&_url_or_drop, + url => \&_url_or_drop, + type => \&_repo_type, + ':custom' => \&_prefix_custom, +}; + +my $resources2_cleanup = { + license => \&_url_list, + homepage => \&_url_or_drop, + bugtracker => sub { ref $_[0] ? _convert( $_[0], $bugtracker2_spec ) : undef }, + repository => sub { my $data = shift; ref $data ? _convert( $data, $repository2_spec ) : undef }, + ':custom' => \&_prefix_custom, +}; + +sub _cleanup_resources_2 { + my ($resources, $key, $meta, $to_version) = @_; + return unless $resources && ref $resources eq 'HASH'; + return _convert($resources, $resources2_cleanup, $to_version); +} + +my $resource1_spec = { + license => \&_url_or_drop, + homepage => \&_url_or_drop, + bugtracker => \&_url_or_drop, + repository => \&_url_or_drop, + ':custom' => \&_keep, +}; + +sub _resources_1_3 { + my (undef, undef, $meta, $version) = @_; + return unless exists $meta->{resources}; + return _convert($meta->{resources}, $resource1_spec); +} + +*_resources_1_4 = *_resources_1_3; + +sub _resources_1_2 { + my (undef, undef, $meta) = @_; + my $resources = $meta->{resources} || {}; + if ( $meta->{license_url} && ! $resources->{license} ) { + $resources->{license} = $meta->{license_url} + if _is_urlish($meta->{license_url}); + } + return unless keys %$resources; + return _convert($resources, $resource1_spec); +} + +my $resource_downgrade_spec = { + license => sub { return ref $_[0] ? $_[0]->[0] : $_[0] }, + homepage => \&_url_or_drop, + bugtracker => sub { return $_[0]->{web} }, + repository => sub { return $_[0]->{url} || $_[0]->{web} }, + ':custom' => \&_no_prefix_ucfirst_custom, +}; + +sub _downgrade_resources { + my (undef, undef, $meta, $version) = @_; + return unless exists $meta->{resources}; + return _convert($meta->{resources}, $resource_downgrade_spec); +} + +sub _release_status { + my ($element, undef, $meta) = @_; + return $element if $element && $element =~ m{\A(?:stable|testing|unstable)\z}; + return _release_status_from_version(undef, undef, $meta); +} + +sub _release_status_from_version { + my (undef, undef, $meta) = @_; + my $version = $meta->{version} || ''; + return ( $version =~ /_/ ) ? 'testing' : 'stable'; +} + +my $provides_spec = { + file => \&_keep, + version => \&_keep, +}; + +my $provides_spec_2 = { + file => \&_keep, + version => \&_keep, + ':custom' => \&_prefix_custom, +}; + +sub _provides { + my ($element, $key, $meta, $to_version) = @_; + return unless defined $element && ref $element eq 'HASH'; + my $spec = $to_version == 2 ? $provides_spec_2 : $provides_spec; + my $new_data = {}; + for my $k ( keys %$element ) { + $new_data->{$k} = _convert($element->{$k}, $spec, $to_version); + $new_data->{$k}{version} = _clean_version($element->{$k}{version}) + if exists $element->{$k}{version}; + } + return $new_data; +} + +sub _convert { + my ($data, $spec, $to_version, $is_fragment) = @_; + + my $new_data = {}; + for my $key ( keys %$spec ) { + next if $key eq ':custom' || $key eq ':drop'; + next unless my $fcn = $spec->{$key}; + if ( $is_fragment && $key eq 'generated_by' ) { + $fcn = \&_keep; + } + die "spec for '$key' is not a coderef" + unless ref $fcn && ref $fcn eq 'CODE'; + my $new_value = $fcn->($data->{$key}, $key, $data, $to_version); + $new_data->{$key} = $new_value if defined $new_value; + } + + my $drop_list = $spec->{':drop'}; + my $customizer = $spec->{':custom'} || \&_keep; + + for my $key ( keys %$data ) { + next if $drop_list && grep { $key eq $_ } @$drop_list; + next if exists $spec->{$key}; # we handled it + $new_data->{ $customizer->($key) } = $data->{$key}; + } + + return $new_data; +} + +#--------------------------------------------------------------------------# +# define converters for each conversion +#--------------------------------------------------------------------------# + +# each converts from prior version +# special ":custom" field is used for keys not recognized in spec +my %up_convert = ( + '2-from-1.4' => { + # PRIOR MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'generated_by' => \&_generated_by, + 'license' => \&_license_2, + 'meta-spec' => \&_change_meta_spec, + 'name' => \&_keep, + 'version' => \&_keep, + # CHANGED TO MANDATORY + 'dynamic_config' => \&_keep_or_one, + # ADDED MANDATORY + 'release_status' => \&_release_status, + # PRIOR OPTIONAL + 'keywords' => \&_keep, + 'no_index' => \&_no_index_directory, + 'optional_features' => \&_upgrade_optional_features, + 'provides' => \&_provides, + 'resources' => \&_upgrade_resources_2, + # ADDED OPTIONAL + 'description' => \&_keep, + 'prereqs' => \&_prereqs_from_1, + + # drop these deprecated fields, but only after we convert + ':drop' => [ qw( + build_requires + configure_requires + conflicts + distribution_type + license_url + private + recommends + requires + ) ], + + # other random keys need x_ prefixing + ':custom' => \&_prefix_custom, + }, + '1.4-from-1.3' => { + # PRIOR MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'meta-spec' => \&_change_meta_spec, + 'name' => \&_keep, + 'version' => \&_keep, + # PRIOR OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'keywords' => \&_keep, + 'no_index' => \&_no_index_directory, + 'optional_features' => \&_optional_features_1_4, + 'provides' => \&_provides, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + 'resources' => \&_resources_1_4, + # ADDED OPTIONAL + 'configure_requires' => \&_keep, + + # drop these deprecated fields, but only after we convert + ':drop' => [ qw( + license_url + private + )], + + # other random keys are OK if already valid + ':custom' => \&_keep + }, + '1.3-from-1.2' => { + # PRIOR MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'meta-spec' => \&_change_meta_spec, + 'name' => \&_keep, + 'version' => \&_keep, + # PRIOR OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'keywords' => \&_keep, + 'no_index' => \&_no_index_directory, + 'optional_features' => \&_optional_features_as_map, + 'provides' => \&_provides, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + 'resources' => \&_resources_1_3, + + # drop these deprecated fields, but only after we convert + ':drop' => [ qw( + license_url + private + )], + + # other random keys are OK if already valid + ':custom' => \&_keep + }, + '1.2-from-1.1' => { + # PRIOR MANDATORY + 'version' => \&_keep, + # CHANGED TO MANDATORY + 'license' => \&_license_1, + 'name' => \&_keep, + 'generated_by' => \&_generated_by, + # ADDED MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'meta-spec' => \&_change_meta_spec, + # PRIOR OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + # ADDED OPTIONAL + 'keywords' => \&_keep, + 'no_index' => \&_no_index_1_2, + 'optional_features' => \&_optional_features_as_map, + 'provides' => \&_provides, + 'resources' => \&_resources_1_2, + + # drop these deprecated fields, but only after we convert + ':drop' => [ qw( + license_url + private + )], + + # other random keys are OK if already valid + ':custom' => \&_keep + }, + '1.1-from-1.0' => { + # CHANGED TO MANDATORY + 'version' => \&_keep, + # IMPLIED MANDATORY + 'name' => \&_keep, + # PRIOR OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + # ADDED OPTIONAL + 'license_url' => \&_url_or_drop, + 'private' => \&_keep, + + # other random keys are OK if already valid + ':custom' => \&_keep + }, +); + +my %down_convert = ( + '1.4-from-2' => { + # MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'generated_by' => \&_generated_by, + 'license' => \&_downgrade_license, + 'meta-spec' => \&_change_meta_spec, + 'name' => \&_keep, + 'version' => \&_keep, + # OPTIONAL + 'build_requires' => \&_get_build_requires, + 'configure_requires' => \&_get_configure_requires, + 'conflicts' => \&_get_conflicts, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'keywords' => \&_keep, + 'no_index' => \&_no_index_directory, + 'optional_features' => \&_downgrade_optional_features, + 'provides' => \&_provides, + 'recommends' => \&_get_recommends, + 'requires' => \&_get_requires, + 'resources' => \&_downgrade_resources, + + # drop these unsupported fields (after conversion) + ':drop' => [ qw( + description + prereqs + release_status + )], + + # custom keys will be left unchanged + ':custom' => \&_keep + }, + '1.3-from-1.4' => { + # MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'meta-spec' => \&_change_meta_spec, + 'name' => \&_keep, + 'version' => \&_keep, + # OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'keywords' => \&_keep, + 'no_index' => \&_no_index_directory, + 'optional_features' => \&_optional_features_as_map, + 'provides' => \&_provides, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + 'resources' => \&_resources_1_3, + + # drop these unsupported fields, but only after we convert + ':drop' => [ qw( + configure_requires + )], + + # other random keys are OK if already valid + ':custom' => \&_keep, + }, + '1.2-from-1.3' => { + # MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'meta-spec' => \&_change_meta_spec, + 'name' => \&_keep, + 'version' => \&_keep, + # OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'keywords' => \&_keep, + 'no_index' => \&_no_index_1_2, + 'optional_features' => \&_optional_features_as_map, + 'provides' => \&_provides, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + 'resources' => \&_resources_1_3, + + # other random keys are OK if already valid + ':custom' => \&_keep, + }, + '1.1-from-1.2' => { + # MANDATORY + 'version' => \&_keep, + # IMPLIED MANDATORY + 'name' => \&_keep, + 'meta-spec' => \&_change_meta_spec, + # OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'private' => \&_keep, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + + # drop unsupported fields + ':drop' => [ qw( + abstract + author + provides + no_index + keywords + resources + )], + + # other random keys are OK if already valid + ':custom' => \&_keep, + }, + '1.0-from-1.1' => { + # IMPLIED MANDATORY + 'name' => \&_keep, + 'meta-spec' => \&_change_meta_spec, + 'version' => \&_keep, + # PRIOR OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + + # other random keys are OK if already valid + ':custom' => \&_keep, + }, +); + +my %cleanup = ( + '2' => { + # PRIOR MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'generated_by' => \&_generated_by, + 'license' => \&_license_2, + 'meta-spec' => \&_change_meta_spec, + 'name' => \&_keep, + 'version' => \&_keep, + # CHANGED TO MANDATORY + 'dynamic_config' => \&_keep_or_one, + # ADDED MANDATORY + 'release_status' => \&_release_status, + # PRIOR OPTIONAL + 'keywords' => \&_keep, + 'no_index' => \&_no_index_directory, + 'optional_features' => \&_cleanup_optional_features_2, + 'provides' => \&_provides, + 'resources' => \&_cleanup_resources_2, + # ADDED OPTIONAL + 'description' => \&_keep, + 'prereqs' => \&_cleanup_prereqs, + + # drop these deprecated fields, but only after we convert + ':drop' => [ qw( + build_requires + configure_requires + conflicts + distribution_type + license_url + private + recommends + requires + ) ], + + # other random keys need x_ prefixing + ':custom' => \&_prefix_custom, + }, + '1.4' => { + # PRIOR MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'meta-spec' => \&_change_meta_spec, + 'name' => \&_keep, + 'version' => \&_keep, + # PRIOR OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'keywords' => \&_keep, + 'no_index' => \&_no_index_directory, + 'optional_features' => \&_optional_features_1_4, + 'provides' => \&_provides, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + 'resources' => \&_resources_1_4, + # ADDED OPTIONAL + 'configure_requires' => \&_keep, + + # other random keys are OK if already valid + ':custom' => \&_keep + }, + '1.3' => { + # PRIOR MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'meta-spec' => \&_change_meta_spec, + 'name' => \&_keep, + 'version' => \&_keep, + # PRIOR OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'keywords' => \&_keep, + 'no_index' => \&_no_index_directory, + 'optional_features' => \&_optional_features_as_map, + 'provides' => \&_provides, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + 'resources' => \&_resources_1_3, + + # other random keys are OK if already valid + ':custom' => \&_keep + }, + '1.2' => { + # PRIOR MANDATORY + 'version' => \&_keep, + # CHANGED TO MANDATORY + 'license' => \&_license_1, + 'name' => \&_keep, + 'generated_by' => \&_generated_by, + # ADDED MANDATORY + 'abstract' => \&_keep_or_unknown, + 'author' => \&_author_list, + 'meta-spec' => \&_change_meta_spec, + # PRIOR OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + # ADDED OPTIONAL + 'keywords' => \&_keep, + 'no_index' => \&_no_index_1_2, + 'optional_features' => \&_optional_features_as_map, + 'provides' => \&_provides, + 'resources' => \&_resources_1_2, + + # other random keys are OK if already valid + ':custom' => \&_keep + }, + '1.1' => { + # CHANGED TO MANDATORY + 'version' => \&_keep, + # IMPLIED MANDATORY + 'name' => \&_keep, + 'meta-spec' => \&_change_meta_spec, + # PRIOR OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + # ADDED OPTIONAL + 'license_url' => \&_url_or_drop, + 'private' => \&_keep, + + # other random keys are OK if already valid + ':custom' => \&_keep + }, + '1.0' => { + # IMPLIED MANDATORY + 'name' => \&_keep, + 'meta-spec' => \&_change_meta_spec, + 'version' => \&_keep, + # IMPLIED OPTIONAL + 'build_requires' => \&_version_map, + 'conflicts' => \&_version_map, + 'distribution_type' => \&_keep, + 'dynamic_config' => \&_keep_or_one, + 'generated_by' => \&_generated_by, + 'license' => \&_license_1, + 'recommends' => \&_version_map, + 'requires' => \&_version_map, + + # other random keys are OK if already valid + ':custom' => \&_keep, + }, +); + +# for a given field in a spec version, what fields will it feed +# into in the *latest* spec (i.e. v2); meta-spec omitted because +# we always expect a meta-spec to be generated +my %fragments_generate = ( + '2' => { + 'abstract' => 'abstract', + 'author' => 'author', + 'generated_by' => 'generated_by', + 'license' => 'license', + 'name' => 'name', + 'version' => 'version', + 'dynamic_config' => 'dynamic_config', + 'release_status' => 'release_status', + 'keywords' => 'keywords', + 'no_index' => 'no_index', + 'optional_features' => 'optional_features', + 'provides' => 'provides', + 'resources' => 'resources', + 'description' => 'description', + 'prereqs' => 'prereqs', + }, + '1.4' => { + 'abstract' => 'abstract', + 'author' => 'author', + 'generated_by' => 'generated_by', + 'license' => 'license', + 'name' => 'name', + 'version' => 'version', + 'build_requires' => 'prereqs', + 'conflicts' => 'prereqs', + 'distribution_type' => 'distribution_type', + 'dynamic_config' => 'dynamic_config', + 'keywords' => 'keywords', + 'no_index' => 'no_index', + 'optional_features' => 'optional_features', + 'provides' => 'provides', + 'recommends' => 'prereqs', + 'requires' => 'prereqs', + 'resources' => 'resources', + 'configure_requires' => 'prereqs', + }, +); +# this is not quite true but will work well enough +# as 1.4 is a superset of earlier ones +$fragments_generate{$_} = $fragments_generate{'1.4'} for qw/1.3 1.2 1.1 1.0/; + +#--------------------------------------------------------------------------# +# Code +#--------------------------------------------------------------------------# + +#pod =method new +#pod +#pod my $cmc = CPAN::Meta::Converter->new( $struct ); +#pod +#pod The constructor should be passed a valid metadata structure but invalid +#pod structures are accepted. If no meta-spec version is provided, version 1.0 will +#pod be assumed. +#pod +#pod Optionally, you can provide a C<default_version> argument after C<$struct>: +#pod +#pod my $cmc = CPAN::Meta::Converter->new( $struct, default_version => "1.4" ); +#pod +#pod This is only needed when converting a metadata fragment that does not include a +#pod C<meta-spec> field. +#pod +#pod =cut + +sub new { + my ($class,$data,%args) = @_; + + # create an attributes hash + my $self = { + 'data' => $data, + 'spec' => _extract_spec_version($data, $args{default_version}), + }; + + # create the object + return bless $self, $class; +} + +sub _extract_spec_version { + my ($data, $default) = @_; + my $spec = $data->{'meta-spec'}; + + # is meta-spec there and valid? + return( $default || "1.0" ) unless defined $spec && ref $spec eq 'HASH'; # before meta-spec? + + # does the version key look like a valid version? + my $v = $spec->{version}; + if ( defined $v && $v =~ /^\d+(?:\.\d+)?$/ ) { + return $v if defined $v && grep { $v eq $_ } keys %known_specs; # known spec + return $v+0 if defined $v && grep { $v == $_ } keys %known_specs; # 2.0 => 2 + } + + # otherwise, use heuristics: look for 1.x vs 2.0 fields + return "2" if exists $data->{prereqs}; + return "1.4" if exists $data->{configure_requires}; + return( $default || "1.2" ); # when meta-spec was first defined +} + +#pod =method convert +#pod +#pod my $new_struct = $cmc->convert( version => "2" ); +#pod +#pod Returns a new hash reference with the metadata converted to a different form. +#pod C<convert> will die if any conversion/standardization still results in an +#pod invalid structure. +#pod +#pod Valid parameters include: +#pod +#pod =over +#pod +#pod =item * +#pod +#pod C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2"). +#pod Defaults to the latest version of the CPAN Meta Spec. +#pod +#pod =back +#pod +#pod Conversion proceeds through each version in turn. For example, a version 1.2 +#pod structure might be converted to 1.3 then 1.4 then finally to version 2. The +#pod conversion process attempts to clean-up simple errors and standardize data. +#pod For example, if C<author> is given as a scalar, it will converted to an array +#pod reference containing the item. (Converting a structure to its own version will +#pod also clean-up and standardize.) +#pod +#pod When data are cleaned and standardized, missing or invalid fields will be +#pod replaced with sensible defaults when possible. This may be lossy or imprecise. +#pod For example, some badly structured META.yml files on CPAN have prerequisite +#pod modules listed as both keys and values: +#pod +#pod requires => { 'Foo::Bar' => 'Bam::Baz' } +#pod +#pod These would be split and each converted to a prerequisite with a minimum +#pod version of zero. +#pod +#pod When some mandatory fields are missing or invalid, the conversion will attempt +#pod to provide a sensible default or will fill them with a value of 'unknown'. For +#pod example a missing or unrecognized C<license> field will result in a C<license> +#pod field of 'unknown'. Fields that may get an 'unknown' include: +#pod +#pod =for :list +#pod * abstract +#pod * author +#pod * license +#pod +#pod =cut + +sub convert { + my ($self, %args) = @_; + my $args = { %args }; + + my $new_version = $args->{version} || $HIGHEST; + my $is_fragment = $args->{is_fragment}; + + my ($old_version) = $self->{spec}; + my $converted = _dclone($self->{data}); + + if ( $old_version == $new_version ) { + $converted = _convert( $converted, $cleanup{$old_version}, $old_version, $is_fragment ); + unless ( $args->{is_fragment} ) { + my $cmv = CPAN::Meta::Validator->new( $converted ); + unless ( $cmv->is_valid ) { + my $errs = join("\n", $cmv->errors); + die "Failed to clean-up $old_version metadata. Errors:\n$errs\n"; + } + } + return $converted; + } + elsif ( $old_version > $new_version ) { + my @vers = sort { $b <=> $a } keys %known_specs; + for my $i ( 0 .. $#vers-1 ) { + next if $vers[$i] > $old_version; + last if $vers[$i+1] < $new_version; + my $spec_string = "$vers[$i+1]-from-$vers[$i]"; + $converted = _convert( $converted, $down_convert{$spec_string}, $vers[$i+1], $is_fragment ); + unless ( $args->{is_fragment} ) { + my $cmv = CPAN::Meta::Validator->new( $converted ); + unless ( $cmv->is_valid ) { + my $errs = join("\n", $cmv->errors); + die "Failed to downconvert metadata to $vers[$i+1]. Errors:\n$errs\n"; + } + } + } + return $converted; + } + else { + my @vers = sort { $a <=> $b } keys %known_specs; + for my $i ( 0 .. $#vers-1 ) { + next if $vers[$i] < $old_version; + last if $vers[$i+1] > $new_version; + my $spec_string = "$vers[$i+1]-from-$vers[$i]"; + $converted = _convert( $converted, $up_convert{$spec_string}, $vers[$i+1], $is_fragment ); + unless ( $args->{is_fragment} ) { + my $cmv = CPAN::Meta::Validator->new( $converted ); + unless ( $cmv->is_valid ) { + my $errs = join("\n", $cmv->errors); + die "Failed to upconvert metadata to $vers[$i+1]. Errors:\n$errs\n"; + } + } + } + return $converted; + } +} + +#pod =method upgrade_fragment +#pod +#pod my $new_struct = $cmc->upgrade_fragment; +#pod +#pod Returns a new hash reference with the metadata converted to the latest version +#pod of the CPAN Meta Spec. No validation is done on the result -- you must +#pod validate after merging fragments into a complete metadata document. +#pod +#pod Available since version 2.141170. +#pod +#pod =cut + +sub upgrade_fragment { + my ($self) = @_; + my ($old_version) = $self->{spec}; + my %expected = + map {; $_ => 1 } + grep { defined } + map { $fragments_generate{$old_version}{$_} } + keys %{ $self->{data} }; + my $converted = $self->convert( version => $HIGHEST, is_fragment => 1 ); + for my $key ( keys %$converted ) { + next if $key =~ /^x_/i || $key eq 'meta-spec'; + delete $converted->{$key} unless $expected{$key}; + } + return $converted; +} + +1; + +# ABSTRACT: Convert CPAN distribution metadata structures + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta::Converter - Convert CPAN distribution metadata structures + +=head1 VERSION + +version 2.150005 + +=head1 SYNOPSIS + + my $struct = decode_json_file('META.json'); + + my $cmc = CPAN::Meta::Converter->new( $struct ); + + my $new_struct = $cmc->convert( version => "2" ); + +=head1 DESCRIPTION + +This module converts CPAN Meta structures from one form to another. The +primary use is to convert older structures to the most modern version of +the specification, but other transformations may be implemented in the +future as needed. (E.g. stripping all custom fields or stripping all +optional fields.) + +=head1 METHODS + +=head2 new + + my $cmc = CPAN::Meta::Converter->new( $struct ); + +The constructor should be passed a valid metadata structure but invalid +structures are accepted. If no meta-spec version is provided, version 1.0 will +be assumed. + +Optionally, you can provide a C<default_version> argument after C<$struct>: + + my $cmc = CPAN::Meta::Converter->new( $struct, default_version => "1.4" ); + +This is only needed when converting a metadata fragment that does not include a +C<meta-spec> field. + +=head2 convert + + my $new_struct = $cmc->convert( version => "2" ); + +Returns a new hash reference with the metadata converted to a different form. +C<convert> will die if any conversion/standardization still results in an +invalid structure. + +Valid parameters include: + +=over + +=item * + +C<version> -- Indicates the desired specification version (e.g. "1.0", "1.1" ... "1.4", "2"). +Defaults to the latest version of the CPAN Meta Spec. + +=back + +Conversion proceeds through each version in turn. For example, a version 1.2 +structure might be converted to 1.3 then 1.4 then finally to version 2. The +conversion process attempts to clean-up simple errors and standardize data. +For example, if C<author> is given as a scalar, it will converted to an array +reference containing the item. (Converting a structure to its own version will +also clean-up and standardize.) + +When data are cleaned and standardized, missing or invalid fields will be +replaced with sensible defaults when possible. This may be lossy or imprecise. +For example, some badly structured META.yml files on CPAN have prerequisite +modules listed as both keys and values: + + requires => { 'Foo::Bar' => 'Bam::Baz' } + +These would be split and each converted to a prerequisite with a minimum +version of zero. + +When some mandatory fields are missing or invalid, the conversion will attempt +to provide a sensible default or will fill them with a value of 'unknown'. For +example a missing or unrecognized C<license> field will result in a C<license> +field of 'unknown'. Fields that may get an 'unknown' include: + +=over 4 + +=item * + +abstract + +=item * + +author + +=item * + +license + +=back + +=head2 upgrade_fragment + + my $new_struct = $cmc->upgrade_fragment; + +Returns a new hash reference with the metadata converted to the latest version +of the CPAN Meta Spec. No validation is done on the result -- you must +validate after merging fragments into a complete metadata document. + +Available since version 2.141170. + +=head1 BUGS + +Please report any bugs or feature using the CPAN Request Tracker. +Bugs can be submitted through the web interface at +L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta> + +When submitting a bug or request, please include a test-file or a patch to an +existing test-file that illustrates the bug or desired feature. + +=head1 AUTHORS + +=over 4 + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Ricardo Signes <rjbs@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by David Golden and Ricardo Signes. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + +__END__ + + +# vim: ts=2 sts=2 sw=2 et : diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta/Feature.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/Feature.pm new file mode 100644 index 000000000..9dac4f421 --- /dev/null +++ b/.checksetup_lib/lib/perl5/CPAN/Meta/Feature.pm @@ -0,0 +1,149 @@ +use 5.006; +use strict; +use warnings; +package CPAN::Meta::Feature; + +our $VERSION = '2.150005'; + +use CPAN::Meta::Prereqs; + +#pod =head1 DESCRIPTION +#pod +#pod A CPAN::Meta::Feature object describes an optional feature offered by a CPAN +#pod distribution and specified in the distribution's F<META.json> (or F<META.yml>) +#pod file. +#pod +#pod For the most part, this class will only be used when operating on the result of +#pod the C<feature> or C<features> methods on a L<CPAN::Meta> object. +#pod +#pod =method new +#pod +#pod my $feature = CPAN::Meta::Feature->new( $identifier => \%spec ); +#pod +#pod This returns a new Feature object. The C<%spec> argument to the constructor +#pod should be the same as the value of the C<optional_feature> entry in the +#pod distmeta. It must contain entries for C<description> and C<prereqs>. +#pod +#pod =cut + +sub new { + my ($class, $identifier, $spec) = @_; + + my %guts = ( + identifier => $identifier, + description => $spec->{description}, + prereqs => CPAN::Meta::Prereqs->new($spec->{prereqs}), + ); + + bless \%guts => $class; +} + +#pod =method identifier +#pod +#pod This method returns the feature's identifier. +#pod +#pod =cut + +sub identifier { $_[0]{identifier} } + +#pod =method description +#pod +#pod This method returns the feature's long description. +#pod +#pod =cut + +sub description { $_[0]{description} } + +#pod =method prereqs +#pod +#pod This method returns the feature's prerequisites as a L<CPAN::Meta::Prereqs> +#pod object. +#pod +#pod =cut + +sub prereqs { $_[0]{prereqs} } + +1; + +# ABSTRACT: an optional feature provided by a CPAN distribution + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta::Feature - an optional feature provided by a CPAN distribution + +=head1 VERSION + +version 2.150005 + +=head1 DESCRIPTION + +A CPAN::Meta::Feature object describes an optional feature offered by a CPAN +distribution and specified in the distribution's F<META.json> (or F<META.yml>) +file. + +For the most part, this class will only be used when operating on the result of +the C<feature> or C<features> methods on a L<CPAN::Meta> object. + +=head1 METHODS + +=head2 new + + my $feature = CPAN::Meta::Feature->new( $identifier => \%spec ); + +This returns a new Feature object. The C<%spec> argument to the constructor +should be the same as the value of the C<optional_feature> entry in the +distmeta. It must contain entries for C<description> and C<prereqs>. + +=head2 identifier + +This method returns the feature's identifier. + +=head2 description + +This method returns the feature's long description. + +=head2 prereqs + +This method returns the feature's prerequisites as a L<CPAN::Meta::Prereqs> +object. + +=head1 BUGS + +Please report any bugs or feature using the CPAN Request Tracker. +Bugs can be submitted through the web interface at +L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta> + +When submitting a bug or request, please include a test-file or a patch to an +existing test-file that illustrates the bug or desired feature. + +=head1 AUTHORS + +=over 4 + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Ricardo Signes <rjbs@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by David Golden and Ricardo Signes. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + +__END__ + + +# vim: ts=2 sts=2 sw=2 et : diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta/History.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/History.pm new file mode 100644 index 000000000..f4cac5e59 --- /dev/null +++ b/.checksetup_lib/lib/perl5/CPAN/Meta/History.pm @@ -0,0 +1,316 @@ +# vi:tw=72 +use 5.006; +use strict; +use warnings; +package CPAN::Meta::History; + +our $VERSION = '2.150005'; + +1; + +# ABSTRACT: history of CPAN Meta Spec changes + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta::History - history of CPAN Meta Spec changes + +=head1 VERSION + +version 2.150005 + +=head1 DESCRIPTION + +The CPAN Meta Spec has gone through several iterations. It was +originally written in HTML and later revised into POD (though published +in HTML generated from the POD). Fields were added, removed or changed, +sometimes by design and sometimes to reflect real-world usage after the +fact. + +This document reconstructs the history of the CPAN Meta Spec based on +change logs, repository commit messages and the published HTML files. +In some cases, particularly prior to version 1.2, the exact version +when certain fields were introduced or changed is inconsistent between +sources. When in doubt, the published HTML files for versions 1.0 to +1.4 as they existed when version 2 was developed are used as the +definitive source. + +Starting with version 2, the specification document is part of the +CPAN-Meta distribution and will be published on CPAN as +L<CPAN::Meta::Spec>. + +Going forward, specification version numbers will be integers and +decimal portions will correspond to a release date for the CPAN::Meta +library. + +=head1 HISTORY + +=head2 Version 2 + +April 2010 + +=over + +=item * + +Revised spec examples as perl data structures rather than YAML + +=item * + +Switched to JSON serialization from YAML + +=item * + +Specified allowed version number formats + +=item * + +Replaced 'requires', 'build_requires', 'configure_requires', +'recommends' and 'conflicts' with new 'prereqs' data structure divided +by I<phase> (configure, build, test, runtime, etc.) and I<relationship> +(requires, recommends, suggests, conflicts) + +=item * + +Added support for 'develop' phase for requirements for maintaining +a list of authoring tools + +=item * + +Changed 'license' to a list and revised the set of valid licenses + +=item * + +Made 'dynamic_config' mandatory to reduce confusion + +=item * + +Changed 'resources' subkey 'repository' to a hash that clarifies +repository type, url for browsing and url for checkout + +=item * + +Changed 'resources' subkey 'bugtracker' to a hash for either web +or mailto resource + +=item * + +Changed specification of 'optional_features': + +=over + +=item * + +Added formal specification and usage guide instead of just example + +=item * + +Changed to use new prereqs data structure instead of individual keys + +=back + +=item * + +Clarified intended use of 'author' as generalized contact list + +=item * + +Added 'release_status' field to indicate stable, testing or unstable +status to provide hints to indexers + +=item * + +Added 'description' field for a longer description of the distribution + +=item * + +Formalized use of "x_" or "X_" for all custom keys not listed in the +official spec + +=back + +=head2 Version 1.4 + +June 2008 + +=over + +=item * + +Noted explicit support for 'perl' in prerequisites + +=item * + +Added 'configure_requires' prerequisite type + +=item * + +Changed 'optional_features' + +=over + +=item * + +Example corrected to show map of maps instead of list of maps +(though descriptive text said 'map' even in v1.3) + +=item * + +Removed 'requires_packages', 'requires_os' and 'excluded_os' +as valid subkeys + +=back + +=back + +=head2 Version 1.3 + +November 2006 + +=over + +=item * + +Added 'no_index' subkey 'directory' and removed 'dir' to match actual +usage in the wild + +=item * + +Added a 'repository' subkey to 'resources' + +=back + +=head2 Version 1.2 + +August 2005 + +=over + +=item * + +Re-wrote and restructured spec in POD syntax + +=item * + +Changed 'name' to be mandatory + +=item * + +Changed 'generated_by' to be mandatory + +=item * + +Changed 'license' to be mandatory + +=item * + +Added version range specifications for prerequisites + +=item * + +Added required 'abstract' field + +=item * + +Added required 'author' field + +=item * + +Added required 'meta-spec' field to define 'version' (and 'url') of the +CPAN Meta Spec used for metadata + +=item * + +Added 'provides' field + +=item * + +Added 'no_index' field and deprecated 'private' field. 'no_index' +subkeys include 'file', 'dir', 'package' and 'namespace' + +=item * + +Added 'keywords' field + +=item * + +Added 'resources' field with subkeys 'homepage', 'license', and +'bugtracker' + +=item * + +Added 'optional_features' field as an alternate under 'recommends'. +Includes 'description', 'requires', 'build_requires', 'conflicts', +'requires_packages', 'requires_os' and 'excluded_os' as valid subkeys + +=item * + +Removed 'license_uri' field + +=back + +=head2 Version 1.1 + +May 2003 + +=over + +=item * + +Changed 'version' to be mandatory + +=item * + +Added 'private' field + +=item * + +Added 'license_uri' field + +=back + +=head2 Version 1.0 + +March 2003 + +=over + +=item * + +Original release (in HTML format only) + +=item * + +Included 'name', 'version', 'license', 'distribution_type', 'requires', +'recommends', 'build_requires', 'conflicts', 'dynamic_config', +'generated_by' + +=back + +=head1 AUTHORS + +=over 4 + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Ricardo Signes <rjbs@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by David Golden and Ricardo Signes. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta/Merge.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/Merge.pm new file mode 100644 index 000000000..05a18ea97 --- /dev/null +++ b/.checksetup_lib/lib/perl5/CPAN/Meta/Merge.pm @@ -0,0 +1,297 @@ +use strict; +use warnings; + +package CPAN::Meta::Merge; + +our $VERSION = '2.150005'; + +use Carp qw/croak/; +use Scalar::Util qw/blessed/; +use CPAN::Meta::Converter 2.141170; + +sub _is_identical { + my ($left, $right) = @_; + return + (not defined $left and not defined $right) + # if either of these are references, we compare the serialized value + || (defined $left and defined $right and $left eq $right); +} + +sub _identical { + my ($left, $right, $path) = @_; + croak sprintf "Can't merge attribute %s: '%s' does not equal '%s'", join('.', @{$path}), $left, $right + unless _is_identical($left, $right); + return $left; +} + +sub _merge { + my ($current, $next, $mergers, $path) = @_; + for my $key (keys %{$next}) { + if (not exists $current->{$key}) { + $current->{$key} = $next->{$key}; + } + elsif (my $merger = $mergers->{$key}) { + $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]); + } + elsif ($merger = $mergers->{':default'}) { + $current->{$key} = $merger->($current->{$key}, $next->{$key}, [ @{$path}, $key ]); + } + else { + croak sprintf "Can't merge unknown attribute '%s'", join '.', @{$path}, $key; + } + } + return $current; +} + +sub _uniq { + my %seen = (); + return grep { not $seen{$_}++ } @_; +} + +sub _set_addition { + my ($left, $right) = @_; + return [ +_uniq(@{$left}, @{$right}) ]; +} + +sub _uniq_map { + my ($left, $right, $path) = @_; + for my $key (keys %{$right}) { + if (not exists $left->{$key}) { + $left->{$key} = $right->{$key}; + } + # identical strings or references are merged identically + elsif (_is_identical($left->{$key}, $right->{$key})) { + 1; # do nothing - keep left + } + elsif (ref $left->{$key} eq 'HASH' and ref $right->{$key} eq 'HASH') { + $left->{$key} = _uniq_map($left->{$key}, $right->{$key}, [ @{$path}, $key ]); + } + else { + croak 'Duplication of element ' . join '.', @{$path}, $key; + } + } + return $left; +} + +sub _improvize { + my ($left, $right, $path) = @_; + my ($name) = reverse @{$path}; + if ($name =~ /^x_/) { + if (ref($left) eq 'ARRAY') { + return _set_addition($left, $right, $path); + } + elsif (ref($left) eq 'HASH') { + return _uniq_map($left, $right, $path); + } + else { + return _identical($left, $right, $path); + } + } + croak sprintf "Can't merge '%s'", join '.', @{$path}; +} + +sub _optional_features { + my ($left, $right, $path) = @_; + + for my $key (keys %{$right}) { + if (not exists $left->{$key}) { + $left->{$key} = $right->{$key}; + } + else { + for my $subkey (keys %{ $right->{$key} }) { + next if $subkey eq 'prereqs'; + if (not exists $left->{$key}{$subkey}) { + $left->{$key}{$subkey} = $right->{$key}{$subkey}; + } + else { + Carp::croak "Cannot merge two optional_features named '$key' with different '$subkey' values" + if do { no warnings 'uninitialized'; $left->{$key}{$subkey} ne $right->{$key}{$subkey} }; + } + } + + require CPAN::Meta::Prereqs; + $left->{$key}{prereqs} = + CPAN::Meta::Prereqs->new($left->{$key}{prereqs}) + ->with_merged_prereqs(CPAN::Meta::Prereqs->new($right->{$key}{prereqs})) + ->as_string_hash; + } + } + return $left; +} + + +my %default = ( + abstract => \&_identical, + author => \&_set_addition, + dynamic_config => sub { + my ($left, $right) = @_; + return $left || $right; + }, + generated_by => sub { + my ($left, $right) = @_; + return join ', ', _uniq(split(/, /, $left), split(/, /, $right)); + }, + license => \&_set_addition, + 'meta-spec' => { + version => \&_identical, + url => \&_identical + }, + name => \&_identical, + release_status => \&_identical, + version => \&_identical, + description => \&_identical, + keywords => \&_set_addition, + no_index => { map { ($_ => \&_set_addition) } qw/file directory package namespace/ }, + optional_features => \&_optional_features, + prereqs => sub { + require CPAN::Meta::Prereqs; + my ($left, $right) = map { CPAN::Meta::Prereqs->new($_) } @_[0,1]; + return $left->with_merged_prereqs($right)->as_string_hash; + }, + provides => \&_uniq_map, + resources => { + license => \&_set_addition, + homepage => \&_identical, + bugtracker => \&_uniq_map, + repository => \&_uniq_map, + ':default' => \&_improvize, + }, + ':default' => \&_improvize, +); + +sub new { + my ($class, %arguments) = @_; + croak 'default version required' if not exists $arguments{default_version}; + my %mapping = %default; + my %extra = %{ $arguments{extra_mappings} || {} }; + for my $key (keys %extra) { + if (ref($mapping{$key}) eq 'HASH') { + $mapping{$key} = { %{ $mapping{$key} }, %{ $extra{$key} } }; + } + else { + $mapping{$key} = $extra{$key}; + } + } + return bless { + default_version => $arguments{default_version}, + mapping => _coerce_mapping(\%mapping, []), + }, $class; +} + +my %coderef_for = ( + set_addition => \&_set_addition, + uniq_map => \&_uniq_map, + identical => \&_identical, + improvize => \&_improvize, +); + +sub _coerce_mapping { + my ($orig, $map_path) = @_; + my %ret; + for my $key (keys %{$orig}) { + my $value = $orig->{$key}; + if (ref($orig->{$key}) eq 'CODE') { + $ret{$key} = $value; + } + elsif (ref($value) eq 'HASH') { + my $mapping = _coerce_mapping($value, [ @{$map_path}, $key ]); + $ret{$key} = sub { + my ($left, $right, $path) = @_; + return _merge($left, $right, $mapping, [ @{$path} ]); + }; + } + elsif ($coderef_for{$value}) { + $ret{$key} = $coderef_for{$value}; + } + else { + croak "Don't know what to do with " . join '.', @{$map_path}, $key; + } + } + return \%ret; +} + +sub merge { + my ($self, @items) = @_; + my $current = {}; + for my $next (@items) { + if ( blessed($next) && $next->isa('CPAN::Meta') ) { + $next = $next->as_struct; + } + elsif ( ref($next) eq 'HASH' ) { + my $cmc = CPAN::Meta::Converter->new( + $next, default_version => $self->{default_version} + ); + $next = $cmc->upgrade_fragment; + } + else { + croak "Don't know how to merge '$next'"; + } + $current = _merge($current, $next, $self->{mapping}, []); + } + return $current; +} + +1; + +# ABSTRACT: Merging CPAN Meta fragments + + +# vim: ts=2 sts=2 sw=2 et : + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta::Merge - Merging CPAN Meta fragments + +=head1 VERSION + +version 2.150005 + +=head1 SYNOPSIS + + my $merger = CPAN::Meta::Merge->new(default_version => "2"); + my $meta = $merger->merge($base, @additional); + +=head1 DESCRIPTION + +=head1 METHODS + +=head2 new + +This creates a CPAN::Meta::Merge object. It takes one mandatory named +argument, C<version>, declaring the version of the meta-spec that must be +used for the merge. It can optionally take an C<extra_mappings> argument +that allows one to add additional merging functions for specific elements. + +=head2 merge(@fragments) + +Merge all C<@fragments> together. It will accept both CPAN::Meta objects and +(possibly incomplete) hashrefs of metadata. + +=head1 AUTHORS + +=over 4 + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Ricardo Signes <rjbs@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by David Golden and Ricardo Signes. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta/Prereqs.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/Prereqs.pm new file mode 100644 index 000000000..8a13eb13c --- /dev/null +++ b/.checksetup_lib/lib/perl5/CPAN/Meta/Prereqs.pm @@ -0,0 +1,422 @@ +use 5.006; +use strict; +use warnings; +package CPAN::Meta::Prereqs; + +our $VERSION = '2.150005'; + +#pod =head1 DESCRIPTION +#pod +#pod A CPAN::Meta::Prereqs object represents the prerequisites for a CPAN +#pod distribution or one of its optional features. Each set of prereqs is +#pod organized by phase and type, as described in L<CPAN::Meta::Prereqs>. +#pod +#pod =cut + +use Carp qw(confess); +use Scalar::Util qw(blessed); +use CPAN::Meta::Requirements 2.121; + +#pod =method new +#pod +#pod my $prereq = CPAN::Meta::Prereqs->new( \%prereq_spec ); +#pod +#pod This method returns a new set of Prereqs. The input should look like the +#pod contents of the C<prereqs> field described in L<CPAN::Meta::Spec>, meaning +#pod something more or less like this: +#pod +#pod my $prereq = CPAN::Meta::Prereqs->new({ +#pod runtime => { +#pod requires => { +#pod 'Some::Module' => '1.234', +#pod ..., +#pod }, +#pod ..., +#pod }, +#pod ..., +#pod }); +#pod +#pod You can also construct an empty set of prereqs with: +#pod +#pod my $prereqs = CPAN::Meta::Prereqs->new; +#pod +#pod This empty set of prereqs is useful for accumulating new prereqs before finally +#pod dumping the whole set into a structure or string. +#pod +#pod =cut + +sub __legal_phases { qw(configure build test runtime develop) } +sub __legal_types { qw(requires recommends suggests conflicts) } + +# expect a prereq spec from META.json -- rjbs, 2010-04-11 +sub new { + my ($class, $prereq_spec) = @_; + $prereq_spec ||= {}; + + my %is_legal_phase = map {; $_ => 1 } $class->__legal_phases; + my %is_legal_type = map {; $_ => 1 } $class->__legal_types; + + my %guts; + PHASE: for my $phase (keys %$prereq_spec) { + next PHASE unless $phase =~ /\Ax_/i or $is_legal_phase{$phase}; + + my $phase_spec = $prereq_spec->{ $phase }; + next PHASE unless keys %$phase_spec; + + TYPE: for my $type (keys %$phase_spec) { + next TYPE unless $type =~ /\Ax_/i or $is_legal_type{$type}; + + my $spec = $phase_spec->{ $type }; + + next TYPE unless keys %$spec; + + $guts{prereqs}{$phase}{$type} = CPAN::Meta::Requirements->from_string_hash( + $spec + ); + } + } + + return bless \%guts => $class; +} + +#pod =method requirements_for +#pod +#pod my $requirements = $prereqs->requirements_for( $phase, $type ); +#pod +#pod This method returns a L<CPAN::Meta::Requirements> object for the given +#pod phase/type combination. If no prerequisites are registered for that +#pod combination, a new CPAN::Meta::Requirements object will be returned, and it may +#pod be added to as needed. +#pod +#pod If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will +#pod be raised. +#pod +#pod =cut + +sub requirements_for { + my ($self, $phase, $type) = @_; + + confess "requirements_for called without phase" unless defined $phase; + confess "requirements_for called without type" unless defined $type; + + unless ($phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases) { + confess "requested requirements for unknown phase: $phase"; + } + + unless ($type =~ /\Ax_/i or grep { $type eq $_ } $self->__legal_types) { + confess "requested requirements for unknown type: $type"; + } + + my $req = ($self->{prereqs}{$phase}{$type} ||= CPAN::Meta::Requirements->new); + + $req->finalize if $self->is_finalized; + + return $req; +} + +#pod =method with_merged_prereqs +#pod +#pod my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs ); +#pod +#pod my $new_prereqs = $prereqs->with_merged_prereqs( \@other_prereqs ); +#pod +#pod This method returns a new CPAN::Meta::Prereqs objects in which all the +#pod other prerequisites given are merged into the current set. This is primarily +#pod provided for combining a distribution's core prereqs with the prereqs of one of +#pod its optional features. +#pod +#pod The new prereqs object has no ties to the originals, and altering it further +#pod will not alter them. +#pod +#pod =cut + +sub with_merged_prereqs { + my ($self, $other) = @_; + + my @other = blessed($other) ? $other : @$other; + + my @prereq_objs = ($self, @other); + + my %new_arg; + + for my $phase ($self->__legal_phases) { + for my $type ($self->__legal_types) { + my $req = CPAN::Meta::Requirements->new; + + for my $prereq (@prereq_objs) { + my $this_req = $prereq->requirements_for($phase, $type); + next unless $this_req->required_modules; + + $req->add_requirements($this_req); + } + + next unless $req->required_modules; + + $new_arg{ $phase }{ $type } = $req->as_string_hash; + } + } + + return (ref $self)->new(\%new_arg); +} + +#pod =method merged_requirements +#pod +#pod my $new_reqs = $prereqs->merged_requirements( \@phases, \@types ); +#pod my $new_reqs = $prereqs->merged_requirements( \@phases ); +#pod my $new_reqs = $prereqs->merged_requirements(); +#pod +#pod This method joins together all requirements across a number of phases +#pod and types into a new L<CPAN::Meta::Requirements> object. If arguments +#pod are omitted, it defaults to "runtime", "build" and "test" for phases +#pod and "requires" and "recommends" for types. +#pod +#pod =cut + +sub merged_requirements { + my ($self, $phases, $types) = @_; + $phases = [qw/runtime build test/] unless defined $phases; + $types = [qw/requires recommends/] unless defined $types; + + confess "merged_requirements phases argument must be an arrayref" + unless ref $phases eq 'ARRAY'; + confess "merged_requirements types argument must be an arrayref" + unless ref $types eq 'ARRAY'; + + my $req = CPAN::Meta::Requirements->new; + + for my $phase ( @$phases ) { + unless ($phase =~ /\Ax_/i or grep { $phase eq $_ } $self->__legal_phases) { + confess "requested requirements for unknown phase: $phase"; + } + for my $type ( @$types ) { + unless ($type =~ /\Ax_/i or grep { $type eq $_ } $self->__legal_types) { + confess "requested requirements for unknown type: $type"; + } + $req->add_requirements( $self->requirements_for($phase, $type) ); + } + } + + $req->finalize if $self->is_finalized; + + return $req; +} + + +#pod =method as_string_hash +#pod +#pod This method returns a hashref containing structures suitable for dumping into a +#pod distmeta data structure. It is made up of hashes and strings, only; there will +#pod be no Prereqs, CPAN::Meta::Requirements, or C<version> objects inside it. +#pod +#pod =cut + +sub as_string_hash { + my ($self) = @_; + + my %hash; + + for my $phase ($self->__legal_phases) { + for my $type ($self->__legal_types) { + my $req = $self->requirements_for($phase, $type); + next unless $req->required_modules; + + $hash{ $phase }{ $type } = $req->as_string_hash; + } + } + + return \%hash; +} + +#pod =method is_finalized +#pod +#pod This method returns true if the set of prereqs has been marked "finalized," and +#pod cannot be altered. +#pod +#pod =cut + +sub is_finalized { $_[0]{finalized} } + +#pod =method finalize +#pod +#pod Calling C<finalize> on a Prereqs object will close it for further modification. +#pod Attempting to make any changes that would actually alter the prereqs will +#pod result in an exception being thrown. +#pod +#pod =cut + +sub finalize { + my ($self) = @_; + + $self->{finalized} = 1; + + for my $phase (keys %{ $self->{prereqs} }) { + $_->finalize for values %{ $self->{prereqs}{$phase} }; + } +} + +#pod =method clone +#pod +#pod my $cloned_prereqs = $prereqs->clone; +#pod +#pod This method returns a Prereqs object that is identical to the original object, +#pod but can be altered without affecting the original object. Finalization does +#pod not survive cloning, meaning that you may clone a finalized set of prereqs and +#pod then modify the clone. +#pod +#pod =cut + +sub clone { + my ($self) = @_; + + my $clone = (ref $self)->new( $self->as_string_hash ); +} + +1; + +# ABSTRACT: a set of distribution prerequisites by phase and type + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta::Prereqs - a set of distribution prerequisites by phase and type + +=head1 VERSION + +version 2.150005 + +=head1 DESCRIPTION + +A CPAN::Meta::Prereqs object represents the prerequisites for a CPAN +distribution or one of its optional features. Each set of prereqs is +organized by phase and type, as described in L<CPAN::Meta::Prereqs>. + +=head1 METHODS + +=head2 new + + my $prereq = CPAN::Meta::Prereqs->new( \%prereq_spec ); + +This method returns a new set of Prereqs. The input should look like the +contents of the C<prereqs> field described in L<CPAN::Meta::Spec>, meaning +something more or less like this: + + my $prereq = CPAN::Meta::Prereqs->new({ + runtime => { + requires => { + 'Some::Module' => '1.234', + ..., + }, + ..., + }, + ..., + }); + +You can also construct an empty set of prereqs with: + + my $prereqs = CPAN::Meta::Prereqs->new; + +This empty set of prereqs is useful for accumulating new prereqs before finally +dumping the whole set into a structure or string. + +=head2 requirements_for + + my $requirements = $prereqs->requirements_for( $phase, $type ); + +This method returns a L<CPAN::Meta::Requirements> object for the given +phase/type combination. If no prerequisites are registered for that +combination, a new CPAN::Meta::Requirements object will be returned, and it may +be added to as needed. + +If C<$phase> or C<$type> are undefined or otherwise invalid, an exception will +be raised. + +=head2 with_merged_prereqs + + my $new_prereqs = $prereqs->with_merged_prereqs( $other_prereqs ); + + my $new_prereqs = $prereqs->with_merged_prereqs( \@other_prereqs ); + +This method returns a new CPAN::Meta::Prereqs objects in which all the +other prerequisites given are merged into the current set. This is primarily +provided for combining a distribution's core prereqs with the prereqs of one of +its optional features. + +The new prereqs object has no ties to the originals, and altering it further +will not alter them. + +=head2 merged_requirements + + my $new_reqs = $prereqs->merged_requirements( \@phases, \@types ); + my $new_reqs = $prereqs->merged_requirements( \@phases ); + my $new_reqs = $prereqs->merged_requirements(); + +This method joins together all requirements across a number of phases +and types into a new L<CPAN::Meta::Requirements> object. If arguments +are omitted, it defaults to "runtime", "build" and "test" for phases +and "requires" and "recommends" for types. + +=head2 as_string_hash + +This method returns a hashref containing structures suitable for dumping into a +distmeta data structure. It is made up of hashes and strings, only; there will +be no Prereqs, CPAN::Meta::Requirements, or C<version> objects inside it. + +=head2 is_finalized + +This method returns true if the set of prereqs has been marked "finalized," and +cannot be altered. + +=head2 finalize + +Calling C<finalize> on a Prereqs object will close it for further modification. +Attempting to make any changes that would actually alter the prereqs will +result in an exception being thrown. + +=head2 clone + + my $cloned_prereqs = $prereqs->clone; + +This method returns a Prereqs object that is identical to the original object, +but can be altered without affecting the original object. Finalization does +not survive cloning, meaning that you may clone a finalized set of prereqs and +then modify the clone. + +=head1 BUGS + +Please report any bugs or feature using the CPAN Request Tracker. +Bugs can be submitted through the web interface at +L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta> + +When submitting a bug or request, please include a test-file or a patch to an +existing test-file that illustrates the bug or desired feature. + +=head1 AUTHORS + +=over 4 + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Ricardo Signes <rjbs@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by David Golden and Ricardo Signes. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + +__END__ + + +# vim: ts=2 sts=2 sw=2 et : diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta/Spec.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/Spec.pm new file mode 100644 index 000000000..9056940b5 --- /dev/null +++ b/.checksetup_lib/lib/perl5/CPAN/Meta/Spec.pm @@ -0,0 +1,1235 @@ +# XXX RULES FOR PATCHING THIS FILE XXX +# Patches that fix typos or formatting are acceptable. Patches +# that change semantics are not acceptable without prior approval +# by David Golden or Ricardo Signes. + +use 5.006; +use strict; +use warnings; +package CPAN::Meta::Spec; + +our $VERSION = '2.150005'; + +1; + +# ABSTRACT: specification for CPAN distribution metadata + + +# vi:tw=72 + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta::Spec - specification for CPAN distribution metadata + +=head1 VERSION + +version 2.150005 + +=head1 SYNOPSIS + + my $distmeta = { + name => 'Module-Build', + abstract => 'Build and install Perl modules', + description => "Module::Build is a system for " + . "building, testing, and installing Perl modules. " + . "It is meant to ... blah blah blah ...", + version => '0.36', + release_status => 'stable', + author => [ + 'Ken Williams <kwilliams@cpan.org>', + 'Module-Build List <module-build@perl.org>', # additional contact + ], + license => [ 'perl_5' ], + prereqs => { + runtime => { + requires => { + 'perl' => '5.006', + 'ExtUtils::Install' => '0', + 'File::Basename' => '0', + 'File::Compare' => '0', + 'IO::File' => '0', + }, + recommends => { + 'Archive::Tar' => '1.00', + 'ExtUtils::Install' => '0.3', + 'ExtUtils::ParseXS' => '2.02', + }, + }, + build => { + requires => { + 'Test::More' => '0', + }, + } + }, + resources => { + license => ['http://dev.perl.org/licenses/'], + }, + optional_features => { + domination => { + description => 'Take over the world', + prereqs => { + develop => { requires => { 'Genius::Evil' => '1.234' } }, + runtime => { requires => { 'Machine::Weather' => '2.0' } }, + }, + }, + }, + dynamic_config => 1, + keywords => [ qw/ toolchain cpan dual-life / ], + 'meta-spec' => { + version => '2', + url => 'https://metacpan.org/pod/CPAN::Meta::Spec', + }, + generated_by => 'Module::Build version 0.36', + }; + +=head1 DESCRIPTION + +This document describes version 2 of the CPAN distribution metadata +specification, also known as the "CPAN Meta Spec". + +Revisions of this specification for typo corrections and prose +clarifications may be issued as CPAN::Meta::Spec 2.I<x>. These +revisions will never change semantics or add or remove specified +behavior. + +Distribution metadata describe important properties of Perl +distributions. Distribution building tools like Module::Build, +Module::Install, ExtUtils::MakeMaker or Dist::Zilla should create a +metadata file in accordance with this specification and include it with +the distribution for use by automated tools that index, examine, package +or install Perl distributions. + +=head1 TERMINOLOGY + +=over 4 + +=item distribution + +This is the primary object described by the metadata. In the context of +this document it usually refers to a collection of modules, scripts, +and/or documents that are distributed together for other developers to +use. Examples of distributions are C<Class-Container>, C<libwww-perl>, +or C<DBI>. + +=item module + +This refers to a reusable library of code contained in a single file. +Modules usually contain one or more packages and are often referred +to by the name of a primary package that can be mapped to the file +name. For example, one might refer to C<File::Spec> instead of +F<File/Spec.pm> + +=item package + +This refers to a namespace declared with the Perl C<package> statement. +In Perl, packages often have a version number property given by the +C<$VERSION> variable in the namespace. + +=item consumer + +This refers to code that reads a metadata file, deserializes it into a +data structure in memory, or interprets a data structure of metadata +elements. + +=item producer + +This refers to code that constructs a metadata data structure, +serializes into a bytestream and/or writes it to disk. + +=item must, should, may, etc. + +These terms are interpreted as described in IETF RFC 2119. + +=back + +=head1 DATA TYPES + +Fields in the L</STRUCTURE> section describe data elements, each of +which has an associated data type as described herein. There are four +primitive types: Boolean, String, List and Map. Other types are +subtypes of primitives and define compound data structures or define +constraints on the values of a data element. + +=head2 Boolean + +A I<Boolean> is used to provide a true or false value. It B<must> be +represented as a defined value. + +=head2 String + +A I<String> is data element containing a non-zero length sequence of +Unicode characters, such as an ordinary Perl scalar that is not a +reference. + +=head2 List + +A I<List> is an ordered collection of zero or more data elements. +Elements of a List may be of mixed types. + +Producers B<must> represent List elements using a data structure which +unambiguously indicates that multiple values are possible, such as a +reference to a Perl array (an "arrayref"). + +Consumers expecting a List B<must> consider a String as equivalent to a +List of length 1. + +=head2 Map + +A I<Map> is an unordered collection of zero or more data elements +("values"), indexed by associated String elements ("keys"). The Map's +value elements may be of mixed types. + +=head2 License String + +A I<License String> is a subtype of String with a restricted set of +values. Valid values are described in detail in the description of +the L</license> field. + +=head2 URL + +I<URL> is a subtype of String containing a Uniform Resource Locator or +Identifier. [ This type is called URL and not URI for historical reasons. ] + +=head2 Version + +A I<Version> is a subtype of String containing a value that describes +the version number of packages or distributions. Restrictions on format +are described in detail in the L</Version Formats> section. + +=head2 Version Range + +The I<Version Range> type is a subtype of String. It describes a range +of Versions that may be present or installed to fulfill prerequisites. +It is specified in detail in the L</Version Ranges> section. + +=head1 STRUCTURE + +The metadata structure is a data element of type Map. This section +describes valid keys within the Map. + +Any keys not described in this specification document (whether top-level +or within compound data structures described herein) are considered +I<custom keys> and B<must> begin with an "x" or "X" and be followed by an +underscore; i.e. they must match the pattern: C<< qr{\Ax_}i >>. If a +custom key refers to a compound data structure, subkeys within it do not +need an "x_" or "X_" prefix. + +Consumers of metadata may ignore any or all custom keys. All other keys +not described herein are invalid and should be ignored by consumers. +Producers must not generate or output invalid keys. + +For each key, an example is provided followed by a description. The +description begins with the version of spec in which the key was added +or in which the definition was modified, whether the key is I<required> +or I<optional> and the data type of the corresponding data element. +These items are in parentheses, brackets and braces, respectively. + +If a data type is a Map or Map subtype, valid subkeys will be described +as well. + +Some fields are marked I<Deprecated>. These are shown for historical +context and must not be produced in or consumed from any metadata structure +of version 2 or higher. + +=head2 REQUIRED FIELDS + +=head3 abstract + +Example: + + abstract => 'Build and install Perl modules' + +(Spec 1.2) [required] {String} + +This is a short description of the purpose of the distribution. + +=head3 author + +Example: + + author => [ 'Ken Williams <kwilliams@cpan.org>' ] + +(Spec 1.2) [required] {List of one or more Strings} + +This List indicates the person(s) to contact concerning the +distribution. The preferred form of the contact string is: + + contact-name <email-address> + +This field provides a general contact list independent of other +structured fields provided within the L</resources> field, such as +C<bugtracker>. The addressee(s) can be contacted for any purpose +including but not limited to (security) problems with the distribution, +questions about the distribution or bugs in the distribution. + +A distribution's original author is usually the contact listed within +this field. Co-maintainers, successor maintainers or mailing lists +devoted to the distribution may also be listed in addition to or instead +of the original author. + +=head3 dynamic_config + +Example: + + dynamic_config => 1 + +(Spec 2) [required] {Boolean} + +A boolean flag indicating whether a F<Build.PL> or F<Makefile.PL> (or +similar) must be executed to determine prerequisites. + +This field should be set to a true value if the distribution performs +some dynamic configuration (asking questions, sensing the environment, +etc.) as part of its configuration. This field should be set to a false +value to indicate that prerequisites included in metadata may be +considered final and valid for static analysis. + +Note: when this field is true, post-configuration prerequisites are not +guaranteed to bear any relation whatsoever to those stated in the metadata, +and relying on them doing so is an error. See also +L</Prerequisites for dynamically configured distributions> in the implementors' +notes. + +This field explicitly B<does not> indicate whether installation may be +safely performed without using a Makefile or Build file, as there may be +special files to install or custom installation targets (e.g. for +dual-life modules that exist on CPAN as well as in the Perl core). This +field only defines whether or not prerequisites are exactly as given in the +metadata. + +=head3 generated_by + +Example: + + generated_by => 'Module::Build version 0.36' + +(Spec 1.0) [required] {String} + +This field indicates the tool that was used to create this metadata. +There are no defined semantics for this field, but it is traditional to +use a string in the form "Generating::Package version 1.23" or the +author's name, if the file was generated by hand. + +=head3 license + +Example: + + license => [ 'perl_5' ] + + license => [ 'apache_2_0', 'mozilla_1_0' ] + +(Spec 2) [required] {List of one or more License Strings} + +One or more licenses that apply to some or all of the files in the +distribution. If multiple licenses are listed, the distribution +documentation should be consulted to clarify the interpretation of +multiple licenses. + +The following list of license strings are valid: + + string description + ------------- ----------------------------------------------- + agpl_3 GNU Affero General Public License, Version 3 + apache_1_1 Apache Software License, Version 1.1 + apache_2_0 Apache License, Version 2.0 + artistic_1 Artistic License, (Version 1) + artistic_2 Artistic License, Version 2.0 + bsd BSD License (three-clause) + freebsd FreeBSD License (two-clause) + gfdl_1_2 GNU Free Documentation License, Version 1.2 + gfdl_1_3 GNU Free Documentation License, Version 1.3 + gpl_1 GNU General Public License, Version 1 + gpl_2 GNU General Public License, Version 2 + gpl_3 GNU General Public License, Version 3 + lgpl_2_1 GNU Lesser General Public License, Version 2.1 + lgpl_3_0 GNU Lesser General Public License, Version 3.0 + mit MIT (aka X11) License + mozilla_1_0 Mozilla Public License, Version 1.0 + mozilla_1_1 Mozilla Public License, Version 1.1 + openssl OpenSSL License + perl_5 The Perl 5 License (Artistic 1 & GPL 1 or later) + qpl_1_0 Q Public License, Version 1.0 + ssleay Original SSLeay License + sun Sun Internet Standards Source License (SISSL) + zlib zlib License + +The following license strings are also valid and indicate other +licensing not described above: + + string description + ------------- ----------------------------------------------- + open_source Other Open Source Initiative (OSI) approved license + restricted Requires special permission from copyright holder + unrestricted Not an OSI approved license, but not restricted + unknown License not provided in metadata + +All other strings are invalid in the license field. + +=head3 meta-spec + +Example: + + 'meta-spec' => { + version => '2', + url => 'http://search.cpan.org/perldoc?CPAN::Meta::Spec', + } + +(Spec 1.2) [required] {Map} + +This field indicates the version of the CPAN Meta Spec that should be +used to interpret the metadata. Consumers must check this key as soon +as possible and abort further metadata processing if the meta-spec +version is not supported by the consumer. + +The following keys are valid, but only C<version> is required. + +=over + +=item version + +This subkey gives the integer I<Version> of the CPAN Meta Spec against +which the document was generated. + +=item url + +This is a I<URL> of the metadata specification document corresponding to +the given version. This is strictly for human-consumption and should +not impact the interpretation of the document. + +For the version 2 spec, either of these are recommended: + +=over 4 + +=item * + +C<https://metacpan.org/pod/CPAN::Meta::Spec> + +=item * + +C<http://search.cpan.org/perldoc?CPAN::Meta::Spec> + +=back + +=back + +=head3 name + +Example: + + name => 'Module-Build' + +(Spec 1.0) [required] {String} + +This field is the name of the distribution. This is often created by +taking the "main package" in the distribution and changing C<::> to +C<->, but the name may be completely unrelated to the packages within +the distribution. For example, L<LWP::UserAgent> is distributed as part +of the distribution name "libwww-perl". + +=head3 release_status + +Example: + + release_status => 'stable' + +(Spec 2) [required] {String} + +This field provides the release status of this distribution. If the +C<version> field contains an underscore character, then +C<release_status> B<must not> be "stable." + +The C<release_status> field B<must> have one of the following values: + +=over + +=item stable + +This indicates an ordinary, "final" release that should be indexed by PAUSE +or other indexers. + +=item testing + +This indicates a "beta" release that is substantially complete, but has an +elevated risk of bugs and requires additional testing. The distribution +should not be installed over a stable release without an explicit request +or other confirmation from a user. This release status may also be used +for "release candidate" versions of a distribution. + +=item unstable + +This indicates an "alpha" release that is under active development, but has +been released for early feedback or testing and may be missing features or +may have serious bugs. The distribution should not be installed over a +stable release without an explicit request or other confirmation from a +user. + +=back + +Consumers B<may> use this field to determine how to index the +distribution for CPAN or other repositories in addition to or in +replacement of heuristics based on version number or file name. + +=head3 version + +Example: + + version => '0.36' + +(Spec 1.0) [required] {Version} + +This field gives the version of the distribution to which the metadata +structure refers. + +=head2 OPTIONAL FIELDS + +=head3 description + +Example: + + description => "Module::Build is a system for " + . "building, testing, and installing Perl modules. " + . "It is meant to ... blah blah blah ...", + +(Spec 2) [optional] {String} + +A longer, more complete description of the purpose or intended use of +the distribution than the one provided by the C<abstract> key. + +=head3 keywords + +Example: + + keywords => [ qw/ toolchain cpan dual-life / ] + +(Spec 1.1) [optional] {List of zero or more Strings} + +A List of keywords that describe this distribution. Keywords +B<must not> include whitespace. + +=head3 no_index + +Example: + + no_index => { + file => [ 'My/Module.pm' ], + directory => [ 'My/Private' ], + package => [ 'My::Module::Secret' ], + namespace => [ 'My::Module::Sample' ], + } + +(Spec 1.2) [optional] {Map} + +This Map describes any files, directories, packages, and namespaces that +are private to the packaging or implementation of the distribution and +should be ignored by indexing or search tools. Note that this is a list of +exclusions, and the spec does not define what to I<include> - see +L</Indexing distributions a la PAUSE> in the implementors notes for more +information. + +Valid subkeys are as follows: + +=over + +=item file + +A I<List> of relative paths to files. Paths B<must be> specified with +unix conventions. + +=item directory + +A I<List> of relative paths to directories. Paths B<must be> specified +with unix conventions. + +[ Note: previous editions of the spec had C<dir> instead of C<directory> ] + +=item package + +A I<List> of package names. + +=item namespace + +A I<List> of package namespaces, where anything below the namespace +must be ignored, but I<not> the namespace itself. + +In the example above for C<no_index>, C<My::Module::Sample::Foo> would +be ignored, but C<My::Module::Sample> would not. + +=back + +=head3 optional_features + +Example: + + optional_features => { + sqlite => { + description => 'Provides SQLite support', + prereqs => { + runtime => { + requires => { + 'DBD::SQLite' => '1.25' + } + } + } + } + } + +(Spec 2) [optional] {Map} + +This Map describes optional features with incremental prerequisites. +Each key of the C<optional_features> Map is a String used to identify +the feature and each value is a Map with additional information about +the feature. Valid subkeys include: + +=over + +=item description + +This is a String describing the feature. Every optional feature +should provide a description + +=item prereqs + +This entry is required and has the same structure as that of the +C<L</prereqs>> key. It provides a list of package requirements +that must be satisfied for the feature to be supported or enabled. + +There is one crucial restriction: the prereqs of an optional feature +B<must not> include C<configure> phase prereqs. + +=back + +Consumers B<must not> include optional features as prerequisites without +explicit instruction from users (whether via interactive prompting, +a function parameter or a configuration value, etc. ). + +If an optional feature is used by a consumer to add additional +prerequisites, the consumer should merge the optional feature +prerequisites into those given by the C<prereqs> key using the same +semantics. See L</Merging and Resolving Prerequisites> for details on +merging prerequisites. + +I<Suggestion for disuse:> Because there is currently no way for a +distribution to specify a dependency on an optional feature of another +dependency, the use of C<optional_feature> is discouraged. Instead, +create a separate, installable distribution that ensures the desired +feature is available. For example, if C<Foo::Bar> has a C<Baz> feature, +release a separate C<Foo-Bar-Baz> distribution that satisfies +requirements for the feature. + +=head3 prereqs + +Example: + + prereqs => { + runtime => { + requires => { + 'perl' => '5.006', + 'File::Spec' => '0.86', + 'JSON' => '2.16', + }, + recommends => { + 'JSON::XS' => '2.26', + }, + suggests => { + 'Archive::Tar' => '0', + }, + }, + build => { + requires => { + 'Alien::SDL' => '1.00', + }, + }, + test => { + recommends => { + 'Test::Deep' => '0.10', + }, + } + } + +(Spec 2) [optional] {Map} + +This is a Map that describes all the prerequisites of the distribution. +The keys are phases of activity, such as C<configure>, C<build>, C<test> +or C<runtime>. Values are Maps in which the keys name the type of +prerequisite relationship such as C<requires>, C<recommends>, or +C<suggests> and the value provides a set of prerequisite relations. The +set of relations B<must> be specified as a Map of package names to +version ranges. + +The full definition for this field is given in the L</Prereq Spec> +section. + +=head3 provides + +Example: + + provides => { + 'Foo::Bar' => { + file => 'lib/Foo/Bar.pm', + version => '0.27_02', + }, + 'Foo::Bar::Blah' => { + file => 'lib/Foo/Bar/Blah.pm', + }, + 'Foo::Bar::Baz' => { + file => 'lib/Foo/Bar/Baz.pm', + version => '0.3', + }, + } + +(Spec 1.2) [optional] {Map} + +This describes all packages provided by this distribution. This +information is used by distribution and automation mechanisms like +PAUSE, CPAN, metacpan.org and search.cpan.org to build indexes saying in +which distribution various packages can be found. + +The keys of C<provides> are package names that can be found within +the distribution. If a package name key is provided, it must +have a Map with the following valid subkeys: + +=over + +=item file + +This field is required. It must contain a Unix-style relative file path +from the root of the distribution directory to a file that contains or +generates the package. It may be given as C<META.yml> or C<META.json> +to claim a package for indexing without needing a C<*.pm>. + +=item version + +If it exists, this field must contains a I<Version> String for the +package. If the package does not have a C<$VERSION>, this field must +be omitted. + +=back + +=head3 resources + +Example: + + resources => { + license => [ 'http://dev.perl.org/licenses/' ], + homepage => 'http://sourceforge.net/projects/module-build', + bugtracker => { + web => 'http://rt.cpan.org/Public/Dist/Display.html?Name=CPAN-Meta', + mailto => 'meta-bugs@example.com', + }, + repository => { + url => 'git://github.com/dagolden/cpan-meta.git', + web => 'http://github.com/dagolden/cpan-meta', + type => 'git', + }, + x_twitter => 'http://twitter.com/cpan_linked/', + } + +(Spec 2) [optional] {Map} + +This field describes resources related to this distribution. + +Valid subkeys include: + +=over + +=item homepage + +The official home of this project on the web. + +=item license + +A List of I<URL>'s that relate to this distribution's license. As with the +top-level C<license> field, distribution documentation should be consulted +to clarify the interpretation of multiple licenses provided here. + +=item bugtracker + +This entry describes the bug tracking system for this distribution. It +is a Map with the following valid keys: + + web - a URL pointing to a web front-end for the bug tracker + mailto - an email address to which bugs can be sent + +=item repository + +This entry describes the source control repository for this distribution. It +is a Map with the following valid keys: + + url - a URL pointing to the repository itself + web - a URL pointing to a web front-end for the repository + type - a lowercase string indicating the VCS used + +Because a url like C<http://myrepo.example.com/> is ambiguous as to +type, producers should provide a C<type> whenever a C<url> key is given. +The C<type> field should be the name of the most common program used +to work with the repository, e.g. C<git>, C<svn>, C<cvs>, C<darcs>, +C<bzr> or C<hg>. + +=back + +=head2 DEPRECATED FIELDS + +=head3 build_requires + +I<(Deprecated in Spec 2)> [optional] {String} + +Replaced by C<prereqs> + +=head3 configure_requires + +I<(Deprecated in Spec 2)> [optional] {String} + +Replaced by C<prereqs> + +=head3 conflicts + +I<(Deprecated in Spec 2)> [optional] {String} + +Replaced by C<prereqs> + +=head3 distribution_type + +I<(Deprecated in Spec 2)> [optional] {String} + +This field indicated 'module' or 'script' but was considered +meaningless, since many distributions are hybrids of several kinds of +things. + +=head3 license_uri + +I<(Deprecated in Spec 1.2)> [optional] {URL} + +Replaced by C<license> in C<resources> + +=head3 private + +I<(Deprecated in Spec 1.2)> [optional] {Map} + +This field has been renamed to L</"no_index">. + +=head3 recommends + +I<(Deprecated in Spec 2)> [optional] {String} + +Replaced by C<prereqs> + +=head3 requires + +I<(Deprecated in Spec 2)> [optional] {String} + +Replaced by C<prereqs> + +=head1 VERSION NUMBERS + +=head2 Version Formats + +This section defines the Version type, used by several fields in the +CPAN Meta Spec. + +Version numbers must be treated as strings, not numbers. For +example, C<1.200> B<must not> be serialized as C<1.2>. Version +comparison should be delegated to the Perl L<version> module, version +0.80 or newer. + +Unless otherwise specified, version numbers B<must> appear in one of two +formats: + +=over + +=item Decimal versions + +Decimal versions are regular "decimal numbers", with some limitations. +They B<must> be non-negative and B<must> begin and end with a digit. A +single underscore B<may> be included, but B<must> be between two digits. +They B<must not> use exponential notation ("1.23e-2"). + + version => '1.234' # OK + version => '1.23_04' # OK + + version => '1.23_04_05' # Illegal + version => '1.' # Illegal + version => '.1' # Illegal + +=item Dotted-integer versions + +Dotted-integer (also known as dotted-decimal) versions consist of +positive integers separated by full stop characters (i.e. "dots", +"periods" or "decimal points"). This are equivalent in format to Perl +"v-strings", with some additional restrictions on form. They must be +given in "normal" form, which has a leading "v" character and at least +three integer components. To retain a one-to-one mapping with decimal +versions, all components after the first B<should> be restricted to the +range 0 to 999. The final component B<may> be separated by an +underscore character instead of a period. + + version => 'v1.2.3' # OK + version => 'v1.2_3' # OK + version => 'v1.2.3.4' # OK + version => 'v1.2.3_4' # OK + version => 'v2009.10.31' # OK + + version => 'v1.2' # Illegal + version => '1.2.3' # Illegal + version => 'v1.2_3_4' # Illegal + version => 'v1.2009.10.31' # Not recommended + +=back + +=head2 Version Ranges + +Some fields (prereq, optional_features) indicate the particular +version(s) of some other module that may be required as a prerequisite. +This section details the Version Range type used to provide this +information. + +The simplest format for a Version Range is just the version +number itself, e.g. C<2.4>. This means that B<at least> version 2.4 +must be present. To indicate that B<any> version of a prerequisite is +okay, even if the prerequisite doesn't define a version at all, use +the version C<0>. + +Alternatively, a version range B<may> use the operators E<lt> (less than), +E<lt>= (less than or equal), E<gt> (greater than), E<gt>= (greater than +or equal), == (equal), and != (not equal). For example, the +specification C<E<lt> 2.0> means that any version of the prerequisite +less than 2.0 is suitable. + +For more complicated situations, version specifications B<may> be AND-ed +together using commas. The specification C<E<gt>= 1.2, != 1.5, E<lt> +2.0> indicates a version that must be B<at least> 1.2, B<less than> 2.0, +and B<not equal to> 1.5. + +=head1 PREREQUISITES + +=head2 Prereq Spec + +The C<prereqs> key in the top-level metadata and within +C<optional_features> define the relationship between a distribution and +other packages. The prereq spec structure is a hierarchical data +structure which divides prerequisites into I<Phases> of activity in the +installation process and I<Relationships> that indicate how +prerequisites should be resolved. + +For example, to specify that C<Data::Dumper> is C<required> during the +C<test> phase, this entry would appear in the distribution metadata: + + prereqs => { + test => { + requires => { + 'Data::Dumper' => '2.00' + } + } + } + +=head3 Phases + +Requirements for regular use must be listed in the C<runtime> phase. +Other requirements should be listed in the earliest stage in which they +are required and consumers must accumulate and satisfy requirements +across phases before executing the activity. For example, C<build> +requirements must also be available during the C<test> phase. + + before action requirements that must be met + ---------------- -------------------------------- + perl Build.PL configure + perl Makefile.PL + + make configure, runtime, build + Build + + make test configure, runtime, build, test + Build test + +Consumers that install the distribution must ensure that +I<runtime> requirements are also installed and may install +dependencies from other phases. + + after action requirements that must be met + ---------------- -------------------------------- + make install runtime + Build install + +=over + +=item configure + +The configure phase occurs before any dynamic configuration has been +attempted. Libraries required by the configure phase B<must> be +available for use before the distribution building tool has been +executed. + +=item build + +The build phase is when the distribution's source code is compiled (if +necessary) and otherwise made ready for installation. + +=item test + +The test phase is when the distribution's automated test suite is run. +Any library that is needed only for testing and not for subsequent use +should be listed here. + +=item runtime + +The runtime phase refers not only to when the distribution's contents +are installed, but also to its continued use. Any library that is a +prerequisite for regular use of this distribution should be indicated +here. + +=item develop + +The develop phase's prereqs are libraries needed to work on the +distribution's source code as its author does. These tools might be +needed to build a release tarball, to run author-only tests, or to +perform other tasks related to developing new versions of the +distribution. + +=back + +=head3 Relationships + +=over + +=item requires + +These dependencies B<must> be installed for proper completion of the +phase. + +=item recommends + +Recommended dependencies are I<strongly> encouraged and should be +satisfied except in resource constrained environments. + +=item suggests + +These dependencies are optional, but are suggested for enhanced operation +of the described distribution. + +=item conflicts + +These libraries cannot be installed when the phase is in operation. +This is a very rare situation, and the C<conflicts> relationship should +be used with great caution, or not at all. + +=back + +=head2 Merging and Resolving Prerequisites + +Whenever metadata consumers merge prerequisites, either from different +phases or from C<optional_features>, they should merged in a way which +preserves the intended semantics of the prerequisite structure. Generally, +this means concatenating the version specifications using commas, as +described in the L<Version Ranges> section. + +Another subtle error that can occur in resolving prerequisites comes from +the way that modules in prerequisites are indexed to distribution files on +CPAN. When a module is deleted from a distribution, prerequisites calling +for that module could indicate an older distribution should be installed, +potentially overwriting files from a newer distribution. + +For example, as of Oct 31, 2009, the CPAN index file contained these +module-distribution mappings: + + Class::MOP 0.94 D/DR/DROLSKY/Class-MOP-0.94.tar.gz + Class::MOP::Class 0.94 D/DR/DROLSKY/Class-MOP-0.94.tar.gz + Class::MOP::Class::Immutable 0.04 S/ST/STEVAN/Class-MOP-0.36.tar.gz + +Consider the case where "Class::MOP" 0.94 is installed. If a +distribution specified "Class::MOP::Class::Immutable" as a prerequisite, +it could result in Class-MOP-0.36.tar.gz being installed, overwriting +any files from Class-MOP-0.94.tar.gz. + +Consumers of metadata B<should> test whether prerequisites would result +in installed module files being "downgraded" to an older version and +B<may> warn users or ignore the prerequisite that would cause such a +result. + +=head1 SERIALIZATION + +Distribution metadata should be serialized (as a hashref) as +JSON-encoded data and packaged with distributions as the file +F<META.json>. + +In the past, the distribution metadata structure had been packed with +distributions as F<META.yml>, a file in the YAML Tiny format (for which, +see L<YAML::Tiny>). Tools that consume distribution metadata from disk +should be capable of loading F<META.yml>, but should prefer F<META.json> +if both are found. + +=head1 NOTES FOR IMPLEMENTORS + +=head2 Extracting Version Numbers from Perl Modules + +To get the version number from a Perl module, consumers should use the +C<< MM->parse_version($file) >> method provided by +L<ExtUtils::MakeMaker> or L<Module::Metadata>. For example, for the +module given by C<$mod>, the version may be retrieved in one of the +following ways: + + # via ExtUtils::MakeMaker + my $file = MM->_installed_file_for_module($mod); + my $version = MM->parse_version($file) + +The private C<_installed_file_for_module> method may be replaced with +other methods for locating a module in C<@INC>. + + # via Module::Metadata + my $info = Module::Metadata->new_from_module($mod); + my $version = $info->version; + +If only a filename is available, the following approach may be used: + + # via Module::Build + my $info = Module::Metadata->new_from_file($file); + my $version = $info->version; + +=head2 Comparing Version Numbers + +The L<version> module provides the most reliable way to compare version +numbers in all the various ways they might be provided or might exist +within modules. Given two strings containing version numbers, C<$v1> and +C<$v2>, they should be converted to C<version> objects before using +ordinary comparison operators. For example: + + use version; + if ( version->new($v1) <=> version->new($v2) ) { + print "Versions are not equal\n"; + } + +If the only comparison needed is whether an installed module is of a +sufficiently high version, a direct test may be done using the string +form of C<eval> and the C<use> function. For example, for module C<$mod> +and version prerequisite C<$prereq>: + + if ( eval "use $mod $prereq (); 1" ) { + print "Module $mod version is OK.\n"; + } + +If the values of C<$mod> and C<$prereq> have not been scrubbed, however, +this presents security implications. + +=head2 Prerequisites for dynamically configured distributions + +When C<dynamic_config> is true, it is an error to presume that the +prerequisites given in distribution metadata will have any relationship +whatsoever to the actual prerequisites of the distribution. + +In practice, however, one can generally expect such prerequisites to be +one of two things: + +=over 4 + +=item * + +The minimum prerequisites for the distribution, to which dynamic configuration will only add items + +=item * + +Whatever the distribution configured with on the releaser's machine at release time + +=back + +The second case often turns out to have identical results to the first case, +albeit only by accident. + +As such, consumers may use this data for informational analysis, but +presenting it to the user as canonical or relying on it as such is +invariably the height of folly. + +=head2 Indexing distributions a la PAUSE + +While no_index tells you what must be ignored when indexing, this spec holds +no opinion on how you should get your initial candidate list of things to +possibly index. For "normal" distributions you might consider simply indexing +the contents of lib/, but there are many fascinating oddities on CPAN and +many dists from the days when it was normal to put the main .pm file in the +root of the distribution archive - so PAUSE currently indexes all .pm and .PL +files that are not either (a) specifically excluded by no_index (b) in +C<inc>, C<xt>, or C<t> directories, or common 'mistake' directories such as +C<perl5>. + +Or: If you're trying to be PAUSE-like, make sure you skip C<inc>, C<xt> and +C<t> as well as anything marked as no_index. + +Also remember: If the META file contains a provides field, you shouldn't be +indexing anything in the first place - just use that. + +=head1 SEE ALSO + +=over 4 + +=item * + +CPAN, L<http://www.cpan.org/> + +=item * + +JSON, L<http://json.org/> + +=item * + +YAML, L<http://www.yaml.org/> + +=item * + +L<CPAN> + +=item * + +L<CPANPLUS> + +=item * + +L<ExtUtils::MakeMaker> + +=item * + +L<Module::Build> + +=item * + +L<Module::Install> + +=back + +=head1 HISTORY + +Ken Williams wrote the original CPAN Meta Spec (also known as the +"META.yml spec") in 2003 and maintained it through several revisions +with input from various members of the community. In 2005, Randy +Sims redrafted it from HTML to POD for the version 1.2 release. Ken +continued to maintain the spec through version 1.4. + +In late 2009, David Golden organized the version 2 proposal review +process. David and Ricardo Signes drafted the final version 2 spec +in April 2010 based on the version 1.4 spec and patches contributed +during the proposal process. + +=head1 AUTHORS + +=over 4 + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Ricardo Signes <rjbs@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by David Golden and Ricardo Signes. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm new file mode 100644 index 000000000..eddaa1073 --- /dev/null +++ b/.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm @@ -0,0 +1,1210 @@ +use 5.006; +use strict; +use warnings; +package CPAN::Meta::Validator; + +our $VERSION = '2.150005'; + +#pod =head1 SYNOPSIS +#pod +#pod my $struct = decode_json_file('META.json'); +#pod +#pod my $cmv = CPAN::Meta::Validator->new( $struct ); +#pod +#pod unless ( $cmv->is_valid ) { +#pod my $msg = "Invalid META structure. Errors found:\n"; +#pod $msg .= join( "\n", $cmv->errors ); +#pod die $msg; +#pod } +#pod +#pod =head1 DESCRIPTION +#pod +#pod This module validates a CPAN Meta structure against the version of the +#pod the specification claimed in the C<meta-spec> field of the structure. +#pod +#pod =cut + +#--------------------------------------------------------------------------# +# This code copied and adapted from Test::CPAN::Meta +# by Barbie, <barbie@cpan.org> for Miss Barbell Productions, +# L<http://www.missbarbell.co.uk> +#--------------------------------------------------------------------------# + +#--------------------------------------------------------------------------# +# Specification Definitions +#--------------------------------------------------------------------------# + +my %known_specs = ( + '1.4' => 'http://module-build.sourceforge.net/META-spec-v1.4.html', + '1.3' => 'http://module-build.sourceforge.net/META-spec-v1.3.html', + '1.2' => 'http://module-build.sourceforge.net/META-spec-v1.2.html', + '1.1' => 'http://module-build.sourceforge.net/META-spec-v1.1.html', + '1.0' => 'http://module-build.sourceforge.net/META-spec-v1.0.html' +); +my %known_urls = map {$known_specs{$_} => $_} keys %known_specs; + +my $module_map1 = { 'map' => { ':key' => { name => \&module, value => \&exversion } } }; + +my $module_map2 = { 'map' => { ':key' => { name => \&module, value => \&version } } }; + +my $no_index_2 = { + 'map' => { file => { list => { value => \&string } }, + directory => { list => { value => \&string } }, + 'package' => { list => { value => \&string } }, + namespace => { list => { value => \&string } }, + ':key' => { name => \&custom_2, value => \&anything }, + } +}; + +my $no_index_1_3 = { + 'map' => { file => { list => { value => \&string } }, + directory => { list => { value => \&string } }, + 'package' => { list => { value => \&string } }, + namespace => { list => { value => \&string } }, + ':key' => { name => \&string, value => \&anything }, + } +}; + +my $no_index_1_2 = { + 'map' => { file => { list => { value => \&string } }, + dir => { list => { value => \&string } }, + 'package' => { list => { value => \&string } }, + namespace => { list => { value => \&string } }, + ':key' => { name => \&string, value => \&anything }, + } +}; + +my $no_index_1_1 = { + 'map' => { ':key' => { name => \&string, list => { value => \&string } }, + } +}; + +my $prereq_map = { + map => { + ':key' => { + name => \&phase, + 'map' => { + ':key' => { + name => \&relation, + %$module_map1, + }, + }, + } + }, +}; + +my %definitions = ( + '2' => { + # REQUIRED + 'abstract' => { mandatory => 1, value => \&string }, + 'author' => { mandatory => 1, list => { value => \&string } }, + 'dynamic_config' => { mandatory => 1, value => \&boolean }, + 'generated_by' => { mandatory => 1, value => \&string }, + 'license' => { mandatory => 1, list => { value => \&license } }, + 'meta-spec' => { + mandatory => 1, + 'map' => { + version => { mandatory => 1, value => \&version}, + url => { value => \&url }, + ':key' => { name => \&custom_2, value => \&anything }, + } + }, + 'name' => { mandatory => 1, value => \&string }, + 'release_status' => { mandatory => 1, value => \&release_status }, + 'version' => { mandatory => 1, value => \&version }, + + # OPTIONAL + 'description' => { value => \&string }, + 'keywords' => { list => { value => \&string } }, + 'no_index' => $no_index_2, + 'optional_features' => { + 'map' => { + ':key' => { + name => \&string, + 'map' => { + description => { value => \&string }, + prereqs => $prereq_map, + ':key' => { name => \&custom_2, value => \&anything }, + } + } + } + }, + 'prereqs' => $prereq_map, + 'provides' => { + 'map' => { + ':key' => { + name => \&module, + 'map' => { + file => { mandatory => 1, value => \&file }, + version => { value => \&version }, + ':key' => { name => \&custom_2, value => \&anything }, + } + } + } + }, + 'resources' => { + 'map' => { + license => { list => { value => \&url } }, + homepage => { value => \&url }, + bugtracker => { + 'map' => { + web => { value => \&url }, + mailto => { value => \&string}, + ':key' => { name => \&custom_2, value => \&anything }, + } + }, + repository => { + 'map' => { + web => { value => \&url }, + url => { value => \&url }, + type => { value => \&string }, + ':key' => { name => \&custom_2, value => \&anything }, + } + }, + ':key' => { value => \&string, name => \&custom_2 }, + } + }, + + # CUSTOM -- additional user defined key/value pairs + # note we can only validate the key name, as the structure is user defined + ':key' => { name => \&custom_2, value => \&anything }, + }, + +'1.4' => { + 'meta-spec' => { + mandatory => 1, + 'map' => { + version => { mandatory => 1, value => \&version}, + url => { mandatory => 1, value => \&urlspec }, + ':key' => { name => \&string, value => \&anything }, + }, + }, + + 'name' => { mandatory => 1, value => \&string }, + 'version' => { mandatory => 1, value => \&version }, + 'abstract' => { mandatory => 1, value => \&string }, + 'author' => { mandatory => 1, list => { value => \&string } }, + 'license' => { mandatory => 1, value => \&license }, + 'generated_by' => { mandatory => 1, value => \&string }, + + 'distribution_type' => { value => \&string }, + 'dynamic_config' => { value => \&boolean }, + + 'requires' => $module_map1, + 'recommends' => $module_map1, + 'build_requires' => $module_map1, + 'configure_requires' => $module_map1, + 'conflicts' => $module_map2, + + 'optional_features' => { + 'map' => { + ':key' => { name => \&string, + 'map' => { description => { value => \&string }, + requires => $module_map1, + recommends => $module_map1, + build_requires => $module_map1, + conflicts => $module_map2, + ':key' => { name => \&string, value => \&anything }, + } + } + } + }, + + 'provides' => { + 'map' => { + ':key' => { name => \&module, + 'map' => { + file => { mandatory => 1, value => \&file }, + version => { value => \&version }, + ':key' => { name => \&string, value => \&anything }, + } + } + } + }, + + 'no_index' => $no_index_1_3, + 'private' => $no_index_1_3, + + 'keywords' => { list => { value => \&string } }, + + 'resources' => { + 'map' => { license => { value => \&url }, + homepage => { value => \&url }, + bugtracker => { value => \&url }, + repository => { value => \&url }, + ':key' => { value => \&string, name => \&custom_1 }, + } + }, + + # additional user defined key/value pairs + # note we can only validate the key name, as the structure is user defined + ':key' => { name => \&string, value => \&anything }, +}, + +'1.3' => { + 'meta-spec' => { + mandatory => 1, + 'map' => { + version => { mandatory => 1, value => \&version}, + url => { mandatory => 1, value => \&urlspec }, + ':key' => { name => \&string, value => \&anything }, + }, + }, + + 'name' => { mandatory => 1, value => \&string }, + 'version' => { mandatory => 1, value => \&version }, + 'abstract' => { mandatory => 1, value => \&string }, + 'author' => { mandatory => 1, list => { value => \&string } }, + 'license' => { mandatory => 1, value => \&license }, + 'generated_by' => { mandatory => 1, value => \&string }, + + 'distribution_type' => { value => \&string }, + 'dynamic_config' => { value => \&boolean }, + + 'requires' => $module_map1, + 'recommends' => $module_map1, + 'build_requires' => $module_map1, + 'conflicts' => $module_map2, + + 'optional_features' => { + 'map' => { + ':key' => { name => \&string, + 'map' => { description => { value => \&string }, + requires => $module_map1, + recommends => $module_map1, + build_requires => $module_map1, + conflicts => $module_map2, + ':key' => { name => \&string, value => \&anything }, + } + } + } + }, + + 'provides' => { + 'map' => { + ':key' => { name => \&module, + 'map' => { + file => { mandatory => 1, value => \&file }, + version => { value => \&version }, + ':key' => { name => \&string, value => \&anything }, + } + } + } + }, + + + 'no_index' => $no_index_1_3, + 'private' => $no_index_1_3, + + 'keywords' => { list => { value => \&string } }, + + 'resources' => { + 'map' => { license => { value => \&url }, + homepage => { value => \&url }, + bugtracker => { value => \&url }, + repository => { value => \&url }, + ':key' => { value => \&string, name => \&custom_1 }, + } + }, + + # additional user defined key/value pairs + # note we can only validate the key name, as the structure is user defined + ':key' => { name => \&string, value => \&anything }, +}, + +# v1.2 is misleading, it seems to assume that a number of fields where created +# within v1.1, when they were created within v1.2. This may have been an +# original mistake, and that a v1.1 was retro fitted into the timeline, when +# v1.2 was originally slated as v1.1. But I could be wrong ;) +'1.2' => { + 'meta-spec' => { + mandatory => 1, + 'map' => { + version => { mandatory => 1, value => \&version}, + url => { mandatory => 1, value => \&urlspec }, + ':key' => { name => \&string, value => \&anything }, + }, + }, + + + 'name' => { mandatory => 1, value => \&string }, + 'version' => { mandatory => 1, value => \&version }, + 'license' => { mandatory => 1, value => \&license }, + 'generated_by' => { mandatory => 1, value => \&string }, + 'author' => { mandatory => 1, list => { value => \&string } }, + 'abstract' => { mandatory => 1, value => \&string }, + + 'distribution_type' => { value => \&string }, + 'dynamic_config' => { value => \&boolean }, + + 'keywords' => { list => { value => \&string } }, + + 'private' => $no_index_1_2, + '$no_index' => $no_index_1_2, + + 'requires' => $module_map1, + 'recommends' => $module_map1, + 'build_requires' => $module_map1, + 'conflicts' => $module_map2, + + 'optional_features' => { + 'map' => { + ':key' => { name => \&string, + 'map' => { description => { value => \&string }, + requires => $module_map1, + recommends => $module_map1, + build_requires => $module_map1, + conflicts => $module_map2, + ':key' => { name => \&string, value => \&anything }, + } + } + } + }, + + 'provides' => { + 'map' => { + ':key' => { name => \&module, + 'map' => { + file => { mandatory => 1, value => \&file }, + version => { value => \&version }, + ':key' => { name => \&string, value => \&anything }, + } + } + } + }, + + 'resources' => { + 'map' => { license => { value => \&url }, + homepage => { value => \&url }, + bugtracker => { value => \&url }, + repository => { value => \&url }, + ':key' => { value => \&string, name => \&custom_1 }, + } + }, + + # additional user defined key/value pairs + # note we can only validate the key name, as the structure is user defined + ':key' => { name => \&string, value => \&anything }, +}, + +# note that the 1.1 spec only specifies 'version' as mandatory +'1.1' => { + 'name' => { value => \&string }, + 'version' => { mandatory => 1, value => \&version }, + 'license' => { value => \&license }, + 'generated_by' => { value => \&string }, + + 'license_uri' => { value => \&url }, + 'distribution_type' => { value => \&string }, + 'dynamic_config' => { value => \&boolean }, + + 'private' => $no_index_1_1, + + 'requires' => $module_map1, + 'recommends' => $module_map1, + 'build_requires' => $module_map1, + 'conflicts' => $module_map2, + + # additional user defined key/value pairs + # note we can only validate the key name, as the structure is user defined + ':key' => { name => \&string, value => \&anything }, +}, + +# note that the 1.0 spec doesn't specify optional or mandatory fields +# but we will treat version as mandatory since otherwise META 1.0 is +# completely arbitrary and pointless +'1.0' => { + 'name' => { value => \&string }, + 'version' => { mandatory => 1, value => \&version }, + 'license' => { value => \&license }, + 'generated_by' => { value => \&string }, + + 'license_uri' => { value => \&url }, + 'distribution_type' => { value => \&string }, + 'dynamic_config' => { value => \&boolean }, + + 'requires' => $module_map1, + 'recommends' => $module_map1, + 'build_requires' => $module_map1, + 'conflicts' => $module_map2, + + # additional user defined key/value pairs + # note we can only validate the key name, as the structure is user defined + ':key' => { name => \&string, value => \&anything }, +}, +); + +#--------------------------------------------------------------------------# +# Code +#--------------------------------------------------------------------------# + +#pod =method new +#pod +#pod my $cmv = CPAN::Meta::Validator->new( $struct ) +#pod +#pod The constructor must be passed a metadata structure. +#pod +#pod =cut + +sub new { + my ($class,$data) = @_; + + # create an attributes hash + my $self = { + 'data' => $data, + 'spec' => eval { $data->{'meta-spec'}{'version'} } || "1.0", + 'errors' => undef, + }; + + # create the object + return bless $self, $class; +} + +#pod =method is_valid +#pod +#pod if ( $cmv->is_valid ) { +#pod ... +#pod } +#pod +#pod Returns a boolean value indicating whether the metadata provided +#pod is valid. +#pod +#pod =cut + +sub is_valid { + my $self = shift; + my $data = $self->{data}; + my $spec_version = $self->{spec}; + $self->check_map($definitions{$spec_version},$data); + return ! $self->errors; +} + +#pod =method errors +#pod +#pod warn( join "\n", $cmv->errors ); +#pod +#pod Returns a list of errors seen during validation. +#pod +#pod =cut + +sub errors { + my $self = shift; + return () unless(defined $self->{errors}); + return @{$self->{errors}}; +} + +#pod =begin :internals +#pod +#pod =head2 Check Methods +#pod +#pod =over +#pod +#pod =item * +#pod +#pod check_map($spec,$data) +#pod +#pod Checks whether a map (or hash) part of the data structure conforms to the +#pod appropriate specification definition. +#pod +#pod =item * +#pod +#pod check_list($spec,$data) +#pod +#pod Checks whether a list (or array) part of the data structure conforms to +#pod the appropriate specification definition. +#pod +#pod =item * +#pod +#pod =back +#pod +#pod =cut + +my $spec_error = "Missing validation action in specification. " + . "Must be one of 'map', 'list', or 'value'"; + +sub check_map { + my ($self,$spec,$data) = @_; + + if(ref($spec) ne 'HASH') { + $self->_error( "Unknown META specification, cannot validate." ); + return; + } + + if(ref($data) ne 'HASH') { + $self->_error( "Expected a map structure from string or file." ); + return; + } + + for my $key (keys %$spec) { + next unless($spec->{$key}->{mandatory}); + next if(defined $data->{$key}); + push @{$self->{stack}}, $key; + $self->_error( "Missing mandatory field, '$key'" ); + pop @{$self->{stack}}; + } + + for my $key (keys %$data) { + push @{$self->{stack}}, $key; + if($spec->{$key}) { + if($spec->{$key}{value}) { + $spec->{$key}{value}->($self,$key,$data->{$key}); + } elsif($spec->{$key}{'map'}) { + $self->check_map($spec->{$key}{'map'},$data->{$key}); + } elsif($spec->{$key}{'list'}) { + $self->check_list($spec->{$key}{'list'},$data->{$key}); + } else { + $self->_error( "$spec_error for '$key'" ); + } + + } elsif ($spec->{':key'}) { + $spec->{':key'}{name}->($self,$key,$key); + if($spec->{':key'}{value}) { + $spec->{':key'}{value}->($self,$key,$data->{$key}); + } elsif($spec->{':key'}{'map'}) { + $self->check_map($spec->{':key'}{'map'},$data->{$key}); + } elsif($spec->{':key'}{'list'}) { + $self->check_list($spec->{':key'}{'list'},$data->{$key}); + } else { + $self->_error( "$spec_error for ':key'" ); + } + + + } else { + $self->_error( "Unknown key, '$key', found in map structure" ); + } + pop @{$self->{stack}}; + } +} + +sub check_list { + my ($self,$spec,$data) = @_; + + if(ref($data) ne 'ARRAY') { + $self->_error( "Expected a list structure" ); + return; + } + + if(defined $spec->{mandatory}) { + if(!defined $data->[0]) { + $self->_error( "Missing entries from mandatory list" ); + } + } + + for my $value (@$data) { + push @{$self->{stack}}, $value || "<undef>"; + if(defined $spec->{value}) { + $spec->{value}->($self,'list',$value); + } elsif(defined $spec->{'map'}) { + $self->check_map($spec->{'map'},$value); + } elsif(defined $spec->{'list'}) { + $self->check_list($spec->{'list'},$value); + } elsif ($spec->{':key'}) { + $self->check_map($spec,$value); + } else { + $self->_error( "$spec_error associated with '$self->{stack}[-2]'" ); + } + pop @{$self->{stack}}; + } +} + +#pod =head2 Validator Methods +#pod +#pod =over +#pod +#pod =item * +#pod +#pod header($self,$key,$value) +#pod +#pod Validates that the header is valid. +#pod +#pod Note: No longer used as we now read the data structure, not the file. +#pod +#pod =item * +#pod +#pod url($self,$key,$value) +#pod +#pod Validates that a given value is in an acceptable URL format +#pod +#pod =item * +#pod +#pod urlspec($self,$key,$value) +#pod +#pod Validates that the URL to a META specification is a known one. +#pod +#pod =item * +#pod +#pod string_or_undef($self,$key,$value) +#pod +#pod Validates that the value is either a string or an undef value. Bit of a +#pod catchall function for parts of the data structure that are completely user +#pod defined. +#pod +#pod =item * +#pod +#pod string($self,$key,$value) +#pod +#pod Validates that a string exists for the given key. +#pod +#pod =item * +#pod +#pod file($self,$key,$value) +#pod +#pod Validate that a file is passed for the given key. This may be made more +#pod thorough in the future. For now it acts like \&string. +#pod +#pod =item * +#pod +#pod exversion($self,$key,$value) +#pod +#pod Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'. +#pod +#pod =item * +#pod +#pod version($self,$key,$value) +#pod +#pod Validates a single version string. Versions of the type '5.8.8' and '0.00_00' +#pod are both valid. A leading 'v' like 'v1.2.3' is also valid. +#pod +#pod =item * +#pod +#pod boolean($self,$key,$value) +#pod +#pod Validates for a boolean value. Currently these values are '1', '0', 'true', +#pod 'false', however the latter 2 may be removed. +#pod +#pod =item * +#pod +#pod license($self,$key,$value) +#pod +#pod Validates that a value is given for the license. Returns 1 if an known license +#pod type, or 2 if a value is given but the license type is not a recommended one. +#pod +#pod =item * +#pod +#pod custom_1($self,$key,$value) +#pod +#pod Validates that the given key is in CamelCase, to indicate a user defined +#pod keyword and only has characters in the class [-_a-zA-Z]. In version 1.X +#pod of the spec, this was only explicitly stated for 'resources'. +#pod +#pod =item * +#pod +#pod custom_2($self,$key,$value) +#pod +#pod Validates that the given key begins with 'x_' or 'X_', to indicate a user +#pod defined keyword and only has characters in the class [-_a-zA-Z] +#pod +#pod =item * +#pod +#pod identifier($self,$key,$value) +#pod +#pod Validates that key is in an acceptable format for the META specification, +#pod for an identifier, i.e. any that matches the regular expression +#pod qr/[a-z][a-z_]/i. +#pod +#pod =item * +#pod +#pod module($self,$key,$value) +#pod +#pod Validates that a given key is in an acceptable module name format, e.g. +#pod 'Test::CPAN::Meta::Version'. +#pod +#pod =back +#pod +#pod =end :internals +#pod +#pod =cut + +sub header { + my ($self,$key,$value) = @_; + if(defined $value) { + return 1 if($value && $value =~ /^--- #YAML:1.0/); + } + $self->_error( "file does not have a valid YAML header." ); + return 0; +} + +sub release_status { + my ($self,$key,$value) = @_; + if(defined $value) { + my $version = $self->{data}{version} || ''; + if ( $version =~ /_/ ) { + return 1 if ( $value =~ /\A(?:testing|unstable)\z/ ); + $self->_error( "'$value' for '$key' is invalid for version '$version'" ); + } + else { + return 1 if ( $value =~ /\A(?:stable|testing|unstable)\z/ ); + $self->_error( "'$value' for '$key' is invalid" ); + } + } + else { + $self->_error( "'$key' is not defined" ); + } + return 0; +} + +# _uri_split taken from URI::Split by Gisle Aas, Copyright 2003 +sub _uri_split { + return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,; +} + +sub url { + my ($self,$key,$value) = @_; + if(defined $value) { + my ($scheme, $auth, $path, $query, $frag) = _uri_split($value); + unless ( defined $scheme && length $scheme ) { + $self->_error( "'$value' for '$key' does not have a URL scheme" ); + return 0; + } + unless ( defined $auth && length $auth ) { + $self->_error( "'$value' for '$key' does not have a URL authority" ); + return 0; + } + return 1; + } + $value ||= ''; + $self->_error( "'$value' for '$key' is not a valid URL." ); + return 0; +} + +sub urlspec { + my ($self,$key,$value) = @_; + if(defined $value) { + return 1 if($value && $known_specs{$self->{spec}} eq $value); + if($value && $known_urls{$value}) { + $self->_error( 'META specification URL does not match version' ); + return 0; + } + } + $self->_error( 'Unknown META specification' ); + return 0; +} + +sub anything { return 1 } + +sub string { + my ($self,$key,$value) = @_; + if(defined $value) { + return 1 if($value || $value =~ /^0$/); + } + $self->_error( "value is an undefined string" ); + return 0; +} + +sub string_or_undef { + my ($self,$key,$value) = @_; + return 1 unless(defined $value); + return 1 if($value || $value =~ /^0$/); + $self->_error( "No string defined for '$key'" ); + return 0; +} + +sub file { + my ($self,$key,$value) = @_; + return 1 if(defined $value); + $self->_error( "No file defined for '$key'" ); + return 0; +} + +sub exversion { + my ($self,$key,$value) = @_; + if(defined $value && ($value || $value =~ /0/)) { + my $pass = 1; + for(split(",",$value)) { $self->version($key,$_) or ($pass = 0); } + return $pass; + } + $value = '<undef>' unless(defined $value); + $self->_error( "'$value' for '$key' is not a valid version." ); + return 0; +} + +sub version { + my ($self,$key,$value) = @_; + if(defined $value) { + return 0 unless($value || $value =~ /0/); + return 1 if($value =~ /^\s*((<|<=|>=|>|!=|==)\s*)?v?\d+((\.\d+((_|\.)\d+)?)?)/); + } else { + $value = '<undef>'; + } + $self->_error( "'$value' for '$key' is not a valid version." ); + return 0; +} + +sub boolean { + my ($self,$key,$value) = @_; + if(defined $value) { + return 1 if($value =~ /^(0|1|true|false)$/); + } else { + $value = '<undef>'; + } + $self->_error( "'$value' for '$key' is not a boolean value." ); + return 0; +} + +my %v1_licenses = ( + 'perl' => 'http://dev.perl.org/licenses/', + 'gpl' => 'http://www.opensource.org/licenses/gpl-license.php', + 'apache' => 'http://apache.org/licenses/LICENSE-2.0', + 'artistic' => 'http://opensource.org/licenses/artistic-license.php', + 'artistic_2' => 'http://opensource.org/licenses/artistic-license-2.0.php', + 'lgpl' => 'http://www.opensource.org/licenses/lgpl-license.php', + 'bsd' => 'http://www.opensource.org/licenses/bsd-license.php', + 'gpl' => 'http://www.opensource.org/licenses/gpl-license.php', + 'mit' => 'http://opensource.org/licenses/mit-license.php', + 'mozilla' => 'http://opensource.org/licenses/mozilla1.1.php', + 'open_source' => undef, + 'unrestricted' => undef, + 'restrictive' => undef, + 'unknown' => undef, +); + +my %v2_licenses = map { $_ => 1 } qw( + agpl_3 + apache_1_1 + apache_2_0 + artistic_1 + artistic_2 + bsd + freebsd + gfdl_1_2 + gfdl_1_3 + gpl_1 + gpl_2 + gpl_3 + lgpl_2_1 + lgpl_3_0 + mit + mozilla_1_0 + mozilla_1_1 + openssl + perl_5 + qpl_1_0 + ssleay + sun + zlib + open_source + restricted + unrestricted + unknown +); + +sub license { + my ($self,$key,$value) = @_; + my $licenses = $self->{spec} < 2 ? \%v1_licenses : \%v2_licenses; + if(defined $value) { + return 1 if($value && exists $licenses->{$value}); + } else { + $value = '<undef>'; + } + $self->_error( "License '$value' is invalid" ); + return 0; +} + +sub custom_1 { + my ($self,$key) = @_; + if(defined $key) { + # a valid user defined key should be alphabetic + # and contain at least one capital case letter. + return 1 if($key && $key =~ /^[_a-z]+$/i && $key =~ /[A-Z]/); + } else { + $key = '<undef>'; + } + $self->_error( "Custom resource '$key' must be in CamelCase." ); + return 0; +} + +sub custom_2 { + my ($self,$key) = @_; + if(defined $key) { + return 1 if($key && $key =~ /^x_/i); # user defined + } else { + $key = '<undef>'; + } + $self->_error( "Custom key '$key' must begin with 'x_' or 'X_'." ); + return 0; +} + +sub identifier { + my ($self,$key) = @_; + if(defined $key) { + return 1 if($key && $key =~ /^([a-z][_a-z]+)$/i); # spec 2.0 defined + } else { + $key = '<undef>'; + } + $self->_error( "Key '$key' is not a legal identifier." ); + return 0; +} + +sub module { + my ($self,$key) = @_; + if(defined $key) { + return 1 if($key && $key =~ /^[A-Za-z0-9_]+(::[A-Za-z0-9_]+)*$/); + } else { + $key = '<undef>'; + } + $self->_error( "Key '$key' is not a legal module name." ); + return 0; +} + +my @valid_phases = qw/ configure build test runtime develop /; +sub phase { + my ($self,$key) = @_; + if(defined $key) { + return 1 if( length $key && grep { $key eq $_ } @valid_phases ); + return 1 if $key =~ /x_/i; + } else { + $key = '<undef>'; + } + $self->_error( "Key '$key' is not a legal phase." ); + return 0; +} + +my @valid_relations = qw/ requires recommends suggests conflicts /; +sub relation { + my ($self,$key) = @_; + if(defined $key) { + return 1 if( length $key && grep { $key eq $_ } @valid_relations ); + return 1 if $key =~ /x_/i; + } else { + $key = '<undef>'; + } + $self->_error( "Key '$key' is not a legal prereq relationship." ); + return 0; +} + +sub _error { + my $self = shift; + my $mess = shift; + + $mess .= ' ('.join(' -> ',@{$self->{stack}}).')' if($self->{stack}); + $mess .= " [Validation: $self->{spec}]"; + + push @{$self->{errors}}, $mess; +} + +1; + +# ABSTRACT: validate CPAN distribution metadata structures + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta::Validator - validate CPAN distribution metadata structures + +=head1 VERSION + +version 2.150005 + +=head1 SYNOPSIS + + my $struct = decode_json_file('META.json'); + + my $cmv = CPAN::Meta::Validator->new( $struct ); + + unless ( $cmv->is_valid ) { + my $msg = "Invalid META structure. Errors found:\n"; + $msg .= join( "\n", $cmv->errors ); + die $msg; + } + +=head1 DESCRIPTION + +This module validates a CPAN Meta structure against the version of the +the specification claimed in the C<meta-spec> field of the structure. + +=head1 METHODS + +=head2 new + + my $cmv = CPAN::Meta::Validator->new( $struct ) + +The constructor must be passed a metadata structure. + +=head2 is_valid + + if ( $cmv->is_valid ) { + ... + } + +Returns a boolean value indicating whether the metadata provided +is valid. + +=head2 errors + + warn( join "\n", $cmv->errors ); + +Returns a list of errors seen during validation. + +=begin :internals + +=head2 Check Methods + +=over + +=item * + +check_map($spec,$data) + +Checks whether a map (or hash) part of the data structure conforms to the +appropriate specification definition. + +=item * + +check_list($spec,$data) + +Checks whether a list (or array) part of the data structure conforms to +the appropriate specification definition. + +=item * + +=back + +=head2 Validator Methods + +=over + +=item * + +header($self,$key,$value) + +Validates that the header is valid. + +Note: No longer used as we now read the data structure, not the file. + +=item * + +url($self,$key,$value) + +Validates that a given value is in an acceptable URL format + +=item * + +urlspec($self,$key,$value) + +Validates that the URL to a META specification is a known one. + +=item * + +string_or_undef($self,$key,$value) + +Validates that the value is either a string or an undef value. Bit of a +catchall function for parts of the data structure that are completely user +defined. + +=item * + +string($self,$key,$value) + +Validates that a string exists for the given key. + +=item * + +file($self,$key,$value) + +Validate that a file is passed for the given key. This may be made more +thorough in the future. For now it acts like \&string. + +=item * + +exversion($self,$key,$value) + +Validates a list of versions, e.g. '<= 5, >=2, ==3, !=4, >1, <6, 0'. + +=item * + +version($self,$key,$value) + +Validates a single version string. Versions of the type '5.8.8' and '0.00_00' +are both valid. A leading 'v' like 'v1.2.3' is also valid. + +=item * + +boolean($self,$key,$value) + +Validates for a boolean value. Currently these values are '1', '0', 'true', +'false', however the latter 2 may be removed. + +=item * + +license($self,$key,$value) + +Validates that a value is given for the license. Returns 1 if an known license +type, or 2 if a value is given but the license type is not a recommended one. + +=item * + +custom_1($self,$key,$value) + +Validates that the given key is in CamelCase, to indicate a user defined +keyword and only has characters in the class [-_a-zA-Z]. In version 1.X +of the spec, this was only explicitly stated for 'resources'. + +=item * + +custom_2($self,$key,$value) + +Validates that the given key begins with 'x_' or 'X_', to indicate a user +defined keyword and only has characters in the class [-_a-zA-Z] + +=item * + +identifier($self,$key,$value) + +Validates that key is in an acceptable format for the META specification, +for an identifier, i.e. any that matches the regular expression +qr/[a-z][a-z_]/i. + +=item * + +module($self,$key,$value) + +Validates that a given key is in an acceptable module name format, e.g. +'Test::CPAN::Meta::Version'. + +=back + +=end :internals + +=for Pod::Coverage anything boolean check_list custom_1 custom_2 exversion file +identifier license module phase relation release_status string string_or_undef +url urlspec version header check_map + +=head1 BUGS + +Please report any bugs or feature using the CPAN Request Tracker. +Bugs can be submitted through the web interface at +L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Meta> + +When submitting a bug or request, please include a test-file or a patch to an +existing test-file that illustrates the bug or desired feature. + +=head1 AUTHORS + +=over 4 + +=item * + +David Golden <dagolden@cpan.org> + +=item * + +Ricardo Signes <rjbs@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by David Golden and Ricardo Signes. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + +__END__ + + +# vim: ts=2 sts=2 sw=2 et : diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta/YAML.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/YAML.pm new file mode 100644 index 000000000..746abd63b --- /dev/null +++ b/.checksetup_lib/lib/perl5/CPAN/Meta/YAML.pm @@ -0,0 +1,951 @@ +use 5.008001; # sane UTF-8 support +use strict; +use warnings; +package CPAN::Meta::YAML; # git description: v1.68-2-gcc5324e +# XXX-INGY is 5.8.1 too old/broken for utf8? +# XXX-XDG Lancaster consensus was that it was sufficient until +# proven otherwise +$CPAN::Meta::YAML::VERSION = '0.018'; +; # original $VERSION removed by Doppelgaenger + +##################################################################### +# The CPAN::Meta::YAML API. +# +# These are the currently documented API functions/methods and +# exports: + +use Exporter; +our @ISA = qw{ Exporter }; +our @EXPORT = qw{ Load Dump }; +our @EXPORT_OK = qw{ LoadFile DumpFile freeze thaw }; + +### +# Functional/Export API: + +sub Dump { + return CPAN::Meta::YAML->new(@_)->_dump_string; +} + +# XXX-INGY Returning last document seems a bad behavior. +# XXX-XDG I think first would seem more natural, but I don't know +# that it's worth changing now +sub Load { + my $self = CPAN::Meta::YAML->_load_string(@_); + if ( wantarray ) { + return @$self; + } else { + # To match YAML.pm, return the last document + return $self->[-1]; + } +} + +# XXX-INGY Do we really need freeze and thaw? +# XXX-XDG I don't think so. I'd support deprecating them. +BEGIN { + *freeze = \&Dump; + *thaw = \&Load; +} + +sub DumpFile { + my $file = shift; + return CPAN::Meta::YAML->new(@_)->_dump_file($file); +} + +sub LoadFile { + my $file = shift; + my $self = CPAN::Meta::YAML->_load_file($file); + if ( wantarray ) { + return @$self; + } else { + # Return only the last document to match YAML.pm, + return $self->[-1]; + } +} + + +### +# Object Oriented API: + +# Create an empty CPAN::Meta::YAML object +# XXX-INGY Why do we use ARRAY object? +# NOTE: I get it now, but I think it's confusing and not needed. +# Will change it on a branch later, for review. +# +# XXX-XDG I don't support changing it yet. It's a very well-documented +# "API" of CPAN::Meta::YAML. I'd support deprecating it, but Adam suggested +# we not change it until YAML.pm's own OO API is established so that +# users only have one API change to digest, not two +sub new { + my $class = shift; + bless [ @_ ], $class; +} + +# XXX-INGY It probably doesn't matter, and it's probably too late to +# change, but 'read/write' are the wrong names. Read and Write +# are actions that take data from storage to memory +# characters/strings. These take the data to/from storage to native +# Perl objects, which the terms dump and load are meant. As long as +# this is a legacy quirk to CPAN::Meta::YAML it's ok, but I'd prefer not +# to add new {read,write}_* methods to this API. + +sub read_string { + my $self = shift; + $self->_load_string(@_); +} + +sub write_string { + my $self = shift; + $self->_dump_string(@_); +} + +sub read { + my $self = shift; + $self->_load_file(@_); +} + +sub write { + my $self = shift; + $self->_dump_file(@_); +} + + + + +##################################################################### +# Constants + +# Printed form of the unprintable characters in the lowest range +# of ASCII characters, listed by ASCII ordinal position. +my @UNPRINTABLE = qw( + 0 x01 x02 x03 x04 x05 x06 a + b t n v f r x0E x0F + x10 x11 x12 x13 x14 x15 x16 x17 + x18 x19 x1A e x1C x1D x1E x1F +); + +# Printable characters for escapes +my %UNESCAPES = ( + 0 => "\x00", z => "\x00", N => "\x85", + a => "\x07", b => "\x08", t => "\x09", + n => "\x0a", v => "\x0b", f => "\x0c", + r => "\x0d", e => "\x1b", '\\' => '\\', +); + +# XXX-INGY +# I(ngy) need to decide if these values should be quoted in +# CPAN::Meta::YAML or not. Probably yes. + +# These 3 values have special meaning when unquoted and using the +# default YAML schema. They need quotes if they are strings. +my %QUOTE = map { $_ => 1 } qw{ + null true false +}; + +# The commented out form is simpler, but overloaded the Perl regex +# engine due to recursion and backtracking problems on strings +# larger than 32,000ish characters. Keep it for reference purposes. +# qr/\"((?:\\.|[^\"])*)\"/ +my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/; +my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/; +# unquoted re gets trailing space that needs to be stripped +my $re_capture_unquoted_key = qr/([^:]+(?::+\S(?:[^:]*|.*?(?=:)))*)(?=\s*\:(?:\s+|$))/; +my $re_trailing_comment = qr/(?:\s+\#.*)?/; +my $re_key_value_separator = qr/\s*:(?:\s+(?:\#.*)?|$)/; + + + + + +##################################################################### +# CPAN::Meta::YAML Implementation. +# +# These are the private methods that do all the work. They may change +# at any time. + + +### +# Loader functions: + +# Create an object from a file +sub _load_file { + my $class = ref $_[0] ? ref shift : shift; + + # Check the file + my $file = shift or $class->_error( 'You did not specify a file name' ); + $class->_error( "File '$file' does not exist" ) + unless -e $file; + $class->_error( "'$file' is a directory, not a file" ) + unless -f _; + $class->_error( "Insufficient permissions to read '$file'" ) + unless -r _; + + # Open unbuffered with strict UTF-8 decoding and no translation layers + open( my $fh, "<:unix:encoding(UTF-8)", $file ); + unless ( $fh ) { + $class->_error("Failed to open file '$file': $!"); + } + + # flock if available (or warn if not possible for OS-specific reasons) + if ( _can_flock() ) { + flock( $fh, Fcntl::LOCK_SH() ) + or warn "Couldn't lock '$file' for reading: $!"; + } + + # slurp the contents + my $contents = eval { + use warnings FATAL => 'utf8'; + local $/; + <$fh> + }; + if ( my $err = $@ ) { + $class->_error("Error reading from file '$file': $err"); + } + + # close the file (release the lock) + unless ( close $fh ) { + $class->_error("Failed to close file '$file': $!"); + } + + $class->_load_string( $contents ); +} + +# Create an object from a string +sub _load_string { + my $class = ref $_[0] ? ref shift : shift; + my $self = bless [], $class; + my $string = $_[0]; + eval { + unless ( defined $string ) { + die \"Did not provide a string to load"; + } + + # Check if Perl has it marked as characters, but it's internally + # inconsistent. E.g. maybe latin1 got read on a :utf8 layer + if ( utf8::is_utf8($string) && ! utf8::valid($string) ) { + die \<<'...'; +Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set). +Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"? +... + } + + # Ensure Unicode character semantics, even for 0x80-0xff + utf8::upgrade($string); + + # Check for and strip any leading UTF-8 BOM + $string =~ s/^\x{FEFF}//; + + # Check for some special cases + return $self unless length $string; + + # Split the file into lines + my @lines = grep { ! /^\s*(?:\#.*)?\z/ } + split /(?:\015{1,2}\012|\015|\012)/, $string; + + # Strip the initial YAML header + @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines; + + # A nibbling parser + my $in_document = 0; + while ( @lines ) { + # Do we have a document header? + if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) { + # Handle scalar documents + shift @lines; + if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) { + push @$self, + $self->_load_scalar( "$1", [ undef ], \@lines ); + next; + } + $in_document = 1; + } + + if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { + # A naked document + push @$self, undef; + while ( @lines and $lines[0] !~ /^---/ ) { + shift @lines; + } + $in_document = 0; + + # XXX The final '-+$' is to look for -- which ends up being an + # error later. + } elsif ( ! $in_document && @$self ) { + # only the first document can be explicit + die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'"; + } elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) { + # An array at the root + my $document = [ ]; + push @$self, $document; + $self->_load_array( $document, [ 0 ], \@lines ); + + } elsif ( $lines[0] =~ /^(\s*)\S/ ) { + # A hash at the root + my $document = { }; + push @$self, $document; + $self->_load_hash( $document, [ length($1) ], \@lines ); + + } else { + # Shouldn't get here. @lines have whitespace-only lines + # stripped, and previous match is a line with any + # non-whitespace. So this clause should only be reachable via + # a perlbug where \s is not symmetric with \S + + # uncoverable statement + die \"CPAN::Meta::YAML failed to classify the line '$lines[0]'"; + } + } + }; + my $err = $@; + if ( ref $err eq 'SCALAR' ) { + $self->_error(${$err}); + } elsif ( $err ) { + $self->_error($err); + } + + return $self; +} + +sub _unquote_single { + my ($self, $string) = @_; + return '' unless length $string; + $string =~ s/\'\'/\'/g; + return $string; +} + +sub _unquote_double { + my ($self, $string) = @_; + return '' unless length $string; + $string =~ s/\\"/"/g; + $string =~ + s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))} + {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex; + return $string; +} + +# Load a YAML scalar string to the actual Perl scalar +sub _load_scalar { + my ($self, $string, $indent, $lines) = @_; + + # Trim trailing whitespace + $string =~ s/\s*\z//; + + # Explitic null/undef + return undef if $string eq '~'; + + # Single quote + if ( $string =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) { + return $self->_unquote_single($1); + } + + # Double quote. + if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) { + return $self->_unquote_double($1); + } + + # Special cases + if ( $string =~ /^[\'\"!&]/ ) { + die \"CPAN::Meta::YAML does not support a feature in line '$string'"; + } + return {} if $string =~ /^{}(?:\s+\#.*)?\z/; + return [] if $string =~ /^\[\](?:\s+\#.*)?\z/; + + # Regular unquoted string + if ( $string !~ /^[>|]/ ) { + die \"CPAN::Meta::YAML found illegal characters in plain scalar: '$string'" + if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or + $string =~ /:(?:\s|$)/; + $string =~ s/\s+#.*\z//; + return $string; + } + + # Error + die \"CPAN::Meta::YAML failed to find multi-line scalar content" unless @$lines; + + # Check the indent depth + $lines->[0] =~ /^(\s*)/; + $indent->[-1] = length("$1"); + if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { + die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'"; + } + + # Pull the lines + my @multiline = (); + while ( @$lines ) { + $lines->[0] =~ /^(\s*)/; + last unless length($1) >= $indent->[-1]; + push @multiline, substr(shift(@$lines), length($1)); + } + + my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; + my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; + return join( $j, @multiline ) . $t; +} + +# Load an array +sub _load_array { + my ($self, $array, $indent, $lines) = @_; + + while ( @$lines ) { + # Check for a new document + if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { + while ( @$lines and $lines->[0] !~ /^---/ ) { + shift @$lines; + } + return 1; + } + + # Check the indent level + $lines->[0] =~ /^(\s*)/; + if ( length($1) < $indent->[-1] ) { + return 1; + } elsif ( length($1) > $indent->[-1] ) { + die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'"; + } + + if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { + # Inline nested hash + my $indent2 = length("$1"); + $lines->[0] =~ s/-/ /; + push @$array, { }; + $self->_load_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); + + } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) { + shift @$lines; + unless ( @$lines ) { + push @$array, undef; + return 1; + } + if ( $lines->[0] =~ /^(\s*)\-/ ) { + my $indent2 = length("$1"); + if ( $indent->[-1] == $indent2 ) { + # Null array entry + push @$array, undef; + } else { + # Naked indenter + push @$array, [ ]; + $self->_load_array( + $array->[-1], [ @$indent, $indent2 ], $lines + ); + } + + } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { + push @$array, { }; + $self->_load_hash( + $array->[-1], [ @$indent, length("$1") ], $lines + ); + + } else { + die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'"; + } + + } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) { + # Array entry with a value + shift @$lines; + push @$array, $self->_load_scalar( + "$2", [ @$indent, undef ], $lines + ); + + } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { + # This is probably a structure like the following... + # --- + # foo: + # - list + # bar: value + # + # ... so lets return and let the hash parser handle it + return 1; + + } else { + die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'"; + } + } + + return 1; +} + +# Load a hash +sub _load_hash { + my ($self, $hash, $indent, $lines) = @_; + + while ( @$lines ) { + # Check for a new document + if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { + while ( @$lines and $lines->[0] !~ /^---/ ) { + shift @$lines; + } + return 1; + } + + # Check the indent level + $lines->[0] =~ /^(\s*)/; + if ( length($1) < $indent->[-1] ) { + return 1; + } elsif ( length($1) > $indent->[-1] ) { + die \"CPAN::Meta::YAML found bad indenting in line '$lines->[0]'"; + } + + # Find the key + my $key; + + # Quoted keys + if ( $lines->[0] =~ + s/^\s*$re_capture_single_quoted$re_key_value_separator// + ) { + $key = $self->_unquote_single($1); + } + elsif ( $lines->[0] =~ + s/^\s*$re_capture_double_quoted$re_key_value_separator// + ) { + $key = $self->_unquote_double($1); + } + elsif ( $lines->[0] =~ + s/^\s*$re_capture_unquoted_key$re_key_value_separator// + ) { + $key = $1; + $key =~ s/\s+$//; + } + elsif ( $lines->[0] =~ /^\s*\?/ ) { + die \"CPAN::Meta::YAML does not support a feature in line '$lines->[0]'"; + } + else { + die \"CPAN::Meta::YAML failed to classify line '$lines->[0]'"; + } + + if ( exists $hash->{$key} ) { + warn "CPAN::Meta::YAML found a duplicate key '$key' in line '$lines->[0]'"; + } + + # Do we have a value? + if ( length $lines->[0] ) { + # Yes + $hash->{$key} = $self->_load_scalar( + shift(@$lines), [ @$indent, undef ], $lines + ); + } else { + # An indent + shift @$lines; + unless ( @$lines ) { + $hash->{$key} = undef; + return 1; + } + if ( $lines->[0] =~ /^(\s*)-/ ) { + $hash->{$key} = []; + $self->_load_array( + $hash->{$key}, [ @$indent, length($1) ], $lines + ); + } elsif ( $lines->[0] =~ /^(\s*)./ ) { + my $indent2 = length("$1"); + if ( $indent->[-1] >= $indent2 ) { + # Null hash entry + $hash->{$key} = undef; + } else { + $hash->{$key} = {}; + $self->_load_hash( + $hash->{$key}, [ @$indent, length($1) ], $lines + ); + } + } + } + } + + return 1; +} + + +### +# Dumper functions: + +# Save an object to a file +sub _dump_file { + my $self = shift; + + require Fcntl; + + # Check the file + my $file = shift or $self->_error( 'You did not specify a file name' ); + + my $fh; + # flock if available (or warn if not possible for OS-specific reasons) + if ( _can_flock() ) { + # Open without truncation (truncate comes after lock) + my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT(); + sysopen( $fh, $file, $flags ); + unless ( $fh ) { + $self->_error("Failed to open file '$file' for writing: $!"); + } + + # Use no translation and strict UTF-8 + binmode( $fh, ":raw:encoding(UTF-8)"); + + flock( $fh, Fcntl::LOCK_EX() ) + or warn "Couldn't lock '$file' for reading: $!"; + + # truncate and spew contents + truncate $fh, 0; + seek $fh, 0, 0; + } + else { + open $fh, ">:unix:encoding(UTF-8)", $file; + } + + # serialize and spew to the handle + print {$fh} $self->_dump_string; + + # close the file (release the lock) + unless ( close $fh ) { + $self->_error("Failed to close file '$file': $!"); + } + + return 1; +} + +# Save an object to a string +sub _dump_string { + my $self = shift; + return '' unless ref $self && @$self; + + # Iterate over the documents + my $indent = 0; + my @lines = (); + + eval { + foreach my $cursor ( @$self ) { + push @lines, '---'; + + # An empty document + if ( ! defined $cursor ) { + # Do nothing + + # A scalar document + } elsif ( ! ref $cursor ) { + $lines[-1] .= ' ' . $self->_dump_scalar( $cursor ); + + # A list at the root + } elsif ( ref $cursor eq 'ARRAY' ) { + unless ( @$cursor ) { + $lines[-1] .= ' []'; + next; + } + push @lines, $self->_dump_array( $cursor, $indent, {} ); + + # A hash at the root + } elsif ( ref $cursor eq 'HASH' ) { + unless ( %$cursor ) { + $lines[-1] .= ' {}'; + next; + } + push @lines, $self->_dump_hash( $cursor, $indent, {} ); + + } else { + die \("Cannot serialize " . ref($cursor)); + } + } + }; + if ( ref $@ eq 'SCALAR' ) { + $self->_error(${$@}); + } elsif ( $@ ) { + $self->_error($@); + } + + join '', map { "$_\n" } @lines; +} + +sub _has_internal_string_value { + my $value = shift; + my $b_obj = B::svref_2object(\$value); # for round trip problem + return $b_obj->FLAGS & B::SVf_POK(); +} + +sub _dump_scalar { + my $string = $_[1]; + my $is_key = $_[2]; + # Check this before checking length or it winds up looking like a string! + my $has_string_flag = _has_internal_string_value($string); + return '~' unless defined $string; + return "''" unless length $string; + if (Scalar::Util::looks_like_number($string)) { + # keys and values that have been used as strings get quoted + if ( $is_key || $has_string_flag ) { + return qq['$string']; + } + else { + return $string; + } + } + if ( $string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/ ) { + $string =~ s/\\/\\\\/g; + $string =~ s/"/\\"/g; + $string =~ s/\n/\\n/g; + $string =~ s/[\x85]/\\N/g; + $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g; + $string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge; + return qq|"$string"|; + } + if ( $string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or + $QUOTE{$string} + ) { + return "'$string'"; + } + return $string; +} + +sub _dump_array { + my ($self, $array, $indent, $seen) = @_; + if ( $seen->{refaddr($array)}++ ) { + die \"CPAN::Meta::YAML does not support circular references"; + } + my @lines = (); + foreach my $el ( @$array ) { + my $line = (' ' x $indent) . '-'; + my $type = ref $el; + if ( ! $type ) { + $line .= ' ' . $self->_dump_scalar( $el ); + push @lines, $line; + + } elsif ( $type eq 'ARRAY' ) { + if ( @$el ) { + push @lines, $line; + push @lines, $self->_dump_array( $el, $indent + 1, $seen ); + } else { + $line .= ' []'; + push @lines, $line; + } + + } elsif ( $type eq 'HASH' ) { + if ( keys %$el ) { + push @lines, $line; + push @lines, $self->_dump_hash( $el, $indent + 1, $seen ); + } else { + $line .= ' {}'; + push @lines, $line; + } + + } else { + die \"CPAN::Meta::YAML does not support $type references"; + } + } + + @lines; +} + +sub _dump_hash { + my ($self, $hash, $indent, $seen) = @_; + if ( $seen->{refaddr($hash)}++ ) { + die \"CPAN::Meta::YAML does not support circular references"; + } + my @lines = (); + foreach my $name ( sort keys %$hash ) { + my $el = $hash->{$name}; + my $line = (' ' x $indent) . $self->_dump_scalar($name, 1) . ":"; + my $type = ref $el; + if ( ! $type ) { + $line .= ' ' . $self->_dump_scalar( $el ); + push @lines, $line; + + } elsif ( $type eq 'ARRAY' ) { + if ( @$el ) { + push @lines, $line; + push @lines, $self->_dump_array( $el, $indent + 1, $seen ); + } else { + $line .= ' []'; + push @lines, $line; + } + + } elsif ( $type eq 'HASH' ) { + if ( keys %$el ) { + push @lines, $line; + push @lines, $self->_dump_hash( $el, $indent + 1, $seen ); + } else { + $line .= ' {}'; + push @lines, $line; + } + + } else { + die \"CPAN::Meta::YAML does not support $type references"; + } + } + + @lines; +} + + + +##################################################################### +# DEPRECATED API methods: + +# Error storage (DEPRECATED as of 1.57) +our $errstr = ''; + +# Set error +sub _error { + require Carp; + $errstr = $_[1]; + $errstr =~ s/ at \S+ line \d+.*//; + Carp::croak( $errstr ); +} + +# Retrieve error +my $errstr_warned; +sub errstr { + require Carp; + Carp::carp( "CPAN::Meta::YAML->errstr and \$CPAN::Meta::YAML::errstr is deprecated" ) + unless $errstr_warned++; + $errstr; +} + + + + +##################################################################### +# Helper functions. Possibly not needed. + + +# Use to detect nv or iv +use B; + +# XXX-INGY Is flock CPAN::Meta::YAML's responsibility? +# Some platforms can't flock :-( +# XXX-XDG I think it is. When reading and writing files, we ought +# to be locking whenever possible. People (foolishly) use YAML +# files for things like session storage, which has race issues. +my $HAS_FLOCK; +sub _can_flock { + if ( defined $HAS_FLOCK ) { + return $HAS_FLOCK; + } + else { + require Config; + my $c = \%Config::Config; + $HAS_FLOCK = grep { $c->{$_} } qw/d_flock d_fcntl_can_lock d_lockf/; + require Fcntl if $HAS_FLOCK; + return $HAS_FLOCK; + } +} + + +# XXX-INGY Is this core in 5.8.1? Can we remove this? +# XXX-XDG Scalar::Util 1.18 didn't land until 5.8.8, so we need this +##################################################################### +# Use Scalar::Util if possible, otherwise emulate it + +use Scalar::Util (); +BEGIN { + local $@; + if ( eval { Scalar::Util->VERSION(1.18); } ) { + *refaddr = *Scalar::Util::refaddr; + } + else { + eval <<'END_PERL'; +# Scalar::Util failed to load or too old +sub refaddr { + my $pkg = ref($_[0]) or return undef; + if ( !! UNIVERSAL::can($_[0], 'can') ) { + bless $_[0], 'Scalar::Util::Fake'; + } else { + $pkg = undef; + } + "$_[0]" =~ /0x(\w+)/; + my $i = do { no warnings 'portable'; hex $1 }; + bless $_[0], $pkg if defined $pkg; + $i; +} +END_PERL + } +} + +delete $CPAN::Meta::YAML::{refaddr}; + +1; + +# XXX-INGY Doc notes I'm putting up here. Changing the doc when it's wrong +# but leaving grey area stuff up here. +# +# I would like to change Read/Write to Load/Dump below without +# changing the actual API names. +# +# It might be better to put Load/Dump API in the SYNOPSIS instead of the +# dubious OO API. +# +# null and bool explanations may be outdated. + +=pod + +=encoding UTF-8 + +=head1 NAME + +CPAN::Meta::YAML - Read and write a subset of YAML for CPAN Meta files + +=head1 VERSION + +version 0.018 + +=head1 SYNOPSIS + + use CPAN::Meta::YAML; + + # reading a META file + open $fh, "<:utf8", "META.yml"; + $yaml_text = do { local $/; <$fh> }; + $yaml = CPAN::Meta::YAML->read_string($yaml_text) + or die CPAN::Meta::YAML->errstr; + + # finding the metadata + $meta = $yaml->[0]; + + # writing a META file + $yaml_text = $yaml->write_string + or die CPAN::Meta::YAML->errstr; + open $fh, ">:utf8", "META.yml"; + print $fh $yaml_text; + +=head1 DESCRIPTION + +This module implements a subset of the YAML specification for use in reading +and writing CPAN metadata files like F<META.yml> and F<MYMETA.yml>. It should +not be used for any other general YAML parsing or generation task. + +NOTE: F<META.yml> (and F<MYMETA.yml>) files should be UTF-8 encoded. Users are +responsible for proper encoding and decoding. In particular, the C<read> and +C<write> methods do B<not> support UTF-8 and should not be used. + +=head1 SUPPORT + +This module is currently derived from L<YAML::Tiny> by Adam Kennedy. If +there are bugs in how it parses a particular META.yml file, please file +a bug report in the YAML::Tiny bugtracker: +L<https://github.com/Perl-Toolchain-Gang/YAML-Tiny/issues> + +=head1 SEE ALSO + +L<YAML::Tiny>, L<YAML>, L<YAML::XS> + +=head1 AUTHORS + +=over 4 + +=item * + +Adam Kennedy <adamk@cpan.org> + +=item * + +David Golden <dagolden@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2010 by Adam Kennedy. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut + +__END__ + + +# ABSTRACT: Read and write a subset of YAML for CPAN Meta files + + diff --git a/.checksetup_lib/lib/perl5/Module/Metadata.pm b/.checksetup_lib/lib/perl5/Module/Metadata.pm new file mode 100644 index 000000000..e352d3162 --- /dev/null +++ b/.checksetup_lib/lib/perl5/Module/Metadata.pm @@ -0,0 +1,1016 @@ +# -*- mode: cperl; tab-width: 8; indent-tabs-mode: nil; basic-offset: 2 -*- +# vim:ts=8:sw=2:et:sta:sts=2 +package Module::Metadata; + +# Adapted from Perl-licensed code originally distributed with +# Module-Build by Ken Williams + +# This module provides routines to gather information about +# perl modules (assuming this may be expanded in the distant +# parrot future to look at other types of modules). + +use strict; +use warnings; + +our $VERSION = '1.000019'; +$VERSION = eval $VERSION; + +use Carp qw/croak/; +use File::Spec; +use IO::File; +use version 0.87; +BEGIN { + if ($INC{'Log/Contextual.pm'}) { + Log::Contextual->import('log_info'); + } else { + *log_info = sub (&) { warn $_[0]->() }; + } +} +use File::Find qw(find); + +my $V_NUM_REGEXP = qr{v?[0-9._]+}; # crudely, a v-string or decimal + +my $PKG_FIRST_WORD_REGEXP = qr{ # the FIRST word in a package name + [a-zA-Z_] # the first word CANNOT start with a digit + (?: + [\w']? # can contain letters, digits, _, or ticks + \w # But, NO multi-ticks or trailing ticks + )* +}x; + +my $PKG_ADDL_WORD_REGEXP = qr{ # the 2nd+ word in a package name + \w # the 2nd+ word CAN start with digits + (?: + [\w']? # and can contain letters or ticks + \w # But, NO multi-ticks or trailing ticks + )* +}x; + +my $PKG_NAME_REGEXP = qr{ # match a package name + (?: :: )? # a pkg name can start with aristotle + $PKG_FIRST_WORD_REGEXP # a package word + (?: + (?: :: )+ ### aristotle (allow one or many times) + $PKG_ADDL_WORD_REGEXP ### a package word + )* # ^ zero, one or many times + (?: + :: # allow trailing aristotle + )? +}x; + +my $PKG_REGEXP = qr{ # match a package declaration + ^[\s\{;]* # intro chars on a line + package # the word 'package' + \s+ # whitespace + ($PKG_NAME_REGEXP) # a package name + \s* # optional whitespace + ($V_NUM_REGEXP)? # optional version number + \s* # optional whitesapce + [;\{] # semicolon line terminator or block start (since 5.16) +}x; + +my $VARNAME_REGEXP = qr{ # match fully-qualified VERSION name + ([\$*]) # sigil - $ or * + ( + ( # optional leading package name + (?:::|\')? # possibly starting like just :: (Ě la $::VERSION) + (?:\w+(?:::|\'))* # Foo::Bar:: ... + )? + VERSION + )\b +}x; + +my $VERS_REGEXP = qr{ # match a VERSION definition + (?: + \(\s*$VARNAME_REGEXP\s*\) # with parens + | + $VARNAME_REGEXP # without parens + ) + \s* + =[^=~] # = but not ==, nor =~ +}x; + +sub new_from_file { + my $class = shift; + my $filename = File::Spec->rel2abs( shift ); + + return undef unless defined( $filename ) && -f $filename; + return $class->_init(undef, $filename, @_); +} + +sub new_from_handle { + my $class = shift; + my $handle = shift; + my $filename = shift; + return undef unless defined($handle) && defined($filename); + $filename = File::Spec->rel2abs( $filename ); + + return $class->_init(undef, $filename, @_, handle => $handle); + +} + + +sub new_from_module { + my $class = shift; + my $module = shift; + my %props = @_; + + $props{inc} ||= \@INC; + my $filename = $class->find_module_by_name( $module, $props{inc} ); + return undef unless defined( $filename ) && -f $filename; + return $class->_init($module, $filename, %props); +} + +{ + + my $compare_versions = sub { + my ($v1, $op, $v2) = @_; + $v1 = version->new($v1) + unless UNIVERSAL::isa($v1,'version'); + + my $eval_str = "\$v1 $op \$v2"; + my $result = eval $eval_str; + log_info { "error comparing versions: '$eval_str' $@" } if $@; + + return $result; + }; + + my $normalize_version = sub { + my ($version) = @_; + if ( $version =~ /[=<>!,]/ ) { # logic, not just version + # take as is without modification + } + elsif ( ref $version eq 'version' ) { # version objects + $version = $version->is_qv ? $version->normal : $version->stringify; + } + elsif ( $version =~ /^[^v][^.]*\.[^.]+\./ ) { # no leading v, multiple dots + # normalize string tuples without "v": "1.2.3" -> "v1.2.3" + $version = "v$version"; + } + else { + # leave alone + } + return $version; + }; + + # separate out some of the conflict resolution logic + + my $resolve_module_versions = sub { + my $packages = shift; + + my( $file, $version ); + my $err = ''; + foreach my $p ( @$packages ) { + if ( defined( $p->{version} ) ) { + if ( defined( $version ) ) { + if ( $compare_versions->( $version, '!=', $p->{version} ) ) { + $err .= " $p->{file} ($p->{version})\n"; + } else { + # same version declared multiple times, ignore + } + } else { + $file = $p->{file}; + $version = $p->{version}; + } + } + $file ||= $p->{file} if defined( $p->{file} ); + } + + if ( $err ) { + $err = " $file ($version)\n" . $err; + } + + my %result = ( + file => $file, + version => $version, + err => $err + ); + + return \%result; + }; + + sub provides { + my $class = shift; + + croak "provides() requires key/value pairs \n" if @_ % 2; + my %args = @_; + + croak "provides() takes only one of 'dir' or 'files'\n" + if $args{dir} && $args{files}; + + croak "provides() requires a 'version' argument" + unless defined $args{version}; + + croak "provides() does not support version '$args{version}' metadata" + unless grep { $args{version} eq $_ } qw/1.4 2/; + + $args{prefix} = 'lib' unless defined $args{prefix}; + + my $p; + if ( $args{dir} ) { + $p = $class->package_versions_from_directory($args{dir}); + } + else { + croak "provides() requires 'files' to be an array reference\n" + unless ref $args{files} eq 'ARRAY'; + $p = $class->package_versions_from_directory($args{files}); + } + + # Now, fix up files with prefix + if ( length $args{prefix} ) { # check in case disabled with q{} + $args{prefix} =~ s{/$}{}; + for my $v ( values %$p ) { + $v->{file} = "$args{prefix}/$v->{file}"; + } + } + + return $p + } + + sub package_versions_from_directory { + my ( $class, $dir, $files ) = @_; + + my @files; + + if ( $files ) { + @files = @$files; + } else { + find( { + wanted => sub { + push @files, $_ if -f $_ && /\.pm$/; + }, + no_chdir => 1, + }, $dir ); + } + + # First, we enumerate all packages & versions, + # separating into primary & alternative candidates + my( %prime, %alt ); + foreach my $file (@files) { + my $mapped_filename = File::Spec::Unix->abs2rel( $file, $dir ); + my @path = split( /\//, $mapped_filename ); + (my $prime_package = join( '::', @path )) =~ s/\.pm$//; + + my $pm_info = $class->new_from_file( $file ); + + foreach my $package ( $pm_info->packages_inside ) { + next if $package eq 'main'; # main can appear numerous times, ignore + next if $package eq 'DB'; # special debugging package, ignore + next if grep /^_/, split( /::/, $package ); # private package, ignore + + my $version = $pm_info->version( $package ); + + $prime_package = $package if lc($prime_package) eq lc($package); + if ( $package eq $prime_package ) { + if ( exists( $prime{$package} ) ) { + croak "Unexpected conflict in '$package'; multiple versions found.\n"; + } else { + $mapped_filename = "$package.pm" if lc("$package.pm") eq lc($mapped_filename); + $prime{$package}{file} = $mapped_filename; + $prime{$package}{version} = $version if defined( $version ); + } + } else { + push( @{$alt{$package}}, { + file => $mapped_filename, + version => $version, + } ); + } + } + } + + # Then we iterate over all the packages found above, identifying conflicts + # and selecting the "best" candidate for recording the file & version + # for each package. + foreach my $package ( keys( %alt ) ) { + my $result = $resolve_module_versions->( $alt{$package} ); + + if ( exists( $prime{$package} ) ) { # primary package selected + + if ( $result->{err} ) { + # Use the selected primary package, but there are conflicting + # errors among multiple alternative packages that need to be + # reported + log_info { + "Found conflicting versions for package '$package'\n" . + " $prime{$package}{file} ($prime{$package}{version})\n" . + $result->{err} + }; + + } elsif ( defined( $result->{version} ) ) { + # There is a primary package selected, and exactly one + # alternative package + + if ( exists( $prime{$package}{version} ) && + defined( $prime{$package}{version} ) ) { + # Unless the version of the primary package agrees with the + # version of the alternative package, report a conflict + if ( $compare_versions->( + $prime{$package}{version}, '!=', $result->{version} + ) + ) { + + log_info { + "Found conflicting versions for package '$package'\n" . + " $prime{$package}{file} ($prime{$package}{version})\n" . + " $result->{file} ($result->{version})\n" + }; + } + + } else { + # The prime package selected has no version so, we choose to + # use any alternative package that does have a version + $prime{$package}{file} = $result->{file}; + $prime{$package}{version} = $result->{version}; + } + + } else { + # no alt package found with a version, but we have a prime + # package so we use it whether it has a version or not + } + + } else { # No primary package was selected, use the best alternative + + if ( $result->{err} ) { + log_info { + "Found conflicting versions for package '$package'\n" . + $result->{err} + }; + } + + # Despite possible conflicting versions, we choose to record + # something rather than nothing + $prime{$package}{file} = $result->{file}; + $prime{$package}{version} = $result->{version} + if defined( $result->{version} ); + } + } + + # Normalize versions. Can't use exists() here because of bug in YAML::Node. + # XXX "bug in YAML::Node" comment seems irrelevant -- dagolden, 2009-05-18 + for (grep defined $_->{version}, values %prime) { + $_->{version} = $normalize_version->( $_->{version} ); + } + + return \%prime; + } +} + + +sub _init { + my $class = shift; + my $module = shift; + my $filename = shift; + my %props = @_; + + my $handle = delete $props{handle}; + my( %valid_props, @valid_props ); + @valid_props = qw( collect_pod inc ); + @valid_props{@valid_props} = delete( @props{@valid_props} ); + warn "Unknown properties: @{[keys %props]}\n" if scalar( %props ); + + my %data = ( + module => $module, + filename => $filename, + version => undef, + packages => [], + versions => {}, + pod => {}, + pod_headings => [], + collect_pod => 0, + + %valid_props, + ); + + my $self = bless(\%data, $class); + + if ( $handle ) { + $self->_parse_fh($handle); + } + else { + $self->_parse_file(); + } + + unless($self->{module} and length($self->{module})) { + my ($v, $d, $f) = File::Spec->splitpath($self->{filename}); + if($f =~ /\.pm$/) { + $f =~ s/\..+$//; + my @candidates = grep /$f$/, @{$self->{packages}}; + $self->{module} = shift(@candidates); # punt + } + else { + if(grep /main/, @{$self->{packages}}) { + $self->{module} = 'main'; + } + else { + $self->{module} = $self->{packages}[0] || ''; + } + } + } + + $self->{version} = $self->{versions}{$self->{module}} + if defined( $self->{module} ); + + return $self; +} + +# class method +sub _do_find_module { + my $class = shift; + my $module = shift || croak 'find_module_by_name() requires a package name'; + my $dirs = shift || \@INC; + + my $file = File::Spec->catfile(split( /::/, $module)); + foreach my $dir ( @$dirs ) { + my $testfile = File::Spec->catfile($dir, $file); + return [ File::Spec->rel2abs( $testfile ), $dir ] + if -e $testfile and !-d _; # For stuff like ExtUtils::xsubpp + return [ File::Spec->rel2abs( "$testfile.pm" ), $dir ] + if -e "$testfile.pm"; + } + return; +} + +# class method +sub find_module_by_name { + my $found = shift()->_do_find_module(@_) or return; + return $found->[0]; +} + +# class method +sub find_module_dir_by_name { + my $found = shift()->_do_find_module(@_) or return; + return $found->[1]; +} + + +# given a line of perl code, attempt to parse it if it looks like a +# $VERSION assignment, returning sigil, full name, & package name +sub _parse_version_expression { + my $self = shift; + my $line = shift; + + my( $sig, $var, $pkg ); + if ( $line =~ /$VERS_REGEXP/o ) { + ( $sig, $var, $pkg ) = $2 ? ( $1, $2, $3 ) : ( $4, $5, $6 ); + if ( $pkg ) { + $pkg = ($pkg eq '::') ? 'main' : $pkg; + $pkg =~ s/::$//; + } + } + + return ( $sig, $var, $pkg ); +} + +sub _parse_file { + my $self = shift; + + my $filename = $self->{filename}; + my $fh = IO::File->new( $filename ) + or croak( "Can't open '$filename': $!" ); + + $self->_handle_bom($fh, $filename); + + $self->_parse_fh($fh); +} + +# Look for a UTF-8/UTF-16BE/UTF-16LE BOM at the beginning of the stream. +# If there's one, then skip it and set the :encoding layer appropriately. +sub _handle_bom { + my ($self, $fh, $filename) = @_; + + my $pos = $fh->getpos; + return unless defined $pos; + + my $buf = ' ' x 2; + my $count = $fh->read( $buf, length $buf ); + return unless defined $count and $count >= 2; + + my $encoding; + if ( $buf eq "\x{FE}\x{FF}" ) { + $encoding = 'UTF-16BE'; + } elsif ( $buf eq "\x{FF}\x{FE}" ) { + $encoding = 'UTF-16LE'; + } elsif ( $buf eq "\x{EF}\x{BB}" ) { + $buf = ' '; + $count = $fh->read( $buf, length $buf ); + if ( defined $count and $count >= 1 and $buf eq "\x{BF}" ) { + $encoding = 'UTF-8'; + } + } + + if ( defined $encoding ) { + if ( "$]" >= 5.008 ) { + # $fh->binmode requires perl 5.10 + binmode( $fh, ":encoding($encoding)" ); + } + } else { + $fh->setpos($pos) + or croak( sprintf "Can't reset position to the top of '$filename'" ); + } + + return $encoding; +} + +sub _parse_fh { + my ($self, $fh) = @_; + + my( $in_pod, $seen_end, $need_vers ) = ( 0, 0, 0 ); + my( @pkgs, %vers, %pod, @pod ); + my $pkg = 'main'; + my $pod_sect = ''; + my $pod_data = ''; + my $in_end = 0; + + while (defined( my $line = <$fh> )) { + my $line_num = $.; + + chomp( $line ); + + # From toke.c : any line that begins by "=X", where X is an alphabetic + # character, introduces a POD segment. + my $is_cut; + if ( $line =~ /^=([a-zA-Z].*)/ ) { + my $cmd = $1; + # Then it goes back to Perl code for "=cutX" where X is a non-alphabetic + # character (which includes the newline, but here we chomped it away). + $is_cut = $cmd =~ /^cut(?:[^a-zA-Z]|$)/; + $in_pod = !$is_cut; + } + + if ( $in_pod ) { + + if ( $line =~ /^=head[1-4]\s+(.+)\s*$/ ) { + push( @pod, $1 ); + if ( $self->{collect_pod} && length( $pod_data ) ) { + $pod{$pod_sect} = $pod_data; + $pod_data = ''; + } + $pod_sect = $1; + + } elsif ( $self->{collect_pod} ) { + $pod_data .= "$line\n"; + + } + + } elsif ( $is_cut ) { + + if ( $self->{collect_pod} && length( $pod_data ) ) { + $pod{$pod_sect} = $pod_data; + $pod_data = ''; + } + $pod_sect = ''; + + } else { + + # Skip after __END__ + next if $in_end; + + # Skip comments in code + next if $line =~ /^\s*#/; + + # Would be nice if we could also check $in_string or something too + if ($line eq '__END__') { + $in_end++; + next; + } + last if $line eq '__DATA__'; + + # parse $line to see if it's a $VERSION declaration + my( $vers_sig, $vers_fullname, $vers_pkg ) = + ($line =~ /VERSION/) + ? $self->_parse_version_expression( $line ) + : (); + + if ( $line =~ /$PKG_REGEXP/o ) { + $pkg = $1; + push( @pkgs, $pkg ) unless grep( $pkg eq $_, @pkgs ); + $vers{$pkg} = $2 unless exists( $vers{$pkg} ); + $need_vers = defined $2 ? 0 : 1; + + # VERSION defined with full package spec, i.e. $Module::VERSION + } elsif ( $vers_fullname && $vers_pkg ) { + push( @pkgs, $vers_pkg ) unless grep( $vers_pkg eq $_, @pkgs ); + $need_vers = 0 if $vers_pkg eq $pkg; + + unless ( defined $vers{$vers_pkg} && length $vers{$vers_pkg} ) { + $vers{$vers_pkg} = + $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); + } + + # first non-comment line in undeclared package main is VERSION + } elsif ( !exists($vers{main}) && $pkg eq 'main' && $vers_fullname ) { + $need_vers = 0; + my $v = + $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); + $vers{$pkg} = $v; + push( @pkgs, 'main' ); + + # first non-comment line in undeclared package defines package main + } elsif ( !exists($vers{main}) && $pkg eq 'main' && $line =~ /\w+/ ) { + $need_vers = 1; + $vers{main} = ''; + push( @pkgs, 'main' ); + + # only keep if this is the first $VERSION seen + } elsif ( $vers_fullname && $need_vers ) { + $need_vers = 0; + my $v = + $self->_evaluate_version_line( $vers_sig, $vers_fullname, $line ); + + + unless ( defined $vers{$pkg} && length $vers{$pkg} ) { + $vers{$pkg} = $v; + } + + } + + } + + } + + if ( $self->{collect_pod} && length($pod_data) ) { + $pod{$pod_sect} = $pod_data; + } + + $self->{versions} = \%vers; + $self->{packages} = \@pkgs; + $self->{pod} = \%pod; + $self->{pod_headings} = \@pod; +} + +{ +my $pn = 0; +sub _evaluate_version_line { + my $self = shift; + my( $sigil, $var, $line ) = @_; + + # Some of this code came from the ExtUtils:: hierarchy. + + # We compile into $vsub because 'use version' would cause + # compiletime/runtime issues with local() + my $vsub; + $pn++; # everybody gets their own package + my $eval = qq{BEGIN { my \$dummy = q# Hide from _packages_inside() + #; package Module::Metadata::_version::p$pn; + use version; + no strict; + no warnings; + + \$vsub = sub { + local $sigil$var; + \$$var=undef; + $line; + \$$var + }; + }}; + + $eval = $1 if $eval =~ m{^(.+)}s; + + local $^W; + # Try to get the $VERSION + eval $eval; + # some modules say $VERSION = $Foo::Bar::VERSION, but Foo::Bar isn't + # installed, so we need to hunt in ./lib for it + if ( $@ =~ /Can't locate/ && -d 'lib' ) { + local @INC = ('lib',@INC); + eval $eval; + } + warn "Error evaling version line '$eval' in $self->{filename}: $@\n" + if $@; + (ref($vsub) eq 'CODE') or + croak "failed to build version sub for $self->{filename}"; + my $result = eval { $vsub->() }; + croak "Could not get version from $self->{filename} by executing:\n$eval\n\nThe fatal error was: $@\n" + if $@; + + # Upgrade it into a version object + my $version = eval { _dwim_version($result) }; + + croak "Version '$result' from $self->{filename} does not appear to be valid:\n$eval\n\nThe fatal error was: $@\n" + unless defined $version; # "0" is OK! + + return $version; +} +} + +# Try to DWIM when things fail the lax version test in obvious ways +{ + my @version_prep = ( + # Best case, it just works + sub { return shift }, + + # If we still don't have a version, try stripping any + # trailing junk that is prohibited by lax rules + sub { + my $v = shift; + $v =~ s{([0-9])[a-z-].*$}{$1}i; # 1.23-alpha or 1.23b + return $v; + }, + + # Activestate apparently creates custom versions like '1.23_45_01', which + # cause version.pm to think it's an invalid alpha. So check for that + # and strip them + sub { + my $v = shift; + my $num_dots = () = $v =~ m{(\.)}g; + my $num_unders = () = $v =~ m{(_)}g; + my $leading_v = substr($v,0,1) eq 'v'; + if ( ! $leading_v && $num_dots < 2 && $num_unders > 1 ) { + $v =~ s{_}{}g; + $num_unders = () = $v =~ m{(_)}g; + } + return $v; + }, + + # Worst case, try numifying it like we would have before version objects + sub { + my $v = shift; + no warnings 'numeric'; + return 0 + $v; + }, + + ); + + sub _dwim_version { + my ($result) = shift; + + return $result if ref($result) eq 'version'; + + my ($version, $error); + for my $f (@version_prep) { + $result = $f->($result); + $version = eval { version->new($result) }; + $error ||= $@ if $@; # capture first failure + last if defined $version; + } + + croak $error unless defined $version; + + return $version; + } +} + +############################################################ + +# accessors +sub name { $_[0]->{module} } + +sub filename { $_[0]->{filename} } +sub packages_inside { @{$_[0]->{packages}} } +sub pod_inside { @{$_[0]->{pod_headings}} } +sub contains_pod { 0+@{$_[0]->{pod_headings}} } + +sub version { + my $self = shift; + my $mod = shift || $self->{module}; + my $vers; + if ( defined( $mod ) && length( $mod ) && + exists( $self->{versions}{$mod} ) ) { + return $self->{versions}{$mod}; + } else { + return undef; + } +} + +sub pod { + my $self = shift; + my $sect = shift; + if ( defined( $sect ) && length( $sect ) && + exists( $self->{pod}{$sect} ) ) { + return $self->{pod}{$sect}; + } else { + return undef; + } +} + +1; + +=head1 NAME + +Module::Metadata - Gather package and POD information from perl module files + +=head1 SYNOPSIS + + use Module::Metadata; + + # information about a .pm file + my $info = Module::Metadata->new_from_file( $file ); + my $version = $info->version; + + # CPAN META 'provides' field for .pm files in a directory + my $provides = Module::Metadata->provides( + dir => 'lib', version => 2 + ); + +=head1 DESCRIPTION + +This module provides a standard way to gather metadata about a .pm file through +(mostly) static analysis and (some) code execution. When determining the +version of a module, the C<$VERSION> assignment is C<eval>ed, as is traditional +in the CPAN toolchain. + +=head1 USAGE + +=head2 Class methods + +=over 4 + +=item C<< new_from_file($filename, collect_pod => 1) >> + +Constructs a C<Module::Metadata> object given the path to a file. Returns +undef if the filename does not exist. + +C<collect_pod> is a optional boolean argument that determines whether POD +data is collected and stored for reference. POD data is not collected by +default. POD headings are always collected. + +If the file begins by an UTF-8, UTF-16BE or UTF-16LE byte-order mark, then +it is skipped before processing, and the content of the file is also decoded +appropriately starting from perl 5.8. + +=item C<< new_from_handle($handle, $filename, collect_pod => 1) >> + +This works just like C<new_from_file>, except that a handle can be provided +as the first argument. + +Note that there is no validation to confirm that the handle is a handle or +something that can act like one. Passing something that isn't a handle will +cause a exception when trying to read from it. The C<filename> argument is +mandatory or undef will be returned. + +You are responsible for setting the decoding layers on C<$handle> if +required. + +=item C<< new_from_module($module, collect_pod => 1, inc => \@dirs) >> + +Constructs a C<Module::Metadata> object given a module or package name. +Returns undef if the module cannot be found. + +In addition to accepting the C<collect_pod> argument as described above, +this method accepts a C<inc> argument which is a reference to an array of +directories to search for the module. If none are given, the default is +@INC. + +If the file that contains the module begins by an UTF-8, UTF-16BE or +UTF-16LE byte-order mark, then it is skipped before processing, and the +content of the file is also decoded appropriately starting from perl 5.8. + +=item C<< find_module_by_name($module, \@dirs) >> + +Returns the path to a module given the module or package name. A list +of directories can be passed in as an optional parameter, otherwise +@INC is searched. + +Can be called as either an object or a class method. + +=item C<< find_module_dir_by_name($module, \@dirs) >> + +Returns the entry in C<@dirs> (or C<@INC> by default) that contains +the module C<$module>. A list of directories can be passed in as an +optional parameter, otherwise @INC is searched. + +Can be called as either an object or a class method. + +=item C<< provides( %options ) >> + +This is a convenience wrapper around C<package_versions_from_directory> +to generate a CPAN META C<provides> data structure. It takes key/value +pairs. Valid option keys include: + +=over + +=item version B<(required)> + +Specifies which version of the L<CPAN::Meta::Spec> should be used as +the format of the C<provides> output. Currently only '1.4' and '2' +are supported (and their format is identical). This may change in +the future as the definition of C<provides> changes. + +The C<version> option is required. If it is omitted or if +an unsupported version is given, then C<provides> will throw an error. + +=item dir + +Directory to search recursively for F<.pm> files. May not be specified with +C<files>. + +=item files + +Array reference of files to examine. May not be specified with C<dir>. + +=item prefix + +String to prepend to the C<file> field of the resulting output. This defaults +to F<lib>, which is the common case for most CPAN distributions with their +F<.pm> files in F<lib>. This option ensures the META information has the +correct relative path even when the C<dir> or C<files> arguments are +absolute or have relative paths from a location other than the distribution +root. + +=back + +For example, given C<dir> of 'lib' and C<prefix> of 'lib', the return value +is a hashref of the form: + + { + 'Package::Name' => { + version => '0.123', + file => 'lib/Package/Name.pm' + }, + 'OtherPackage::Name' => ... + } + +=item C<< package_versions_from_directory($dir, \@files?) >> + +Scans C<$dir> for .pm files (unless C<@files> is given, in which case looks +for those files in C<$dir> - and reads each file for packages and versions, +returning a hashref of the form: + + { + 'Package::Name' => { + version => '0.123', + file => 'Package/Name.pm' + }, + 'OtherPackage::Name' => ... + } + +The C<DB> and C<main> packages are always omitted, as are any "private" +packages that have leading underscores in the namespace (e.g. +C<Foo::_private>) + +Note that the file path is relative to C<$dir> if that is specified. +This B<must not> be used directly for CPAN META C<provides>. See +the C<provides> method instead. + +=item C<< log_info (internal) >> + +Used internally to perform logging; imported from Log::Contextual if +Log::Contextual has already been loaded, otherwise simply calls warn. + +=back + +=head2 Object methods + +=over 4 + +=item C<< name() >> + +Returns the name of the package represented by this module. If there +are more than one packages, it makes a best guess based on the +filename. If it's a script (i.e. not a *.pm) the package name is +'main'. + +=item C<< version($package) >> + +Returns the version as defined by the $VERSION variable for the +package as returned by the C<name> method if no arguments are +given. If given the name of a package it will attempt to return the +version of that package if it is specified in the file. + +=item C<< filename() >> + +Returns the absolute path to the file. + +=item C<< packages_inside() >> + +Returns a list of packages. Note: this is a raw list of packages +discovered (or assumed, in the case of C<main>). It is not +filtered for C<DB>, C<main> or private packages the way the +C<provides> method does. Invalid package names are not returned, +for example "Foo:Bar". Strange but valid package names are +returned, for example "Foo::Bar::", and are left up to the caller +on how to handle. + +=item C<< pod_inside() >> + +Returns a list of POD sections. + +=item C<< contains_pod() >> + +Returns true if there is any POD in the file. + +=item C<< pod($section) >> + +Returns the POD data in the given section. + +=back + +=head1 AUTHOR + +Original code from Module::Build::ModuleInfo by Ken Williams +<kwilliams@cpan.org>, Randy W. Sims <RandyS@ThePierianSpring.org> + +Released as Module::Metadata by Matt S Trout (mst) <mst@shadowcat.co.uk> with +assistance from David Golden (xdg) <dagolden@cpan.org>. + +=head1 COPYRIGHT & LICENSE + +Original code Copyright (c) 2001-2011 Ken Williams. +Additional code Copyright (c) 2010-2011 Matt Trout and David Golden. +All rights reserved. + +This library is free software; you can redistribute it and/or +modify it under the same terms as Perl itself. + +=cut + diff --git a/.checksetup_lib/lib/perl5/Parse/CPAN/Meta.pm b/.checksetup_lib/lib/perl5/Parse/CPAN/Meta.pm new file mode 100644 index 000000000..77a076477 --- /dev/null +++ b/.checksetup_lib/lib/perl5/Parse/CPAN/Meta.pm @@ -0,0 +1,352 @@ +use 5.008001; +use strict; +package Parse::CPAN::Meta; +# ABSTRACT: Parse META.yml and META.json CPAN metadata files + +our $VERSION = '1.4417'; + +use Exporter; +use Carp 'croak'; + +our @ISA = qw/Exporter/; +our @EXPORT_OK = qw/Load LoadFile/; + +sub load_file { + my ($class, $filename) = @_; + + my $meta = _slurp($filename); + + if ($filename =~ /\.ya?ml$/) { + return $class->load_yaml_string($meta); + } + elsif ($filename =~ /\.json$/) { + return $class->load_json_string($meta); + } + else { + $class->load_string($meta); # try to detect yaml/json + } +} + +sub load_string { + my ($class, $string) = @_; + if ( $string =~ /^---/ ) { # looks like YAML + return $class->load_yaml_string($string); + } + elsif ( $string =~ /^\s*\{/ ) { # looks like JSON + return $class->load_json_string($string); + } + else { # maybe doc-marker-free YAML + return $class->load_yaml_string($string); + } +} + +sub load_yaml_string { + my ($class, $string) = @_; + my $backend = $class->yaml_backend(); + my $data = eval { no strict 'refs'; &{"$backend\::Load"}($string) }; + croak $@ if $@; + return $data || {}; # in case document was valid but empty +} + +sub load_json_string { + my ($class, $string) = @_; + my $data = eval { $class->json_backend()->new->decode($string) }; + croak $@ if $@; + return $data || {}; +} + +sub yaml_backend { + if (! defined $ENV{PERL_YAML_BACKEND} ) { + _can_load( 'CPAN::Meta::YAML', 0.011 ) + or croak "CPAN::Meta::YAML 0.011 is not available\n"; + return "CPAN::Meta::YAML"; + } + else { + my $backend = $ENV{PERL_YAML_BACKEND}; + _can_load( $backend ) + or croak "Could not load PERL_YAML_BACKEND '$backend'\n"; + $backend->can("Load") + or croak "PERL_YAML_BACKEND '$backend' does not implement Load()\n"; + return $backend; + } +} + +sub json_backend { + if (! $ENV{PERL_JSON_BACKEND} or $ENV{PERL_JSON_BACKEND} eq 'JSON::PP') { + _can_load( 'JSON::PP' => 2.27103 ) + or croak "JSON::PP 2.27103 is not available\n"; + return 'JSON::PP'; + } + else { + _can_load( 'JSON' => 2.5 ) + or croak "JSON 2.5 is required for " . + "\$ENV{PERL_JSON_BACKEND} = '$ENV{PERL_JSON_BACKEND}'\n"; + return "JSON"; + } +} + +sub _slurp { + require Encode; + open my $fh, "<:raw", "$_[0]" ## no critic + or die "can't open $_[0] for reading: $!"; + my $content = do { local $/; <$fh> }; + $content = Encode::decode('UTF-8', $content, Encode::PERLQQ()); + return $content; +} + +sub _can_load { + my ($module, $version) = @_; + (my $file = $module) =~ s{::}{/}g; + $file .= ".pm"; + return 1 if $INC{$file}; + return 0 if exists $INC{$file}; # prior load failed + eval { require $file; 1 } + or return 0; + if ( defined $version ) { + eval { $module->VERSION($version); 1 } + or return 0; + } + return 1; +} + +# Kept for backwards compatibility only +# Create an object from a file +sub LoadFile ($) { ## no critic + return Load(_slurp(shift)); +} + +# Parse a document from a string. +sub Load ($) { ## no critic + require CPAN::Meta::YAML; + my $object = eval { CPAN::Meta::YAML::Load(shift) }; + croak $@ if $@; + return $object; +} + +1; + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +Parse::CPAN::Meta - Parse META.yml and META.json CPAN metadata files + +=head1 VERSION + +version 1.4417 + +=head1 SYNOPSIS + + ############################################# + # In your file + + --- + name: My-Distribution + version: 1.23 + resources: + homepage: "http://example.com/dist/My-Distribution" + + + ############################################# + # In your program + + use Parse::CPAN::Meta; + + my $distmeta = Parse::CPAN::Meta->load_file('META.yml'); + + # Reading properties + my $name = $distmeta->{name}; + my $version = $distmeta->{version}; + my $homepage = $distmeta->{resources}{homepage}; + +=head1 DESCRIPTION + +B<Parse::CPAN::Meta> is a parser for F<META.json> and F<META.yml> files, using +L<JSON::PP> and/or L<CPAN::Meta::YAML>. + +B<Parse::CPAN::Meta> provides three methods: C<load_file>, C<load_json_string>, +and C<load_yaml_string>. These will read and deserialize CPAN metafiles, and +are described below in detail. + +B<Parse::CPAN::Meta> provides a legacy API of only two functions, +based on the YAML functions of the same name. Wherever possible, +identical calling semantics are used. These may only be used with YAML sources. + +All error reporting is done with exceptions (die'ing). + +Note that META files are expected to be in UTF-8 encoding, only. When +converted string data, it must first be decoded from UTF-8. + +=begin Pod::Coverage + + + + +=end Pod::Coverage + +=head1 METHODS + +=head2 load_file + + my $metadata_structure = Parse::CPAN::Meta->load_file('META.json'); + + my $metadata_structure = Parse::CPAN::Meta->load_file('META.yml'); + +This method will read the named file and deserialize it to a data structure, +determining whether it should be JSON or YAML based on the filename. +The file will be read using the ":utf8" IO layer. + +=head2 load_yaml_string + + my $metadata_structure = Parse::CPAN::Meta->load_yaml_string($yaml_string); + +This method deserializes the given string of YAML and returns the first +document in it. (CPAN metadata files should always have only one document.) +If the source was UTF-8 encoded, the string must be decoded before calling +C<load_yaml_string>. + +=head2 load_json_string + + my $metadata_structure = Parse::CPAN::Meta->load_json_string($json_string); + +This method deserializes the given string of JSON and the result. +If the source was UTF-8 encoded, the string must be decoded before calling +C<load_json_string>. + +=head2 load_string + + my $metadata_structure = Parse::CPAN::Meta->load_string($some_string); + +If you don't know whether a string contains YAML or JSON data, this method +will use some heuristics and guess. If it can't tell, it assumes YAML. + +=head2 yaml_backend + + my $backend = Parse::CPAN::Meta->yaml_backend; + +Returns the module name of the YAML serializer. See L</ENVIRONMENT> +for details. + +=head2 json_backend + + my $backend = Parse::CPAN::Meta->json_backend; + +Returns the module name of the JSON serializer. This will either +be L<JSON::PP> or L<JSON>. Even if C<PERL_JSON_BACKEND> is set, +this will return L<JSON> as further delegation is handled by +the L<JSON> module. See L</ENVIRONMENT> for details. + +=head1 FUNCTIONS + +For maintenance clarity, no functions are exported by default. These functions +are available for backwards compatibility only and are best avoided in favor of +C<load_file>. + +=head2 Load + + my @yaml = Parse::CPAN::Meta::Load( $string ); + +Parses a string containing a valid YAML stream into a list of Perl data +structures. + +=head2 LoadFile + + my @yaml = Parse::CPAN::Meta::LoadFile( 'META.yml' ); + +Reads the YAML stream from a file instead of a string. + +=head1 ENVIRONMENT + +=head2 PERL_JSON_BACKEND + +By default, L<JSON::PP> will be used for deserializing JSON data. If the +C<PERL_JSON_BACKEND> environment variable exists, is true and is not +"JSON::PP", then the L<JSON> module (version 2.5 or greater) will be loaded and +used to interpret C<PERL_JSON_BACKEND>. If L<JSON> is not installed or is too +old, an exception will be thrown. + +=head2 PERL_YAML_BACKEND + +By default, L<CPAN::Meta::YAML> will be used for deserializing YAML data. If +the C<PERL_YAML_BACKEND> environment variable is defined, then it is interpreted +as a module to use for deserialization. The given module must be installed, +must load correctly and must implement the C<Load()> function or an exception +will be thrown. + +=for :stopwords cpan testmatrix url annocpan anno bugtracker rt cpants kwalitee diff irc mailto metadata placeholders metacpan + +=head1 SUPPORT + +=head2 Bugs / Feature Requests + +Please report any bugs or feature requests through the issue tracker +at L<https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta/issues>. +You will be notified automatically of any progress on your issue. + +=head2 Source Code + +This is open source software. The code repository is available for +public review and contribution under the terms of the license. + +L<https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta> + + git clone https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta.git + +=head1 AUTHORS + +=over 4 + +=item * + +Adam Kennedy <adamk@cpan.org> + +=item * + +David Golden <dagolden@cpan.org> + +=back + +=head1 CONTRIBUTORS + +=for stopwords Graham Knop Joshua ben Jore Karen Etheridge Neil Bowers Ricardo Signes Steffen Mueller + +=over 4 + +=item * + +Graham Knop <haarg@haarg.org> + +=item * + +Joshua ben Jore <jjore@cpan.org> + +=item * + +Karen Etheridge <ether@cpan.org> + +=item * + +Neil Bowers <neil@bowers.com> + +=item * + +Ricardo Signes <rjbs@cpan.org> + +=item * + +Steffen Mueller <smueller@cpan.org> + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2015 by Adam Kennedy and Contributors. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut |