From 08d1c9d759986c4f2cf80149128c73f129c3b62e Mon Sep 17 00:00:00 2001 From: Dylan William Hardison Date: Sun, 5 Mar 2017 19:40:39 -0500 Subject: [PATCH] Bug 1342832 - Remove some of the broken things from checksetup.pl and Makefile.PL --- .checksetup_lib/lib/perl5/CPAN/Meta.pm | 1156 ------- .../lib/perl5/CPAN/Meta/Converter.pm | 1639 ---------- .../lib/perl5/CPAN/Meta/Feature.pm | 149 - .../lib/perl5/CPAN/Meta/History.pm | 316 -- .checksetup_lib/lib/perl5/CPAN/Meta/Merge.pm | 297 -- .../lib/perl5/CPAN/Meta/Prereqs.pm | 422 --- .../lib/perl5/CPAN/Meta/Requirements.pm | 1194 ------- .checksetup_lib/lib/perl5/CPAN/Meta/Spec.pm | 1235 -------- .../lib/perl5/CPAN/Meta/Validator.pm | 1210 ------- .checksetup_lib/lib/perl5/CPAN/Meta/YAML.pm | 951 ------ .checksetup_lib/lib/perl5/JSON/PP.pm | 2797 ----------------- .checksetup_lib/lib/perl5/JSON/PP/Boolean.pm | 26 - .checksetup_lib/lib/perl5/Module/Metadata.pm | 1016 ------ .checksetup_lib/lib/perl5/Parse/CPAN/Meta.pm | 352 --- Bugzilla/Install/Requirements.pm | 7 +- META.json | 399 --- META.yml | 194 -- Makefile.PL | 46 +- checksetup.pl | 26 +- .../en/default/global/code-error.html.tmpl | 2 +- 20 files changed, 26 insertions(+), 13408 deletions(-) delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta.pm delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta/Converter.pm delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta/Feature.pm delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta/History.pm delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta/Merge.pm delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta/Prereqs.pm delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta/Requirements.pm delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta/Spec.pm delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm delete mode 100644 .checksetup_lib/lib/perl5/CPAN/Meta/YAML.pm delete mode 100644 .checksetup_lib/lib/perl5/JSON/PP.pm delete mode 100644 .checksetup_lib/lib/perl5/JSON/PP/Boolean.pm delete mode 100644 .checksetup_lib/lib/perl5/Module/Metadata.pm delete mode 100644 .checksetup_lib/lib/perl5/Parse/CPAN/Meta.pm delete mode 100644 META.json delete mode 100644 META.yml diff --git a/.checksetup_lib/lib/perl5/CPAN/Meta.pm b/.checksetup_lib/lib/perl5/CPAN/Meta.pm deleted file mode 100644 index afbb221855..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta.pm +++ /dev/null @@ -1,1156 +0,0 @@ -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 or, for -#pod older distributions, F, which describes the distribution, its -#pod contents, and the requirements for building and installing the distribution. -#pod The data structure stored in the F file is described in -#pod L. -#pod -#pod CPAN::Meta provides a simple class to represent this distribution metadata (or -#pod I), 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 and C methods may also be called as C and -#pod C, 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 method and -#pod particular keys may be retrieved with the C 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, except that C and C fields -#pod will be generated if not provided. This means the metadata structure is -#pod assumed to otherwise follow the latest L. -#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 object, just -#pod like C. 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 but C 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. -#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. -#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 to guess. In other respects it is identical to -#pod C. -#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, which defaults to '2'. On Perl 5.8.1 or later, the file -#pod is saved with UTF-8 encoding. -#pod -#pod For C 2 (or higher), the filename should end in '.json'. L -#pod is the default JSON backend. Using another JSON backend requires L 2.5 or -#pod later and you must set the C<$ENV{PERL_JSON_BACKEND}> to a supported alternate -#pod backend like L. -#pod -#pod For C less than 2, the filename should end in '.yml'. -#pod L 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 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 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 and C keys in the C property of -#pod the distmeta structure. Note that neither the version format nor -#pod C 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 and C keys in the C -#pod property of the distmeta structure. Note that neither the version format nor -#pod C 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 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 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 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 UTF-8 encoded.) It takes an optional hashref -#pod of options. If the hashref contains a C 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 greater than or equal to 2, the string will be serialized as -#pod JSON. For C less than 2, the string will be serialized as YAML. In -#pod both cases, the same rules are followed as in the C method for choosing -#pod a serialization backend. -#pod -#pod The serialized structure will include a C 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 or, for -older distributions, F, which describes the distribution, its -contents, and the requirements for building and installing the distribution. -The data structure stored in the F file is described in -L. - -CPAN::Meta provides a simple class to represent this distribution metadata (or -I), 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, except that C and C fields -will be generated if not provided. This means the metadata structure is -assumed to otherwise follow the latest L. - -=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 object, just -like C. It will die if the deserialized version fails to validate -against its stated specification version. - -It takes the same options as C but C 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. - -=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. - -=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 to guess. In other respects it is identical to -C. - -=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, which defaults to '2'. On Perl 5.8.1 or later, the file -is saved with UTF-8 encoding. - -For C 2 (or higher), the filename should end in '.json'. L -is the default JSON backend. Using another JSON backend requires L 2.5 or -later and you must set the C<$ENV{PERL_JSON_BACKEND}> to a supported alternate -backend like L. - -For C less than 2, the filename should end in '.yml'. -L 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 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 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 and C keys in the C property of -the distmeta structure. Note that neither the version format nor -C 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 and C keys in the C -property of the distmeta structure. Note that neither the version format nor -C are considered. - -=head2 features - - my @feature_objects = $meta->features; - -This method returns a list of L 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 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 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 UTF-8 encoded.) It takes an optional hashref -of options. If the hashref contains a C 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 greater than or equal to 2, the string will be serialized as -JSON. For C less than 2, the string will be serialized as YAML. In -both cases, the same rules are followed as in the C method for choosing -a serialization backend. - -The serialized structure will include a C 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 and C methods may also be called as C and -C, 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 method and -particular keys may be retrieved with the C 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 - -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 - -=item * - -L - -=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. -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 - - git clone https://github.com/Perl-Toolchain-Gang/CPAN-Meta.git - -=head1 AUTHORS - -=over 4 - -=item * - -David Golden - -=item * - -Ricardo Signes - -=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 - -=item * - -Avar Arnfjord Bjarmason - -=item * - -Christopher J. Madsen - -=item * - -Chuck Adams - -=item * - -Cory G Watson - -=item * - -Damyan Ivanov - -=item * - -Eric Wilhelm - -=item * - -Graham Knop - -=item * - -Gregor Hermann - -=item * - -Karen Etheridge - -=item * - -Kenichi Ishigaki - -=item * - -Ken Williams - -=item * - -Lars Dieckow - -=item * - -Leon Timmermans - -=item * - -majensen - -=item * - -Mark Fowler - -=item * - -Matt S Trout - -=item * - -Michael G. Schwern - -=item * - -mohawk2 - -=item * - -moznion - -=item * - -Niko Tyni - -=item * - -Olaf Alders - -=item * - -Olivier Mengué - -=item * - -Randy Sims - -=item * - -Tomohiro Hosaka - -=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 deleted file mode 100644 index 03806bc82b..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta/Converter.pm +++ /dev/null @@ -1,1639 +0,0 @@ -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 || ""); - - 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 '' ); - - 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 '' ) { - $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 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 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 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 -- 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 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 field will result in a C -#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 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 field. - -=head2 convert - - my $new_struct = $cmc->convert( version => "2" ); - -Returns a new hash reference with the metadata converted to a different form. -C will die if any conversion/standardization still results in an -invalid structure. - -Valid parameters include: - -=over - -=item * - -C -- 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 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 field will result in a C -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 - -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 - -=item * - -Ricardo Signes - -=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 deleted file mode 100644 index 9dac4f4218..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta/Feature.pm +++ /dev/null @@ -1,149 +0,0 @@ -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 (or F) -#pod file. -#pod -#pod For the most part, this class will only be used when operating on the result of -#pod the C or C methods on a L 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 entry in the -#pod distmeta. It must contain entries for C and C. -#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 -#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 (or F) -file. - -For the most part, this class will only be used when operating on the result of -the C or C methods on a L 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 entry in the -distmeta. It must contain entries for C and C. - -=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 -object. - -=head1 BUGS - -Please report any bugs or feature using the CPAN Request Tracker. -Bugs can be submitted through the web interface at -L - -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 - -=item * - -Ricardo Signes - -=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 deleted file mode 100644 index f4cac5e59a..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta/History.pm +++ /dev/null @@ -1,316 +0,0 @@ -# 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. - -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 (configure, build, test, runtime, etc.) and I -(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 - -=item * - -Ricardo Signes - -=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 deleted file mode 100644 index 05a18ea973..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta/Merge.pm +++ /dev/null @@ -1,297 +0,0 @@ -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, declaring the version of the meta-spec that must be -used for the merge. It can optionally take an C 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 - -=item * - -Ricardo Signes - -=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 deleted file mode 100644 index 8a13eb13c8..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta/Prereqs.pm +++ /dev/null @@ -1,422 +0,0 @@ -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. -#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 field described in L, 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 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 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 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 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. - -=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 field described in L, 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 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 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 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 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 - -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 - -=item * - -Ricardo Signes - -=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/Requirements.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/Requirements.pm deleted file mode 100644 index b0e83b0d2d..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta/Requirements.pm +++ /dev/null @@ -1,1194 +0,0 @@ -use 5.006; # keep at v5.6 for CPAN.pm -use strict; -use warnings; -package CPAN::Meta::Requirements; -# ABSTRACT: a set of version requirements for a CPAN dist - -our $VERSION = '2.140'; - -#pod =head1 SYNOPSIS -#pod -#pod use CPAN::Meta::Requirements; -#pod -#pod my $build_requires = CPAN::Meta::Requirements->new; -#pod -#pod $build_requires->add_minimum('Library::Foo' => 1.208); -#pod -#pod $build_requires->add_minimum('Library::Foo' => 2.602); -#pod -#pod $build_requires->add_minimum('Module::Bar' => 'v1.2.3'); -#pod -#pod $METAyml->{build_requires} = $build_requires->as_string_hash; -#pod -#pod =head1 DESCRIPTION -#pod -#pod A CPAN::Meta::Requirements object models a set of version constraints like -#pod those specified in the F or F files in CPAN distributions, -#pod and as defined by L; -#pod It can be built up by adding more and more constraints, and it will reduce them -#pod to the simplest representation. -#pod -#pod Logically impossible constraints will be identified immediately by thrown -#pod exceptions. -#pod -#pod =cut - -use Carp (); - -# 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} }; - -# construct once, reuse many times -my $V0 = version->new(0); - -#pod =method new -#pod -#pod my $req = CPAN::Meta::Requirements->new; -#pod -#pod This returns a new CPAN::Meta::Requirements object. It takes an optional -#pod hash reference argument. Currently, only one key is supported: -#pod -#pod =for :list -#pod * C -- if provided, when a version cannot be parsed into -#pod a version object, this code reference will be called with the invalid -#pod version string as first argument, and the module name as second -#pod argument. It must return a valid version object. -#pod -#pod All other keys are ignored. -#pod -#pod =cut - -my @valid_options = qw( bad_version_hook ); - -sub new { - my ($class, $options) = @_; - $options ||= {}; - Carp::croak "Argument to $class\->new() must be a hash reference" - unless ref $options eq 'HASH'; - my %self = map {; $_ => $options->{$_}} @valid_options; - - return bless \%self => $class; -} - -# from version::vpp -sub _find_magic_vstring { - my $value = shift; - my $tvalue = ''; - require B; - my $sv = B::svref_2object(\$value); - my $magic = ref($sv) eq 'B::PVMG' ? $sv->MAGIC : undef; - while ( $magic ) { - if ( $magic->TYPE eq 'V' ) { - $tvalue = $magic->PTR; - $tvalue =~ s/^v?(.+)$/v$1/; - last; - } - else { - $magic = $magic->MOREMAGIC; - } - } - return $tvalue; -} - -# safe if given an unblessed reference -sub _isa_version { - UNIVERSAL::isa( $_[0], 'UNIVERSAL' ) && $_[0]->isa('version') -} - -sub _version_object { - my ($self, $module, $version) = @_; - - my ($vobj, $err); - - if (not defined $version or (!ref($version) && $version eq '0')) { - return $V0; - } - elsif ( ref($version) eq 'version' || ( ref($version) && _isa_version($version) ) ) { - $vobj = $version; - } - else { - # hack around version::vpp not handling <3 character vstring literals - if ( $INC{'version/vpp.pm'} || $INC{'ExtUtils/MakeMaker/version/vpp.pm'} ) { - my $magic = _find_magic_vstring( $version ); - $version = $magic if length $magic; - } - # pad to 3 characters if before 5.8.1 and appears to be a v-string - if ( $] < 5.008001 && $version !~ /\A[0-9]/ && substr($version,0,1) ne 'v' && length($version) < 3 ) { - $version .= "\0" x (3 - length($version)); - } - eval { - local $SIG{__WARN__} = sub { die "Invalid version: $_[0]" }; - # avoid specific segfault on some older version.pm versions - die "Invalid version: $version" if $version eq 'version'; - $vobj = version->new($version); - }; - if ( my $err = $@ ) { - my $hook = $self->{bad_version_hook}; - $vobj = eval { $hook->($version, $module) } - if ref $hook eq 'CODE'; - unless (eval { $vobj->isa("version") }) { - $err =~ s{ at .* line \d+.*$}{}; - die "Can't convert '$version': $err"; - } - } - } - - # ensure no leading '.' - if ( $vobj =~ m{\A\.} ) { - $vobj = version->new("0$vobj"); - } - - # ensure normal v-string form - if ( _is_qv($vobj) ) { - $vobj = version->new($vobj->normal); - } - - return $vobj; -} - -#pod =method add_minimum -#pod -#pod $req->add_minimum( $module => $version ); -#pod -#pod This adds a new minimum version requirement. If the new requirement is -#pod redundant to the existing specification, this has no effect. -#pod -#pod Minimum requirements are inclusive. C<$version> is required, along with any -#pod greater version number. -#pod -#pod This method returns the requirements object. -#pod -#pod =method add_maximum -#pod -#pod $req->add_maximum( $module => $version ); -#pod -#pod This adds a new maximum version requirement. If the new requirement is -#pod redundant to the existing specification, this has no effect. -#pod -#pod Maximum requirements are inclusive. No version strictly greater than the given -#pod version is allowed. -#pod -#pod This method returns the requirements object. -#pod -#pod =method add_exclusion -#pod -#pod $req->add_exclusion( $module => $version ); -#pod -#pod This adds a new excluded version. For example, you might use these three -#pod method calls: -#pod -#pod $req->add_minimum( $module => '1.00' ); -#pod $req->add_maximum( $module => '1.82' ); -#pod -#pod $req->add_exclusion( $module => '1.75' ); -#pod -#pod Any version between 1.00 and 1.82 inclusive would be acceptable, except for -#pod 1.75. -#pod -#pod This method returns the requirements object. -#pod -#pod =method exact_version -#pod -#pod $req->exact_version( $module => $version ); -#pod -#pod This sets the version required for the given module to I the given -#pod version. No other version would be considered acceptable. -#pod -#pod This method returns the requirements object. -#pod -#pod =cut - -BEGIN { - for my $type (qw(maximum exclusion exact_version)) { - my $method = "with_$type"; - my $to_add = $type eq 'exact_version' ? $type : "add_$type"; - - my $code = sub { - my ($self, $name, $version) = @_; - - $version = $self->_version_object( $name, $version ); - - $self->__modify_entry_for($name, $method, $version); - - return $self; - }; - - no strict 'refs'; - *$to_add = $code; - } -} - -# add_minimum is optimized compared to generated subs above because -# it is called frequently and with "0" or equivalent input -sub add_minimum { - my ($self, $name, $version) = @_; - - # stringify $version so that version->new("0.00")->stringify ne "0" - # which preserves the user's choice of "0.00" as the requirement - if (not defined $version or "$version" eq '0') { - return $self if $self->__entry_for($name); - Carp::confess("can't add new requirements to finalized requirements") - if $self->is_finalized; - - $self->{requirements}{ $name } = - CPAN::Meta::Requirements::_Range::Range->with_minimum($V0, $name); - } - else { - $version = $self->_version_object( $name, $version ); - - $self->__modify_entry_for($name, 'with_minimum', $version); - } - return $self; -} - -#pod =method add_requirements -#pod -#pod $req->add_requirements( $another_req_object ); -#pod -#pod This method adds all the requirements in the given CPAN::Meta::Requirements -#pod object to the requirements object on which it was called. If there are any -#pod conflicts, an exception is thrown. -#pod -#pod This method returns the requirements object. -#pod -#pod =cut - -sub add_requirements { - my ($self, $req) = @_; - - for my $module ($req->required_modules) { - my $modifiers = $req->__entry_for($module)->as_modifiers; - for my $modifier (@$modifiers) { - my ($method, @args) = @$modifier; - $self->$method($module => @args); - }; - } - - return $self; -} - -#pod =method accepts_module -#pod -#pod my $bool = $req->accepts_module($module => $version); -#pod -#pod Given an module and version, this method returns true if the version -#pod specification for the module accepts the provided version. In other words, -#pod given: -#pod -#pod Module => '>= 1.00, < 2.00' -#pod -#pod We will accept 1.00 and 1.75 but not 0.50 or 2.00. -#pod -#pod For modules that do not appear in the requirements, this method will return -#pod true. -#pod -#pod =cut - -sub accepts_module { - my ($self, $module, $version) = @_; - - $version = $self->_version_object( $module, $version ); - - return 1 unless my $range = $self->__entry_for($module); - return $range->_accepts($version); -} - -#pod =method clear_requirement -#pod -#pod $req->clear_requirement( $module ); -#pod -#pod This removes the requirement for a given module from the object. -#pod -#pod This method returns the requirements object. -#pod -#pod =cut - -sub clear_requirement { - my ($self, $module) = @_; - - return $self unless $self->__entry_for($module); - - Carp::confess("can't clear requirements on finalized requirements") - if $self->is_finalized; - - delete $self->{requirements}{ $module }; - - return $self; -} - -#pod =method requirements_for_module -#pod -#pod $req->requirements_for_module( $module ); -#pod -#pod This returns a string containing the version requirements for a given module in -#pod the format described in L or undef if the given module has no -#pod requirements. This should only be used for informational purposes such as error -#pod messages and should not be interpreted or used for comparison (see -#pod L instead). -#pod -#pod =cut - -sub requirements_for_module { - my ($self, $module) = @_; - my $entry = $self->__entry_for($module); - return unless $entry; - return $entry->as_string; -} - -#pod =method structured_requirements_for_module -#pod -#pod $req->structured_requirements_for_module( $module ); -#pod -#pod This returns a data structure containing the version requirements for a given -#pod module or undef if the given module has no requirements. This should -#pod not be used for version checks (see L instead). -#pod -#pod Added in version 2.134. -#pod -#pod =cut - -sub structured_requirements_for_module { - my ($self, $module) = @_; - my $entry = $self->__entry_for($module); - return unless $entry; - return $entry->as_struct; -} - -#pod =method required_modules -#pod -#pod This method returns a list of all the modules for which requirements have been -#pod specified. -#pod -#pod =cut - -sub required_modules { keys %{ $_[0]{requirements} } } - -#pod =method clone -#pod -#pod $req->clone; -#pod -#pod This method returns a clone of the invocant. The clone and the original object -#pod can then be changed independent of one another. -#pod -#pod =cut - -sub clone { - my ($self) = @_; - my $new = (ref $self)->new; - - return $new->add_requirements($self); -} - -sub __entry_for { $_[0]{requirements}{ $_[1] } } - -sub __modify_entry_for { - my ($self, $name, $method, $version) = @_; - - my $fin = $self->is_finalized; - my $old = $self->__entry_for($name); - - Carp::confess("can't add new requirements to finalized requirements") - if $fin and not $old; - - my $new = ($old || 'CPAN::Meta::Requirements::_Range::Range') - ->$method($version, $name); - - Carp::confess("can't modify finalized requirements") - if $fin and $old->as_string ne $new->as_string; - - $self->{requirements}{ $name } = $new; -} - -#pod =method is_simple -#pod -#pod This method returns true if and only if all requirements are inclusive minimums -#pod -- that is, if their string expression is just the version number. -#pod -#pod =cut - -sub is_simple { - my ($self) = @_; - for my $module ($self->required_modules) { - # XXX: This is a complete hack, but also entirely correct. - return if $self->__entry_for($module)->as_string =~ /\s/; - } - - return 1; -} - -#pod =method is_finalized -#pod -#pod This method returns true if the requirements have been finalized by having the -#pod C method called on them. -#pod -#pod =cut - -sub is_finalized { $_[0]{finalized} } - -#pod =method finalize -#pod -#pod This method marks the requirements finalized. Subsequent attempts to change -#pod the requirements will be fatal, I they would result in a change. If they -#pod would not alter the requirements, they have no effect. -#pod -#pod If a finalized set of requirements is cloned, the cloned requirements are not -#pod also finalized. -#pod -#pod =cut - -sub finalize { $_[0]{finalized} = 1 } - -#pod =method as_string_hash -#pod -#pod This returns a reference to a hash describing the requirements using the -#pod strings in the L specification. -#pod -#pod For example after the following program: -#pod -#pod my $req = CPAN::Meta::Requirements->new; -#pod -#pod $req->add_minimum('CPAN::Meta::Requirements' => 0.102); -#pod -#pod $req->add_minimum('Library::Foo' => 1.208); -#pod -#pod $req->add_maximum('Library::Foo' => 2.602); -#pod -#pod $req->add_minimum('Module::Bar' => 'v1.2.3'); -#pod -#pod $req->add_exclusion('Module::Bar' => 'v1.2.8'); -#pod -#pod $req->exact_version('Xyzzy' => '6.01'); -#pod -#pod my $hashref = $req->as_string_hash; -#pod -#pod C<$hashref> would contain: -#pod -#pod { -#pod 'CPAN::Meta::Requirements' => '0.102', -#pod 'Library::Foo' => '>= 1.208, <= 2.206', -#pod 'Module::Bar' => '>= v1.2.3, != v1.2.8', -#pod 'Xyzzy' => '== 6.01', -#pod } -#pod -#pod =cut - -sub as_string_hash { - my ($self) = @_; - - my %hash = map {; $_ => $self->{requirements}{$_}->as_string } - $self->required_modules; - - return \%hash; -} - -#pod =method add_string_requirement -#pod -#pod $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206'); -#pod $req->add_string_requirement('Library::Foo' => v1.208); -#pod -#pod This method parses the passed in string and adds the appropriate requirement -#pod for the given module. A version can be a Perl "v-string". It understands -#pod version ranges as described in the L. For -#pod example: -#pod -#pod =over 4 -#pod -#pod =item 1.3 -#pod -#pod =item >= 1.3 -#pod -#pod =item <= 1.3 -#pod -#pod =item == 1.3 -#pod -#pod =item != 1.3 -#pod -#pod =item > 1.3 -#pod -#pod =item < 1.3 -#pod -#pod =item >= 1.3, != 1.5, <= 2.0 -#pod -#pod A version number without an operator is equivalent to specifying a minimum -#pod (C=>). Extra whitespace is allowed. -#pod -#pod =back -#pod -#pod =cut - -my %methods_for_op = ( - '==' => [ qw(exact_version) ], - '!=' => [ qw(add_exclusion) ], - '>=' => [ qw(add_minimum) ], - '<=' => [ qw(add_maximum) ], - '>' => [ qw(add_minimum add_exclusion) ], - '<' => [ qw(add_maximum add_exclusion) ], -); - -sub add_string_requirement { - my ($self, $module, $req) = @_; - - unless ( defined $req && length $req ) { - $req = 0; - $self->_blank_carp($module); - } - - my $magic = _find_magic_vstring( $req ); - if (length $magic) { - $self->add_minimum($module => $magic); - return; - } - - my @parts = split qr{\s*,\s*}, $req; - - for my $part (@parts) { - my ($op, $ver) = $part =~ m{\A\s*(==|>=|>|<=|<|!=)\s*(.*)\z}; - - if (! defined $op) { - $self->add_minimum($module => $part); - } else { - Carp::confess("illegal requirement string: $req") - unless my $methods = $methods_for_op{ $op }; - - $self->$_($module => $ver) for @$methods; - } - } -} - -#pod =method from_string_hash -#pod -#pod my $req = CPAN::Meta::Requirements->from_string_hash( \%hash ); -#pod my $req = CPAN::Meta::Requirements->from_string_hash( \%hash, \%opts ); -#pod -#pod This is an alternate constructor for a CPAN::Meta::Requirements -#pod object. It takes a hash of module names and version requirement -#pod strings and returns a new CPAN::Meta::Requirements object. As with -#pod add_string_requirement, a version can be a Perl "v-string". Optionally, -#pod you can supply a hash-reference of options, exactly as with the L -#pod method. -#pod -#pod =cut - -sub _blank_carp { - my ($self, $module) = @_; - Carp::carp("Undefined requirement for $module treated as '0'"); -} - -sub from_string_hash { - my ($class, $hash, $options) = @_; - - my $self = $class->new($options); - - for my $module (keys %$hash) { - my $req = $hash->{$module}; - unless ( defined $req && length $req ) { - $req = 0; - $class->_blank_carp($module); - } - $self->add_string_requirement($module, $req); - } - - return $self; -} - -############################################################## - -{ - package - CPAN::Meta::Requirements::_Range::Exact; - sub _new { bless { version => $_[1] } => $_[0] } - - sub _accepts { return $_[0]{version} == $_[1] } - - sub as_string { return "== $_[0]{version}" } - - sub as_struct { return [ [ '==', "$_[0]{version}" ] ] } - - sub as_modifiers { return [ [ exact_version => $_[0]{version} ] ] } - - sub _reject_requirements { - my ($self, $module, $error) = @_; - Carp::confess("illegal requirements for $module: $error") - } - - sub _clone { - (ref $_[0])->_new( version->new( $_[0]{version} ) ) - } - - sub with_exact_version { - my ($self, $version, $module) = @_; - $module = 'module' unless defined $module; - - return $self->_clone if $self->_accepts($version); - - $self->_reject_requirements( - $module, - "can't be exactly $version when exact requirement is already $self->{version}", - ); - } - - sub with_minimum { - my ($self, $minimum, $module) = @_; - $module = 'module' unless defined $module; - - return $self->_clone if $self->{version} >= $minimum; - $self->_reject_requirements( - $module, - "minimum $minimum exceeds exact specification $self->{version}", - ); - } - - sub with_maximum { - my ($self, $maximum, $module) = @_; - $module = 'module' unless defined $module; - - return $self->_clone if $self->{version} <= $maximum; - $self->_reject_requirements( - $module, - "maximum $maximum below exact specification $self->{version}", - ); - } - - sub with_exclusion { - my ($self, $exclusion, $module) = @_; - $module = 'module' unless defined $module; - - return $self->_clone unless $exclusion == $self->{version}; - $self->_reject_requirements( - $module, - "tried to exclude $exclusion, which is already exactly specified", - ); - } -} - -############################################################## - -{ - package - CPAN::Meta::Requirements::_Range::Range; - - sub _self { ref($_[0]) ? $_[0] : (bless { } => $_[0]) } - - sub _clone { - return (bless { } => $_[0]) unless ref $_[0]; - - my ($s) = @_; - my %guts = ( - (exists $s->{minimum} ? (minimum => version->new($s->{minimum})) : ()), - (exists $s->{maximum} ? (maximum => version->new($s->{maximum})) : ()), - - (exists $s->{exclusions} - ? (exclusions => [ map { version->new($_) } @{ $s->{exclusions} } ]) - : ()), - ); - - bless \%guts => ref($s); - } - - sub as_modifiers { - my ($self) = @_; - my @mods; - push @mods, [ add_minimum => $self->{minimum} ] if exists $self->{minimum}; - push @mods, [ add_maximum => $self->{maximum} ] if exists $self->{maximum}; - push @mods, map {; [ add_exclusion => $_ ] } @{$self->{exclusions} || []}; - return \@mods; - } - - sub as_struct { - my ($self) = @_; - - return 0 if ! keys %$self; - - my @exclusions = @{ $self->{exclusions} || [] }; - - my @parts; - - for my $tuple ( - [ qw( >= > minimum ) ], - [ qw( <= < maximum ) ], - ) { - my ($op, $e_op, $k) = @$tuple; - if (exists $self->{$k}) { - my @new_exclusions = grep { $_ != $self->{ $k } } @exclusions; - if (@new_exclusions == @exclusions) { - push @parts, [ $op, "$self->{ $k }" ]; - } else { - push @parts, [ $e_op, "$self->{ $k }" ]; - @exclusions = @new_exclusions; - } - } - } - - push @parts, map {; [ "!=", "$_" ] } @exclusions; - - return \@parts; - } - - sub as_string { - my ($self) = @_; - - my @parts = @{ $self->as_struct }; - - return $parts[0][1] if @parts == 1 and $parts[0][0] eq '>='; - - return join q{, }, map {; join q{ }, @$_ } @parts; - } - - sub _reject_requirements { - my ($self, $module, $error) = @_; - Carp::confess("illegal requirements for $module: $error") - } - - sub with_exact_version { - my ($self, $version, $module) = @_; - $module = 'module' unless defined $module; - $self = $self->_clone; - - unless ($self->_accepts($version)) { - $self->_reject_requirements( - $module, - "exact specification $version outside of range " . $self->as_string - ); - } - - return CPAN::Meta::Requirements::_Range::Exact->_new($version); - } - - sub _simplify { - my ($self, $module) = @_; - - if (defined $self->{minimum} and defined $self->{maximum}) { - if ($self->{minimum} == $self->{maximum}) { - if (grep { $_ == $self->{minimum} } @{ $self->{exclusions} || [] }) { - $self->_reject_requirements( - $module, - "minimum and maximum are both $self->{minimum}, which is excluded", - ); - } - - return CPAN::Meta::Requirements::_Range::Exact->_new($self->{minimum}) - } - - if ($self->{minimum} > $self->{maximum}) { - $self->_reject_requirements( - $module, - "minimum $self->{minimum} exceeds maximum $self->{maximum}", - ); - } - } - - # eliminate irrelevant exclusions - if ($self->{exclusions}) { - my %seen; - @{ $self->{exclusions} } = grep { - (! defined $self->{minimum} or $_ >= $self->{minimum}) - and - (! defined $self->{maximum} or $_ <= $self->{maximum}) - and - ! $seen{$_}++ - } @{ $self->{exclusions} }; - } - - return $self; - } - - sub with_minimum { - my ($self, $minimum, $module) = @_; - $module = 'module' unless defined $module; - $self = $self->_clone; - - if (defined (my $old_min = $self->{minimum})) { - $self->{minimum} = (sort { $b cmp $a } ($minimum, $old_min))[0]; - } else { - $self->{minimum} = $minimum; - } - - return $self->_simplify($module); - } - - sub with_maximum { - my ($self, $maximum, $module) = @_; - $module = 'module' unless defined $module; - $self = $self->_clone; - - if (defined (my $old_max = $self->{maximum})) { - $self->{maximum} = (sort { $a cmp $b } ($maximum, $old_max))[0]; - } else { - $self->{maximum} = $maximum; - } - - return $self->_simplify($module); - } - - sub with_exclusion { - my ($self, $exclusion, $module) = @_; - $module = 'module' unless defined $module; - $self = $self->_clone; - - push @{ $self->{exclusions} ||= [] }, $exclusion; - - return $self->_simplify($module); - } - - sub _accepts { - my ($self, $version) = @_; - - return if defined $self->{minimum} and $version < $self->{minimum}; - return if defined $self->{maximum} and $version > $self->{maximum}; - return if defined $self->{exclusions} - and grep { $version == $_ } @{ $self->{exclusions} }; - - return 1; - } -} - -1; -# vim: ts=2 sts=2 sw=2 et: - -__END__ - -=pod - -=encoding UTF-8 - -=head1 NAME - -CPAN::Meta::Requirements - a set of version requirements for a CPAN dist - -=head1 VERSION - -version 2.140 - -=head1 SYNOPSIS - - use CPAN::Meta::Requirements; - - my $build_requires = CPAN::Meta::Requirements->new; - - $build_requires->add_minimum('Library::Foo' => 1.208); - - $build_requires->add_minimum('Library::Foo' => 2.602); - - $build_requires->add_minimum('Module::Bar' => 'v1.2.3'); - - $METAyml->{build_requires} = $build_requires->as_string_hash; - -=head1 DESCRIPTION - -A CPAN::Meta::Requirements object models a set of version constraints like -those specified in the F or F files in CPAN distributions, -and as defined by L; -It can be built up by adding more and more constraints, and it will reduce them -to the simplest representation. - -Logically impossible constraints will be identified immediately by thrown -exceptions. - -=head1 METHODS - -=head2 new - - my $req = CPAN::Meta::Requirements->new; - -This returns a new CPAN::Meta::Requirements object. It takes an optional -hash reference argument. Currently, only one key is supported: - -=over 4 - -=item * - -C -- if provided, when a version cannot be parsed into a version object, this code reference will be called with the invalid version string as first argument, and the module name as second argument. It must return a valid version object. - -=back - -All other keys are ignored. - -=head2 add_minimum - - $req->add_minimum( $module => $version ); - -This adds a new minimum version requirement. If the new requirement is -redundant to the existing specification, this has no effect. - -Minimum requirements are inclusive. C<$version> is required, along with any -greater version number. - -This method returns the requirements object. - -=head2 add_maximum - - $req->add_maximum( $module => $version ); - -This adds a new maximum version requirement. If the new requirement is -redundant to the existing specification, this has no effect. - -Maximum requirements are inclusive. No version strictly greater than the given -version is allowed. - -This method returns the requirements object. - -=head2 add_exclusion - - $req->add_exclusion( $module => $version ); - -This adds a new excluded version. For example, you might use these three -method calls: - - $req->add_minimum( $module => '1.00' ); - $req->add_maximum( $module => '1.82' ); - - $req->add_exclusion( $module => '1.75' ); - -Any version between 1.00 and 1.82 inclusive would be acceptable, except for -1.75. - -This method returns the requirements object. - -=head2 exact_version - - $req->exact_version( $module => $version ); - -This sets the version required for the given module to I the given -version. No other version would be considered acceptable. - -This method returns the requirements object. - -=head2 add_requirements - - $req->add_requirements( $another_req_object ); - -This method adds all the requirements in the given CPAN::Meta::Requirements -object to the requirements object on which it was called. If there are any -conflicts, an exception is thrown. - -This method returns the requirements object. - -=head2 accepts_module - - my $bool = $req->accepts_module($module => $version); - -Given an module and version, this method returns true if the version -specification for the module accepts the provided version. In other words, -given: - - Module => '>= 1.00, < 2.00' - -We will accept 1.00 and 1.75 but not 0.50 or 2.00. - -For modules that do not appear in the requirements, this method will return -true. - -=head2 clear_requirement - - $req->clear_requirement( $module ); - -This removes the requirement for a given module from the object. - -This method returns the requirements object. - -=head2 requirements_for_module - - $req->requirements_for_module( $module ); - -This returns a string containing the version requirements for a given module in -the format described in L or undef if the given module has no -requirements. This should only be used for informational purposes such as error -messages and should not be interpreted or used for comparison (see -L instead). - -=head2 structured_requirements_for_module - - $req->structured_requirements_for_module( $module ); - -This returns a data structure containing the version requirements for a given -module or undef if the given module has no requirements. This should -not be used for version checks (see L instead). - -Added in version 2.134. - -=head2 required_modules - -This method returns a list of all the modules for which requirements have been -specified. - -=head2 clone - - $req->clone; - -This method returns a clone of the invocant. The clone and the original object -can then be changed independent of one another. - -=head2 is_simple - -This method returns true if and only if all requirements are inclusive minimums --- that is, if their string expression is just the version number. - -=head2 is_finalized - -This method returns true if the requirements have been finalized by having the -C method called on them. - -=head2 finalize - -This method marks the requirements finalized. Subsequent attempts to change -the requirements will be fatal, I they would result in a change. If they -would not alter the requirements, they have no effect. - -If a finalized set of requirements is cloned, the cloned requirements are not -also finalized. - -=head2 as_string_hash - -This returns a reference to a hash describing the requirements using the -strings in the L specification. - -For example after the following program: - - my $req = CPAN::Meta::Requirements->new; - - $req->add_minimum('CPAN::Meta::Requirements' => 0.102); - - $req->add_minimum('Library::Foo' => 1.208); - - $req->add_maximum('Library::Foo' => 2.602); - - $req->add_minimum('Module::Bar' => 'v1.2.3'); - - $req->add_exclusion('Module::Bar' => 'v1.2.8'); - - $req->exact_version('Xyzzy' => '6.01'); - - my $hashref = $req->as_string_hash; - -C<$hashref> would contain: - - { - 'CPAN::Meta::Requirements' => '0.102', - 'Library::Foo' => '>= 1.208, <= 2.206', - 'Module::Bar' => '>= v1.2.3, != v1.2.8', - 'Xyzzy' => '== 6.01', - } - -=head2 add_string_requirement - - $req->add_string_requirement('Library::Foo' => '>= 1.208, <= 2.206'); - $req->add_string_requirement('Library::Foo' => v1.208); - -This method parses the passed in string and adds the appropriate requirement -for the given module. A version can be a Perl "v-string". It understands -version ranges as described in the L. For -example: - -=over 4 - -=item 1.3 - -=item >= 1.3 - -=item <= 1.3 - -=item == 1.3 - -=item != 1.3 - -=item > 1.3 - -=item < 1.3 - -=item >= 1.3, != 1.5, <= 2.0 - -A version number without an operator is equivalent to specifying a minimum -(C=>). Extra whitespace is allowed. - -=back - -=head2 from_string_hash - - my $req = CPAN::Meta::Requirements->from_string_hash( \%hash ); - my $req = CPAN::Meta::Requirements->from_string_hash( \%hash, \%opts ); - -This is an alternate constructor for a CPAN::Meta::Requirements -object. It takes a hash of module names and version requirement -strings and returns a new CPAN::Meta::Requirements object. As with -add_string_requirement, a version can be a Perl "v-string". Optionally, -you can supply a hash-reference of options, exactly as with the L -method. - -=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. -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 - - git clone https://github.com/Perl-Toolchain-Gang/CPAN-Meta-Requirements.git - -=head1 AUTHORS - -=over 4 - -=item * - -David Golden - -=item * - -Ricardo Signes - -=back - -=head1 CONTRIBUTORS - -=for stopwords Ed J Karen Etheridge Leon Timmermans robario - -=over 4 - -=item * - -Ed J - -=item * - -Karen Etheridge - -=item * - -Leon Timmermans - -=item * - -robario - -=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/Spec.pm b/.checksetup_lib/lib/perl5/CPAN/Meta/Spec.pm deleted file mode 100644 index 9056940b51..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta/Spec.pm +++ /dev/null @@ -1,1235 +0,0 @@ -# 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 ', - 'Module-Build List ', # 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. 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, C, -or C. - -=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 instead of -F - -=item package - -This refers to a namespace declared with the Perl C 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 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 is used to provide a true or false value. It B be -represented as a defined value. - -=head2 String - -A I 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 is an ordered collection of zero or more data elements. -Elements of a List may be of mixed types. - -Producers B 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 consider a String as equivalent to a -List of length 1. - -=head2 Map - -A I 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 is a subtype of String with a restricted set of -values. Valid values are described in detail in the description of -the L field. - -=head2 URL - -I 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 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 section. - -=head2 Version Range - -The I 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 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 and B 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 -or I 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. 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 ' ] - -(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 - -This field provides a general contact list independent of other -structured fields provided within the L field, such as -C. 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 or F (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 in the implementors' -notes. - -This field explicitly B 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 is required. - -=over - -=item version - -This subkey gives the integer I of the CPAN Meta Spec against -which the document was generated. - -=item url - -This is a I 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 - -=item * - -C - -=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 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 field contains an underscore character, then -C B be "stable." - -The C field B 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 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 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 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 - see -L in the implementors notes for more -information. - -Valid subkeys are as follows: - -=over - -=item file - -A I of relative paths to files. Paths B specified with -unix conventions. - -=item directory - -A I of relative paths to directories. Paths B specified -with unix conventions. - -[ Note: previous editions of the spec had C instead of C ] - -=item package - -A I of package names. - -=item namespace - -A I of package namespaces, where anything below the namespace -must be ignored, but I the namespace itself. - -In the example above for C, C would -be ignored, but C 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 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> 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 include C phase prereqs. - -=back - -Consumers B 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 key using the same -semantics. See L for details on -merging prerequisites. - -I Because there is currently no way for a -distribution to specify a dependency on an optional feature of another -dependency, the use of C is discouraged. Instead, -create a separate, installable distribution that ensures the desired -feature is available. For example, if C has a C feature, -release a separate C 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, C, C -or C. Values are Maps in which the keys name the type of -prerequisite relationship such as C, C, or -C and the value provides a set of prerequisite relations. The -set of relations B be specified as a Map of package names to -version ranges. - -The full definition for this field is given in the L -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 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 or C -to claim a package for indexing without needing a C<*.pm>. - -=item version - -If it exists, this field must contains a I 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's that relate to this distribution's license. As with the -top-level C 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 is ambiguous as to -type, producers should provide a C whenever a C key is given. -The C field should be the name of the most common program used -to work with the repository, e.g. C, C, C, C, -C or C. - -=back - -=head2 DEPRECATED FIELDS - -=head3 build_requires - -I<(Deprecated in Spec 2)> [optional] {String} - -Replaced by C - -=head3 configure_requires - -I<(Deprecated in Spec 2)> [optional] {String} - -Replaced by C - -=head3 conflicts - -I<(Deprecated in Spec 2)> [optional] {String} - -Replaced by C - -=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 in C - -=head3 private - -I<(Deprecated in Spec 1.2)> [optional] {Map} - -This field has been renamed to L. - -=head3 recommends - -I<(Deprecated in Spec 2)> [optional] {String} - -Replaced by C - -=head3 requires - -I<(Deprecated in Spec 2)> [optional] {String} - -Replaced by C - -=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 be serialized as C<1.2>. Version -comparison should be delegated to the Perl L module, version -0.80 or newer. - -Unless otherwise specified, version numbers B appear in one of two -formats: - -=over - -=item Decimal versions - -Decimal versions are regular "decimal numbers", with some limitations. -They B be non-negative and B begin and end with a digit. A -single underscore B be included, but B be between two digits. -They B 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 be restricted to the -range 0 to 999. The final component B 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 version 2.4 -must be present. To indicate that B 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 use the operators E (less than), -E= (less than or equal), E (greater than), E= (greater than -or equal), == (equal), and != (not equal). For example, the -specification C 2.0> means that any version of the prerequisite -less than 2.0 is suitable. - -For more complicated situations, version specifications B be AND-ed -together using commas. The specification C= 1.2, != 1.5, E -2.0> indicates a version that must be B 1.2, B 2.0, -and B 1.5. - -=head1 PREREQUISITES - -=head2 Prereq Spec - -The C key in the top-level metadata and within -C define the relationship between a distribution and -other packages. The prereq spec structure is a hierarchical data -structure which divides prerequisites into I of activity in the -installation process and I that indicate how -prerequisites should be resolved. - -For example, to specify that C is C during the -C 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 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 -requirements must also be available during the C 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 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 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 be installed for proper completion of the -phase. - -=item recommends - -Recommended dependencies are I 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 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, 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 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 test whether prerequisites would result -in installed module files being "downgraded" to an older version and -B 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. - -In the past, the distribution metadata structure had been packed with -distributions as F, a file in the YAML Tiny format (for which, -see L). Tools that consume distribution metadata from disk -should be capable of loading F, but should prefer F -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 or L. 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 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 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 and the C 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 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, C, or C directories, or common 'mistake' directories such as -C. - -Or: If you're trying to be PAUSE-like, make sure you skip C, C and -C 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 - -=item * - -JSON, L - -=item * - -YAML, L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=item * - -L - -=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 - -=item * - -Ricardo Signes - -=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 deleted file mode 100644 index eddaa10730..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta/Validator.pm +++ /dev/null @@ -1,1210 +0,0 @@ -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 field of the structure. -#pod -#pod =cut - -#--------------------------------------------------------------------------# -# This code copied and adapted from Test::CPAN::Meta -# by Barbie, for Miss Barbell Productions, -# L -#--------------------------------------------------------------------------# - -#--------------------------------------------------------------------------# -# 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 || ""; - 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 = '' 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 = ''; - } - $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 = ''; - } - $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 = ''; - } - $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 = ''; - } - $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 = ''; - } - $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 = ''; - } - $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 = ''; - } - $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 = ''; - } - $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 = ''; - } - $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 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 - -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 - -=item * - -Ricardo Signes - -=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 deleted file mode 100644 index 746abd63bc..0000000000 --- a/.checksetup_lib/lib/perl5/CPAN/Meta/YAML.pm +++ /dev/null @@ -1,951 +0,0 @@ -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 and F. It should -not be used for any other general YAML parsing or generation task. - -NOTE: F (and F) files should be UTF-8 encoded. Users are -responsible for proper encoding and decoding. In particular, the C and -C methods do B support UTF-8 and should not be used. - -=head1 SUPPORT - -This module is currently derived from L 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 - -=head1 SEE ALSO - -L, L, L - -=head1 AUTHORS - -=over 4 - -=item * - -Adam Kennedy - -=item * - -David Golden - -=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/JSON/PP.pm b/.checksetup_lib/lib/perl5/JSON/PP.pm deleted file mode 100644 index 28ea2d757e..0000000000 --- a/.checksetup_lib/lib/perl5/JSON/PP.pm +++ /dev/null @@ -1,2797 +0,0 @@ -package JSON::PP; - -# JSON-2.0 - -use 5.005; -use strict; -use base qw(Exporter); -use overload (); - -use Carp (); -use B (); -#use Devel::Peek; - -$JSON::PP::VERSION = '2.27400'; - -@JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json); - -# instead of hash-access, i tried index-access for speed. -# but this method is not faster than what i expected. so it will be changed. - -use constant P_ASCII => 0; -use constant P_LATIN1 => 1; -use constant P_UTF8 => 2; -use constant P_INDENT => 3; -use constant P_CANONICAL => 4; -use constant P_SPACE_BEFORE => 5; -use constant P_SPACE_AFTER => 6; -use constant P_ALLOW_NONREF => 7; -use constant P_SHRINK => 8; -use constant P_ALLOW_BLESSED => 9; -use constant P_CONVERT_BLESSED => 10; -use constant P_RELAXED => 11; - -use constant P_LOOSE => 12; -use constant P_ALLOW_BIGNUM => 13; -use constant P_ALLOW_BAREKEY => 14; -use constant P_ALLOW_SINGLEQUOTE => 15; -use constant P_ESCAPE_SLASH => 16; -use constant P_AS_NONBLESSED => 17; - -use constant P_ALLOW_UNKNOWN => 18; - -use constant OLD_PERL => $] < 5.008 ? 1 : 0; - -BEGIN { - my @xs_compati_bit_properties = qw( - latin1 ascii utf8 indent canonical space_before space_after allow_nonref shrink - allow_blessed convert_blessed relaxed allow_unknown - ); - my @pp_bit_properties = qw( - allow_singlequote allow_bignum loose - allow_barekey escape_slash as_nonblessed - ); - - # Perl version check, Unicode handling is enabled? - # Helper module sets @JSON::PP::_properties. - if ($] < 5.008 ) { - my $helper = $] >= 5.006 ? 'JSON::PP::Compat5006' : 'JSON::PP::Compat5005'; - eval qq| require $helper |; - if ($@) { Carp::croak $@; } - } - - for my $name (@xs_compati_bit_properties, @pp_bit_properties) { - my $flag_name = 'P_' . uc($name); - - eval qq/ - sub $name { - my \$enable = defined \$_[1] ? \$_[1] : 1; - - if (\$enable) { - \$_[0]->{PROPS}->[$flag_name] = 1; - } - else { - \$_[0]->{PROPS}->[$flag_name] = 0; - } - - \$_[0]; - } - - sub get_$name { - \$_[0]->{PROPS}->[$flag_name] ? 1 : ''; - } - /; - } - -} - - - -# Functions - -my %encode_allow_method - = map {($_ => 1)} qw/utf8 pretty allow_nonref latin1 self_encode escape_slash - allow_blessed convert_blessed indent indent_length allow_bignum - as_nonblessed - /; -my %decode_allow_method - = map {($_ => 1)} qw/utf8 allow_nonref loose allow_singlequote allow_bignum - allow_barekey max_size relaxed/; - - -my $JSON; # cache - -sub encode_json ($) { # encode - ($JSON ||= __PACKAGE__->new->utf8)->encode(@_); -} - - -sub decode_json { # decode - ($JSON ||= __PACKAGE__->new->utf8)->decode(@_); -} - -# Obsoleted - -sub to_json($) { - Carp::croak ("JSON::PP::to_json has been renamed to encode_json."); -} - - -sub from_json($) { - Carp::croak ("JSON::PP::from_json has been renamed to decode_json."); -} - - -# Methods - -sub new { - my $class = shift; - my $self = { - max_depth => 512, - max_size => 0, - indent => 0, - FLAGS => 0, - fallback => sub { encode_error('Invalid value. JSON can only reference.') }, - indent_length => 3, - }; - - bless $self, $class; -} - - -sub encode { - return $_[0]->PP_encode_json($_[1]); -} - - -sub decode { - return $_[0]->PP_decode_json($_[1], 0x00000000); -} - - -sub decode_prefix { - return $_[0]->PP_decode_json($_[1], 0x00000001); -} - - -# accessor - - -# pretty printing - -sub pretty { - my ($self, $v) = @_; - my $enable = defined $v ? $v : 1; - - if ($enable) { # indent_length(3) for JSON::XS compatibility - $self->indent(1)->indent_length(3)->space_before(1)->space_after(1); - } - else { - $self->indent(0)->space_before(0)->space_after(0); - } - - $self; -} - -# etc - -sub max_depth { - my $max = defined $_[1] ? $_[1] : 0x80000000; - $_[0]->{max_depth} = $max; - $_[0]; -} - - -sub get_max_depth { $_[0]->{max_depth}; } - - -sub max_size { - my $max = defined $_[1] ? $_[1] : 0; - $_[0]->{max_size} = $max; - $_[0]; -} - - -sub get_max_size { $_[0]->{max_size}; } - - -sub filter_json_object { - $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0; - $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0; - $_[0]; -} - -sub filter_json_single_key_object { - if (@_ > 1) { - $_[0]->{cb_sk_object}->{$_[1]} = $_[2]; - } - $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0; - $_[0]; -} - -sub indent_length { - if (!defined $_[1] or $_[1] > 15 or $_[1] < 0) { - Carp::carp "The acceptable range of indent_length() is 0 to 15."; - } - else { - $_[0]->{indent_length} = $_[1]; - } - $_[0]; -} - -sub get_indent_length { - $_[0]->{indent_length}; -} - -sub sort_by { - $_[0]->{sort_by} = defined $_[1] ? $_[1] : 1; - $_[0]; -} - -sub allow_bigint { - Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted."); -} - -############################### - -### -### Perl => JSON -### - - -{ # Convert - - my $max_depth; - my $indent; - my $ascii; - my $latin1; - my $utf8; - my $space_before; - my $space_after; - my $canonical; - my $allow_blessed; - my $convert_blessed; - - my $indent_length; - my $escape_slash; - my $bignum; - my $as_nonblessed; - - my $depth; - my $indent_count; - my $keysort; - - - sub PP_encode_json { - my $self = shift; - my $obj = shift; - - $indent_count = 0; - $depth = 0; - - my $idx = $self->{PROPS}; - - ($ascii, $latin1, $utf8, $indent, $canonical, $space_before, $space_after, $allow_blessed, - $convert_blessed, $escape_slash, $bignum, $as_nonblessed) - = @{$idx}[P_ASCII .. P_SPACE_AFTER, P_ALLOW_BLESSED, P_CONVERT_BLESSED, - P_ESCAPE_SLASH, P_ALLOW_BIGNUM, P_AS_NONBLESSED]; - - ($max_depth, $indent_length) = @{$self}{qw/max_depth indent_length/}; - - $keysort = $canonical ? sub { $a cmp $b } : undef; - - if ($self->{sort_by}) { - $keysort = ref($self->{sort_by}) eq 'CODE' ? $self->{sort_by} - : $self->{sort_by} =~ /\D+/ ? $self->{sort_by} - : sub { $a cmp $b }; - } - - encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)") - if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]); - - my $str = $self->object_to_json($obj); - - $str .= "\n" if ( $indent ); # JSON::XS 2.26 compatible - - unless ($ascii or $latin1 or $utf8) { - utf8::upgrade($str); - } - - if ($idx->[ P_SHRINK ]) { - utf8::downgrade($str, 1); - } - - return $str; - } - - - sub object_to_json { - my ($self, $obj) = @_; - my $type = ref($obj); - - if($type eq 'HASH'){ - return $self->hash_to_json($obj); - } - elsif($type eq 'ARRAY'){ - return $self->array_to_json($obj); - } - elsif ($type) { # blessed object? - if (blessed($obj)) { - - return $self->value_to_json($obj) if ( $obj->isa('JSON::PP::Boolean') ); - - if ( $convert_blessed and $obj->can('TO_JSON') ) { - my $result = $obj->TO_JSON(); - if ( defined $result and ref( $result ) ) { - if ( refaddr( $obj ) eq refaddr( $result ) ) { - encode_error( sprintf( - "%s::TO_JSON method returned same object as was passed instead of a new one", - ref $obj - ) ); - } - } - - return $self->object_to_json( $result ); - } - - return "$obj" if ( $bignum and _is_bignum($obj) ); - return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed. - - encode_error( sprintf("encountered object '%s', but neither allow_blessed " - . "nor convert_blessed settings are enabled", $obj) - ) unless ($allow_blessed); - - return 'null'; - } - else { - return $self->value_to_json($obj); - } - } - else{ - return $self->value_to_json($obj); - } - } - - - sub hash_to_json { - my ($self, $obj) = @_; - my @res; - - encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)") - if (++$depth > $max_depth); - - my ($pre, $post) = $indent ? $self->_up_indent() : ('', ''); - my $del = ($space_before ? ' ' : '') . ':' . ($space_after ? ' ' : ''); - - for my $k ( _sort( $obj ) ) { - if ( OLD_PERL ) { utf8::decode($k) } # key for Perl 5.6 / be optimized - push @res, string_to_json( $self, $k ) - . $del - . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) ); - } - - --$depth; - $self->_down_indent() if ($indent); - - return '{' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . '}'; - } - - - sub array_to_json { - my ($self, $obj) = @_; - my @res; - - encode_error("json text or perl structure exceeds maximum nesting level (max_depth set too low?)") - if (++$depth > $max_depth); - - my ($pre, $post) = $indent ? $self->_up_indent() : ('', ''); - - for my $v (@$obj){ - push @res, $self->object_to_json($v) || $self->value_to_json($v); - } - - --$depth; - $self->_down_indent() if ($indent); - - return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']'; - } - - - sub value_to_json { - my ($self, $value) = @_; - - return 'null' if(!defined $value); - - my $b_obj = B::svref_2object(\$value); # for round trip problem - my $flags = $b_obj->FLAGS; - - return $value # as is - if $flags & ( B::SVp_IOK | B::SVp_NOK ) and !( $flags & B::SVp_POK ); # SvTYPE is IV or NV? - - my $type = ref($value); - - if(!$type){ - return string_to_json($self, $value); - } - elsif( blessed($value) and $value->isa('JSON::PP::Boolean') ){ - return $$value == 1 ? 'true' : 'false'; - } - elsif ($type) { - if ((overload::StrVal($value) =~ /=(\w+)/)[0]) { - return $self->value_to_json("$value"); - } - - if ($type eq 'SCALAR' and defined $$value) { - return $$value eq '1' ? 'true' - : $$value eq '0' ? 'false' - : $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ? 'null' - : encode_error("cannot encode reference to scalar"); - } - - if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) { - return 'null'; - } - else { - if ( $type eq 'SCALAR' or $type eq 'REF' ) { - encode_error("cannot encode reference to scalar"); - } - else { - encode_error("encountered $value, but JSON can only represent references to arrays or hashes"); - } - } - - } - else { - return $self->{fallback}->($value) - if ($self->{fallback} and ref($self->{fallback}) eq 'CODE'); - return 'null'; - } - - } - - - my %esc = ( - "\n" => '\n', - "\r" => '\r', - "\t" => '\t', - "\f" => '\f', - "\b" => '\b', - "\"" => '\"', - "\\" => '\\\\', - "\'" => '\\\'', - ); - - - sub string_to_json { - my ($self, $arg) = @_; - - $arg =~ s/([\x22\x5c\n\r\t\f\b])/$esc{$1}/g; - $arg =~ s/\//\\\//g if ($escape_slash); - $arg =~ s/([\x00-\x08\x0b\x0e-\x1f])/'\\u00' . unpack('H2', $1)/eg; - - if ($ascii) { - $arg = JSON_PP_encode_ascii($arg); - } - - if ($latin1) { - $arg = JSON_PP_encode_latin1($arg); - } - - if ($utf8) { - utf8::encode($arg); - } - - return '"' . $arg . '"'; - } - - - sub blessed_to_json { - my $reftype = reftype($_[1]) || ''; - if ($reftype eq 'HASH') { - return $_[0]->hash_to_json($_[1]); - } - elsif ($reftype eq 'ARRAY') { - return $_[0]->array_to_json($_[1]); - } - else { - return 'null'; - } - } - - - sub encode_error { - my $error = shift; - Carp::croak "$error"; - } - - - sub _sort { - defined $keysort ? (sort $keysort (keys %{$_[0]})) : keys %{$_[0]}; - } - - - sub _up_indent { - my $self = shift; - my $space = ' ' x $indent_length; - - my ($pre,$post) = ('',''); - - $post = "\n" . $space x $indent_count; - - $indent_count++; - - $pre = "\n" . $space x $indent_count; - - return ($pre,$post); - } - - - sub _down_indent { $indent_count--; } - - - sub PP_encode_box { - { - depth => $depth, - indent_count => $indent_count, - }; - } - -} # Convert - - -sub _encode_ascii { - join('', - map { - $_ <= 127 ? - chr($_) : - $_ <= 65535 ? - sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_)); - } unpack('U*', $_[0]) - ); -} - - -sub _encode_latin1 { - join('', - map { - $_ <= 255 ? - chr($_) : - $_ <= 65535 ? - sprintf('\u%04x', $_) : sprintf('\u%x\u%x', _encode_surrogates($_)); - } unpack('U*', $_[0]) - ); -} - - -sub _encode_surrogates { # from perlunicode - my $uni = $_[0] - 0x10000; - return ($uni / 0x400 + 0xD800, $uni % 0x400 + 0xDC00); -} - - -sub _is_bignum { - $_[0]->isa('Math::BigInt') or $_[0]->isa('Math::BigFloat'); -} - - - -# -# JSON => Perl -# - -my $max_intsize; - -BEGIN { - my $checkint = 1111; - for my $d (5..64) { - $checkint .= 1; - my $int = eval qq| $checkint |; - if ($int =~ /[eE]/) { - $max_intsize = $d - 1; - last; - } - } -} - -{ # PARSE - - my %escapes = ( # by Jeremy Muhlich - b => "\x8", - t => "\x9", - n => "\xA", - f => "\xC", - r => "\xD", - '\\' => '\\', - '"' => '"', - '/' => '/', - ); - - my $text; # json data - my $at; # offset - my $ch; # first character - my $len; # text length (changed according to UTF8 or NON UTF8) - # INTERNAL - my $depth; # nest counter - my $encoding; # json text encoding - my $is_valid_utf8; # temp variable - my $utf8_len; # utf8 byte length - # FLAGS - my $utf8; # must be utf8 - my $max_depth; # max nest number of objects and arrays - my $max_size; - my $relaxed; - my $cb_object; - my $cb_sk_object; - - my $F_HOOK; - - my $allow_bigint; # using Math::BigInt - my $singlequote; # loosely quoting - my $loose; # - my $allow_barekey; # bareKey - - # $opt flag - # 0x00000001 .... decode_prefix - # 0x10000000 .... incr_parse - - sub PP_decode_json { - my ($self, $opt); # $opt is an effective flag during this decode_json. - - ($self, $text, $opt) = @_; - - ($at, $ch, $depth) = (0, '', 0); - - if ( !defined $text or ref $text ) { - decode_error("malformed JSON string, neither array, object, number, string or atom"); - } - - my $idx = $self->{PROPS}; - - ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote) - = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE]; - - if ( $utf8 ) { - utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry"); - } - else { - utf8::upgrade( $text ); - utf8::encode( $text ); - } - - $len = length $text; - - ($max_depth, $max_size, $cb_object, $cb_sk_object, $F_HOOK) - = @{$self}{qw/max_depth max_size cb_object cb_sk_object F_HOOK/}; - - if ($max_size > 1) { - use bytes; - my $bytes = length $text; - decode_error( - sprintf("attempted decode of JSON text of %s bytes size, but max_size is set to %s" - , $bytes, $max_size), 1 - ) if ($bytes > $max_size); - } - - # Currently no effect - # should use regexp - my @octets = unpack('C4', $text); - $encoding = ( $octets[0] and $octets[1]) ? 'UTF-8' - : (!$octets[0] and $octets[1]) ? 'UTF-16BE' - : (!$octets[0] and !$octets[1]) ? 'UTF-32BE' - : ( $octets[2] ) ? 'UTF-16LE' - : (!$octets[2] ) ? 'UTF-32LE' - : 'unknown'; - - white(); # remove head white space - - my $valid_start = defined $ch; # Is there a first character for JSON structure? - - my $result = value(); - - return undef if ( !$result && ( $opt & 0x10000000 ) ); # for incr_parse - - decode_error("malformed JSON string, neither array, object, number, string or atom") unless $valid_start; - - if ( !$idx->[ P_ALLOW_NONREF ] and !ref $result ) { - decode_error( - 'JSON text must be an object or array (but found number, string, true, false or null,' - . ' use allow_nonref to allow this)', 1); - } - - Carp::croak('something wrong.') if $len < $at; # we won't arrive here. - - my $consumed = defined $ch ? $at - 1 : $at; # consumed JSON text length - - white(); # remove tail white space - - if ( $ch ) { - return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix - decode_error("garbage after JSON object"); - } - - ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result; - } - - - sub next_chr { - return $ch = undef if($at >= $len); - $ch = substr($text, $at++, 1); - } - - - sub value { - white(); - return if(!defined $ch); - return object() if($ch eq '{'); - return array() if($ch eq '['); - return string() if($ch eq '"' or ($singlequote and $ch eq "'")); - return number() if($ch =~ /[0-9]/ or $ch eq '-'); - return word(); - } - - sub string { - my ($i, $s, $t, $u); - my $utf16; - my $is_utf8; - - ($is_valid_utf8, $utf8_len) = ('', 0); - - $s = ''; # basically UTF8 flag on - - if($ch eq '"' or ($singlequote and $ch eq "'")){ - my $boundChar = $ch; - - OUTER: while( defined(next_chr()) ){ - - if($ch eq $boundChar){ - next_chr(); - - if ($utf16) { - decode_error("missing low surrogate character in surrogate pair"); - } - - utf8::decode($s) if($is_utf8); - - return $s; - } - elsif($ch eq '\\'){ - next_chr(); - if(exists $escapes{$ch}){ - $s .= $escapes{$ch}; - } - elsif($ch eq 'u'){ # UNICODE handling - my $u = ''; - - for(1..4){ - $ch = next_chr(); - last OUTER if($ch !~ /[0-9a-fA-F]/); - $u .= $ch; - } - - # U+D800 - U+DBFF - if ($u =~ /^[dD][89abAB][0-9a-fA-F]{2}/) { # UTF-16 high surrogate? - $utf16 = $u; - } - # U+DC00 - U+DFFF - elsif ($u =~ /^[dD][c-fC-F][0-9a-fA-F]{2}/) { # UTF-16 low surrogate? - unless (defined $utf16) { - decode_error("missing high surrogate character in surrogate pair"); - } - $is_utf8 = 1; - $s .= JSON_PP_decode_surrogates($utf16, $u) || next; - $utf16 = undef; - } - else { - if (defined $utf16) { - decode_error("surrogate pair expected"); - } - - if ( ( my $hex = hex( $u ) ) > 127 ) { - $is_utf8 = 1; - $s .= JSON_PP_decode_unicode($u) || next; - } - else { - $s .= chr $hex; - } - } - - } - else{ - unless ($loose) { - $at -= 2; - decode_error('illegal backslash escape sequence in string'); - } - $s .= $ch; - } - } - else{ - - if ( ord $ch > 127 ) { - unless( $ch = is_valid_utf8($ch) ) { - $at -= 1; - decode_error("malformed UTF-8 character in JSON string"); - } - else { - $at += $utf8_len - 1; - } - - $is_utf8 = 1; - } - - if (!$loose) { - if ($ch =~ /[\x00-\x1f\x22\x5c]/) { # '/' ok - $at--; - decode_error('invalid character encountered while parsing JSON string'); - } - } - - $s .= $ch; - } - } - } - - decode_error("unexpected end of string while parsing JSON string"); - } - - - sub white { - while( defined $ch ){ - if($ch le ' '){ - next_chr(); - } - elsif($ch eq '/'){ - next_chr(); - if(defined $ch and $ch eq '/'){ - 1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r"); - } - elsif(defined $ch and $ch eq '*'){ - next_chr(); - while(1){ - if(defined $ch){ - if($ch eq '*'){ - if(defined(next_chr()) and $ch eq '/'){ - next_chr(); - last; - } - } - else{ - next_chr(); - } - } - else{ - decode_error("Unterminated comment"); - } - } - next; - } - else{ - $at--; - decode_error("malformed JSON string, neither array, object, number, string or atom"); - } - } - else{ - if ($relaxed and $ch eq '#') { # correctly? - pos($text) = $at; - $text =~ /\G([^\n]*(?:\r\n|\r|\n|$))/g; - $at = pos($text); - next_chr; - next; - } - - last; - } - } - } - - - sub array { - my $a = $_[0] || []; # you can use this code to use another array ref object. - - decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)') - if (++$depth > $max_depth); - - next_chr(); - white(); - - if(defined $ch and $ch eq ']'){ - --$depth; - next_chr(); - return $a; - } - else { - while(defined($ch)){ - push @$a, value(); - - white(); - - if (!defined $ch) { - last; - } - - if($ch eq ']'){ - --$depth; - next_chr(); - return $a; - } - - if($ch ne ','){ - last; - } - - next_chr(); - white(); - - if ($relaxed and $ch eq ']') { - --$depth; - next_chr(); - return $a; - } - - } - } - - decode_error(", or ] expected while parsing array"); - } - - - sub object { - my $o = $_[0] || {}; # you can use this code to use another hash ref object. - my $k; - - decode_error('json text or perl structure exceeds maximum nesting level (max_depth set too low?)') - if (++$depth > $max_depth); - next_chr(); - white(); - - if(defined $ch and $ch eq '}'){ - --$depth; - next_chr(); - if ($F_HOOK) { - return _json_object_hook($o); - } - return $o; - } - else { - while (defined $ch) { - $k = ($allow_barekey and $ch ne '"' and $ch ne "'") ? bareKey() : string(); - white(); - - if(!defined $ch or $ch ne ':'){ - $at--; - decode_error("':' expected"); - } - - next_chr(); - $o->{$k} = value(); - white(); - - last if (!defined $ch); - - if($ch eq '}'){ - --$depth; - next_chr(); - if ($F_HOOK) { - return _json_object_hook($o); - } - return $o; - } - - if($ch ne ','){ - last; - } - - next_chr(); - white(); - - if ($relaxed and $ch eq '}') { - --$depth; - next_chr(); - if ($F_HOOK) { - return _json_object_hook($o); - } - return $o; - } - - } - - } - - $at--; - decode_error(", or } expected while parsing object/hash"); - } - - - sub bareKey { # doesn't strictly follow Standard ECMA-262 3rd Edition - my $key; - while($ch =~ /[^\x00-\x23\x25-\x2F\x3A-\x40\x5B-\x5E\x60\x7B-\x7F]/){ - $key .= $ch; - next_chr(); - } - return $key; - } - - - sub word { - my $word = substr($text,$at-1,4); - - if($word eq 'true'){ - $at += 3; - next_chr; - return $JSON::PP::true; - } - elsif($word eq 'null'){ - $at += 3; - next_chr; - return undef; - } - elsif($word eq 'fals'){ - $at += 3; - if(substr($text,$at,1) eq 'e'){ - $at++; - next_chr; - return $JSON::PP::false; - } - } - - $at--; # for decode_error report - - decode_error("'null' expected") if ($word =~ /^n/); - decode_error("'true' expected") if ($word =~ /^t/); - decode_error("'false' expected") if ($word =~ /^f/); - decode_error("malformed JSON string, neither array, object, number, string or atom"); - } - - - sub number { - my $n = ''; - my $v; - my $is_dec; - - # According to RFC4627, hex or oct digits are invalid. - if($ch eq '0'){ - my $peek = substr($text,$at,1); - my $hex = $peek =~ /[xX]/; # 0 or 1 - - if($hex){ - decode_error("malformed number (leading zero must not be followed by another digit)"); - ($n) = ( substr($text, $at+1) =~ /^([0-9a-fA-F]+)/); - } - else{ # oct - ($n) = ( substr($text, $at) =~ /^([0-7]+)/); - if (defined $n and length $n > 1) { - decode_error("malformed number (leading zero must not be followed by another digit)"); - } - } - - if(defined $n and length($n)){ - if (!$hex and length($n) == 1) { - decode_error("malformed number (leading zero must not be followed by another digit)"); - } - $at += length($n) + $hex; - next_chr; - return $hex ? hex($n) : oct($n); - } - } - - if($ch eq '-'){ - $n = '-'; - next_chr; - if (!defined $ch or $ch !~ /\d/) { - decode_error("malformed number (no digits after initial minus)"); - } - } - - while(defined $ch and $ch =~ /\d/){ - $n .= $ch; - next_chr; - } - - if(defined $ch and $ch eq '.'){ - $n .= '.'; - $is_dec = 1; - - next_chr; - if (!defined $ch or $ch !~ /\d/) { - decode_error("malformed number (no digits after decimal point)"); - } - else { - $n .= $ch; - } - - while(defined(next_chr) and $ch =~ /\d/){ - $n .= $ch; - } - } - - if(defined $ch and ($ch eq 'e' or $ch eq 'E')){ - $n .= $ch; - next_chr; - - if(defined($ch) and ($ch eq '+' or $ch eq '-')){ - $n .= $ch; - next_chr; - if (!defined $ch or $ch =~ /\D/) { - decode_error("malformed number (no digits after exp sign)"); - } - $n .= $ch; - } - elsif(defined($ch) and $ch =~ /\d/){ - $n .= $ch; - } - else { - decode_error("malformed number (no digits after exp sign)"); - } - - while(defined(next_chr) and $ch =~ /\d/){ - $n .= $ch; - } - - } - - $v .= $n; - - if ($v !~ /[.eE]/ and length $v > $max_intsize) { - if ($allow_bigint) { # from Adam Sussman - require Math::BigInt; - return Math::BigInt->new($v); - } - else { - return "$v"; - } - } - elsif ($allow_bigint) { - require Math::BigFloat; - return Math::BigFloat->new($v); - } - - return $is_dec ? $v/1.0 : 0+$v; - } - - - sub is_valid_utf8 { - - $utf8_len = $_[0] =~ /[\x00-\x7F]/ ? 1 - : $_[0] =~ /[\xC2-\xDF]/ ? 2 - : $_[0] =~ /[\xE0-\xEF]/ ? 3 - : $_[0] =~ /[\xF0-\xF4]/ ? 4 - : 0 - ; - - return unless $utf8_len; - - my $is_valid_utf8 = substr($text, $at - 1, $utf8_len); - - return ( $is_valid_utf8 =~ /^(?: - [\x00-\x7F] - |[\xC2-\xDF][\x80-\xBF] - |[\xE0][\xA0-\xBF][\x80-\xBF] - |[\xE1-\xEC][\x80-\xBF][\x80-\xBF] - |[\xED][\x80-\x9F][\x80-\xBF] - |[\xEE-\xEF][\x80-\xBF][\x80-\xBF] - |[\xF0][\x90-\xBF][\x80-\xBF][\x80-\xBF] - |[\xF1-\xF3][\x80-\xBF][\x80-\xBF][\x80-\xBF] - |[\xF4][\x80-\x8F][\x80-\xBF][\x80-\xBF] - )$/x ) ? $is_valid_utf8 : ''; - } - - - sub decode_error { - my $error = shift; - my $no_rep = shift; - my $str = defined $text ? substr($text, $at) : ''; - my $mess = ''; - my $type = $] >= 5.008 ? 'U*' - : $] < 5.006 ? 'C*' - : utf8::is_utf8( $str ) ? 'U*' # 5.6 - : 'C*' - ; - - for my $c ( unpack( $type, $str ) ) { # emulate pv_uni_display() ? - $mess .= $c == 0x07 ? '\a' - : $c == 0x09 ? '\t' - : $c == 0x0a ? '\n' - : $c == 0x0d ? '\r' - : $c == 0x0c ? '\f' - : $c < 0x20 ? sprintf('\x{%x}', $c) - : $c == 0x5c ? '\\\\' - : $c < 0x80 ? chr($c) - : sprintf('\x{%x}', $c) - ; - if ( length $mess >= 20 ) { - $mess .= '...'; - last; - } - } - - unless ( length $mess ) { - $mess = '(end of string)'; - } - - Carp::croak ( - $no_rep ? "$error" : "$error, at character offset $at (before \"$mess\")" - ); - - } - - - sub _json_object_hook { - my $o = $_[0]; - my @ks = keys %{$o}; - - if ( $cb_sk_object and @ks == 1 and exists $cb_sk_object->{ $ks[0] } and ref $cb_sk_object->{ $ks[0] } ) { - my @val = $cb_sk_object->{ $ks[0] }->( $o->{$ks[0]} ); - if (@val == 1) { - return $val[0]; - } - } - - my @val = $cb_object->($o) if ($cb_object); - if (@val == 0 or @val > 1) { - return $o; - } - else { - return $val[0]; - } - } - - - sub PP_decode_box { - { - text => $text, - at => $at, - ch => $ch, - len => $len, - depth => $depth, - encoding => $encoding, - is_valid_utf8 => $is_valid_utf8, - }; - } - -} # PARSE - - -sub _decode_surrogates { # from perlunicode - my $uni = 0x10000 + (hex($_[0]) - 0xD800) * 0x400 + (hex($_[1]) - 0xDC00); - my $un = pack('U*', $uni); - utf8::encode( $un ); - return $un; -} - - -sub _decode_unicode { - my $un = pack('U', hex shift); - utf8::encode( $un ); - return $un; -} - -# -# Setup for various Perl versions (the code from JSON::PP58) -# - -BEGIN { - - unless ( defined &utf8::is_utf8 ) { - require Encode; - *utf8::is_utf8 = *Encode::is_utf8; - } - - if ( $] >= 5.008 ) { - *JSON::PP::JSON_PP_encode_ascii = \&_encode_ascii; - *JSON::PP::JSON_PP_encode_latin1 = \&_encode_latin1; - *JSON::PP::JSON_PP_decode_surrogates = \&_decode_surrogates; - *JSON::PP::JSON_PP_decode_unicode = \&_decode_unicode; - } - - if ($] >= 5.008 and $] < 5.008003) { # join() in 5.8.0 - 5.8.2 is broken. - package JSON::PP; - require subs; - subs->import('join'); - eval q| - sub join { - return '' if (@_ < 2); - my $j = shift; - my $str = shift; - for (@_) { $str .= $j . $_; } - return $str; - } - |; - } - - - sub JSON::PP::incr_parse { - local $Carp::CarpLevel = 1; - ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_parse( @_ ); - } - - - sub JSON::PP::incr_skip { - ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_skip; - } - - - sub JSON::PP::incr_reset { - ( $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new )->incr_reset; - } - - eval q{ - sub JSON::PP::incr_text : lvalue { - $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new; - - if ( $_[0]->{_incr_parser}->{incr_parsing} ) { - Carp::croak("incr_text cannot be called when the incremental parser already started parsing"); - } - $_[0]->{_incr_parser}->{incr_text}; - } - } if ( $] >= 5.006 ); - -} # Setup for various Perl versions (the code from JSON::PP58) - - -############################### -# Utilities -# - -BEGIN { - eval 'require Scalar::Util'; - unless($@){ - *JSON::PP::blessed = \&Scalar::Util::blessed; - *JSON::PP::reftype = \&Scalar::Util::reftype; - *JSON::PP::refaddr = \&Scalar::Util::refaddr; - } - else{ # This code is from Sclar::Util. - # warn $@; - eval 'sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }'; - *JSON::PP::blessed = sub { - local($@, $SIG{__DIE__}, $SIG{__WARN__}); - ref($_[0]) ? eval { $_[0]->a_sub_not_likely_to_be_here } : undef; - }; - my %tmap = qw( - B::NULL SCALAR - B::HV HASH - B::AV ARRAY - B::CV CODE - B::IO IO - B::GV GLOB - B::REGEXP REGEXP - ); - *JSON::PP::reftype = sub { - my $r = shift; - - return undef unless length(ref($r)); - - my $t = ref(B::svref_2object($r)); - - return - exists $tmap{$t} ? $tmap{$t} - : length(ref($$r)) ? 'REF' - : 'SCALAR'; - }; - *JSON::PP::refaddr = sub { - return undef unless length(ref($_[0])); - - my $addr; - if(defined(my $pkg = blessed($_[0]))) { - $addr .= bless $_[0], 'Scalar::Util::Fake'; - bless $_[0], $pkg; - } - else { - $addr .= $_[0] - } - - $addr =~ /0x(\w+)/; - local $^W; - #no warnings 'portable'; - hex($1); - } - } -} - - -# shamelessly copied and modified from JSON::XS code. - -$JSON::PP::true = do { bless \(my $dummy = 1), "JSON::PP::Boolean" }; -$JSON::PP::false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" }; - -sub is_bool { defined $_[0] and UNIVERSAL::isa($_[0], "JSON::PP::Boolean"); } - -sub true { $JSON::PP::true } -sub false { $JSON::PP::false } -sub null { undef; } - -############################### - -package JSON::PP::Boolean; - -use overload ( - "0+" => sub { ${$_[0]} }, - "++" => sub { $_[0] = ${$_[0]} + 1 }, - "--" => sub { $_[0] = ${$_[0]} - 1 }, - fallback => 1, -); - - -############################### - -package JSON::PP::IncrParser; - -use strict; - -use constant INCR_M_WS => 0; # initial whitespace skipping -use constant INCR_M_STR => 1; # inside string -use constant INCR_M_BS => 2; # inside backslash -use constant INCR_M_JSON => 3; # outside anything, count nesting -use constant INCR_M_C0 => 4; -use constant INCR_M_C1 => 5; - -$JSON::PP::IncrParser::VERSION = '1.01'; - -my $unpack_format = $] < 5.006 ? 'C*' : 'U*'; - -sub new { - my ( $class ) = @_; - - bless { - incr_nest => 0, - incr_text => undef, - incr_parsing => 0, - incr_p => 0, - }, $class; -} - - -sub incr_parse { - my ( $self, $coder, $text ) = @_; - - $self->{incr_text} = '' unless ( defined $self->{incr_text} ); - - if ( defined $text ) { - if ( utf8::is_utf8( $text ) and !utf8::is_utf8( $self->{incr_text} ) ) { - utf8::upgrade( $self->{incr_text} ) ; - utf8::decode( $self->{incr_text} ) ; - } - $self->{incr_text} .= $text; - } - - - my $max_size = $coder->get_max_size; - - if ( defined wantarray ) { - - $self->{incr_mode} = INCR_M_WS unless defined $self->{incr_mode}; - - if ( wantarray ) { - my @ret; - - $self->{incr_parsing} = 1; - - do { - push @ret, $self->_incr_parse( $coder, $self->{incr_text} ); - - unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) { - $self->{incr_mode} = INCR_M_WS if $self->{incr_mode} != INCR_M_STR; - } - - } until ( length $self->{incr_text} >= $self->{incr_p} ); - - $self->{incr_parsing} = 0; - - return @ret; - } - else { # in scalar context - $self->{incr_parsing} = 1; - my $obj = $self->_incr_parse( $coder, $self->{incr_text} ); - $self->{incr_parsing} = 0 if defined $obj; # pointed by Martin J. Evans - return $obj ? $obj : undef; # $obj is an empty string, parsing was completed. - } - - } - -} - - -sub _incr_parse { - my ( $self, $coder, $text, $skip ) = @_; - my $p = $self->{incr_p}; - my $restore = $p; - - my @obj; - my $len = length $text; - - if ( $self->{incr_mode} == INCR_M_WS ) { - while ( $len > $p ) { - my $s = substr( $text, $p, 1 ); - $p++ and next if ( 0x20 >= unpack($unpack_format, $s) ); - $self->{incr_mode} = INCR_M_JSON; - last; - } - } - - while ( $len > $p ) { - my $s = substr( $text, $p++, 1 ); - - if ( $s eq '"' ) { - if (substr( $text, $p - 2, 1 ) eq '\\' ) { - next; - } - - if ( $self->{incr_mode} != INCR_M_STR ) { - $self->{incr_mode} = INCR_M_STR; - } - else { - $self->{incr_mode} = INCR_M_JSON; - unless ( $self->{incr_nest} ) { - last; - } - } - } - - if ( $self->{incr_mode} == INCR_M_JSON ) { - - if ( $s eq '[' or $s eq '{' ) { - if ( ++$self->{incr_nest} > $coder->get_max_depth ) { - Carp::croak('json text or perl structure exceeds maximum nesting level (max_depth set too low?)'); - } - } - elsif ( $s eq ']' or $s eq '}' ) { - last if ( --$self->{incr_nest} <= 0 ); - } - elsif ( $s eq '#' ) { - while ( $len > $p ) { - last if substr( $text, $p++, 1 ) eq "\n"; - } - } - - } - - } - - $self->{incr_p} = $p; - - return if ( $self->{incr_mode} == INCR_M_STR and not $self->{incr_nest} ); - return if ( $self->{incr_mode} == INCR_M_JSON and $self->{incr_nest} > 0 ); - - return '' unless ( length substr( $self->{incr_text}, 0, $p ) ); - - local $Carp::CarpLevel = 2; - - $self->{incr_p} = $restore; - $self->{incr_c} = $p; - - my ( $obj, $tail ) = $coder->PP_decode_json( substr( $self->{incr_text}, 0, $p ), 0x10000001 ); - - $self->{incr_text} = substr( $self->{incr_text}, $p ); - $self->{incr_p} = 0; - - return $obj || ''; -} - - -sub incr_text { - if ( $_[0]->{incr_parsing} ) { - Carp::croak("incr_text cannot be called when the incremental parser already started parsing"); - } - $_[0]->{incr_text}; -} - - -sub incr_skip { - my $self = shift; - $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} ); - $self->{incr_p} = 0; -} - - -sub incr_reset { - my $self = shift; - $self->{incr_text} = undef; - $self->{incr_p} = 0; - $self->{incr_mode} = 0; - $self->{incr_nest} = 0; - $self->{incr_parsing} = 0; -} - -############################### - - -1; -__END__ -=pod - -=head1 NAME - -JSON::PP - JSON::XS compatible pure-Perl module. - -=head1 SYNOPSIS - - use JSON::PP; - - # exported functions, they croak on error - # and expect/generate UTF-8 - - $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref; - $perl_hash_or_arrayref = decode_json $utf8_encoded_json_text; - - # OO-interface - - $coder = JSON::PP->new->ascii->pretty->allow_nonref; - - $json_text = $json->encode( $perl_scalar ); - $perl_scalar = $json->decode( $json_text ); - - $pretty_printed = $json->pretty->encode( $perl_scalar ); # pretty-printing - - # Note that JSON version 2.0 and above will automatically use - # JSON::XS or JSON::PP, so you should be able to just: - - use JSON; - - -=head1 VERSION - - 2.27400 - -L 2.27 (~2.30) compatible. - -=head1 NOTE - -JSON::PP had been included in JSON distribution (CPAN module). -It was a perl core module in Perl 5.14. - -=head1 DESCRIPTION - -This module is L compatible pure Perl module. -(Perl 5.8 or later is recommended) - -JSON::XS is the fastest and most proper JSON module on CPAN. -It is written by Marc Lehmann in C, so must be compiled and -installed in the used environment. - -JSON::PP is a pure-Perl module and has compatibility to JSON::XS. - - -=head2 FEATURES - -=over - -=item * correct unicode handling - -This module knows how to handle Unicode (depending on Perl version). - -See to L and L. - - -=item * round-trip integrity - -When you serialise a perl data structure using only data types supported -by JSON and Perl, the deserialised data structure is identical on the Perl -level. (e.g. the string "2.0" doesn't suddenly become "2" just because -it looks like a number). There I minor exceptions to this, read the -MAPPING section below to learn about those. - - -=item * strict checking of JSON correctness - -There is no guessing, no generating of illegal JSON texts by default, -and only JSON is accepted as input by default (the latter is a security feature). -But when some options are set, loose checking features are available. - -=back - -=head1 FUNCTIONAL INTERFACE - -Some documents are copied and modified from L. - -=head2 encode_json - - $json_text = encode_json $perl_scalar - -Converts the given Perl data structure to a UTF-8 encoded, binary string. - -This function call is functionally identical to: - - $json_text = JSON::PP->new->utf8->encode($perl_scalar) - -=head2 decode_json - - $perl_scalar = decode_json $json_text - -The opposite of C: expects an UTF-8 (binary) string and tries -to parse that as an UTF-8 encoded JSON text, returning the resulting -reference. - -This function call is functionally identical to: - - $perl_scalar = JSON::PP->new->utf8->decode($json_text) - -=head2 JSON::PP::is_bool - - $is_boolean = JSON::PP::is_bool($scalar) - -Returns true if the passed scalar represents either JSON::PP::true or -JSON::PP::false, two constants that act like C<1> and C<0> respectively -and are also used to represent JSON C and C in Perl strings. - -=head2 JSON::PP::true - -Returns JSON true value which is blessed object. -It C JSON::PP::Boolean object. - -=head2 JSON::PP::false - -Returns JSON false value which is blessed object. -It C JSON::PP::Boolean object. - -=head2 JSON::PP::null - -Returns C. - -See L, below, for more information on how JSON values are mapped to -Perl. - - -=head1 HOW DO I DECODE A DATA FROM OUTER AND ENCODE TO OUTER - -This section supposes that your perl version is 5.8 or later. - -If you know a JSON text from an outer world - a network, a file content, and so on, -is encoded in UTF-8, you should use C or C module object -with C enabled. And the decoded result will contain UNICODE characters. - - # from network - my $json = JSON::PP->new->utf8; - my $json_text = CGI->new->param( 'json_data' ); - my $perl_scalar = $json->decode( $json_text ); - - # from file content - local $/; - open( my $fh, '<', 'json.data' ); - $json_text = <$fh>; - $perl_scalar = decode_json( $json_text ); - -If an outer data is not encoded in UTF-8, firstly you should C it. - - use Encode; - local $/; - open( my $fh, '<', 'json.data' ); - my $encoding = 'cp932'; - my $unicode_json_text = decode( $encoding, <$fh> ); # UNICODE - - # or you can write the below code. - # - # open( my $fh, "<:encoding($encoding)", 'json.data' ); - # $unicode_json_text = <$fh>; - -In this case, C<$unicode_json_text> is of course UNICODE string. -So you B use C nor C module object with C enabled. -Instead of them, you use C module object with C disable. - - $perl_scalar = $json->utf8(0)->decode( $unicode_json_text ); - -Or C and C: - - $perl_scalar = decode_json( encode( 'utf8', $unicode_json_text ) ); - # this way is not efficient. - -And now, you want to convert your C<$perl_scalar> into JSON data and -send it to an outer world - a network or a file content, and so on. - -Your data usually contains UNICODE strings and you want the converted data to be encoded -in UTF-8, you should use C or C module object with C enabled. - - print encode_json( $perl_scalar ); # to a network? file? or display? - # or - print $json->utf8->encode( $perl_scalar ); - -If C<$perl_scalar> does not contain UNICODE but C<$encoding>-encoded strings -for some reason, then its characters are regarded as B for perl -(because it does not concern with your $encoding). -You B use C nor C module object with C enabled. -Instead of them, you use C module object with C disable. -Note that the resulted text is a UNICODE string but no problem to print it. - - # $perl_scalar contains $encoding encoded string values - $unicode_json_text = $json->utf8(0)->encode( $perl_scalar ); - # $unicode_json_text consists of characters less than 0x100 - print $unicode_json_text; - -Or C all string values and C: - - $perl_scalar->{ foo } = decode( $encoding, $perl_scalar->{ foo } ); - # ... do it to each string values, then encode_json - $json_text = encode_json( $perl_scalar ); - -This method is a proper way but probably not efficient. - -See to L, L. - - -=head1 METHODS - -Basically, check to L or L. - -=head2 new - - $json = JSON::PP->new - -Returns a new JSON::PP object that can be used to de/encode JSON -strings. - -All boolean flags described below are by default I. - -The mutators for flags all return the JSON object again and thus calls can -be chained: - - my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]}) - => {"a": [1, 2]} - -=head2 ascii - - $json = $json->ascii([$enable]) - - $enabled = $json->get_ascii - -If $enable is true (or missing), then the encode method will not generate characters outside -the code range 0..127. Any Unicode characters outside that range will be escaped using either -a single \uXXXX or a double \uHHHH\uLLLLL escape sequence, as per RFC4627. -(See to L). - -In Perl 5.005, there is no character having high value (more than 255). -See to L. - -If $enable is false, then the encode method will not escape Unicode characters unless -required by the JSON syntax or other flags. This results in a faster and more compact format. - - JSON::PP->new->ascii(1)->encode([chr 0x10401]) - => ["\ud801\udc01"] - -=head2 latin1 - - $json = $json->latin1([$enable]) - - $enabled = $json->get_latin1 - -If $enable is true (or missing), then the encode method will encode the resulting JSON -text as latin1 (or iso-8859-1), escaping any characters outside the code range 0..255. - -If $enable is false, then the encode method will not escape Unicode characters -unless required by the JSON syntax or other flags. - - JSON::XS->new->latin1->encode (["\x{89}\x{abc}"] - => ["\x{89}\\u0abc"] # (perl syntax, U+abc escaped, U+89 not) - -See to L. - -=head2 utf8 - - $json = $json->utf8([$enable]) - - $enabled = $json->get_utf8 - -If $enable is true (or missing), then the encode method will encode the JSON result -into UTF-8, as required by many protocols, while the decode method expects to be handled -an UTF-8-encoded string. Please note that UTF-8-encoded strings do not contain any -characters outside the range 0..255, they are thus useful for bytewise/binary I/O. - -(In Perl 5.005, any character outside the range 0..255 does not exist. -See to L.) - -In future versions, enabling this option might enable autodetection of the UTF-16 and UTF-32 -encoding families, as described in RFC4627. - -If $enable is false, then the encode method will return the JSON string as a (non-encoded) -Unicode string, while decode expects thus a Unicode string. Any decoding or encoding -(e.g. to UTF-8 or UTF-16) needs to be done yourself, e.g. using the Encode module. - -Example, output UTF-16BE-encoded JSON: - - use Encode; - $jsontext = encode "UTF-16BE", JSON::PP->new->encode ($object); - -Example, decode UTF-32LE-encoded JSON: - - use Encode; - $object = JSON::PP->new->decode (decode "UTF-32LE", $jsontext); - - -=head2 pretty - - $json = $json->pretty([$enable]) - -This enables (or disables) all of the C, C and -C flags in one call to generate the most readable -(or most compact) form possible. - -Equivalent to: - - $json->indent->space_before->space_after - -=head2 indent - - $json = $json->indent([$enable]) - - $enabled = $json->get_indent - -The default indent space length is three. -You can use C to change the length. - -=head2 space_before - - $json = $json->space_before([$enable]) - - $enabled = $json->get_space_before - -If C<$enable> is true (or missing), then the C method will add an extra -optional space before the C<:> separating keys from values in JSON objects. - -If C<$enable> is false, then the C method will not add any extra -space at those places. - -This setting has no effect when decoding JSON texts. - -Example, space_before enabled, space_after and indent disabled: - - {"key" :"value"} - -=head2 space_after - - $json = $json->space_after([$enable]) - - $enabled = $json->get_space_after - -If C<$enable> is true (or missing), then the C method will add an extra -optional space after the C<:> separating keys from values in JSON objects -and extra whitespace after the C<,> separating key-value pairs and array -members. - -If C<$enable> is false, then the C method will not add any extra -space at those places. - -This setting has no effect when decoding JSON texts. - -Example, space_before and indent disabled, space_after enabled: - - {"key": "value"} - -=head2 relaxed - - $json = $json->relaxed([$enable]) - - $enabled = $json->get_relaxed - -If C<$enable> is true (or missing), then C will accept some -extensions to normal JSON syntax (see below). C will not be -affected in anyway. I. I suggest only to use this option to -parse application-specific files written by humans (configuration files, -resource files etc.) - -If C<$enable> is false (the default), then C will only accept -valid JSON texts. - -Currently accepted extensions are: - -=over 4 - -=item * list items can have an end-comma - -JSON I array elements and key-value pairs with commas. This -can be annoying if you write JSON texts manually and want to be able to -quickly append elements, so this extension accepts comma at the end of -such items not just between them: - - [ - 1, - 2, <- this comma not normally allowed - ] - { - "k1": "v1", - "k2": "v2", <- this comma not normally allowed - } - -=item * shell-style '#'-comments - -Whenever JSON allows whitespace, shell-style comments are additionally -allowed. They are terminated by the first carriage-return or line-feed -character, after which more white-space and comments are allowed. - - [ - 1, # this comment not allowed in JSON - # neither this one... - ] - -=back - -=head2 canonical - - $json = $json->canonical([$enable]) - - $enabled = $json->get_canonical - -If C<$enable> is true (or missing), then the C method will output JSON objects -by sorting their keys. This is adding a comparatively high overhead. - -If C<$enable> is false, then the C method will output key-value -pairs in the order Perl stores them (which will likely change between runs -of the same script). - -This option is useful if you want the same data structure to be encoded as -the same JSON text (given the same overall settings). If it is disabled, -the same hash might be encoded differently even if contains the same data, -as key-value pairs have no inherent ordering in Perl. - -This setting has no effect when decoding JSON texts. - -If you want your own sorting routine, you can give a code reference -or a subroutine name to C. See to C. - -=head2 allow_nonref - - $json = $json->allow_nonref([$enable]) - - $enabled = $json->get_allow_nonref - -If C<$enable> is true (or missing), then the C method can convert a -non-reference into its corresponding string, number or null JSON value, -which is an extension to RFC4627. Likewise, C will accept those JSON -values instead of croaking. - -If C<$enable> is false, then the C method will croak if it isn't -passed an arrayref or hashref, as JSON texts must either be an object -or array. Likewise, C will croak if given something that is not a -JSON object or array. - - JSON::PP->new->allow_nonref->encode ("Hello, World!") - => "Hello, World!" - -=head2 allow_unknown - - $json = $json->allow_unknown ([$enable]) - - $enabled = $json->get_allow_unknown - -If $enable is true (or missing), then "encode" will *not* throw an -exception when it encounters values it cannot represent in JSON (for -example, filehandles) but instead will encode a JSON "null" value. -Note that blessed objects are not included here and are handled -separately by c. - -If $enable is false (the default), then "encode" will throw an -exception when it encounters anything it cannot encode as JSON. - -This option does not affect "decode" in any way, and it is -recommended to leave it off unless you know your communications -partner. - -=head2 allow_blessed - - $json = $json->allow_blessed([$enable]) - - $enabled = $json->get_allow_blessed - -If C<$enable> is true (or missing), then the C method will not -barf when it encounters a blessed reference. Instead, the value of the -B option will decide whether C (C -disabled or no C method found) or a representation of the -object (C enabled and C method found) is being -encoded. Has no effect on C. - -If C<$enable> is false (the default), then C will throw an -exception when it encounters a blessed object. - -=head2 convert_blessed - - $json = $json->convert_blessed([$enable]) - - $enabled = $json->get_convert_blessed - -If C<$enable> is true (or missing), then C, upon encountering a -blessed object, will check for the availability of the C method -on the object's class. If found, it will be called in scalar context -and the resulting scalar will be encoded instead of the object. If no -C method is found, the value of C will decide what -to do. - -The C method may safely call die if it wants. If C -returns other blessed objects, those will be handled in the same -way. C must take care of not causing an endless recursion cycle -(== crash) in this case. The name of C was chosen because other -methods called by the Perl core (== not by the user of the object) are -usually in upper case letters and to avoid collisions with the C -function or method. - -This setting does not yet influence C in any way. - -If C<$enable> is false, then the C setting will decide what -to do when a blessed object is found. - -=head2 filter_json_object - - $json = $json->filter_json_object([$coderef]) - -When C<$coderef> is specified, it will be called from C each -time it decodes a JSON object. The only argument passed to the coderef -is a reference to the newly-created hash. If the code references returns -a single scalar (which need not be a reference), this value -(i.e. a copy of that scalar to avoid aliasing) is inserted into the -deserialised data structure. If it returns an empty list -(NOTE: I C, which is a valid scalar), the original deserialised -hash will be inserted. This setting can slow down decoding considerably. - -When C<$coderef> is omitted or undefined, any existing callback will -be removed and C will not change the deserialised hash in any -way. - -Example, convert all JSON objects into the integer 5: - - my $js = JSON::PP->new->filter_json_object (sub { 5 }); - # returns [5] - $js->decode ('[{}]'); # the given subroutine takes a hash reference. - # throw an exception because allow_nonref is not enabled - # so a lone 5 is not allowed. - $js->decode ('{"a":1, "b":2}'); - -=head2 filter_json_single_key_object - - $json = $json->filter_json_single_key_object($key [=> $coderef]) - -Works remotely similar to C, but is only called for -JSON objects having a single key named C<$key>. - -This C<$coderef> is called before the one specified via -C, if any. It gets passed the single value in the JSON -object. If it returns a single value, it will be inserted into the data -structure. If it returns nothing (not even C but the empty list), -the callback from C will be called next, as if no -single-key callback were specified. - -If C<$coderef> is omitted or undefined, the corresponding callback will be -disabled. There can only ever be one callback for a given key. - -As this callback gets called less often then the C -one, decoding speed will not usually suffer as much. Therefore, single-key -objects make excellent targets to serialise Perl objects into, especially -as single-key JSON objects are as close to the type-tagged value concept -as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not -support this in any way, so you need to make sure your data never looks -like a serialised Perl hash. - -Typical names for the single object key are C<__class_whatever__>, or -C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even -things like C<__class_md5sum(classname)__>, to reduce the risk of clashing -with real hashes. - -Example, decode JSON objects of the form C<< { "__widget__" => } >> -into the corresponding C<< $WIDGET{} >> object: - - # return whatever is in $WIDGET{5}: - JSON::PP - ->new - ->filter_json_single_key_object (__widget__ => sub { - $WIDGET{ $_[0] } - }) - ->decode ('{"__widget__": 5') - - # this can be used with a TO_JSON method in some "widget" class - # for serialisation to json: - sub WidgetBase::TO_JSON { - my ($self) = @_; - - unless ($self->{id}) { - $self->{id} = ..get..some..id..; - $WIDGET{$self->{id}} = $self; - } - - { __widget__ => $self->{id} } - } - -=head2 shrink - - $json = $json->shrink([$enable]) - - $enabled = $json->get_shrink - -In JSON::XS, this flag resizes strings generated by either -C or C to their minimum size possible. -It will also try to downgrade any strings to octet-form if possible. - -In JSON::PP, it is noop about resizing strings but tries -C to the returned string by C. -See to L. - -See to L - -=head2 max_depth - - $json = $json->max_depth([$maximum_nesting_depth]) - - $max_depth = $json->get_max_depth - -Sets the maximum nesting level (default C<512>) accepted while encoding -or decoding. If a higher nesting level is detected in JSON text or a Perl -data structure, then the encoder and decoder will stop and croak at that -point. - -Nesting level is defined by number of hash- or arrayrefs that the encoder -needs to traverse to reach a given point or the number of C<{> or C<[> -characters without their matching closing parenthesis crossed to reach a -given character in a string. - -If no argument is given, the highest possible setting will be used, which -is rarely useful. - -See L for more info on why this is useful. - -When a large value (100 or more) was set and it de/encodes a deep nested object/text, -it may raise a warning 'Deep recursion on subroutine' at the perl runtime phase. - -=head2 max_size - - $json = $json->max_size([$maximum_string_size]) - - $max_size = $json->get_max_size - -Set the maximum length a JSON text may have (in bytes) where decoding is -being attempted. The default is C<0>, meaning no limit. When C -is called on a string that is longer then this many bytes, it will not -attempt to decode the string but throw an exception. This setting has no -effect on C (yet). - -If no argument is given, the limit check will be deactivated (same as when -C<0> is specified). - -See L for more info on why this is useful. - -=head2 encode - - $json_text = $json->encode($perl_scalar) - -Converts the given Perl data structure (a simple scalar or a reference -to a hash or array) to its JSON representation. Simple scalars will be -converted into JSON string or number sequences, while references to arrays -become JSON arrays and references to hashes become JSON objects. Undefined -Perl values (e.g. C) become JSON C values. -References to the integers C<0> and C<1> are converted into C and C. - -=head2 decode - - $perl_scalar = $json->decode($json_text) - -The opposite of C: expects a JSON text and tries to parse it, -returning the resulting simple scalar or reference. Croaks on error. - -JSON numbers and strings become simple Perl scalars. JSON arrays become -Perl arrayrefs and JSON objects become Perl hashrefs. C becomes -C<1> (C), C becomes C<0> (C) and -C becomes C. - -=head2 decode_prefix - - ($perl_scalar, $characters) = $json->decode_prefix($json_text) - -This works like the C method, but instead of raising an exception -when there is trailing garbage after the first JSON object, it will -silently stop parsing there and return the number of characters consumed -so far. - - JSON->new->decode_prefix ("[1] the tail") - => ([], 3) - -=head1 INCREMENTAL PARSING - -Most of this section are copied and modified from L. - -In some cases, there is the need for incremental parsing of JSON texts. -This module does allow you to parse a JSON stream incrementally. -It does so by accumulating text until it has a full JSON object, which -it then can decode. This process is similar to using C -to see if a full JSON object is available, but is much more efficient -(and can be implemented with a minimum of method calls). - -This module will only attempt to parse the JSON text once it is sure it -has enough text to get a decisive result, using a very simple but -truly incremental parser. This means that it sometimes won't stop as -early as the full parser, for example, it doesn't detect parentheses -mismatches. The only thing it guarantees is that it starts decoding as -soon as a syntactically valid JSON text has been seen. This means you need -to set resource limits (e.g. C) to ensure the parser will stop -parsing in the presence if syntax errors. - -The following methods implement this incremental parser. - -=head2 incr_parse - - $json->incr_parse( [$string] ) # void context - - $obj_or_undef = $json->incr_parse( [$string] ) # scalar context - - @obj_or_empty = $json->incr_parse( [$string] ) # list context - -This is the central parsing function. It can both append new text and -extract objects from the stream accumulated so far (both of these -functions are optional). - -If C<$string> is given, then this string is appended to the already -existing JSON fragment stored in the C<$json> object. - -After that, if the function is called in void context, it will simply -return without doing anything further. This can be used to add more text -in as many chunks as you want. - -If the method is called in scalar context, then it will try to extract -exactly I JSON object. If that is successful, it will return this -object, otherwise it will return C. If there is a parse error, -this method will croak just as C would do (one can then use -C to skip the erroneous part). This is the most common way of -using the method. - -And finally, in list context, it will try to extract as many objects -from the stream as it can find and return them, or the empty list -otherwise. For this to work, there must be no separators between the JSON -objects or arrays, instead they must be concatenated back-to-back. If -an error occurs, an exception will be raised as in the scalar context -case. Note that in this case, any previously-parsed JSON texts will be -lost. - -Example: Parse some JSON arrays/objects in a given string and return them. - - my @objs = JSON->new->incr_parse ("[5][7][1,2]"); - -=head2 incr_text - - $lvalue_string = $json->incr_text - -This method returns the currently stored JSON fragment as an lvalue, that -is, you can manipulate it. This I works when a preceding call to -C in I successfully returned an object. Under -all other circumstances you must not call this function (I mean it. -although in simple tests it might actually work, it I fail under -real world conditions). As a special exception, you can also call this -method before having parsed anything. - -This function is useful in two cases: a) finding the trailing text after a -JSON object or b) parsing multiple JSON objects separated by non-JSON text -(such as commas). - - $json->incr_text =~ s/\s*,\s*//; - -In Perl 5.005, C attribute is not available. -You must write codes like the below: - - $string = $json->incr_text; - $string =~ s/\s*,\s*//; - $json->incr_text( $string ); - -=head2 incr_skip - - $json->incr_skip - -This will reset the state of the incremental parser and will remove the -parsed text from the input buffer. This is useful after C -died, in which case the input buffer and incremental parser state is left -unchanged, to skip the text parsed so far and to reset the parse state. - -=head2 incr_reset - - $json->incr_reset - -This completely resets the incremental parser, that is, after this call, -it will be as if the parser had never parsed anything. - -This is useful if you want to repeatedly parse JSON objects and want to -ignore any trailing data, which means you have to reset the parser after -each successful decode. - -See to L for examples. - - -=head1 JSON::PP OWN METHODS - -=head2 allow_singlequote - - $json = $json->allow_singlequote([$enable]) - -If C<$enable> is true (or missing), then C will accept -JSON strings quoted by single quotations that are invalid JSON -format. - - $json->allow_singlequote->decode({"foo":'bar'}); - $json->allow_singlequote->decode({'foo':"bar"}); - $json->allow_singlequote->decode({'foo':'bar'}); - -As same as the C option, this option may be used to parse -application-specific files written by humans. - - -=head2 allow_barekey - - $json = $json->allow_barekey([$enable]) - -If C<$enable> is true (or missing), then C will accept -bare keys of JSON object that are invalid JSON format. - -As same as the C option, this option may be used to parse -application-specific files written by humans. - - $json->allow_barekey->decode('{foo:"bar"}'); - -=head2 allow_bignum - - $json = $json->allow_bignum([$enable]) - -If C<$enable> is true (or missing), then C will convert -the big integer Perl cannot handle as integer into a L -object and convert a floating number (any) into a L. - -On the contrary, C converts C objects and C -objects into JSON numbers with C enabled. - - $json->allow_nonref->allow_blessed->allow_bignum; - $bigfloat = $json->decode('2.000000000000000000000000001'); - print $json->encode($bigfloat); - # => 2.000000000000000000000000001 - -See to L about the normal conversion of JSON number. - -=head2 loose - - $json = $json->loose([$enable]) - -The unescaped [\x00-\x1f\x22\x2f\x5c] strings are invalid in JSON strings -and the module doesn't allow you to C to these (except for \x2f). -If C<$enable> is true (or missing), then C will accept these -unescaped strings. - - $json->loose->decode(qq|["abc - def"]|); - -See L. - -=head2 escape_slash - - $json = $json->escape_slash([$enable]) - -According to JSON Grammar, I (U+002F) is escaped. But default -JSON::PP (as same as JSON::XS) encodes strings without escaping slash. - -If C<$enable> is true (or missing), then C will escape slashes. - -=head2 indent_length - - $json = $json->indent_length($length) - -JSON::XS indent space length is 3 and cannot be changed. -JSON::PP set the indent space length with the given $length. -The default is 3. The acceptable range is 0 to 15. - -=head2 sort_by - - $json = $json->sort_by($function_name) - $json = $json->sort_by($subroutine_ref) - -If $function_name or $subroutine_ref are set, its sort routine are used -in encoding JSON objects. - - $js = $pc->sort_by(sub { $JSON::PP::a cmp $JSON::PP::b })->encode($obj); - # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|); - - $js = $pc->sort_by('own_sort')->encode($obj); - # is($js, q|{"a":1,"b":2,"c":3,"d":4,"e":5,"f":6,"g":7,"h":8,"i":9}|); - - sub JSON::PP::own_sort { $JSON::PP::a cmp $JSON::PP::b } - -As the sorting routine runs in the JSON::PP scope, the given -subroutine name and the special variables C<$a>, C<$b> will begin -'JSON::PP::'. - -If $integer is set, then the effect is same as C on. - -=head1 INTERNAL - -For developers. - -=over - -=item PP_encode_box - -Returns - - { - depth => $depth, - indent_count => $indent_count, - } - - -=item PP_decode_box - -Returns - - { - text => $text, - at => $at, - ch => $ch, - len => $len, - depth => $depth, - encoding => $encoding, - is_valid_utf8 => $is_valid_utf8, - }; - -=back - -=head1 MAPPING - -This section is copied from JSON::XS and modified to C. -JSON::XS and JSON::PP mapping mechanisms are almost equivalent. - -See to L. - -=head2 JSON -> PERL - -=over 4 - -=item object - -A JSON object becomes a reference to a hash in Perl. No ordering of object -keys is preserved (JSON does not preserver object key ordering itself). - -=item array - -A JSON array becomes a reference to an array in Perl. - -=item string - -A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON -are represented by the same codepoints in the Perl string, so no manual -decoding is necessary. - -=item number - -A JSON number becomes either an integer, numeric (floating point) or -string scalar in perl, depending on its range and any fractional parts. On -the Perl level, there is no difference between those as Perl handles all -the conversion details, but an integer may take slightly less memory and -might represent more values exactly than floating point numbers. - -If the number consists of digits only, C will try to represent -it as an integer value. If that fails, it will try to represent it as -a numeric (floating point) value if that is possible without loss of -precision. Otherwise it will preserve the number as a string value (in -which case you lose roundtripping ability, as the JSON number will be -re-encoded to a JSON string). - -Numbers containing a fractional or exponential part will always be -represented as numeric (floating point) values, possibly at a loss of -precision (in which case you might lose perfect roundtripping ability, but -the JSON number will still be re-encoded as a JSON number). - -Note that precision is not accuracy - binary floating point values cannot -represent most decimal fractions exactly, and when converting from and to -floating point, C only guarantees precision up to but not including -the least significant bit. - -When C is enabled, the big integers -and the numeric can be optionally converted into L and -L objects. - -=item true, false - -These JSON atoms become C and C, -respectively. They are overloaded to act almost exactly like the numbers -C<1> and C<0>. You can check whether a scalar is a JSON boolean by using -the C function. - - print JSON::PP::true . "\n"; - => true - print JSON::PP::true + 1; - => 1 - - ok(JSON::true eq '1'); - ok(JSON::true == 1); - -C will install these missing overloading features to the backend modules. - - -=item null - -A JSON null atom becomes C in Perl. - -C returns C. - -=back - - -=head2 PERL -> JSON - -The mapping from Perl to JSON is slightly more difficult, as Perl is a -truly typeless language, so we can only guess which JSON type is meant by -a Perl value. - -=over 4 - -=item hash references - -Perl hash references become JSON objects. As there is no inherent ordering -in hash keys (or JSON objects), they will usually be encoded in a -pseudo-random order that can change between runs of the same program but -stays generally the same within a single run of a program. C -optionally sort the hash keys (determined by the I flag), so -the same datastructure will serialise to the same JSON text (given same -settings and version of JSON::XS), but this incurs a runtime overhead -and is only rarely useful, e.g. when you want to compare some JSON text -against another for equality. - - -=item array references - -Perl array references become JSON arrays. - -=item other references - -Other unblessed references are generally not allowed and will cause an -exception to be thrown, except for references to the integers C<0> and -C<1>, which get turned into C and C atoms in JSON. You can -also use C and C to improve readability. - - to_json [\0,JSON::PP::true] # yields [false,true] - -=item JSON::PP::true, JSON::PP::false, JSON::PP::null - -These special values become JSON true and JSON false values, -respectively. You can also use C<\1> and C<\0> directly if you want. - -JSON::PP::null returns C. - -=item blessed objects - -Blessed objects are not directly representable in JSON. See the -C and C methods on various options on -how to deal with this: basically, you can choose between throwing an -exception, encoding the reference as if it weren't blessed, or provide -your own serialiser method. - -See to L. - -=item simple scalars - -Simple Perl scalars (any scalar that is not a reference) are the most -difficult objects to encode: JSON::XS and JSON::PP will encode undefined scalars as -JSON C values, scalars that have last been used in a string context -before encoding as JSON strings, and anything else as number value: - - # dump as number - encode_json [2] # yields [2] - encode_json [-3.0e17] # yields [-3e+17] - my $value = 5; encode_json [$value] # yields [5] - - # used as string, so dump as string - print $value; - encode_json [$value] # yields ["5"] - - # undef becomes null - encode_json [undef] # yields [null] - -You can force the type to be a string by stringifying it: - - my $x = 3.1; # some variable containing a number - "$x"; # stringified - $x .= ""; # another, more awkward way to stringify - print $x; # perl does it for you, too, quite often - -You can force the type to be a number by numifying it: - - my $x = "3"; # some variable containing a string - $x += 0; # numify it, ensuring it will be dumped as a number - $x *= 1; # same thing, the choice is yours. - -You cannot currently force the type in other, less obscure, ways. - -Note that numerical precision has the same meaning as under Perl (so -binary to decimal conversion follows the same rules as in Perl, which -can differ to other languages). Also, your perl interpreter might expose -extensions to the floating point numbers of your platform, such as -infinities or NaN's - these cannot be represented in JSON, and it is an -error to pass those in. - -=item Big Number - -When C is enabled, -C converts C objects and C -objects into JSON numbers. - - -=back - -=head1 UNICODE HANDLING ON PERLS - -If you do not know about Unicode on Perl well, -please check L. - -=head2 Perl 5.8 and later - -Perl can handle Unicode and the JSON::PP de/encode methods also work properly. - - $json->allow_nonref->encode(chr hex 3042); - $json->allow_nonref->encode(chr hex 12345); - -Returns C<"\u3042"> and C<"\ud808\udf45"> respectively. - - $json->allow_nonref->decode('"\u3042"'); - $json->allow_nonref->decode('"\ud808\udf45"'); - -Returns UTF-8 encoded strings with UTF8 flag, regarded as C and C. - -Note that the versions from Perl 5.8.0 to 5.8.2, Perl built-in C was broken, -so JSON::PP wraps the C with a subroutine. Thus JSON::PP works slow in the versions. - - -=head2 Perl 5.6 - -Perl can handle Unicode and the JSON::PP de/encode methods also work. - -=head2 Perl 5.005 - -Perl 5.005 is a byte semantics world -- all strings are sequences of bytes. -That means the unicode handling is not available. - -In encoding, - - $json->allow_nonref->encode(chr hex 3042); # hex 3042 is 12354. - $json->allow_nonref->encode(chr hex 12345); # hex 12345 is 74565. - -Returns C and C, as C takes a value more than 255, it treats -as C<$value % 256>, so the above codes are equivalent to : - - $json->allow_nonref->encode(chr 66); - $json->allow_nonref->encode(chr 69); - -In decoding, - - $json->decode('"\u00e3\u0081\u0082"'); - -The returned is a byte sequence C<0xE3 0x81 0x82> for UTF-8 encoded -Japanese character (C). -And if it is represented in Unicode code point, C. - -Next, - - $json->decode('"\u3042"'); - -We ordinary expect the returned value is a Unicode character C. -But here is 5.005 world. This is C<0xE3 0x81 0x82>. - - $json->decode('"\ud808\udf45"'); - -This is not a character C but bytes - C<0xf0 0x92 0x8d 0x85>. - - -=head1 TODO - -=over - -=item speed - -=item memory saving - -=back - - -=head1 SEE ALSO - -Most of the document are copied and modified from JSON::XS doc. - -L - -RFC4627 (L) - -=head1 AUTHOR - -Makamaka Hannyaharamitu, Emakamaka[at]cpan.orgE - - -=head1 COPYRIGHT AND LICENSE - -Copyright 2007-2016 by Makamaka Hannyaharamitu - -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/JSON/PP/Boolean.pm b/.checksetup_lib/lib/perl5/JSON/PP/Boolean.pm deleted file mode 100644 index 0b1fb19b2c..0000000000 --- a/.checksetup_lib/lib/perl5/JSON/PP/Boolean.pm +++ /dev/null @@ -1,26 +0,0 @@ -=head1 NAME - -JSON::PP::Boolean - dummy module providing JSON::PP::Boolean - -=head1 SYNOPSIS - - # do not "use" yourself - -=head1 DESCRIPTION - -This module exists only to provide overload resolution for Storable and similar modules. See -L for more info about this class. - -=cut - -use JSON::PP (); -use strict; - -1; - -=head1 AUTHOR - -This idea is from L written by Marc Lehmann - -=cut - diff --git a/.checksetup_lib/lib/perl5/Module/Metadata.pm b/.checksetup_lib/lib/perl5/Module/Metadata.pm deleted file mode 100644 index e352d31620..0000000000 --- a/.checksetup_lib/lib/perl5/Module/Metadata.pm +++ /dev/null @@ -1,1016 +0,0 @@ -# -*- 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 Ced, 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 object given the path to a file. Returns -undef if the filename does not exist. - -C 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, 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 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 object given a module or package name. -Returns undef if the module cannot be found. - -In addition to accepting the C argument as described above, -this method accepts a C 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 -to generate a CPAN META C data structure. It takes key/value -pairs. Valid option keys include: - -=over - -=item version B<(required)> - -Specifies which version of the L should be used as -the format of the C 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 changes. - -The C option is required. If it is omitted or if -an unsupported version is given, then C will throw an error. - -=item dir - -Directory to search recursively for F<.pm> files. May not be specified with -C. - -=item files - -Array reference of files to examine. May not be specified with C. - -=item prefix - -String to prepend to the C field of the resulting output. This defaults -to F, which is the common case for most CPAN distributions with their -F<.pm> files in F. This option ensures the META information has the -correct relative path even when the C or C arguments are -absolute or have relative paths from a location other than the distribution -root. - -=back - -For example, given C of 'lib' and C 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 and C
packages are always omitted, as are any "private" -packages that have leading underscores in the namespace (e.g. -C) - -Note that the file path is relative to C<$dir> if that is specified. -This B be used directly for CPAN META C. See -the C 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 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
). It is not -filtered for C, C
or private packages the way the -C 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 -, Randy W. Sims - -Released as Module::Metadata by Matt S Trout (mst) with -assistance from David Golden (xdg) . - -=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 deleted file mode 100644 index 77a0764772..0000000000 --- a/.checksetup_lib/lib/perl5/Parse/CPAN/Meta.pm +++ /dev/null @@ -1,352 +0,0 @@ -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 is a parser for F and F files, using -L and/or L. - -B provides three methods: C, C, -and C. These will read and deserialize CPAN metafiles, and -are described below in detail. - -B 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. - -=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. - -=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 -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 or L. Even if C is set, -this will return L as further delegation is handled by -the L module. See L 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. - -=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 will be used for deserializing JSON data. If the -C environment variable exists, is true and is not -"JSON::PP", then the L module (version 2.5 or greater) will be loaded and -used to interpret C. If L is not installed or is too -old, an exception will be thrown. - -=head2 PERL_YAML_BACKEND - -By default, L will be used for deserializing YAML data. If -the C 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 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. -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 - - git clone https://github.com/Perl-Toolchain-Gang/Parse-CPAN-Meta.git - -=head1 AUTHORS - -=over 4 - -=item * - -Adam Kennedy - -=item * - -David Golden - -=back - -=head1 CONTRIBUTORS - -=for stopwords Graham Knop Joshua ben Jore Karen Etheridge Neil Bowers Ricardo Signes Steffen Mueller - -=over 4 - -=item * - -Graham Knop - -=item * - -Joshua ben Jore - -=item * - -Karen Etheridge - -=item * - -Neil Bowers - -=item * - -Ricardo Signes - -=item * - -Steffen Mueller - -=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 diff --git a/Bugzilla/Install/Requirements.pm b/Bugzilla/Install/Requirements.pm index e02c427357..eeffed0767 100644 --- a/Bugzilla/Install/Requirements.pm +++ b/Bugzilla/Install/Requirements.pm @@ -102,10 +102,9 @@ use constant FEATURE_FILES => ( sub load_cpan_meta { my $dir = bz_locations()->{libpath}; - my @meta_json = map { File::Spec->catfile($dir, $_) } qw( MYMETA.json META.json ); - my ($file) = grep { -f $_ } @meta_json; + my $file = File::Spec->catfile($dir, 'MYMETA.json'); - if ($file) { + if (-f $file) { open my $meta_fh, '<', $file or die "unable to open $file: $!"; my $str = do { local $/ = undef; scalar <$meta_fh> }; # detaint @@ -491,7 +490,7 @@ that must be enabled in order to compile that file. =item C -Load MYMETA.json or META.json from the bugzilla directory, and a return a L object. +Load MYMETA.json from the bugzilla directory, and a return a L object. =back diff --git a/META.json b/META.json deleted file mode 100644 index 29b0c35a57..0000000000 --- a/META.json +++ /dev/null @@ -1,399 +0,0 @@ -{ - "abstract" : "Bugzilla Bug Tracking System", - "author" : [ - "Bugzilla Developers " - ], - "dynamic_config" : 1, - "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005", - "license" : [ - "unknown" - ], - "meta-spec" : { - "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", - "version" : "2" - }, - "name" : "Bugzilla", - "no_index" : { - "directory" : [ - "t", - "inc" - ] - }, - "optional_features" : { - "auth_delegation" : { - "description" : "Auth Delegation", - "prereqs" : { - "runtime" : { - "requires" : { - "LWP::UserAgent" : "0" - } - } - } - }, - "auth_ldap" : { - "description" : "LDAP Authentication", - "prereqs" : { - "runtime" : { - "requires" : { - "Net::LDAP" : "0" - } - } - } - }, - "auth_radius" : { - "description" : "RADIUS Authentication", - "prereqs" : { - "runtime" : { - "requires" : { - "Authen::Radius" : "0" - } - } - } - }, - "csp" : { - "description" : "Content-Security-Policy support", - "prereqs" : { - "runtime" : { - "requires" : { - "MooX::StrictConstructor" : "0.008", - "Type::Tiny" : "1" - } - } - } - }, - "db_from_env" : { - "description" : "Support for using $ENV{DATABASE_URL}", - "prereqs" : { - "runtime" : { - "requires" : { - "URI::db" : "0.17" - } - } - } - }, - "detect_charset" : { - "description" : "Automatic charset detection for text attachments", - "prereqs" : { - "runtime" : { - "requires" : { - "Encode" : "2.21", - "Encode::Detect" : "0" - } - } - } - }, - "documentation" : { - "description" : "Documentation", - "prereqs" : { - "runtime" : { - "requires" : { - "File::Copy::Recursive" : "0", - "File::Which" : "0" - } - } - } - }, - "features" : { - "description" : "Modules required to enable any feature", - "prereqs" : { - "runtime" : { - "requires" : { - "CPAN::Meta::Prereqs" : "2.132830", - "CPAN::Meta::Requirements" : "2.121", - "Module::Metadata" : "1.000019", - "Module::Runtime" : "0" - } - } - } - }, - "graphical_reports" : { - "description" : "Graphical Reports", - "prereqs" : { - "runtime" : { - "requires" : { - "GD" : "1.20", - "GD::Graph" : "0", - "GD::Text" : "0", - "Template::Plugin::GD::Image" : "0" - } - } - } - }, - "html_desc" : { - "description" : "More HTML in Product/Group Descriptions", - "prereqs" : { - "runtime" : { - "requires" : { - "HTML::Parser" : "3.67", - "HTML::Scrubber" : "0" - } - } - } - }, - "inbound_email" : { - "description" : "Inbound Email", - "prereqs" : { - "runtime" : { - "requires" : { - "Email::Reply" : "0", - "HTML::FormatText::WithLinks" : "0.13" - } - } - } - }, - "jobqueue" : { - "description" : "Mail Queueing", - "prereqs" : { - "runtime" : { - "requires" : { - "Daemon::Generic" : "0", - "TheSchwartz" : "1.10" - } - } - } - }, - "jsonrpc" : { - "description" : "JSON-RPC Interface", - "prereqs" : { - "runtime" : { - "requires" : { - "JSON::RPC" : "0" - } - } - } - }, - "markdown" : { - "description" : "Markdown syntax support for comments", - "prereqs" : { - "runtime" : { - "requires" : { - "Text::MultiMarkdown" : "1.000034" - } - } - } - }, - "memcached" : { - "description" : "Memcached Support", - "prereqs" : { - "runtime" : { - "requires" : { - "Cache::Memcached::Fast" : "0.17" - } - } - } - }, - "mod_perl" : { - "description" : "mod_perl support under Apache", - "prereqs" : { - "runtime" : { - "requires" : { - "Apache2::SizeLimit" : "0.96", - "mod_perl2" : "1.999022" - } - } - } - }, - "moving" : { - "description" : "Move Bugs Between Installations", - "prereqs" : { - "runtime" : { - "requires" : { - "MIME::Parser" : "5.406", - "XML::Twig" : "0" - } - } - } - }, - "mysql" : { - "description" : "MySQL database support", - "prereqs" : { - "runtime" : { - "requires" : { - "DBD::mysql" : "4.001" - } - } - } - }, - "new_charts" : { - "description" : "New Charts", - "prereqs" : { - "runtime" : { - "requires" : { - "Chart::Lines" : "v2.4.10", - "GD" : "1.20" - } - } - } - }, - "old_charts" : { - "description" : "Old Charts", - "prereqs" : { - "runtime" : { - "requires" : { - "Chart::Lines" : "v2.4.10", - "GD" : "1.20" - } - } - } - }, - "oracle" : { - "description" : "Oracle database support", - "prereqs" : { - "runtime" : { - "requires" : { - "DBD::Oracle" : "1.19" - } - } - } - }, - "patch_viewer" : { - "description" : "Patch Viewer", - "prereqs" : { - "runtime" : { - "requires" : { - "PatchReader" : "v0.9.6" - } - } - } - }, - "pg" : { - "description" : "Postgres database support", - "prereqs" : { - "runtime" : { - "requires" : { - "DBD::Pg" : "v2.19.3" - } - } - } - }, - "psgi" : { - "description" : "Plack/PSGI support", - "prereqs" : { - "runtime" : { - "requires" : { - "CGI::Compile" : "0", - "CGI::Emulate::PSGI" : "0", - "Plack" : "1.0031" - } - } - } - }, - "smtp_auth" : { - "description" : "SMTP Authentication", - "prereqs" : { - "runtime" : { - "requires" : { - "Authen::SASL" : "0" - } - } - } - }, - "smtp_ssl" : { - "description" : "SSL Support for SMTP", - "prereqs" : { - "runtime" : { - "requires" : { - "Net::SMTP::SSL" : "1.01" - } - } - } - }, - "sqlite" : { - "description" : "SQLite database support", - "prereqs" : { - "runtime" : { - "requires" : { - "DBD::SQLite" : "1.29" - } - } - } - }, - "typesniffer" : { - "description" : "Sniff MIME type of attachments", - "prereqs" : { - "runtime" : { - "requires" : { - "File::MimeInfo::Magic" : "0", - "IO::Scalar" : "0" - } - } - } - }, - "updates" : { - "description" : "Automatic Update Notifications", - "prereqs" : { - "runtime" : { - "requires" : { - "LWP::UserAgent" : "0", - "XML::Twig" : "0" - } - } - } - }, - "xmlrpc" : { - "description" : "XML-RPC Interface", - "prereqs" : { - "runtime" : { - "requires" : { - "SOAP::Lite" : "0.712", - "XMLRPC::Lite" : "0.712" - } - } - } - } - }, - "prereqs" : { - "build" : { - "requires" : { - "ExtUtils::MakeMaker" : "6.55" - } - }, - "configure" : { - "requires" : { - "ExtUtils::MakeMaker" : "6.55" - } - }, - "runtime" : { - "recommends" : { - "CPAN::Meta::Prereqs" : "2.132830", - "CPAN::Meta::Requirements" : "2.121", - "Module::Metadata" : "1.000019", - "Module::Runtime" : "0", - "Safe" : "2.30" - }, - "requires" : { - "CGI" : "4.09", - "DBI" : "1.614", - "Date::Format" : "2.23", - "DateTime" : "0.75", - "DateTime::TimeZone" : "1.64", - "Digest::SHA" : "0", - "Email::MIME" : "1.904", - "Email::Sender" : "1.300011", - "HTTP::Request" : "0", - "HTTP::Response" : "0", - "JSON::XS" : "2.01", - "List::MoreUtils" : "0.32", - "Math::Random::ISAAC" : "v1.0.1", - "Module::Runtime" : "0", - "Moo" : "2", - "Template" : "2.24", - "Test::Taint" : "1.06", - "URI" : "1.55", - "perl" : "5.014000" - } - }, - "test" : { - "requires" : { - "Pod::Checker" : "0", - "Pod::Coverage" : "0", - "Test2::Suite" : "0", - "Test::More" : "0", - "Test::Perl::Critic" : "0" - } - } - }, - "release_status" : "stable", - "version" : "v5.1.1+", - "x_serialization_backend" : "JSON::PP version 2.27300" -} diff --git a/META.yml b/META.yml deleted file mode 100644 index a1647627bf..0000000000 --- a/META.yml +++ /dev/null @@ -1,194 +0,0 @@ ---- -abstract: 'Bugzilla Bug Tracking System' -author: - - 'Bugzilla Developers ' -build_requires: - ExtUtils::MakeMaker: '6.55' - Pod::Checker: '0' - Pod::Coverage: '0' - Test2::Suite: '0' - Test::More: '0' - Test::Perl::Critic: '0' -configure_requires: - ExtUtils::MakeMaker: '6.55' -dynamic_config: 1 -generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150005' -license: unknown -meta-spec: - url: http://module-build.sourceforge.net/META-spec-v1.4.html - version: '1.4' -name: Bugzilla -no_index: - directory: - - t - - inc -optional_features: - auth_delegation: - description: 'Auth Delegation' - requires: - LWP::UserAgent: '0' - auth_ldap: - description: 'LDAP Authentication' - requires: - Net::LDAP: '0' - auth_radius: - description: 'RADIUS Authentication' - requires: - Authen::Radius: '0' - csp: - description: 'Content-Security-Policy support' - requires: - MooX::StrictConstructor: '0.008' - Type::Tiny: '1' - db_from_env: - description: 'Support for using $ENV{DATABASE_URL}' - requires: - URI::db: '0.17' - detect_charset: - description: 'Automatic charset detection for text attachments' - requires: - Encode: '2.21' - Encode::Detect: '0' - documentation: - description: Documentation - requires: - File::Copy::Recursive: '0' - File::Which: '0' - features: - description: 'Modules required to enable any feature' - requires: - CPAN::Meta::Prereqs: '2.132830' - CPAN::Meta::Requirements: '2.121' - Module::Metadata: '1.000019' - Module::Runtime: '0' - graphical_reports: - description: 'Graphical Reports' - requires: - GD: '1.20' - GD::Graph: '0' - GD::Text: '0' - Template::Plugin::GD::Image: '0' - html_desc: - description: 'More HTML in Product/Group Descriptions' - requires: - HTML::Parser: '3.67' - HTML::Scrubber: '0' - inbound_email: - description: 'Inbound Email' - requires: - Email::Reply: '0' - HTML::FormatText::WithLinks: '0.13' - jobqueue: - description: 'Mail Queueing' - requires: - Daemon::Generic: '0' - TheSchwartz: '1.10' - jsonrpc: - description: 'JSON-RPC Interface' - requires: - JSON::RPC: '0' - markdown: - description: 'Markdown syntax support for comments' - requires: - Text::MultiMarkdown: '1.000034' - memcached: - description: 'Memcached Support' - requires: - Cache::Memcached::Fast: '0.17' - mod_perl: - description: 'mod_perl support under Apache' - requires: - Apache2::SizeLimit: '0.96' - mod_perl2: '1.999022' - moving: - description: 'Move Bugs Between Installations' - requires: - MIME::Parser: '5.406' - XML::Twig: '0' - mysql: - description: 'MySQL database support' - requires: - DBD::mysql: '4.001' - new_charts: - description: 'New Charts' - requires: - Chart::Lines: v2.4.10 - GD: '1.20' - old_charts: - description: 'Old Charts' - requires: - Chart::Lines: v2.4.10 - GD: '1.20' - oracle: - description: 'Oracle database support' - requires: - DBD::Oracle: '1.19' - patch_viewer: - description: 'Patch Viewer' - requires: - PatchReader: v0.9.6 - pg: - description: 'Postgres database support' - requires: - DBD::Pg: v2.19.3 - psgi: - description: 'Plack/PSGI support' - requires: - CGI::Compile: '0' - CGI::Emulate::PSGI: '0' - Plack: '1.0031' - smtp_auth: - description: 'SMTP Authentication' - requires: - Authen::SASL: '0' - smtp_ssl: - description: 'SSL Support for SMTP' - requires: - Net::SMTP::SSL: '1.01' - sqlite: - description: 'SQLite database support' - requires: - DBD::SQLite: '1.29' - typesniffer: - description: 'Sniff MIME type of attachments' - requires: - File::MimeInfo::Magic: '0' - IO::Scalar: '0' - updates: - description: 'Automatic Update Notifications' - requires: - LWP::UserAgent: '0' - XML::Twig: '0' - xmlrpc: - description: 'XML-RPC Interface' - requires: - SOAP::Lite: '0.712' - XMLRPC::Lite: '0.712' -recommends: - CPAN::Meta::Prereqs: '2.132830' - CPAN::Meta::Requirements: '2.121' - Module::Metadata: '1.000019' - Module::Runtime: '0' - Safe: '2.30' -requires: - CGI: '4.09' - DBI: '1.614' - Date::Format: '2.23' - DateTime: '0.75' - DateTime::TimeZone: '1.64' - Digest::SHA: '0' - Email::MIME: '1.904' - Email::Sender: '1.300011' - HTTP::Request: '0' - HTTP::Response: '0' - JSON::XS: '2.01' - List::MoreUtils: '0.32' - Math::Random::ISAAC: v1.0.1 - Module::Runtime: '0' - Moo: '2' - Template: '2.24' - Test::Taint: '1.06' - URI: '1.55' - perl: '5.014000' -version: v5.1.1+ -x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/Makefile.PL b/Makefile.PL index 1d78e5e784..7d94b62fa5 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -16,7 +16,13 @@ use 5.14.0; use strict; use warnings; -use lib qw(. lib local/lib/perl5); +use File::Basename; +use File::Spec; +BEGIN { + require lib; + my $dir = File::Spec->rel2abs(dirname(__FILE__)); + lib->import($dir, File::Spec->catdir($dir, "lib"), File::Spec->catdir($dir, qw(local lib perl5))); +} use ExtUtils::MakeMaker 6.55; use Bugzilla::Constants qw(BUGZILLA_VERSION); @@ -30,28 +36,6 @@ BEGIN { } } -# META.json and META.yml exist only for the benefit of older -# installs where cpanm can't get the optional features out of Makefile.PL -# Unfortunately having META.json and META.yml commited to the repo is weird -# and MakeMaker always prefers their content to the internal data (unless CPAN::META -# is not installed). -# Since we (Bugzilla) require this cludge, we hide the files from MakeMaker. -BEGIN { - warn "Hiding META.{json,yml} from MakeMaker...\n"; - rename( 'META.json', 'META.json.hide' ) || unlink("META.json"); - rename( 'META.yml', 'META.yml.hide' ) || unlink("META.yml"); - - if (!eval { ExtUtils::MakeMaker->VERSION('6.57_07') }) { - warn "WARNING: ExtUtils::MakeMaker should be at least 6.57_07 in order to support updating META.json files\n"; - } -} - -END { - warn "Unhiding META.{json,yml}...\n"; - rename( 'META.json.hide', 'META.json' ); - rename( 'META.yml.hide', 'META.yml' ); -} - # PREREQ_PM my %requires = ( 'CGI' => '4.09', @@ -379,21 +363,5 @@ sub MY::postamble { GEN_CPANFILE_ARGS = -A -U mod_perl -U oracle cpanfile: MYMETA.json \t\$(PERLRUN) gen-cpanfile.pl \$(GEN_CPANFILE_ARGS) - -checksetup_lib: Makefile.PL -\tcpanm -L .checksetup_lib --notest \\ - CPAN::Meta JSON::PP CPAN::Meta::Requirements \\ - Module::Metadata\@$all_features{'Module::Metadata'} -\t-rm -fr .checksetup_lib/man -\t-rm -fr .checksetup_lib/lib/perl5/*/.meta -\t-rm -fr .checksetup_lib/lib/perl5/Test -\t-rm -fr .checksetup_lib/lib/perl5/ok.pm -\t-find .checksetup_lib '(' -name '*.pod' -or -name .packlist ')' -print0 | xargs -0 rm -f - -META.json: Makefile.PL -\tmake distmeta 2>&1 /dev/null; mv */META.json . - -META.yml: Makefile.PL -\tmake distmeta 2>&1 /dev/null; mv */META.yml . MAKE } diff --git a/checksetup.pl b/checksetup.pl index 7ce9673ced..9afc84c7d2 100755 --- a/checksetup.pl +++ b/checksetup.pl @@ -17,11 +17,13 @@ use strict; use warnings; use File::Basename; -BEGIN { chdir dirname($0); } -use lib qw(. lib local/lib/perl5 .checksetup_lib/lib/perl5); - -# the @INC which checksetup needs to operate against. -our @BUGZILLA_INC = grep { !/checksetup_lib/ } @INC; +use File::Spec; +BEGIN { + require lib; + my $dir = File::Spec->rel2abs(dirname(__FILE__)); + lib->import($dir, File::Spec->catdir($dir, "lib"), File::Spec->catdir($dir, qw(local lib perl5))); + chdir($dir); +} use Getopt::Long qw(:config bundling); use Pod::Usage; @@ -95,18 +97,20 @@ $ENV{PERL_MM_USE_DEFAULT} = 1; $ENV{BZ_SILENT_MAKEFILE} = 1; system($^X, "Makefile.PL"); +if (! -f "MYMETA.json") { + die "Makefile.PL failed to generate a MYMETA.json file.", + "Try upgrading ExtUtils::MakeMaker"; +} + my $meta = load_cpan_meta(); if (keys %{$meta->{optional_features}} < 1) { - warn "Your version of ExtUtils::MakeMaker is probably too old\n"; - warn "Falling back to static (and wrong) META.json\n"; - unlink('MYMETA.json'); - $meta = load_cpan_meta(); + die "Your version of ExtUtils::MakeMaker is too old or broken\n"; } -my $requirements = check_cpan_requirements($meta, \@BUGZILLA_INC, !$silent); +my $requirements = check_cpan_requirements($meta, [@INC], !$silent); exit 1 unless $requirements->{ok}; -check_all_cpan_features($meta, \@BUGZILLA_INC, !$silent); +check_all_cpan_features($meta, [@INC], !$silent); exit 0 if $switch{'check-modules'}; ########################################################################### diff --git a/template/en/default/global/code-error.html.tmpl b/template/en/default/global/code-error.html.tmpl index 3f83dbb687..e457727c7c 100644 --- a/template/en/default/global/code-error.html.tmpl +++ b/template/en/default/global/code-error.html.tmpl @@ -115,7 +115,7 @@ [% ELSIF error == "cookies_need_value" %] Every cookie must have a value. [% ELSIF error == "cpan_meta_missing" %] - META.json/MYMETA.json file is missing. + MYMETA.json file is missing. [% ELSIF error == "env_no_email" %] Bugzilla did not receive an email address from the environment. -- 2.47.2