diff -Nru libcpanplus-perl-0.9162/ChangeLog libcpanplus-perl-0.9172/ChangeLog --- libcpanplus-perl-0.9162/ChangeLog 2017-01-15 11:16:18.000000000 +0000 +++ libcpanplus-perl-0.9172/ChangeLog 2017-10-09 11:21:32.000000000 +0000 @@ -1,3 +1,31 @@ +0.9172 Mon Oct 9 12:14:38 BST 2017 + +* Replace File'Fetch with File::Fetch [rt.cpan.org #123221] + +0.9170 Wed Sep 13 19:40:37 BST 2017 + +* Fix RT#122849 problems with parse_module() + +0.9168 Sun May 14 14:17:26 BST 2017 + +* fix typo in YAML_BACKEND environment variable +* Add support for meta x_use_unsafe_inc + +0.9166 Wed Apr 12 09:37:20 BST 2017 + +* make Autoflush do STDOUT and STDERR +* switch from PERLWRAPPER to Autoflush + +0.9164 Thu Feb 16 12:05:02 GMT 2017 + +* Set env var PERL_USE_UNSAFE_INC if required [rt.cpan.org #120227] +* Handle @INC without 'dot' scenario in Makefile.PL +* Fixed versiononly process for scripts to only run for when we were in core + +0.9162 Sun Jan 15 11:23:10 GMT 2017 + +* Fix RT#116479 test failure with v5.24.1-RC* + 0.9160 Wed May 18 21:27:41 BST 2016 * Add new bundled module to the MANIFEST *doh* diff -Nru libcpanplus-perl-0.9162/debian/changelog libcpanplus-perl-0.9172/debian/changelog --- libcpanplus-perl-0.9162/debian/changelog 2017-01-22 03:07:03.000000000 +0000 +++ libcpanplus-perl-0.9172/debian/changelog 2017-11-11 18:19:05.000000000 +0000 @@ -1,3 +1,23 @@ +libcpanplus-perl (0.9172-1ubuntu1) bionic; urgency=medium + + * Merge from Debian unstable. Remaining changes: + - Depend on libdbd-sqlite3-perl and libdbix-simple-perl for + runtime-deps-and-recommends autopkgtest; these are also covered by + needs-recommends, but an explicit dependency forces autopkgtest not to + drop them during Perl transitions due to pinning only necessary packages + from -proposed. + + -- Bhavani Shankar Sat, 11 Nov 2017 23:47:46 +0530 + +libcpanplus-perl (0.9172-1) unstable; urgency=medium + + * Import upstream version 0.9172. + * debian/upstream/metadata: update Contact field. + * Update versioned alternative (build) dependencies. Thanks to cme. + * Declare compliance with Debian Policy 4.1.1. + + -- gregor herrmann Sat, 14 Oct 2017 16:09:24 +0200 + libcpanplus-perl (0.9162-1ubuntu1) zesty; urgency=medium * Merge from Debian unstable. Remaining changes: diff -Nru libcpanplus-perl-0.9162/debian/control libcpanplus-perl-0.9172/debian/control --- libcpanplus-perl-0.9162/debian/control 2017-01-21 21:46:21.000000000 +0000 +++ libcpanplus-perl-0.9172/debian/control 2017-10-14 22:52:18.000000000 +0000 @@ -7,13 +7,13 @@ Priority: optional Build-Depends: debhelper (>= 9) Build-Depends-Indep: perl, - libarchive-extract-perl | perl (<< 5.17.0), + libarchive-extract-perl | perl (<< 5.17.9), liblog-message-perl, - libmodule-pluggable-perl | perl (<< 5.17.0), + libmodule-pluggable-perl | perl (<< 5.17.9), libobject-accessor-perl, - libpackage-constants-perl | perl (<< 5.19.0), - libterm-ui-perl | perl (<< 5.17.0) -Standards-Version: 3.9.8 + libpackage-constants-perl | perl (<< 5.19.6), + libterm-ui-perl | perl (<< 5.17.9) +Standards-Version: 4.1.1 Vcs-Browser: https://anonscm.debian.org/cgit/pkg-perl/packages/libcpanplus-perl.git Vcs-Git: https://anonscm.debian.org/git/pkg-perl/packages/libcpanplus-perl.git Homepage: https://metacpan.org/release/CPANPLUS @@ -22,12 +22,12 @@ Architecture: all Depends: ${misc:Depends}, ${perl:Depends}, - libarchive-extract-perl | perl (<< 5.17.0), + libarchive-extract-perl | perl (<< 5.17.9), liblog-message-perl, - libmodule-pluggable-perl | perl (<< 5.17.0), + libmodule-pluggable-perl | perl (<< 5.17.9), libobject-accessor-perl, - libpackage-constants-perl | perl (<< 5.19.0), - libterm-ui-perl | perl (<< 5.17.0) + libpackage-constants-perl | perl (<< 5.19.6), + libterm-ui-perl | perl (<< 5.17.9) Recommends: libdbd-sqlite3-perl, libdbix-simple-perl Provides: cpanplus diff -Nru libcpanplus-perl-0.9162/debian/tests/pkg-perl/smoke-skip libcpanplus-perl-0.9172/debian/tests/pkg-perl/smoke-skip --- libcpanplus-perl-0.9162/debian/tests/pkg-perl/smoke-skip 2017-01-21 21:46:21.000000000 +0000 +++ libcpanplus-perl-0.9172/debian/tests/pkg-perl/smoke-skip 2017-10-14 22:52:18.000000000 +0000 @@ -1,2 +1,3 @@ -# stumbles over some path issues (?), needs further investigation +# tries to parse CPANPLUS, i.e. needs the source tree which is not avalaible under autopkgtest +# alternative: patch out '.' in @map in the test t/08_CPANPLUS-Backend.t diff -Nru libcpanplus-perl-0.9162/debian/upstream/metadata libcpanplus-perl-0.9172/debian/upstream/metadata --- libcpanplus-perl-0.9162/debian/upstream/metadata 2017-01-21 21:46:21.000000000 +0000 +++ libcpanplus-perl-0.9172/debian/upstream/metadata 2017-10-14 22:52:18.000000000 +0000 @@ -1,5 +1,5 @@ --- Archive: CPAN -Contact: Jos Boumans +Contact: Chris Williams Name: CPANPLUS Repository: https://github.com/jib/cpanplus-devel diff -Nru libcpanplus-perl-0.9162/inc/bundle/Archive/Extract.pm libcpanplus-perl-0.9172/inc/bundle/Archive/Extract.pm --- libcpanplus-perl-0.9162/inc/bundle/Archive/Extract.pm 2017-01-15 10:52:18.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/Archive/Extract.pm 2017-04-12 08:29:25.000000000 +0000 @@ -48,7 +48,7 @@ $_ALLOW_BIN $_ALLOW_PURE_PERL $_ALLOW_TAR_ITER ]; -$VERSION = '0.78'; +$VERSION = '0.80'; $PREFER_BIN = 0; $WARN = 1; $DEBUG = 0; @@ -135,7 +135,7 @@ $PROGRAMS->{$pgm} = $unzip; next CMD; } - if ( $pgm eq 'unzip' and ON_FREEBSD ) { + if ( $pgm eq 'unzip' and ( ON_FREEBSD || ON_LINUX ) ) { local $IPC::Cmd::INSTANCES = 1; ($PROGRAMS->{$pgm}) = grep { _is_infozip_esque($_) } can_run($pgm); next CMD; @@ -145,13 +145,6 @@ ($PROGRAMS->{$pgm}) = grep { m!/usr/pkg/! } can_run($pgm); next CMD; } - if ( $pgm eq 'unzip' and ON_LINUX ) { - # Check if 'unzip' is busybox masquerading - local $IPC::Cmd::INSTANCES = 1; - my $opt = ON_VMS ? '"-Z"' : '-Z'; - ($PROGRAMS->{$pgm}) = grep { scalar run(command=> [ $_, $opt, '-1' ]) } can_run($pgm); - next CMD; - } if ( $pgm eq 'tar' and ( ON_OPENBSD || ON_SOLARIS || ON_NETBSD ) ) { # try gtar first next CMD if $PROGRAMS->{$pgm} = can_run('gtar'); diff -Nru libcpanplus-perl-0.9162/inc/bundle/Archive/Tar/Constant.pm libcpanplus-perl-0.9172/inc/bundle/Archive/Tar/Constant.pm --- libcpanplus-perl-0.9162/inc/bundle/Archive/Tar/Constant.pm 2017-01-15 10:52:19.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/Archive/Tar/Constant.pm 2017-05-14 13:08:18.000000000 +0000 @@ -3,7 +3,7 @@ BEGIN { require Exporter; - $VERSION = '2.24'; + $VERSION = '2.26'; @ISA = qw[Exporter]; require Time::Local if $^O eq "MacOS"; diff -Nru libcpanplus-perl-0.9162/inc/bundle/Archive/Tar/File.pm libcpanplus-perl-0.9172/inc/bundle/Archive/Tar/File.pm --- libcpanplus-perl-0.9162/inc/bundle/Archive/Tar/File.pm 2017-01-15 10:52:19.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/Archive/Tar/File.pm 2017-05-14 13:08:18.000000000 +0000 @@ -13,7 +13,7 @@ use vars qw[@ISA $VERSION]; #@ISA = qw[Archive::Tar]; -$VERSION = '2.24'; +$VERSION = '2.26'; ### set value to 1 to oct() it during the unpack ### diff -Nru libcpanplus-perl-0.9162/inc/bundle/Archive/Tar.pm libcpanplus-perl-0.9172/inc/bundle/Archive/Tar.pm --- libcpanplus-perl-0.9162/inc/bundle/Archive/Tar.pm 2017-01-15 10:52:19.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/Archive/Tar.pm 2017-05-14 13:08:18.000000000 +0000 @@ -31,7 +31,7 @@ $DEBUG = 0; $WARN = 1; $FOLLOW_SYMLINK = 0; -$VERSION = "2.24"; +$VERSION = "2.26"; $CHOWN = 1; $CHMOD = 1; $SAME_PERMISSIONS = $> == 0 ? 1 : 0; @@ -1756,7 +1756,8 @@ sub iter { my $class = shift; - my $filename = shift or return; + my $filename = shift; + return unless defined $filename; my $compressed = shift || 0; my $opts = shift || {}; diff -Nru libcpanplus-perl-0.9162/inc/bundle/File/Fetch.pm libcpanplus-perl-0.9172/inc/bundle/File/Fetch.pm --- libcpanplus-perl-0.9162/inc/bundle/File/Fetch.pm 2017-01-15 10:52:19.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/File/Fetch.pm 2017-10-09 11:13:58.000000000 +0000 @@ -22,7 +22,7 @@ $FTP_PASSIVE $TIMEOUT $DEBUG $WARN $FORCEIPV4 ]; -$VERSION = '0.52'; +$VERSION = '0.54'; $VERSION = eval $VERSION; # avoid warnings with development releases $PREFER_BIN = 0; # XXX TODO implement $FROM_EMAIL = 'File-Fetch@example.com'; diff -Nru libcpanplus-perl-0.9162/inc/bundle/IPC/Cmd.pm libcpanplus-perl-0.9172/inc/bundle/IPC/Cmd.pm --- libcpanplus-perl-0.9162/inc/bundle/IPC/Cmd.pm 2017-01-15 10:52:19.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/IPC/Cmd.pm 2017-05-14 13:08:18.000000000 +0000 @@ -18,7 +18,7 @@ $HAVE_MONOTONIC ]; - $VERSION = '0.96'; + $VERSION = '0.98'; $VERBOSE = 0; $DEBUG = 0; $WARN = 1; @@ -242,7 +242,7 @@ } else { for my $dir ( File::Spec->path, - File::Spec->curdir + ( IS_WIN32 ? File::Spec->curdir : () ) ) { next if ! $dir || ! -d $dir; my $abs = File::Spec->catfile( IS_WIN32 ? Win32::GetShortPathName( $dir ) : $dir, $command); @@ -742,6 +742,29 @@ Coderef of a subroutine to call when a portion of data is received on STDERR from the executing program. +=item C + +Coderef of a subroutine to call inside of the main waiting loop +(while C waits for the external to finish or fail). +It is useful to stop running external process before it ends +by itself, e.g. + + my $r = run_forked("some external command", { + 'wait_loop_callback' => sub { + if (condition) { + kill(1, $$); + } + }, + 'terminate_on_signal' => 'HUP', + }); + +Combined with C and C allows terminating +external command based on its output. Could also be used as a timer +without engaging with L (signals). + +Remember that this code could be called every millisecond (depending +on the output which external command generates), so try to make it +as lightweight as possible. =item C @@ -1075,6 +1098,10 @@ push @{$ready_fds}, $select->can_read(1/100) if $child_finished; } + if ($opts->{'wait_loop_callback'} && ref($opts->{'wait_loop_callback'}) eq 'CODE') { + $opts->{'wait_loop_callback'}->(); + } + Time::HiRes::usleep(1); } diff -Nru libcpanplus-perl-0.9162/inc/bundle/JSON/PP/Boolean.pm libcpanplus-perl-0.9172/inc/bundle/JSON/PP/Boolean.pm --- libcpanplus-perl-0.9162/inc/bundle/JSON/PP/Boolean.pm 2016-05-18 20:05:47.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/JSON/PP/Boolean.pm 2017-10-09 11:12:17.000000000 +0000 @@ -1,3 +1,19 @@ +package JSON::PP::Boolean; + +use strict; +use overload ( + "0+" => sub { ${$_[0]} }, + "++" => sub { $_[0] = ${$_[0]} + 1 }, + "--" => sub { $_[0] = ${$_[0]} - 1 }, + fallback => 1, +); + +$JSON::PP::Boolean::VERSION = '2.94'; + +1; + +__END__ + =head1 NAME JSON::PP::Boolean - dummy module providing JSON::PP::Boolean @@ -11,13 +27,6 @@ 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 diff -Nru libcpanplus-perl-0.9162/inc/bundle/JSON/PP.pm libcpanplus-perl-0.9172/inc/bundle/JSON/PP.pm --- libcpanplus-perl-0.9162/inc/bundle/JSON/PP.pm 2016-05-18 20:05:47.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/JSON/PP.pm 2017-10-09 11:12:17.000000000 +0000 @@ -4,14 +4,17 @@ use 5.005; use strict; -use base qw(Exporter); + +use Exporter (); +BEGIN { @JSON::PP::ISA = ('Exporter') } + use overload (); +use JSON::PP::Boolean; use Carp (); -use B (); #use Devel::Peek; -$JSON::PP::VERSION = '2.27400'; +$JSON::PP::VERSION = '2.94'; @JSON::PP::EXPORT = qw(encode_json decode_json from_json to_json); @@ -41,6 +44,13 @@ use constant P_ALLOW_UNKNOWN => 18; use constant OLD_PERL => $] < 5.008 ? 1 : 0; +use constant USE_B => 0; + +BEGIN { +if (USE_B) { + require B; +} +} BEGIN { my @xs_compati_bit_properties = qw( @@ -54,31 +64,31 @@ # Perl version check, Unicode handling is enabled? # Helper module sets @JSON::PP::_properties. - if ($] < 5.008 ) { + if ( OLD_PERL ) { 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); + my $property_id = 'P_' . uc($name); eval qq/ sub $name { my \$enable = defined \$_[1] ? \$_[1] : 1; if (\$enable) { - \$_[0]->{PROPS}->[$flag_name] = 1; + \$_[0]->{PROPS}->[$property_id] = 1; } else { - \$_[0]->{PROPS}->[$flag_name] = 0; + \$_[0]->{PROPS}->[$property_id] = 0; } \$_[0]; } sub get_$name { - \$_[0]->{PROPS}->[$flag_name] ? 1 : ''; + \$_[0]->{PROPS}->[$property_id] ? 1 : ''; } /; } @@ -89,16 +99,6 @@ # 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 @@ -129,9 +129,6 @@ 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, }; @@ -164,7 +161,7 @@ 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); + $self->indent(1)->space_before(1)->space_after(1); } else { $self->indent(0)->space_before(0)->space_after(0); @@ -196,14 +193,24 @@ sub filter_json_object { - $_[0]->{cb_object} = defined $_[1] ? $_[1] : 0; + if (defined $_[1] and ref $_[1] eq 'CODE') { + $_[0]->{cb_object} = $_[1]; + } else { + delete $_[0]->{cb_object}; + } $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0; $_[0]; } sub filter_json_single_key_object { - if (@_ > 1) { + if (@_ == 1 or @_ > 3) { + Carp::croak("Usage: JSON::PP::filter_json_single_key_object(self, key, callback = undef)"); + } + if (defined $_[2] and ref $_[2] eq 'CODE') { $_[0]->{cb_sk_object}->{$_[1]} = $_[2]; + } else { + delete $_[0]->{cb_sk_object}->{$_[1]}; + delete $_[0]->{cb_sk_object} unless %{$_[0]->{cb_sk_object} || {}}; } $_[0]->{F_HOOK} = ($_[0]->{cb_object} or $_[0]->{cb_sk_object}) ? 1 : 0; $_[0]; @@ -229,7 +236,8 @@ } sub allow_bigint { - Carp::carp("allow_bigint() is obsoleted. use allow_bignum() insted."); + Carp::carp("allow_bigint() is obsoleted. use allow_bignum() instead."); + $_[0]->allow_bignum; } ############################### @@ -269,11 +277,11 @@ $indent_count = 0; $depth = 0; - my $idx = $self->{PROPS}; + my $props = $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, + = @{$props}[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/}; @@ -287,7 +295,7 @@ } encode_error("hash- or arrayref expected (not a simple scalar, use allow_nonref to allow this)") - if(!ref $obj and !$idx->[ P_ALLOW_NONREF ]); + if(!ref $obj and !$props->[ P_ALLOW_NONREF ]); my $str = $self->object_to_json($obj); @@ -297,7 +305,7 @@ utf8::upgrade($str); } - if ($idx->[ P_SHRINK ]) { + if ($props->[ P_SHRINK ]) { utf8::downgrade($str, 1); } @@ -335,13 +343,14 @@ } return "$obj" if ( $bignum and _is_bignum($obj) ); - return $self->blessed_to_json($obj) if ($allow_blessed and $as_nonblessed); # will be removed. + if ($allow_blessed) { + return $self->blessed_to_json($obj) if ($as_nonblessed); # will be removed. + return 'null'; + } 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); @@ -365,15 +374,16 @@ 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 ) + push @res, $self->string_to_json( $k ) . $del - . ( $self->object_to_json( $obj->{$k} ) || $self->value_to_json( $obj->{$k} ) ); + . ( ref $obj->{$k} ? $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 : '' ) . '}'; + return '{}' unless @res; + return '{' . $pre . join( ",$pre", @res ) . $post . '}'; } @@ -387,36 +397,53 @@ my ($pre, $post) = $indent ? $self->_up_indent() : ('', ''); for my $v (@$obj){ - push @res, $self->object_to_json($v) || $self->value_to_json($v); + push @res, ref($v) ? $self->object_to_json($v) : $self->value_to_json($v); } --$depth; $self->_down_indent() if ($indent); - return '[' . ( @res ? $pre : '' ) . ( @res ? join( ",$pre", @res ) . $post : '' ) . ']'; + return '[]' unless @res; + return '[' . $pre . join( ",$pre", @res ) . $post . ']'; } + sub _looks_like_number { + my $value = shift; + if (USE_B) { + my $b_obj = B::svref_2object(\$value); + my $flags = $b_obj->FLAGS; + return 1 if $flags & ( B::SVp_IOK() | B::SVp_NOK() ) and !( $flags & B::SVp_POK() ); + return; + } else { + no warnings 'numeric'; + # detect numbers + # string & "" -> "" + # number & "" -> 0 (with warning) + # nan and inf can detect as numbers, so check with * 0 + return unless length((my $dummy = "") & $value); + return unless 0 + $value eq $value; + return 1 if $value * 0 == 0; + return -1; # inf/nan + } + } 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); + if (!$type) { + if (_looks_like_number($value)) { + return $value; + } + return $self->string_to_json($value); } elsif( blessed($value) and $value->isa('JSON::PP::Boolean') ){ return $$value == 1 ? 'true' : 'false'; } - elsif ($type) { + else { if ((overload::StrVal($value) =~ /=(\w+)/)[0]) { return $self->value_to_json("$value"); } @@ -428,25 +455,19 @@ : encode_error("cannot encode reference to scalar"); } - if ( $self->{PROPS}->[ P_ALLOW_UNKNOWN ] ) { - return 'null'; - } - else { - if ( $type eq 'SCALAR' or $type eq 'REF' ) { + 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 { + } + 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'; - } - } @@ -625,19 +646,27 @@ my $F_HOOK; - my $allow_bigint; # using Math::BigInt + my $allow_bignum; # using Math::BigInt/BigFloat my $singlequote; # loosely quoting my $loose; # my $allow_barekey; # bareKey - # $opt flag - # 0x00000001 .... decode_prefix - # 0x10000000 .... incr_parse + sub _detect_utf_encoding { + my $text = shift; + my @octets = unpack('C4', $text); + return 'unknown' unless defined $octets[3]; + return ( $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'; + } sub PP_decode_json { - my ($self, $opt); # $opt is an effective flag during this decode_json. + my ($self, $want_offset); - ($self, $text, $opt) = @_; + ($self, $text, $want_offset) = @_; ($at, $ch, $depth) = (0, '', 0); @@ -645,13 +674,19 @@ decode_error("malformed JSON string, neither array, object, number, string or atom"); } - my $idx = $self->{PROPS}; + my $props = $self->{PROPS}; - ($utf8, $relaxed, $loose, $allow_bigint, $allow_barekey, $singlequote) - = @{$idx}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE]; + ($utf8, $relaxed, $loose, $allow_bignum, $allow_barekey, $singlequote) + = @{$props}[P_UTF8, P_RELAXED, P_LOOSE .. P_ALLOW_SINGLEQUOTE]; if ( $utf8 ) { - utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry"); + $encoding = _detect_utf_encoding($text); + if ($encoding ne 'UTF-8' and $encoding ne 'unknown') { + require Encode; + Encode::from_to($text, $encoding, 'utf-8'); + } else { + utf8::downgrade( $text, 1 ) or Carp::croak("Wide character in subroutine entry"); + } } else { utf8::upgrade( $text ); @@ -672,27 +707,13 @@ ) 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? + decode_error("malformed JSON string, neither array, object, number, string or atom") unless 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 ) { + if ( !$props->[ 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); @@ -704,12 +725,11 @@ white(); # remove tail white space - if ( $ch ) { - return ( $result, $consumed ) if ($opt & 0x00000001); # all right if decode_prefix - decode_error("garbage after JSON object"); - } + return ( $result, $consumed ) if $want_offset; # all right if decode_prefix + + decode_error("garbage after JSON object") if defined $ch; - ( $opt & 0x00000001 ) ? ( $result, $consumed ) : $result; + $result; } @@ -730,13 +750,12 @@ } sub string { - my ($i, $s, $t, $u); my $utf16; my $is_utf8; ($is_valid_utf8, $utf8_len) = ('', 0); - $s = ''; # basically UTF8 flag on + my $s = ''; # basically UTF8 flag on if($ch eq '"' or ($singlequote and $ch eq "'")){ my $boundChar = $ch; @@ -836,10 +855,10 @@ sub white { while( defined $ch ){ - if($ch le ' '){ + if($ch eq '' or $ch =~ /\A[ \t\r\n]\z/){ next_chr(); } - elsif($ch eq '/'){ + elsif($relaxed and $ch eq '/'){ next_chr(); if(defined $ch and $ch eq '/'){ 1 while(defined(next_chr()) and $ch ne "\n" and $ch ne "\r"); @@ -930,6 +949,7 @@ } } + $at-- if defined $ch and $ch ne ''; decode_error(", or ] expected while parsing array"); } @@ -996,7 +1016,7 @@ } - $at--; + $at-- if defined $ch and $ch ne ''; decode_error(", or } expected while parsing object/hash"); } @@ -1046,32 +1066,7 @@ 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); - } - } + my $is_exp; if($ch eq '-'){ $n = '-'; @@ -1081,6 +1076,16 @@ } } + # According to RFC4627, hex or oct digits are invalid. + if($ch eq '0'){ + my $peek = substr($text,$at,1); + if($peek =~ /^[0-9a-dfA-DF]/){ # e may be valid (exponential) + decode_error("malformed number (leading zero must not be followed by another digit)"); + } + $n .= $ch; + next_chr; + } + while(defined $ch and $ch =~ /\d/){ $n .= $ch; next_chr; @@ -1105,6 +1110,7 @@ if(defined $ch and ($ch eq 'e' or $ch eq 'E')){ $n .= $ch; + $is_exp = 1; next_chr; if(defined($ch) and ($ch eq '+' or $ch eq '-')){ @@ -1130,19 +1136,22 @@ $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"; + if ($is_dec or $is_exp) { + if ($allow_bignum) { + require Math::BigFloat; + return Math::BigFloat->new($v); + } + } else { + if (length $v > $max_intsize) { + if ($allow_bignum) { # 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; } @@ -1180,11 +1189,14 @@ 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*' - ; + my $type = 'U*'; + + if ( OLD_PERL ) { + my $type = $] < 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' @@ -1275,26 +1287,26 @@ *utf8::is_utf8 = *Encode::is_utf8; } - if ( $] >= 5.008 ) { + if ( !OLD_PERL ) { *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; - } - |; + if ($] < 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; + } + |; + } } @@ -1317,7 +1329,7 @@ sub JSON::PP::incr_text : lvalue { $_[0]->{_incr_parser} ||= JSON::PP::IncrParser->new; - if ( $_[0]->{_incr_parser}->{incr_parsing} ) { + if ( $_[0]->{_incr_parser}->{incr_pos} ) { Carp::croak("incr_text cannot be called when the incremental parser already started parsing"); } $_[0]->{_incr_parser}->{incr_text}; @@ -1338,13 +1350,14 @@ *JSON::PP::reftype = \&Scalar::Util::reftype; *JSON::PP::refaddr = \&Scalar::Util::refaddr; } - else{ # This code is from Sclar::Util. + else{ # This code is from Scalar::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; }; + require B; my %tmap = qw( B::NULL SCALAR B::HV HASH @@ -1400,18 +1413,6 @@ ############################### -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; @@ -1425,16 +1426,14 @@ $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, + incr_pos => 0, + incr_mode => 0, }, $class; } @@ -1452,122 +1451,150 @@ $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; - + my $max_size = $coder->get_max_size; + my $p = $self->{incr_pos}; + my @ret; + { do { - push @ret, $self->_incr_parse( $coder, $self->{incr_text} ); + unless ( $self->{incr_nest} <= 0 and $self->{incr_mode} == INCR_M_JSON ) { + $self->_incr_parse( $coder ); - unless ( !$self->{incr_nest} and $self->{incr_mode} == INCR_M_JSON ) { - $self->{incr_mode} = INCR_M_WS if $self->{incr_mode} != INCR_M_STR; + if ( $max_size and $self->{incr_pos} > $max_size ) { + Carp::croak("attempted decode of JSON text of $self->{incr_pos} bytes size, but max_size is set to $max_size"); + } + unless ( $self->{incr_nest} <= 0 and $self->{incr_mode} == INCR_M_JSON ) { + # as an optimisation, do not accumulate white space in the incr buffer + if ( $self->{incr_mode} == INCR_M_WS and $self->{incr_pos} ) { + $self->{incr_pos} = 0; + $self->{incr_text} = ''; + } + last; + } } - } until ( length $self->{incr_text} >= $self->{incr_p} ); - - $self->{incr_parsing} = 0; + my ($obj, $offset) = $coder->PP_decode_json( $self->{incr_text}, 0x00000001 ); + push @ret, $obj; + use bytes; + $self->{incr_text} = substr( $self->{incr_text}, $offset || 0 ); + $self->{incr_pos} = 0; + $self->{incr_nest} = 0; + $self->{incr_mode} = 0; + last unless wantarray; + } while ( wantarray ); + } + if ( wantarray ) { 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. + return $ret[0] ? $ret[0] : undef; } - } - } sub _incr_parse { - my ( $self, $coder, $text, $skip ) = @_; - my $p = $self->{incr_p}; - my $restore = $p; - - my @obj; + my ($self, $coder) = @_; + my $text = $self->{incr_text}; my $len = length $text; + my $p = $self->{incr_pos}; - 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; - } - } - +INCR_PARSE: 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; + my $s = substr( $text, $p, 1 ); + last INCR_PARSE unless defined $s; + my $mode = $self->{incr_mode}; + + if ( $mode == INCR_M_WS ) { + while ( $len > $p ) { + $s = substr( $text, $p, 1 ); + last INCR_PARSE unless defined $s; + if ( ord($s) > 0x20 ) { + if ( $s eq '#' ) { + $self->{incr_mode} = INCR_M_C0; + redo INCR_PARSE; + } else { + $self->{incr_mode} = INCR_M_JSON; + redo INCR_PARSE; + } + } + $p++; } - else { - $self->{incr_mode} = INCR_M_JSON; - unless ( $self->{incr_nest} ) { + } elsif ( $mode == INCR_M_BS ) { + $p++; + $self->{incr_mode} = INCR_M_STR; + redo INCR_PARSE; + } elsif ( $mode == INCR_M_C0 or $mode == INCR_M_C1 ) { + while ( $len > $p ) { + $s = substr( $text, $p, 1 ); + last INCR_PARSE unless defined $s; + if ( $s eq "\n" ) { + $self->{incr_mode} = $self->{incr_mode} == INCR_M_C0 ? INCR_M_WS : INCR_M_JSON; last; } + $p++; } - } - - 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?)'); + next; + } elsif ( $mode == INCR_M_STR ) { + while ( $len > $p ) { + $s = substr( $text, $p, 1 ); + last INCR_PARSE unless defined $s; + if ( $s eq '"' ) { + $p++; + $self->{incr_mode} = INCR_M_JSON; + + last INCR_PARSE unless $self->{incr_nest}; + redo INCR_PARSE; + } + elsif ( $s eq '\\' ) { + $p++; + if ( !defined substr($text, $p, 1) ) { + $self->{incr_mode} = INCR_M_BS; + last INCR_PARSE; + } } + $p++; } - 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"; + } elsif ( $mode == INCR_M_JSON ) { + while ( $len > $p ) { + $s = substr( $text, $p++, 1 ); + if ( $s eq "\x00" ) { + $p--; + last INCR_PARSE; + } elsif ( $s eq "\x09" or $s eq "\x0a" or $s eq "\x0d" or $s eq "\x20" ) { + if ( !$self->{incr_nest} ) { + $p--; # do not eat the whitespace, let the next round do it + last INCR_PARSE; + } + next; + } elsif ( $s eq '"' ) { + $self->{incr_mode} = INCR_M_STR; + redo INCR_PARSE; + } elsif ( $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?)'); + } + next; + } elsif ( $s eq ']' or $s eq '}' ) { + if ( --$self->{incr_nest} <= 0 ) { + last INCR_PARSE; + } + } elsif ( $s eq '#' ) { + $self->{incr_mode} = INCR_M_C1; + redo INCR_PARSE; } } - } - } - $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 || ''; + $self->{incr_pos} = $p; + $self->{incr_parsing} = $p ? 1 : 0; # for backward compatibility } sub incr_text { - if ( $_[0]->{incr_parsing} ) { + if ( $_[0]->{incr_pos} ) { Carp::croak("incr_text cannot be called when the incremental parser already started parsing"); } $_[0]->{incr_text}; @@ -1576,18 +1603,19 @@ sub incr_skip { my $self = shift; - $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_c} ); - $self->{incr_p} = 0; + $self->{incr_text} = substr( $self->{incr_text}, $self->{incr_pos} ); + $self->{incr_pos} = 0; + $self->{incr_mode} = 0; + $self->{incr_nest} = 0; } sub incr_reset { my $self = shift; $self->{incr_text} = undef; - $self->{incr_p} = 0; + $self->{incr_pos} = 0; $self->{incr_mode} = 0; $self->{incr_nest} = 0; - $self->{incr_parsing} = 0; } ############################### @@ -1613,13 +1641,11 @@ # OO-interface - $coder = JSON::PP->new->ascii->pretty->allow_nonref; + $json = JSON::PP->new->ascii->pretty->allow_nonref; - $json_text = $json->encode( $perl_scalar ); + $pretty_printed_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: @@ -1628,81 +1654,61 @@ =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. + 2.91_04 =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 +JSON::PP is a pure perl JSON decoder/encoder (as of RFC4627, which +we know is obsolete but we still stick to; see below for an option +to support part of RFC7159), and (almost) compatible to much +faster L written by Marc Lehmann in C. JSON::PP works as +a fallback module when you use L module without having +installed JSON::XS. + +Because of this fallback feature of JSON.pm, JSON::PP tries not to +be more JavaScript-friendly than JSON::XS (i.e. not to escape extra +characters such as U+2028 and U+2029 nor support RFC7159/ECMA-404), +in order for you not to lose such JavaScript-friendliness silently +when you use JSON.pm and install JSON::XS for speed or by accident. +If you need JavaScript-friendly RFC7159-compliant pure perl module, +try L, which is derived from L web +framework and is also smaller and faster than JSON::PP. -=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 +JSON::PP has been in the Perl core since Perl 5.14, mainly for +CPAN toolchain modules to parse META.json. =head1 FUNCTIONAL INTERFACE -Some documents are copied and modified from L. +This section is taken from JSON::XS almost verbatim. C +and C are exported by default. =head2 encode_json $json_text = encode_json $perl_scalar -Converts the given Perl data structure to a UTF-8 encoded, binary string. +Converts the given Perl data structure to a UTF-8 encoded, binary string +(that is, the string contains octets only). Croaks on error. This function call is functionally identical to: $json_text = JSON::PP->new->utf8->encode($perl_scalar) +Except being faster. + =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. +reference. Croaks on error. This function call is functionally identical to: $perl_scalar = JSON::PP->new->utf8->decode($json_text) +Except being faster. + =head2 JSON::PP::is_bool $is_boolean = JSON::PP::is_bool($scalar) @@ -1711,114 +1717,24 @@ 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 OBJECT-ORIENTED INTERFACE -=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. +This section is also taken from JSON::XS. -See to L, L. - - -=head1 METHODS - -Basically, check to L or L. +The object oriented interface lets you configure your own encoding or +decoding style, within the limits of supported formats. =head2 new $json = JSON::PP->new -Returns a new JSON::PP object that can be used to de/encode JSON -strings. +Creates a new JSON::PP object that can be used to de/encode JSON +strings. All boolean flags described below are by default I. -All boolean flags described below are by default I. - -The mutators for flags all return the JSON object again and thus calls can +The mutators for flags all return the JSON::PP object again and thus calls can be chained: my $json = JSON::PP->new->utf8->space_after->encode({a => [1,2]}) @@ -1830,16 +1746,23 @@ $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. +If C<$enable> is true (or missing), then the C method will not +generate characters outside the code range C<0..127> (which is ASCII). Any +Unicode characters outside that range will be escaped using either a +single \uXXXX (BMP characters) or a double \uHHHH\uLLLLL escape sequence, +as per RFC4627. The resulting encoded JSON text can be treated as a native +Unicode string, an ascii-encoded, latin1-encoded or UTF-8 encoded string, +or any other superset of ASCII. + +If C<$enable> is false, then the C method will not escape Unicode +characters unless required by the JSON syntax or other flags. This results +in a faster and more compact format. + +See also the section I later in this document. + +The main use for this flag is to produce JSON texts that can be +transmitted over a 7-bit channel, as the encoded JSON texts will not +contain any 8 bit characters. JSON::PP->new->ascii(1)->encode([chr 0x10401]) => ["\ud801\udc01"] @@ -1850,37 +1773,49 @@ $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. +If C<$enable> is true (or missing), then the C method will encode +the resulting JSON text as latin1 (or iso-8859-1), escaping any characters +outside the code range C<0..255>. The resulting string can be treated as a +latin1-encoded JSON text or a native Unicode string. The C method +will not be affected in any way by this flag, as C by default +expects Unicode, which is a strict superset of latin1. + +If C<$enable> is false, then the C method will not escape Unicode +characters unless required by the JSON syntax or other flags. + +See also the section I later in this document. + +The main use for this flag is efficiently encoding binary data as JSON +text, as most octets will not be escaped, resulting in a smaller encoded +size. The disadvantage is that the resulting JSON text is encoded +in latin1 (and must correctly be treated as such when storing and +transferring), a rare encoding for JSON. It is therefore most useful when +you want to store data structures known to contain binary data efficiently +in files or databases, not when talking to other JSON encoders/decoders. - JSON::XS->new->latin1->encode (["\x{89}\x{abc}"] + JSON::PP->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. +If C<$enable> is true (or missing), then the C method will encode +the JSON result into UTF-8, as required by many protocols, while the +C 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 C<0..255>, they are thus useful for bytewise/binary I/O. In future +versions, enabling this option might enable autodetection of the UTF-16 +and UTF-32 encoding families, as described in RFC4627. + +If C<$enable> is false, then the C method will return the JSON +string as a (non-encoded) Unicode string, while C 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. + +See also the section I later in this document. Example, output UTF-16BE-encoded JSON: @@ -1892,18 +1827,13 @@ 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 +C (and in the future possibly more) flags in one call to +generate the most readable (or most compact) form possible. =head2 indent @@ -1911,6 +1841,15 @@ $enabled = $json->get_indent +If C<$enable> is true (or missing), then the C method will use a multiline +format as output, putting every array member or object/hash key-value pair +into its own line, indenting them properly. + +If C<$enable> is false, no newlines or indenting will be produced, and the +resulting JSON text is guaranteed not to contain any C. + +This setting has no effect when decoding JSON texts. + The default indent space length is three. You can use C to change the length. @@ -1926,7 +1865,8 @@ 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. +This setting has no effect when decoding JSON texts. You will also +most likely combine this setting with C. Example, space_before enabled, space_after and indent disabled: @@ -1999,6 +1939,28 @@ # neither this one... ] +=item * C-style multiple-line '/* */'-comments (JSON::PP only) + +Whenever JSON allows whitespace, C-style multiple-line comments are additionally +allowed. Everything between C and C<*/> is a comment, after which +more white-space and comments are allowed. + + [ + 1, /* this comment not allowed in JSON */ + /* neither this one... */ + ] + +=item * C++-style one-line '//'-comments (JSON::PP only) + +Whenever JSON allows whitespace, C++-style one-line 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 @@ -2012,7 +1974,8 @@ 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). +of the same script, and can change even within the same run from 5.18 +onwards). 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, @@ -2021,8 +1984,7 @@ 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. +This setting has currently no effect on tied hashes. =head2 allow_nonref @@ -2040,6 +2002,9 @@ or array. Likewise, C will croak if given something that is not a JSON object or array. +Example, encode a Perl scalar as JSON value with enabled C, +resulting in an invalid JSON text: + JSON::PP->new->allow_nonref->encode ("Hello, World!") => "Hello, World!" @@ -2049,18 +2014,17 @@ $enabled = $json->get_allow_unknown -If $enable is true (or missing), then "encode" will *not* throw an +If C<$enable> is true (or missing), then C will I 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. +example, filehandles) but instead will encode a JSON C 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 +If C<$enable> is false (the default), then C 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. +This option does not affect C in any way, and it is recommended to +leave it off unless you know your communications partner. =head2 allow_blessed @@ -2068,15 +2032,17 @@ $enabled = $json->get_allow_blessed +See L for details. + 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. +barf when it encounters a blessed reference that it cannot convert +otherwise. Instead, a JSON C value is encoded instead of the object. If C<$enable> is false (the default), then C will throw an -exception when it encounters a blessed object. +exception when it encounters a blessed object that it cannot convert +otherwise. + +This setting has no effect on C. =head2 convert_blessed @@ -2084,38 +2050,38 @@ $enabled = $json->get_convert_blessed +See L for details. + 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. +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. 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 +usually in upper case letters and to avoid collisions with any C function or method. -This setting does not yet influence C in any way. +If C<$enable> is false (the default), then C will not consider +this type of conversion. -If C<$enable> is false, then the C setting will decide what -to do when a blessed object is found. +This setting has no effect on C. =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. +time it decodes a JSON object. The only argument 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 @@ -2190,15 +2156,13 @@ $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. +If C<$enable> is true (or missing), the string returned by C will +be shrunk (i.e. downgraded if possible). + +The actual definition of what shrink does might change in future versions, +but it will always try to save space at the expense of time. -See to L +If C<$enable> is false, then JSON::PP does nothing. =head2 max_depth @@ -2216,14 +2180,14 @@ characters without their matching closing parenthesis crossed to reach a given character in a string. +Setting the maximum depth to one disallows any nesting, so that ensures +that the object is only a single hash/object or array. + 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]) @@ -2245,12 +2209,8 @@ $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. +Converts the given Perl value or data structure to its JSON +representation. Croaks on error. =head2 decode @@ -2259,11 +2219,6 @@ 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) @@ -2273,25 +2228,185 @@ silently stop parsing there and return the number of characters consumed so far. - JSON->new->decode_prefix ("[1] the tail") - => ([], 3) +This is useful if your JSON texts are not delimited by an outer protocol +and you need to know where the JSON text ends. + + JSON::PP->new->decode_prefix ("[1] the tail") + => ([1], 3) + +=head1 FLAGS FOR JSON::PP ONLY + +The following flags and properties are for JSON::PP only. If you use +any of these, you can't make your application run faster by replacing +JSON::PP with JSON::XS. If you need these and also speed boost, +try L, a fork of JSON::XS by Reini Urban, which +supports some of these. + +=head2 allow_singlequote + + $json = $json->allow_singlequote([$enable]) + $enabled = $json->get_allow_singlequote + +If C<$enable> is true (or missing), then C will accept +invalid JSON texts that contain strings that begin and end with +single quotation marks. 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. + + $json->allow_singlequote->decode(qq|{"foo":'bar'}|); + $json->allow_singlequote->decode(qq|{'foo':"bar"}|); + $json->allow_singlequote->decode(qq|{'foo':'bar'}|); + +=head2 allow_barekey + + $json = $json->allow_barekey([$enable]) + $enabled = $json->get_allow_barekey + +If C<$enable> is true (or missing), then C will accept +invalid JSON texts that contain JSON objects whose names don't +begin and end with quotation marks. 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. + + $json->allow_barekey->decode(qq|{foo:"bar"}|); + +=head2 allow_bignum + + $json = $json->allow_bignum([$enable]) + $enabled = $json->get_allow_bignum + +If C<$enable> is true (or missing), then C will convert +big integers Perl cannot handle as integer into L +objects and convert floating numbers into L +objects. C will convert C and C +objects into JSON numbers. + + $json->allow_nonref->allow_bignum; + $bigfloat = $json->decode('2.000000000000000000000000001'); + print $json->encode($bigfloat); + # => 2.000000000000000000000000001 + +See also L. + +=head2 loose + + $json = $json->loose([$enable]) + $enabled = $json->get_loose + +If C<$enable> is true (or missing), then C will accept +invalid JSON texts that contain unescaped [\x00-\x1f\x22\x5c] +characters. 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. + + $json->loose->decode(qq|["abc + def"]|); + +=head2 escape_slash + + $json = $json->escape_slash([$enable]) + $enabled = $json->get_escape_slash + +If C<$enable> is true (or missing), then C will explicitly +escape I (solidus; C) characters to reduce the risk of +XSS (cross site scripting) that may be caused by C<< >> +in a JSON text, with the cost of bloating the size of JSON texts. + +This option may be useful when you embed JSON in HTML, but embedding +arbitrary JSON in HTML (by some HTML template toolkit or by string +interpolation) is risky in general. You must escape necessary +characters in correct order, depending on the context. + +C will not be affected in anyway. + +=head2 indent_length + + $json = $json->indent_length($number_of_spaces) + $length = $json->get_indent_length + +This option is only useful when you also enable C or C. + +JSON::XS indents with three spaces when you C (if requested +by C or C), and the number cannot be changed. +JSON::PP allows you to change/get the number of indent spaces with these +mutator/accessor. The default number of spaces is three (the same as +JSON::XS), and the acceptable range is from C<0> (no indentation; +it'd be better to disable indentation by C) to C<15>. + +=head2 sort_by + + $json = $json->sort_by($code_ref) + $json = $json->sort_by($subroutine_name) + +If you just want to sort keys (names) in JSON objects when you +C, enable C option (see above) that allows you to +sort object keys alphabetically. + +If you do need to sort non-alphabetically for whatever reasons, +you can give a code reference (or a subroutine name) to C, +then the argument will be passed to Perl's C built-in function. + +As the sorting is done in the JSON::PP scope, you usually need to +prepend C to the subroutine name, and the special variables +C<$a> and C<$b> used in the subrontine used by C function. + +Example: + + my %ORDER = (id => 1, class => 2, name => 3); + $json->sort_by(sub { + ($ORDER{$JSON::PP::a} // 999) <=> ($ORDER{$JSON::PP::b} // 999) + or $JSON::PP::a cmp $JSON::PP::b + }); + print $json->encode([ + {name => 'CPAN', id => 1, href => 'http://cpan.org'} + ]); + # [{"id":1,"name":"CPAN","href":"http://cpan.org"}] + +Note that C affects all the plain hashes in the data structure. +If you need finer control, C necessary hashes with a module that +implements ordered hash (such as L and L). +C and C don't affect the key order in Cd +hashes. + + use Hash::Ordered; + tie my %hash, 'Hash::Ordered', + (name => 'CPAN', id => 1, href => 'http://cpan.org'); + print $json->encode([\%hash]); + # [{"name":"CPAN","id":1,"href":"http://cpan.org"}] # order is kept =head1 INCREMENTAL PARSING -Most of this section are copied and modified from L. +This section is also taken from JSON::XS. -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). +In some cases, there is the need for incremental parsing of JSON +texts. While this module always has to keep both JSON text and resulting +Perl data structure in memory at one time, it 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 +JSON::PP 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 +early as the full parser, for example, it doesn't detect mismatched +parentheses. 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. @@ -2326,15 +2441,16 @@ 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. +otherwise. For this to work, there must be no separators (other than +whitespace) 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. +Example: Parse some JSON arrays/objects in a given string and return +them. - my @objs = JSON->new->incr_parse ("[5][7][1,2]"); + my @objs = JSON::PP->new->incr_parse ("[5][7][1,2]"); =head2 incr_text @@ -2348,27 +2464,26 @@ real world conditions). As a special exception, you can also call this method before having parsed anything. +That means you can only use this function to look at or manipulate text +before or after complete JSON objects, not while the parser is in the +middle of parsing a JSON object. + 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. +This will reset the state of the incremental parser and will remove +the parsed text from the input buffer so far. 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. + +The difference to C is that only text until the parse error +occurred is removed. =head2 incr_reset @@ -2381,148 +2496,18 @@ 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. +Most of this section is also taken from JSON::XS. -See to L. +This section describes how JSON::PP maps Perl values to JSON values and +vice versa. These mappings are designed to "do the right thing" in most +circumstances automatically, preserving round-tripping characteristics +(what you put in comes out as something equivalent). + +For the more enlightened: note that in the following descriptions, +lowercase I refers to the Perl interpreter, while uppercase I +refers to the abstract Perl language itself. =head2 JSON -> PERL @@ -2531,7 +2516,7 @@ =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). +keys is preserved (JSON does not preserve object key ordering itself). =item array @@ -2551,7 +2536,7 @@ 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 +If the number consists of digits only, JSON::PP 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 @@ -2565,36 +2550,30 @@ 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 +floating point, JSON::PP 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. +When C is enabled, big integer values and any numeric +values will be converted into L and L +objects respectively, without becoming string scalars or losing +precision. =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. - +the C function. =item null A JSON null atom becomes C in Perl. -C returns C. +=item shell-style comments (C<< # I >>) + +As a nonstandard extension to the JSON syntax that is enabled by the +C setting, shell-style comments are allowed. They can start +anywhere outside strings and go till the end of the line. =back @@ -2609,16 +2588,14 @@ =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. - +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. JSON::PP can optionally sort the hash keys +(determined by the I flag and/or I property), so +the same data structure will serialise to the same JSON text (given +same settings and version of JSON::PP), 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 @@ -2629,31 +2606,30 @@ 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. +also use C and C to improve +readability. - to_json [\0,JSON::PP::true] # yields [false,true] + to_json [\0, JSON::PP::true] # yields [false,true] -=item JSON::PP::true, JSON::PP::false, JSON::PP::null +=item JSON::PP::true, JSON::PP::false 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 JSON::PP::null -=item blessed objects +This special value becomes JSON null. -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. +=item blessed objects -See to L. +Blessed objects are not directly representable in JSON, but C +allows various ways of handling objects. See L, +below, for details. =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 +difficult objects to encode: 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: @@ -2675,6 +2651,7 @@ "$x"; # stringified $x .= ""; # another, more awkward way to stringify print $x; # perl does it for you, too, quite often + # (but for older perls) You can force the type to be a number by numifying it: @@ -2691,94 +2668,171 @@ 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. - +JSON::PP (and JSON::XS) trusts what you pass to C method +(or C function) is a clean, validated data structure with +values that can be represented as valid JSON values only, because it's +not from an external data source (as opposed to JSON texts you pass to +C or C, which JSON::PP considers tainted and +doesn't trust). As JSON::PP doesn't know exactly what you and consumers +of your JSON texts want the unexpected values to be (you may want to +convert them into null, or to stringify them with or without +normalisation (string representation of infinities/NaN may vary +depending on platforms), or to croak without conversion), you're advised +to do what you and your consumers need before you encode, and also not +to numify values that may start with values that look like a number +(including infinities/NaN), without validating. =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. +=head2 OBJECT SERIALISATION - $json->allow_nonref->decode('"\u3042"'); - $json->allow_nonref->decode('"\ud808\udf45"'); +As for Perl objects, JSON::PP only supports a pure JSON representation (without the ability to deserialise the object automatically again). -Returns UTF-8 encoded strings with UTF8 flag, regarded as C and C. +=head3 SERIALISATION -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. +What happens when C encounters a Perl object depends on the +C, C and C settings, which are +used in this order: +=over 4 -=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 : +=item 1. C is enabled and the object has a C method. - $json->allow_nonref->encode(chr 66); - $json->allow_nonref->encode(chr 69); +In this case, the C method of the object is invoked in scalar +context. It must return a single scalar that can be directly encoded into +JSON. This scalar replaces the object in the JSON text. + +For example, the following C method will convert all L +objects to JSON strings when serialised. The fact that these values +originally were L objects is lost. + + sub URI::TO_JSON { + my ($uri) = @_; + $uri->as_string + } -In decoding, +=item 2. C is enabled and the object is a C or C. - $json->decode('"\u00e3\u0081\u0082"'); +The object will be serialised as a JSON number value. -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. +=item 3. C is enabled. -Next, +The object will be serialised as a JSON null value. - $json->decode('"\u3042"'); +=item 4. none of the above -We ordinary expect the returned value is a Unicode character C. -But here is 5.005 world. This is C<0xE3 0x81 0x82>. +If none of the settings are enabled or the respective methods are missing, +C throws an exception. - $json->decode('"\ud808\udf45"'); +=back -This is not a character C but bytes - C<0xf0 0x92 0x8d 0x85>. +=head1 ENCODING/CODESET FLAG NOTES +This section is taken from JSON::XS. -=head1 TODO +The interested reader might have seen a number of flags that signify +encodings or codesets - C, C and C. There seems to be +some confusion on what these do, so here is a short comparison: + +C controls whether the JSON text created by C (and expected +by C) is UTF-8 encoded or not, while C and C only +control whether C escapes character values outside their respective +codeset range. Neither of these flags conflict with each other, although +some combinations make less sense than others. + +Care has been taken to make all flags symmetrical with respect to +C and C, that is, texts encoded with any combination of +these flag values will be correctly decoded when the same flags are used +- in general, if you use different flag settings while encoding vs. when +decoding you likely have a bug somewhere. + +Below comes a verbose discussion of these flags. Note that a "codeset" is +simply an abstract set of character-codepoint pairs, while an encoding +takes those codepoint numbers and I them, in our case into +octets. Unicode is (among other things) a codeset, UTF-8 is an encoding, +and ISO-8859-1 (= latin 1) and ASCII are both codesets I encodings at +the same time, which can be confusing. -=over +=over 4 -=item speed +=item C flag disabled -=item memory saving +When C is disabled (the default), then C/C generate +and expect Unicode strings, that is, characters with high ordinal Unicode +values (> 255) will be encoded as such characters, and likewise such +characters are decoded as-is, no changes to them will be done, except +"(re-)interpreting" them as Unicode codepoints or Unicode characters, +respectively (to Perl, these are the same thing in strings unless you do +funny/weird/dumb stuff). + +This is useful when you want to do the encoding yourself (e.g. when you +want to have UTF-16 encoded JSON texts) or when some other layer does +the encoding for you (for example, when printing to a terminal using a +filehandle that transparently encodes to UTF-8 you certainly do NOT want +to UTF-8 encode your data first and have Perl encode it another time). + +=item C flag enabled + +If the C-flag is enabled, C/C will encode all +characters using the corresponding UTF-8 multi-byte sequence, and will +expect your input strings to be encoded as UTF-8, that is, no "character" +of the input string must have any value > 255, as UTF-8 does not allow +that. + +The C flag therefore switches between two modes: disabled means you +will get a Unicode string in Perl, enabled means you get an UTF-8 encoded +octet/binary string in Perl. + +=item C or C flags enabled + +With C (or C) enabled, C will escape characters +with ordinal values > 255 (> 127 with C) and encode the remaining +characters as specified by the C flag. + +If C is disabled, then the result is also correctly encoded in those +character sets (as both are proper subsets of Unicode, meaning that a +Unicode string with all character values < 256 is the same thing as a +ISO-8859-1 string, and a Unicode string with all character values < 128 is +the same thing as an ASCII string in Perl). + +If C is enabled, you still get a correct UTF-8-encoded string, +regardless of these flags, just some more characters will be escaped using +C<\uXXXX> then before. + +Note that ISO-8859-1-I strings are not compatible with UTF-8 +encoding, while ASCII-encoded strings are. That is because the ISO-8859-1 +encoding is NOT a subset of UTF-8 (despite the ISO-8859-1 I being +a subset of Unicode), while ASCII is. + +Surprisingly, C will ignore these flags and so treat all input +values as governed by the C flag. If it is disabled, this allows you +to decode ISO-8859-1- and ASCII-encoded strings, as both strict subsets of +Unicode. If it is enabled, you can correctly decode UTF-8 encoded strings. + +So neither C nor C are incompatible with the C flag - +they only govern when the JSON output engine escapes a character or not. + +The main use for C is to relatively efficiently store binary data +as JSON, at the expense of breaking compatibility with most JSON decoders. + +The main use for C is to force the output to not contain characters +with values > 127, which means you can interpret the resulting string +as UTF-8, ISO-8859-1, ASCII, KOI8-R or most about any character set and +8-bit-encoding, and still get the same data structure back. This is useful +when your channel for JSON transfer is not 8-bit clean or the encoding +might be mangled in between (e.g. in mail), and works because ASCII is a +proper subset of most 8-bit and multibyte encodings in use in the world. =back - =head1 SEE ALSO -Most of the document are copied and modified from JSON::XS doc. +The F command line utility for quick experiments. + +L, L, and L for faster alternatives. +L and L for easy migration. -L +L and L for older perl users. RFC4627 (L) diff -Nru libcpanplus-perl-0.9162/inc/bundle/Module/CoreList/TieHashDelta.pm libcpanplus-perl-0.9172/inc/bundle/Module/CoreList/TieHashDelta.pm --- libcpanplus-perl-0.9162/inc/bundle/Module/CoreList/TieHashDelta.pm 2017-01-15 10:52:20.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/Module/CoreList/TieHashDelta.pm 2017-10-09 11:13:58.000000000 +0000 @@ -3,7 +3,7 @@ use strict; use vars qw($VERSION); -$VERSION = '5.20170115'; +$VERSION = '5.20170923'; sub TIEHASH { my ($class, $changed, $removed, $parent) = @_; diff -Nru libcpanplus-perl-0.9162/inc/bundle/Module/CoreList/Utils.pm libcpanplus-perl-0.9172/inc/bundle/Module/CoreList/Utils.pm --- libcpanplus-perl-0.9162/inc/bundle/Module/CoreList/Utils.pm 2017-01-15 10:52:20.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/Module/CoreList/Utils.pm 2017-10-09 11:13:58.000000000 +0000 @@ -5,7 +5,7 @@ use vars qw[$VERSION %utilities]; use Module::CoreList; -$VERSION = '5.20170115'; +$VERSION = '5.20170923'; sub utilities { my $perl = shift; @@ -1224,6 +1224,106 @@ changed => { }, removed => { + } + }, + 5.025009 => { + delta_from => 5.025008, + changed => { + }, + removed => { + 'c2ph' => 1, + 'pstruct' => 1, + } + }, + 5.025010 => { + delta_from => 5.025009, + changed => { + }, + removed => { + } + }, + 5.025011 => { + delta_from => 5.025010, + changed => { + }, + removed => { + } + }, + 5.025012 => { + delta_from => 5.025011, + changed => { + }, + removed => { + } + }, + 5.026000 => { + delta_from => 5.025012, + changed => { + }, + removed => { + } + }, + 5.027000 => { + delta_from => 5.026000, + changed => { + }, + removed => { + } + }, + 5.027001 => { + delta_from => 5.027000, + changed => { + }, + removed => { + } + }, + 5.022004 => { + delta_from => 5.022003, + changed => { + }, + removed => { + } + }, + 5.024002 => { + delta_from => 5.024001, + changed => { + }, + removed => { + } + }, + 5.027002 => { + delta_from => 5.027001, + changed => { + }, + removed => { + } + }, + 5.027003 => { + delta_from => 5.027002, + changed => { + }, + removed => { + } + }, + 5.027004 => { + delta_from => 5.027003, + changed => { + }, + removed => { + } + }, + 5.024003 => { + delta_from => 5.024002, + changed => { + }, + removed => { + } + }, + 5.026001 => { + delta_from => 5.026000, + changed => { + }, + removed => { } }, ); diff -Nru libcpanplus-perl-0.9162/inc/bundle/Module/CoreList.pm libcpanplus-perl-0.9172/inc/bundle/Module/CoreList.pm --- libcpanplus-perl-0.9162/inc/bundle/Module/CoreList.pm 2017-01-15 10:52:20.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/Module/CoreList.pm 2017-10-09 11:13:58.000000000 +0000 @@ -3,7 +3,10 @@ use vars qw/$VERSION %released %version %families %upstream %bug_tracker %deprecated %delta/; use version; -$VERSION = '5.20170115'; +$VERSION = '5.20170923'; + +sub PKG_PATTERN () { q#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z# } +sub _looks_like_invocant ($) { local $@; !!eval { $_[0]->isa(__PACKAGE__) } } sub _undelta { my ($delta) = @_; @@ -44,9 +47,8 @@ sub first_release_raw { + shift if defined $_[1] and $_[1] =~ PKG_PATTERN and _looks_like_invocant $_[0]; my $module = shift; - $module = shift if eval { $module->isa(__PACKAGE__) } - and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#; my $version = shift; my @perls = $version @@ -70,10 +72,9 @@ } sub find_modules { + shift if _looks_like_invocant $_[0]; my $regex = shift; - $regex = shift if eval { $regex->isa(__PACKAGE__) }; - my @perls = @_; - @perls = keys %version unless @perls; + my @perls = @_ ? @_ : keys %version; my %mods; foreach (@perls) { @@ -85,30 +86,23 @@ } sub find_version { + shift if _looks_like_invocant $_[0]; my $v = shift; - if ($v->isa(__PACKAGE__)) { - $v = shift; - return if not defined $v; - } - return $version{$v} if defined $version{$v}; + return $version{$v} if defined $v and defined $version{$v}; return; } sub is_deprecated { + shift if defined $_[1] and $_[1] =~ PKG_PATTERN and _looks_like_invocant $_[0]; my $module = shift; - $module = shift if eval { $module->isa(__PACKAGE__) } - and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#; - my $perl_version = shift; - $perl_version ||= $]; + my $perl_version = shift || $]; return unless $module && exists $deprecated{$perl_version}{$module}; return $deprecated{$perl_version}{$module}; } sub deprecated_in { - my $module = shift; - $module = shift if eval { $module->isa(__PACKAGE__) } - and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#; - return unless $module; + shift if defined $_[1] and $_[1] =~ PKG_PATTERN and _looks_like_invocant $_[0]; + my $module = shift or return; my @perls = grep { exists $deprecated{$_}{$module} } keys %deprecated; return unless @perls; require List::Util; @@ -126,9 +120,8 @@ } sub removed_raw { + shift if defined $_[1] and $_[1] =~ PKG_PATTERN and _looks_like_invocant $_[0]; my $mod = shift; - $mod = shift if eval { $mod->isa(__PACKAGE__) } - and scalar @_ and $_[0] =~ m#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z#; return unless my @perls = sort { $a cmp $b } first_release_raw($mod); my $last = pop @perls; my @removed = grep { $_ > $last } sort { $a cmp $b } keys %version; @@ -136,8 +129,8 @@ } sub changes_between { + shift if _looks_like_invocant $_[0]; my $left_ver = shift; - $left_ver = shift if eval { $left_ver->isa(__PACKAGE__) }; my $right_ver = shift; my $left = $version{ $left_ver }; @@ -316,6 +309,20 @@ 5.025008 => '2016-12-20', 5.022003 => '2017-01-14', 5.024001 => '2017-01-14', + 5.025009 => '2017-01-20', + 5.025010 => '2017-02-20', + 5.025011 => '2017-03-20', + 5.025012 => '2017-04-20', + 5.026000 => '2017-05-30', + 5.027000 => '2017-05-31', + 5.027001 => '2017-06-20', + 5.022004 => '2017-07-15', + 5.024002 => '2017-07-15', + 5.027002 => '2017-07-20', + 5.027003 => '2017-08-21', + 5.027004 => '2017-09-20', + 5.024003 => '2017-09-22', + 5.026001 => '2017-09-22', ); for my $version ( sort { $a <=> $b } keys %released ) { @@ -13871,16 +13878,593 @@ removed => { } }, + 5.025009 => { + delta_from => 5.025008, + changed => { + 'App::Cpan' => '1.66', + 'B::Deparse' => '1.40', + 'B::Op_private' => '5.025009', + 'B::Terse' => '1.07', + 'B::Xref' => '1.06', + 'CPAN' => '2.16', + 'CPAN::Bundle' => '5.5002', + 'CPAN::Distribution' => '2.16', + 'CPAN::Exception::RecursiveDependency'=> '5.5001', + 'CPAN::FTP' => '5.5008', + 'CPAN::FirstTime' => '5.5310', + 'CPAN::HandleConfig' => '5.5008', + 'CPAN::Module' => '5.5003', + 'Compress::Raw::Bzip2' => '2.070', + 'Compress::Raw::Zlib' => '2.070', + 'Config' => '5.025009', + 'DB_File' => '1.840', + 'Data::Dumper' => '2.167', + 'Devel::SelfStubber' => '1.06', + 'DynaLoader' => '1.41', + 'Errno' => '1.28', + 'ExtUtils::Embed' => '1.34', + 'File::Glob' => '1.28', + 'I18N::LangTags' => '0.42', + 'Module::CoreList' => '5.20170120', + 'Module::CoreList::TieHashDelta'=> '5.20170120', + 'Module::CoreList::Utils'=> '5.20170120', + 'OS2::Process' => '1.12', + 'PerlIO::scalar' => '0.26', + 'Pod::Html' => '1.2202', + 'Storable' => '2.61', + 'Symbol' => '1.08', + 'Term::ReadLine' => '1.16', + 'Test' => '1.30', + 'Unicode::UCD' => '0.68', + 'VMS::DCLsym' => '1.08', + 'XS::APItest' => '0.88', + 'XSLoader' => '0.26', + 'attributes' => '0.29', + 'diagnostics' => '1.36', + 'feature' => '1.46', + 'lib' => '0.64', + 'overload' => '1.28', + 're' => '0.34', + 'threads' => '2.12', + 'threads::shared' => '1.54', + }, + removed => { + } + }, + 5.025010 => { + delta_from => 5.025009, + changed => { + 'B' => '1.68', + 'B::Op_private' => '5.025010', + 'CPAN' => '2.17', + 'CPAN::Distribution' => '2.17', + 'Config' => '5.02501', + 'Getopt::Std' => '1.12', + 'Module::CoreList' => '5.20170220', + 'Module::CoreList::TieHashDelta'=> '5.20170220', + 'Module::CoreList::Utils'=> '5.20170220', + 'PerlIO' => '1.10', + 'Storable' => '2.62', + 'Thread::Queue' => '3.12', + 'feature' => '1.47', + 'open' => '1.11', + 'threads' => '2.13', + }, + removed => { + } + }, + 5.025011 => { + delta_from => 5.025010, + changed => { + 'App::Prove' => '3.38', + 'App::Prove::State' => '3.38', + 'App::Prove::State::Result'=> '3.38', + 'App::Prove::State::Result::Test'=> '3.38', + 'B::Op_private' => '5.025011', + 'Compress::Raw::Bzip2' => '2.074', + 'Compress::Raw::Zlib' => '2.074', + 'Compress::Zlib' => '2.074', + 'Config' => '5.025011', + 'Config::Perl::V' => '0.28', + 'Cwd' => '3.67', + 'ExtUtils::ParseXS' => '3.34', + 'ExtUtils::ParseXS::Constants'=> '3.34', + 'ExtUtils::ParseXS::CountLines'=> '3.34', + 'ExtUtils::ParseXS::Eval'=> '3.34', + 'ExtUtils::Typemaps' => '3.34', + 'ExtUtils::Typemaps::Cmd'=> '3.34', + 'ExtUtils::Typemaps::InputMap'=> '3.34', + 'ExtUtils::Typemaps::OutputMap'=> '3.34', + 'ExtUtils::Typemaps::Type'=> '3.34', + 'File::Spec' => '3.67', + 'File::Spec::AmigaOS' => '3.67', + 'File::Spec::Cygwin' => '3.67', + 'File::Spec::Epoc' => '3.67', + 'File::Spec::Functions' => '3.67', + 'File::Spec::Mac' => '3.67', + 'File::Spec::OS2' => '3.67', + 'File::Spec::Unix' => '3.67', + 'File::Spec::VMS' => '3.67', + 'File::Spec::Win32' => '3.67', + 'IO::Compress::Adapter::Bzip2'=> '2.074', + 'IO::Compress::Adapter::Deflate'=> '2.074', + 'IO::Compress::Adapter::Identity'=> '2.074', + 'IO::Compress::Base' => '2.074', + 'IO::Compress::Base::Common'=> '2.074', + 'IO::Compress::Bzip2' => '2.074', + 'IO::Compress::Deflate' => '2.074', + 'IO::Compress::Gzip' => '2.074', + 'IO::Compress::Gzip::Constants'=> '2.074', + 'IO::Compress::RawDeflate'=> '2.074', + 'IO::Compress::Zip' => '2.074', + 'IO::Compress::Zip::Constants'=> '2.074', + 'IO::Compress::Zlib::Constants'=> '2.074', + 'IO::Compress::Zlib::Extra'=> '2.074', + 'IO::Uncompress::Adapter::Bunzip2'=> '2.074', + 'IO::Uncompress::Adapter::Identity'=> '2.074', + 'IO::Uncompress::Adapter::Inflate'=> '2.074', + 'IO::Uncompress::AnyInflate'=> '2.074', + 'IO::Uncompress::AnyUncompress'=> '2.074', + 'IO::Uncompress::Base' => '2.074', + 'IO::Uncompress::Bunzip2'=> '2.074', + 'IO::Uncompress::Gunzip'=> '2.074', + 'IO::Uncompress::Inflate'=> '2.074', + 'IO::Uncompress::RawInflate'=> '2.074', + 'IO::Uncompress::Unzip' => '2.074', + 'Module::CoreList' => '5.20170320', + 'Module::CoreList::TieHashDelta'=> '5.20170230', + 'Module::CoreList::Utils'=> '5.20170320', + 'Pod::Perldoc' => '3.28', + 'Pod::Perldoc::BaseTo' => '3.28', + 'Pod::Perldoc::GetOptsOO'=> '3.28', + 'Pod::Perldoc::ToANSI' => '3.28', + 'Pod::Perldoc::ToChecker'=> '3.28', + 'Pod::Perldoc::ToMan' => '3.28', + 'Pod::Perldoc::ToNroff' => '3.28', + 'Pod::Perldoc::ToPod' => '3.28', + 'Pod::Perldoc::ToRtf' => '3.28', + 'Pod::Perldoc::ToTerm' => '3.28', + 'Pod::Perldoc::ToText' => '3.28', + 'Pod::Perldoc::ToTk' => '3.28', + 'Pod::Perldoc::ToXml' => '3.28', + 'TAP::Base' => '3.38', + 'TAP::Formatter::Base' => '3.38', + 'TAP::Formatter::Color' => '3.38', + 'TAP::Formatter::Console'=> '3.38', + 'TAP::Formatter::Console::ParallelSession'=> '3.38', + 'TAP::Formatter::Console::Session'=> '3.38', + 'TAP::Formatter::File' => '3.38', + 'TAP::Formatter::File::Session'=> '3.38', + 'TAP::Formatter::Session'=> '3.38', + 'TAP::Harness' => '3.38', + 'TAP::Harness::Env' => '3.38', + 'TAP::Object' => '3.38', + 'TAP::Parser' => '3.38', + 'TAP::Parser::Aggregator'=> '3.38', + 'TAP::Parser::Grammar' => '3.38', + 'TAP::Parser::Iterator' => '3.38', + 'TAP::Parser::Iterator::Array'=> '3.38', + 'TAP::Parser::Iterator::Process'=> '3.38', + 'TAP::Parser::Iterator::Stream'=> '3.38', + 'TAP::Parser::IteratorFactory'=> '3.38', + 'TAP::Parser::Multiplexer'=> '3.38', + 'TAP::Parser::Result' => '3.38', + 'TAP::Parser::Result::Bailout'=> '3.38', + 'TAP::Parser::Result::Comment'=> '3.38', + 'TAP::Parser::Result::Plan'=> '3.38', + 'TAP::Parser::Result::Pragma'=> '3.38', + 'TAP::Parser::Result::Test'=> '3.38', + 'TAP::Parser::Result::Unknown'=> '3.38', + 'TAP::Parser::Result::Version'=> '3.38', + 'TAP::Parser::Result::YAML'=> '3.38', + 'TAP::Parser::ResultFactory'=> '3.38', + 'TAP::Parser::Scheduler'=> '3.38', + 'TAP::Parser::Scheduler::Job'=> '3.38', + 'TAP::Parser::Scheduler::Spinner'=> '3.38', + 'TAP::Parser::Source' => '3.38', + 'TAP::Parser::SourceHandler'=> '3.38', + 'TAP::Parser::SourceHandler::Executable'=> '3.38', + 'TAP::Parser::SourceHandler::File'=> '3.38', + 'TAP::Parser::SourceHandler::Handle'=> '3.38', + 'TAP::Parser::SourceHandler::Perl'=> '3.38', + 'TAP::Parser::SourceHandler::RawTAP'=> '3.38', + 'TAP::Parser::YAMLish::Reader'=> '3.38', + 'TAP::Parser::YAMLish::Writer'=> '3.38', + 'Test::Harness' => '3.38', + 'VMS::Stdio' => '2.41', + 'threads' => '2.15', + 'threads::shared' => '1.55', + }, + removed => { + } + }, + 5.025012 => { + delta_from => 5.025011, + changed => { + 'B::Op_private' => '5.025012', + 'CPAN' => '2.18', + 'CPAN::Bundle' => '5.5003', + 'CPAN::Distribution' => '2.18', + 'Config' => '5.025012', + 'DynaLoader' => '1.42', + 'Module::CoreList' => '5.20170420', + 'Module::CoreList::TieHashDelta'=> '5.20170420', + 'Module::CoreList::Utils'=> '5.20170420', + 'Safe' => '2.40', + 'XSLoader' => '0.27', + 'base' => '2.25', + 'threads::shared' => '1.56', + }, + removed => { + } + }, + 5.026000 => { + delta_from => 5.025012, + changed => { + 'B::Op_private' => '5.026000', + 'Config' => '5.026', + 'Module::CoreList' => '5.20170530', + 'Module::CoreList::TieHashDelta'=> '5.20170530', + 'Module::CoreList::Utils'=> '5.20170530', + }, + removed => { + } + }, + 5.027000 => { + delta_from => 5.026000, + changed => { + 'Attribute::Handlers' => '1.00', + 'B::Concise' => '1.000', + 'B::Deparse' => '1.41', + 'B::Op_private' => '5.027000', + 'Config' => '5.027', + 'Module::CoreList' => '5.20170531', + 'Module::CoreList::TieHashDelta'=> '5.20170531', + 'Module::CoreList::Utils'=> '5.20170531', + 'O' => '1.02', + 'attributes' => '0.3', + 'feature' => '1.48', + }, + removed => { + } + }, + 5.027001 => { + delta_from => 5.027, + changed => { + 'App::Prove' => '3.39', + 'App::Prove::State' => '3.39', + 'App::Prove::State::Result'=> '3.39', + 'App::Prove::State::Result::Test'=> '3.39', + 'Archive::Tar' => '2.26', + 'Archive::Tar::Constant'=> '2.26', + 'Archive::Tar::File' => '2.26', + 'B::Op_private' => '5.027001', + 'B::Terse' => '1.08', + 'Config' => '5.027001', + 'Devel::PPPort' => '3.36', + 'DirHandle' => '1.05', + 'ExtUtils::Command' => '7.30', + 'ExtUtils::Command::MM' => '7.30', + 'ExtUtils::Install' => '2.14', + 'ExtUtils::Installed' => '2.14', + 'ExtUtils::Liblist' => '7.30', + 'ExtUtils::Liblist::Kid'=> '7.30', + 'ExtUtils::MM' => '7.30', + 'ExtUtils::MM_AIX' => '7.30', + 'ExtUtils::MM_Any' => '7.30', + 'ExtUtils::MM_BeOS' => '7.30', + 'ExtUtils::MM_Cygwin' => '7.30', + 'ExtUtils::MM_DOS' => '7.30', + 'ExtUtils::MM_Darwin' => '7.30', + 'ExtUtils::MM_MacOS' => '7.30', + 'ExtUtils::MM_NW5' => '7.30', + 'ExtUtils::MM_OS2' => '7.30', + 'ExtUtils::MM_QNX' => '7.30', + 'ExtUtils::MM_UWIN' => '7.30', + 'ExtUtils::MM_Unix' => '7.30', + 'ExtUtils::MM_VMS' => '7.30', + 'ExtUtils::MM_VOS' => '7.30', + 'ExtUtils::MM_Win32' => '7.30', + 'ExtUtils::MM_Win95' => '7.30', + 'ExtUtils::MY' => '7.30', + 'ExtUtils::MakeMaker' => '7.30', + 'ExtUtils::MakeMaker::Config'=> '7.30', + 'ExtUtils::MakeMaker::Locale'=> '7.30', + 'ExtUtils::MakeMaker::version'=> '7.30', + 'ExtUtils::MakeMaker::version::regex'=> '7.30', + 'ExtUtils::Mkbootstrap' => '7.30', + 'ExtUtils::Mksymlists' => '7.30', + 'ExtUtils::Packlist' => '2.14', + 'ExtUtils::testlib' => '7.30', + 'File::Path' => '2.14', + 'Filter::Util::Call' => '1.57', + 'GDBM_File' => '1.16', + 'Getopt::Long' => '2.5', + 'IO::Socket::IP' => '0.39', + 'IPC::Cmd' => '0.98', + 'JSON::PP' => '2.94', + 'JSON::PP::Boolean' => '2.94', + 'Locale::Codes' => '3.52', + 'Locale::Codes::Constants'=> '3.52', + 'Locale::Codes::Country'=> '3.52', + 'Locale::Codes::Country_Codes'=> '3.52', + 'Locale::Codes::Country_Retired'=> '3.52', + 'Locale::Codes::Currency'=> '3.52', + 'Locale::Codes::Currency_Codes'=> '3.52', + 'Locale::Codes::Currency_Retired'=> '3.52', + 'Locale::Codes::LangExt'=> '3.52', + 'Locale::Codes::LangExt_Codes'=> '3.52', + 'Locale::Codes::LangExt_Retired'=> '3.52', + 'Locale::Codes::LangFam'=> '3.52', + 'Locale::Codes::LangFam_Codes'=> '3.52', + 'Locale::Codes::LangFam_Retired'=> '3.52', + 'Locale::Codes::LangVar'=> '3.52', + 'Locale::Codes::LangVar_Codes'=> '3.52', + 'Locale::Codes::LangVar_Retired'=> '3.52', + 'Locale::Codes::Language'=> '3.52', + 'Locale::Codes::Language_Codes'=> '3.52', + 'Locale::Codes::Language_Retired'=> '3.52', + 'Locale::Codes::Script' => '3.52', + 'Locale::Codes::Script_Codes'=> '3.52', + 'Locale::Codes::Script_Retired'=> '3.52', + 'Locale::Country' => '3.52', + 'Locale::Currency' => '3.52', + 'Locale::Language' => '3.52', + 'Locale::Script' => '3.52', + 'Module::CoreList' => '5.20170621', + 'Module::CoreList::TieHashDelta'=> '5.20170621', + 'Module::CoreList::Utils'=> '5.20170621', + 'PerlIO::scalar' => '0.27', + 'PerlIO::via' => '0.17', + 'Storable' => '2.63', + 'TAP::Base' => '3.39', + 'TAP::Formatter::Base' => '3.39', + 'TAP::Formatter::Color' => '3.39', + 'TAP::Formatter::Console'=> '3.39', + 'TAP::Formatter::Console::ParallelSession'=> '3.39', + 'TAP::Formatter::Console::Session'=> '3.39', + 'TAP::Formatter::File' => '3.39', + 'TAP::Formatter::File::Session'=> '3.39', + 'TAP::Formatter::Session'=> '3.39', + 'TAP::Harness' => '3.39', + 'TAP::Harness::Env' => '3.39', + 'TAP::Object' => '3.39', + 'TAP::Parser' => '3.39', + 'TAP::Parser::Aggregator'=> '3.39', + 'TAP::Parser::Grammar' => '3.39', + 'TAP::Parser::Iterator' => '3.39', + 'TAP::Parser::Iterator::Array'=> '3.39', + 'TAP::Parser::Iterator::Process'=> '3.39', + 'TAP::Parser::Iterator::Stream'=> '3.39', + 'TAP::Parser::IteratorFactory'=> '3.39', + 'TAP::Parser::Multiplexer'=> '3.39', + 'TAP::Parser::Result' => '3.39', + 'TAP::Parser::Result::Bailout'=> '3.39', + 'TAP::Parser::Result::Comment'=> '3.39', + 'TAP::Parser::Result::Plan'=> '3.39', + 'TAP::Parser::Result::Pragma'=> '3.39', + 'TAP::Parser::Result::Test'=> '3.39', + 'TAP::Parser::Result::Unknown'=> '3.39', + 'TAP::Parser::Result::Version'=> '3.39', + 'TAP::Parser::Result::YAML'=> '3.39', + 'TAP::Parser::ResultFactory'=> '3.39', + 'TAP::Parser::Scheduler'=> '3.39', + 'TAP::Parser::Scheduler::Job'=> '3.39', + 'TAP::Parser::Scheduler::Spinner'=> '3.39', + 'TAP::Parser::Source' => '3.39', + 'TAP::Parser::SourceHandler'=> '3.39', + 'TAP::Parser::SourceHandler::Executable'=> '3.39', + 'TAP::Parser::SourceHandler::File'=> '3.39', + 'TAP::Parser::SourceHandler::Handle'=> '3.39', + 'TAP::Parser::SourceHandler::Perl'=> '3.39', + 'TAP::Parser::SourceHandler::RawTAP'=> '3.39', + 'TAP::Parser::YAMLish::Reader'=> '3.39', + 'TAP::Parser::YAMLish::Writer'=> '3.39', + 'Test::Harness' => '3.39', + 'XS::APItest' => '0.89', + '_charnames' => '1.45', + 'charnames' => '1.45', + 'if' => '0.0607', + 'mro' => '1.21', + 'threads' => '2.16', + 'threads::shared' => '1.57', + 'version' => '0.9918', + 'version::regex' => '0.9918', + }, + removed => { + } + }, + 5.022004 => { + delta_from => 5.022003, + changed => { + 'B::Op_private' => '5.022004', + 'Config' => '5.022004', + 'Module::CoreList' => '5.20170715_22', + 'Module::CoreList::TieHashDelta'=> '5.20170715_22', + 'Module::CoreList::Utils'=> '5.20170715_22', + 'base' => '2.22_01', + }, + removed => { + } + }, + 5.024002 => { + delta_from => 5.024001, + changed => { + 'B::Op_private' => '5.024002', + 'Config' => '5.024002', + 'Module::CoreList' => '5.20170715_24', + 'Module::CoreList::TieHashDelta'=> '5.20170715_24', + 'Module::CoreList::Utils'=> '5.20170715_24', + 'base' => '2.23_01', + }, + removed => { + } + }, + 5.027002 => { + delta_from => 5.027001, + changed => { + 'B::Op_private' => '5.027002', + 'Carp' => '1.43', + 'Carp::Heavy' => '1.43', + 'Config' => '5.027002', + 'Cwd' => '3.68', + 'Encode' => '2.92', + 'Encode::Alias' => '2.23', + 'Encode::CN::HZ' => '2.09', + 'Encode::Encoding' => '2.08', + 'Encode::GSM0338' => '2.07', + 'Encode::Guess' => '2.07', + 'Encode::JP::JIS7' => '2.07', + 'Encode::KR::2022_KR' => '2.04', + 'Encode::MIME::Header' => '2.27', + 'Encode::MIME::Header::ISO_2022_JP'=> '1.09', + 'Encode::Unicode' => '2.16', + 'Encode::Unicode::UTF7' => '2.10', + 'ExtUtils::CBuilder' => '0.280228', + 'ExtUtils::CBuilder::Base'=> '0.280228', + 'ExtUtils::CBuilder::Platform::Unix'=> '0.280228', + 'ExtUtils::CBuilder::Platform::VMS'=> '0.280228', + 'ExtUtils::CBuilder::Platform::Windows'=> '0.280228', + 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.280228', + 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.280228', + 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.280228', + 'ExtUtils::CBuilder::Platform::aix'=> '0.280228', + 'ExtUtils::CBuilder::Platform::android'=> '0.280228', + 'ExtUtils::CBuilder::Platform::cygwin'=> '0.280228', + 'ExtUtils::CBuilder::Platform::darwin'=> '0.280228', + 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.280228', + 'ExtUtils::CBuilder::Platform::os2'=> '0.280228', + 'File::Glob' => '1.29', + 'File::Spec' => '3.68', + 'File::Spec::AmigaOS' => '3.68', + 'File::Spec::Cygwin' => '3.68', + 'File::Spec::Epoc' => '3.68', + 'File::Spec::Functions' => '3.68', + 'File::Spec::Mac' => '3.68', + 'File::Spec::OS2' => '3.68', + 'File::Spec::Unix' => '3.68', + 'File::Spec::VMS' => '3.68', + 'File::Spec::Win32' => '3.68', + 'List::Util' => '1.48', + 'List::Util::XS' => '1.48', + 'Math::BigRat' => '0.2613', + 'Module::CoreList' => '5.20170720', + 'Module::CoreList::TieHashDelta'=> '5.20170720', + 'Module::CoreList::Utils'=> '5.20170720', + 'Opcode' => '1.40', + 'POSIX' => '1.77', + 'PerlIO::scalar' => '0.29', + 'Scalar::Util' => '1.48', + 'Sub::Util' => '1.48', + 'Time::HiRes' => '1.9743', + 'Time::Piece' => '1.3201', + 'Time::Seconds' => '1.3201', + 'Unicode' => '10.0.0', + 'XS::APItest' => '0.90', + 'arybase' => '0.13', + 'encoding' => '2.20', + 'feature' => '1.49', + 're' => '0.35', + }, + removed => { + } + }, + 5.027003 => { + delta_from => 5.027002, + changed => { + 'B' => '1.69', + 'B::Concise' => '1.001', + 'B::Debug' => '1.25', + 'B::Deparse' => '1.42', + 'B::Op_private' => '5.027003', + 'Config' => '5.027003', + 'Data::Dumper' => '2.167_02', + 'Devel::Peek' => '1.27', + 'ExtUtils::Constant' => '0.24', + 'ExtUtils::Constant::Base'=> '0.06', + 'ExtUtils::Constant::ProxySubs'=> '0.09', + 'ExtUtils::Constant::Utils'=> '0.04', + 'ExtUtils::ParseXS' => '3.35', + 'ExtUtils::ParseXS::Constants'=> '3.35', + 'ExtUtils::ParseXS::CountLines'=> '3.35', + 'ExtUtils::ParseXS::Eval'=> '3.35', + 'ExtUtils::ParseXS::Utilities'=> '3.35', + 'ExtUtils::Typemaps' => '3.35', + 'ExtUtils::Typemaps::Cmd'=> '3.35', + 'ExtUtils::Typemaps::InputMap'=> '3.35', + 'ExtUtils::Typemaps::OutputMap'=> '3.35', + 'ExtUtils::Typemaps::Type'=> '3.35', + 'Filter::Simple' => '0.94', + 'Module::CoreList' => '5.20170821', + 'Module::CoreList::TieHashDelta'=> '5.20170821', + 'Module::CoreList::Utils'=> '5.20170821', + 'SelfLoader' => '1.24', + 'Storable' => '2.64', + 'XS::APItest' => '0.91', + 'base' => '2.26', + 'threads' => '2.17', + 'utf8' => '1.20', + }, + removed => { + } + }, + 5.027004 => { + delta_from => 5.027003, + changed => { + 'B::Op_private' => '5.027004', + 'Config' => '5.027004', + 'File::Glob' => '1.30', + 'I18N::Langinfo' => '0.14', + 'Module::CoreList' => '5.20170920', + 'Module::CoreList::TieHashDelta'=> '5.20170920', + 'Module::CoreList::Utils'=> '5.20170920', + 'Term::ReadLine' => '1.17', + 'VMS::Stdio' => '2.42', + 'XS::APItest' => '0.92', + 'attributes' => '0.31', + 'sort' => '2.03', + 'threads' => '2.18', + }, + removed => { + } + }, + 5.024003 => { + delta_from => 5.024002, + changed => { + 'B::Op_private' => '5.024003', + 'Config' => '5.024003', + 'Module::CoreList' => '5.20170922_24', + 'Module::CoreList::TieHashDelta'=> '5.20170922_24', + 'Module::CoreList::Utils'=> '5.20170922_24', + 'POSIX' => '1.65_01', + 'Time::HiRes' => '1.9741', + }, + removed => { + } + }, + 5.026001 => { + delta_from => 5.026000, + changed => { + 'B::Op_private' => '5.026001', + 'Config' => '5.026001', + 'Module::CoreList' => '5.20170922_26', + 'Module::CoreList::TieHashDelta'=> '5.20170922_26', + 'Module::CoreList::Utils'=> '5.20170922_26', + '_charnames' => '1.45', + 'base' => '2.26', + 'charnames' => '1.45', + }, + removed => { + } + }, ); sub is_core { + shift if defined $_[1] and $_[1] =~ /^\w/ and _looks_like_invocant $_[0]; my $module = shift; - $module = shift if eval { $module->isa(__PACKAGE__) } && @_ > 0 && defined($_[0]) && $_[0] =~ /^\w/; - my ($module_version, $perl_version); - - $module_version = shift if @_ > 0; - $perl_version = @_ > 0 ? shift : $]; + my $module_version = @_ > 0 ? shift : undef; + my $perl_version = @_ > 0 ? shift : $]; my $first_release = first_release($module); @@ -14595,6 +15179,105 @@ removed => { } }, + 5.025009 => { + delta_from => 5.025008, + changed => { + }, + removed => { + } + }, + 5.025010 => { + delta_from => 5.025009, + changed => { + }, + removed => { + } + }, + 5.025011 => { + delta_from => 5.025010, + changed => { + }, + removed => { + } + }, + 5.025012 => { + delta_from => 5.025011, + changed => { + }, + removed => { + } + }, + 5.026000 => { + delta_from => 5.025012, + changed => { + }, + removed => { + } + }, + 5.027000 => { + delta_from => 5.026, + changed => { + }, + removed => { + } + }, + 5.027001 => { + delta_from => 5.027, + changed => { + }, + removed => { + } + }, + 5.022004 => { + delta_from => 5.022003, + changed => { + }, + removed => { + } + }, + 5.024002 => { + delta_from => 5.024001, + changed => { + }, + removed => { + } + }, + 5.027002 => { + delta_from => 5.027001, + changed => { + }, + removed => { + } + }, + 5.027003 => { + delta_from => 5.027002, + changed => { + 'B::Debug' => '1', + }, + removed => { + } + }, + 5.027004 => { + delta_from => 5.027003, + changed => { + }, + removed => { + } + }, + 5.024003 => { + delta_from => 5.024002, + changed => { + }, + removed => { + } + }, + 5.026001 => { + delta_from => 5.026000, + changed => { + }, + removed => { + } + }, ); %deprecated = _undelta(\%deprecated); @@ -15404,7 +16087,7 @@ 'Test2::Event::Encoding'=> 'http://github.com/Test-More/test-more/issues', 'Test2::Event::Exception'=> 'http://github.com/Test-More/test-more/issues', 'Test2::Event::Generic' => 'http://github.com/Test-More/test-more/issues', - 'Test2::Event::Info' => 'http://github.com/Test-More/test-more/issues', + 'Test2::Event::Info' => undef, 'Test2::Event::Note' => 'http://github.com/Test-More/test-more/issues', 'Test2::Event::Ok' => 'http://github.com/Test-More/test-more/issues', 'Test2::Event::Plan' => 'http://github.com/Test-More/test-more/issues', diff -Nru libcpanplus-perl-0.9162/inc/bundle/version/regex.pm libcpanplus-perl-0.9172/inc/bundle/version/regex.pm --- libcpanplus-perl-0.9162/inc/bundle/version/regex.pm 2017-01-15 10:52:20.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/version/regex.pm 2017-05-14 13:08:19.000000000 +0000 @@ -2,9 +2,13 @@ use strict; -use vars qw($VERSION $CLASS $STRICT $LAX); +use vars qw( + $VERSION $CLASS $STRICT $LAX + $STRICT_DECIMAL_VERSION $STRICT_DOTTED_DECIMAL_VERSION + $LAX_DECIMAL_VERSION $LAX_DOTTED_DECIMAL_VERSION +); -$VERSION = 0.9917; +$VERSION = 0.9918; #--------------------------------------------------------------------------# # Version regexp components @@ -57,13 +61,13 @@ # Strict decimal version number. -my $STRICT_DECIMAL_VERSION = +$STRICT_DECIMAL_VERSION = qr/ $STRICT_INTEGER_PART $FRACTION_PART? /x; # Strict dotted-decimal version number. Must have both leading "v" and # at least three parts, to avoid confusion with decimal syntax. -my $STRICT_DOTTED_DECIMAL_VERSION = +$STRICT_DOTTED_DECIMAL_VERSION = qr/ v $STRICT_INTEGER_PART $STRICT_DOTTED_DECIMAL_PART{2,} /x; # Complete strict version number syntax -- should generally be used @@ -80,7 +84,7 @@ # allowing an alpha suffix or allowing a leading or trailing # decimal-point -my $LAX_DECIMAL_VERSION = +$LAX_DECIMAL_VERSION = qr/ $LAX_INTEGER_PART (?: $FRACTION_PART | \. )? $LAX_ALPHA_PART? | $FRACTION_PART $LAX_ALPHA_PART? @@ -92,7 +96,7 @@ # enough, without the leading "v", Perl takes .1.2 to mean v0.1.2, # so when there is no "v", the leading part is optional -my $LAX_DOTTED_DECIMAL_VERSION = +$LAX_DOTTED_DECIMAL_VERSION = qr/ v $LAX_INTEGER_PART (?: $LAX_DOTTED_DECIMAL_PART+ $LAX_ALPHA_PART? )? | diff -Nru libcpanplus-perl-0.9162/inc/bundle/version/vpp.pm libcpanplus-perl-0.9172/inc/bundle/version/vpp.pm --- libcpanplus-perl-0.9162/inc/bundle/version/vpp.pm 2017-01-15 10:52:20.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/version/vpp.pm 2017-05-14 13:08:19.000000000 +0000 @@ -123,7 +123,7 @@ use Config; use vars qw($VERSION $CLASS @ISA $LAX $STRICT $WARN_CATEGORY); -$VERSION = 0.9917; +$VERSION = 0.9918; $CLASS = 'version::vpp'; if ($] > 5.015) { warnings::register_categories(qw/version/); diff -Nru libcpanplus-perl-0.9162/inc/bundle/version.pm libcpanplus-perl-0.9172/inc/bundle/version.pm --- libcpanplus-perl-0.9162/inc/bundle/version.pm 2017-01-15 10:52:20.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/bundle/version.pm 2017-05-14 13:08:19.000000000 +0000 @@ -10,7 +10,7 @@ use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); -$VERSION = 0.9917; +$VERSION = 0.9918; $CLASS = 'version'; # !!!!Delete this next block completely when adding to Perl core!!!! @@ -64,7 +64,11 @@ *version::is_lax = \&version::regex::is_lax; *version::is_strict = \&version::regex::is_strict; *LAX = \$version::regex::LAX; +*LAX_DECIMAL_VERSION = \$version::regex::LAX_DECIMAL_VERSION; +*LAX_DOTTED_DECIMAL_VERSION = \$version::regex::LAX_DOTTED_DECIMAL_VERSION; *STRICT = \$version::regex::STRICT; +*STRICT_DECIMAL_VERSION = \$version::regex::STRICT_DECIMAL_VERSION; +*STRICT_DOTTED_DECIMAL_VERSION = \$version::regex::STRICT_DOTTED_DECIMAL_VERSION; sub import { no strict 'refs'; diff -Nru libcpanplus-perl-0.9162/inc/Module/Install/Base.pm libcpanplus-perl-0.9172/inc/Module/Install/Base.pm --- libcpanplus-perl-0.9162/inc/Module/Install/Base.pm 2013-05-12 15:21:47.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/Module/Install/Base.pm 2017-04-12 08:30:46.000000000 +0000 @@ -1,7 +1,11 @@ #line 1 package Module::Install::Base; -$VERSION = '0.65'; +use strict 'vars'; +use vars qw{$VERSION}; +BEGIN { + $VERSION = '1.18'; +} # Suspend handler for "redefined" warnings BEGIN { @@ -9,52 +13,61 @@ $SIG{__WARN__} = sub { $w }; } -### This is the ONLY module that shouldn't have strict on -# use strict; - -#line 41 +#line 42 sub new { - my ($class, %args) = @_; - - foreach my $method ( qw(call load) ) { - *{"$class\::$method"} = sub { - shift()->_top->$method(@_); - } unless defined &{"$class\::$method"}; - } - - bless( \%args, $class ); + my $class = shift; + unless ( defined &{"${class}::call"} ) { + *{"${class}::call"} = sub { shift->_top->call(@_) }; + } + unless ( defined &{"${class}::load"} ) { + *{"${class}::load"} = sub { shift->_top->load(@_) }; + } + bless { @_ }, $class; } #line 61 sub AUTOLOAD { - my $self = shift; - local $@; - my $autoload = eval { $self->_top->autoload } or return; - goto &$autoload; + local $@; + my $func = eval { shift->_top->autoload } or return; + goto &$func; } -#line 76 +#line 75 -sub _top { $_[0]->{_top} } +sub _top { + $_[0]->{_top}; +} -#line 89 +#line 90 sub admin { - $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; + $_[0]->_top->{admin} + or + Module::Install::Base::FakeAdmin->new; } +#line 106 + sub is_admin { - $_[0]->admin->VERSION; + ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; -my $Fake; -sub new { $Fake ||= bless(\@_, $_[0]) } +use vars qw{$VERSION}; +BEGIN { + $VERSION = $Module::Install::Base::VERSION; +} + +my $fake; + +sub new { + $fake ||= bless(\@_, $_[0]); +} sub AUTOLOAD {} @@ -67,4 +80,4 @@ 1; -#line 138 +#line 159 diff -Nru libcpanplus-perl-0.9162/inc/Module/Install/Can.pm libcpanplus-perl-0.9172/inc/Module/Install/Can.pm --- libcpanplus-perl-0.9162/inc/Module/Install/Can.pm 2013-05-12 15:21:47.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/Module/Install/Can.pm 2017-04-12 08:30:46.000000000 +0000 @@ -2,18 +2,15 @@ package Module::Install::Can; use strict; -use Module::Install::Base; -use Config (); -### This adds a 5.005 Perl version dependency. -### This is a bug and will be fixed. -use File::Spec (); -use ExtUtils::MakeMaker (); +use Config (); +use ExtUtils::MakeMaker (); +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.65'; + $VERSION = '1.18'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } # check if we can load some module @@ -31,7 +28,7 @@ eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } -# check if we can run some command +# Check if we can run some command sub can_run { my ($self, $cmd) = @_; @@ -39,16 +36,100 @@ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { - my $abs = File::Spec->catfile($dir, $_[1]); + next if $dir eq ''; + require File::Spec; + my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } -# can we locate a (the) C compiler +# Can our C compiler environment build XS files +sub can_xs { + my $self = shift; + + # Ensure we have the CBuilder module + $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); + + # Do we have the configure_requires checker? + local $@; + eval "require ExtUtils::CBuilder;"; + if ( $@ ) { + # They don't obey configure_requires, so it is + # someone old and delicate. Try to avoid hurting + # them by falling back to an older simpler test. + return $self->can_cc(); + } + + # Do we have a working C compiler + my $builder = ExtUtils::CBuilder->new( + quiet => 1, + ); + unless ( $builder->have_compiler ) { + # No working C compiler + return 0; + } + + # Write a C file representative of what XS becomes + require File::Temp; + my ( $FH, $tmpfile ) = File::Temp::tempfile( + "compilexs-XXXXX", + SUFFIX => '.c', + ); + binmode $FH; + print $FH <<'END_C'; +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +int main(int argc, char **argv) { + return 0; +} + +int boot_sanexs() { + return 1; +} + +END_C + close $FH; + + # Can the C compiler access the same headers XS does + my @libs = (); + my $object = undef; + eval { + local $^W = 0; + $object = $builder->compile( + source => $tmpfile, + ); + @libs = $builder->link( + objects => $object, + module_name => 'sanexs', + ); + }; + my $result = $@ ? 0 : 1; + + # Clean up all the build files + foreach ( $tmpfile, $object, @libs ) { + next unless defined $_; + 1 while unlink; + } + + return $result; +} + +# Can we locate a (the) C compiler sub can_cc { my $self = shift; + + if ($^O eq 'VMS') { + require ExtUtils::CBuilder; + my $builder = ExtUtils::CBuilder->new( + quiet => 1, + ); + return $builder->have_compiler; + } + my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part @@ -79,4 +160,4 @@ __END__ -#line 157 +#line 245 diff -Nru libcpanplus-perl-0.9162/inc/Module/Install/Fetch.pm libcpanplus-perl-0.9172/inc/Module/Install/Fetch.pm --- libcpanplus-perl-0.9162/inc/Module/Install/Fetch.pm 2013-05-12 15:21:47.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/Module/Install/Fetch.pm 2017-04-12 08:30:46.000000000 +0000 @@ -2,13 +2,13 @@ package Module::Install::Fetch; use strict; -use Module::Install::Base; +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.65'; + $VERSION = '1.18'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } sub get_file { diff -Nru libcpanplus-perl-0.9162/inc/Module/Install/Makefile.pm libcpanplus-perl-0.9172/inc/Module/Install/Makefile.pm --- libcpanplus-perl-0.9162/inc/Module/Install/Makefile.pm 2013-05-12 15:21:47.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/Module/Install/Makefile.pm 2017-04-12 08:30:46.000000000 +0000 @@ -2,14 +2,15 @@ package Module::Install::Makefile; use strict 'vars'; -use Module::Install::Base; -use ExtUtils::MakeMaker (); +use ExtUtils::MakeMaker (); +use Module::Install::Base (); +use Fcntl qw/:flock :seek/; -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.65'; + $VERSION = '1.18'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } @@ -17,196 +18,401 @@ my %seen = (); sub prompt { - shift; + shift; - # Infinite loop protection - my @c = caller(); - if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { - die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; - } - - # In automated testing, always use defaults - if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { - local $ENV{PERL_MM_USE_DEFAULT} = 1; - goto &ExtUtils::MakeMaker::prompt; - } else { - goto &ExtUtils::MakeMaker::prompt; - } -} + # Infinite loop protection + my @c = caller(); + if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { + die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; + } + + # In automated testing or non-interactive session, always use defaults + if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { + local $ENV{PERL_MM_USE_DEFAULT} = 1; + goto &ExtUtils::MakeMaker::prompt; + } else { + goto &ExtUtils::MakeMaker::prompt; + } +} + +# Store a cleaned up version of the MakeMaker version, +# since we need to behave differently in a variety of +# ways based on the MM version. +my $makemaker = eval $ExtUtils::MakeMaker::VERSION; + +# If we are passed a param, do a "newer than" comparison. +# Otherwise, just return the MakeMaker version. +sub makemaker { + ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 +} + +# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified +# as we only need to know here whether the attribute is an array +# or a hash or something else (which may or may not be appendable). +my %makemaker_argtype = ( + C => 'ARRAY', + CONFIG => 'ARRAY', +# CONFIGURE => 'CODE', # ignore + DIR => 'ARRAY', + DL_FUNCS => 'HASH', + DL_VARS => 'ARRAY', + EXCLUDE_EXT => 'ARRAY', + EXE_FILES => 'ARRAY', + FUNCLIST => 'ARRAY', + H => 'ARRAY', + IMPORTS => 'HASH', + INCLUDE_EXT => 'ARRAY', + LIBS => 'ARRAY', # ignore '' + MAN1PODS => 'HASH', + MAN3PODS => 'HASH', + META_ADD => 'HASH', + META_MERGE => 'HASH', + PL_FILES => 'HASH', + PM => 'HASH', + PMLIBDIRS => 'ARRAY', + PMLIBPARENTDIRS => 'ARRAY', + PREREQ_PM => 'HASH', + CONFIGURE_REQUIRES => 'HASH', + SKIP => 'ARRAY', + TYPEMAPS => 'ARRAY', + XS => 'HASH', +# VERSION => ['version',''], # ignore +# _KEEP_AFTER_FLUSH => '', + + clean => 'HASH', + depend => 'HASH', + dist => 'HASH', + dynamic_lib=> 'HASH', + linkext => 'HASH', + macro => 'HASH', + postamble => 'HASH', + realclean => 'HASH', + test => 'HASH', + tool_autosplit => 'HASH', + + # special cases where you can use makemaker_append + CCFLAGS => 'APPENDABLE', + DEFINE => 'APPENDABLE', + INC => 'APPENDABLE', + LDDLFLAGS => 'APPENDABLE', + LDFROM => 'APPENDABLE', +); sub makemaker_args { - my $self = shift; - my $args = ($self->{makemaker_args} ||= {}); - %$args = ( %$args, @_ ) if @_; - $args; + my ($self, %new_args) = @_; + my $args = ( $self->{makemaker_args} ||= {} ); + foreach my $key (keys %new_args) { + if ($makemaker_argtype{$key}) { + if ($makemaker_argtype{$key} eq 'ARRAY') { + $args->{$key} = [] unless defined $args->{$key}; + unless (ref $args->{$key} eq 'ARRAY') { + $args->{$key} = [$args->{$key}] + } + push @{$args->{$key}}, + ref $new_args{$key} eq 'ARRAY' + ? @{$new_args{$key}} + : $new_args{$key}; + } + elsif ($makemaker_argtype{$key} eq 'HASH') { + $args->{$key} = {} unless defined $args->{$key}; + foreach my $skey (keys %{ $new_args{$key} }) { + $args->{$key}{$skey} = $new_args{$key}{$skey}; + } + } + elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { + $self->makemaker_append($key => $new_args{$key}); + } + } + else { + if (defined $args->{$key}) { + warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; + } + $args->{$key} = $new_args{$key}; + } + } + return $args; } -# For mm args that take multiple space-seperated args, +# For mm args that take multiple space-separated args, # append an argument to the current list. sub makemaker_append { - my $self = shift; - my $name = shift; - my $args = $self->makemaker_args; - $args->{name} = defined $args->{$name} - ? join( ' ', $args->{name}, @_ ) - : join( ' ', @_ ); + my $self = shift; + my $name = shift; + my $args = $self->makemaker_args; + $args->{$name} = defined $args->{$name} + ? join( ' ', $args->{$name}, @_ ) + : join( ' ', @_ ); } sub build_subdirs { - my $self = shift; - my $subdirs = $self->makemaker_args->{DIR} ||= []; - for my $subdir (@_) { - push @$subdirs, $subdir; - } + my $self = shift; + my $subdirs = $self->makemaker_args->{DIR} ||= []; + for my $subdir (@_) { + push @$subdirs, $subdir; + } } sub clean_files { - my $self = shift; - my $clean = $self->makemaker_args->{clean} ||= {}; - %$clean = ( - %$clean, - FILES => join(' ', grep length, $clean->{FILES}, @_), - ); + my $self = shift; + my $clean = $self->makemaker_args->{clean} ||= {}; + %$clean = ( + %$clean, + FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), + ); } sub realclean_files { - my $self = shift; - my $realclean = $self->makemaker_args->{realclean} ||= {}; - %$realclean = ( - %$realclean, - FILES => join(' ', grep length, $realclean->{FILES}, @_), - ); + my $self = shift; + my $realclean = $self->makemaker_args->{realclean} ||= {}; + %$realclean = ( + %$realclean, + FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), + ); } sub libs { - my $self = shift; - my $libs = ref $_[0] ? shift : [ shift ]; - $self->makemaker_args( LIBS => $libs ); + my $self = shift; + my $libs = ref $_[0] ? shift : [ shift ]; + $self->makemaker_args( LIBS => $libs ); } sub inc { - my $self = shift; - $self->makemaker_args( INC => shift ); + my $self = shift; + $self->makemaker_args( INC => shift ); +} + +sub _wanted_t { +} + +sub tests_recursive { + my $self = shift; + my $dir = shift || 't'; + unless ( -d $dir ) { + die "tests_recursive dir '$dir' does not exist"; + } + my %tests = map { $_ => 1 } split / /, ($self->tests || ''); + require File::Find; + File::Find::find( + sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, + $dir + ); + $self->tests( join ' ', sort keys %tests ); } sub write { - my $self = shift; - die "&Makefile->write() takes no arguments\n" if @_; + my $self = shift; + die "&Makefile->write() takes no arguments\n" if @_; - my $args = $self->makemaker_args; - $args->{DISTNAME} = $self->name; - $args->{NAME} = $self->module_name || $self->name || $self->determine_NAME($args); - $args->{VERSION} = $self->version || $self->determine_VERSION($args); - $args->{NAME} =~ s/-/::/g; - if ( $self->tests ) { - $args->{test} = { TESTS => $self->tests }; - } - if ($] >= 5.005) { - $args->{ABSTRACT} = $self->abstract; - $args->{AUTHOR} = $self->author; - } - if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { - $args->{NO_META} = 1; - } - if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { - $args->{SIGN} = 1; - } - unless ( $self->is_admin ) { - delete $args->{SIGN}; - } - - # merge both kinds of requires into prereq_pm - my $prereq = ($args->{PREREQ_PM} ||= {}); - %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, - ($self->build_requires, $self->requires) ); - - # merge both kinds of requires into prereq_pm - my $subdirs = ($args->{DIR} ||= []); - if ($self->bundles) { - foreach my $bundle (@{ $self->bundles }) { - my ($file, $dir) = @$bundle; - push @$subdirs, $dir if -d $dir; - delete $prereq->{$file}; - } - } - - if ( my $perl_version = $self->perl_version ) { - eval "use $perl_version; 1" - or die "ERROR: perl: Version $] is installed, " - . "but we need version >= $perl_version"; - } - - $args->{INSTALLDIRS} = $self->installdirs; - - my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; - - my $user_preop = delete $args{dist}->{PREOP}; - if (my $preop = $self->admin->preop($user_preop)) { - $args{dist} = $preop; - } + # Check the current Perl version + my $perl_version = $self->perl_version; + if ( $perl_version ) { + eval "use $perl_version; 1" + or die "ERROR: perl: Version $] is installed, " + . "but we need version >= $perl_version"; + } + + # Make sure we have a new enough MakeMaker + require ExtUtils::MakeMaker; + + if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { + # This previous attempted to inherit the version of + # ExtUtils::MakeMaker in use by the module author, but this + # was found to be untenable as some authors build releases + # using future dev versions of EU:MM that nobody else has. + # Instead, #toolchain suggests we use 6.59 which is the most + # stable version on CPAN at time of writing and is, to quote + # ribasushi, "not terminally fucked, > and tested enough". + # TODO: We will now need to maintain this over time to push + # the version up as new versions are released. + $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); + $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); + } else { + # Allow legacy-compatibility with 5.005 by depending on the + # most recent EU:MM that supported 5.005. + $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); + $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); + } + + # Generate the MakeMaker params + my $args = $self->makemaker_args; + $args->{DISTNAME} = $self->name; + $args->{NAME} = $self->module_name || $self->name; + $args->{NAME} =~ s/-/::/g; + $args->{VERSION} = $self->version or die <<'EOT'; +ERROR: Can't determine distribution version. Please specify it +explicitly via 'version' in Makefile.PL, or set a valid $VERSION +in a module, and provide its file path via 'version_from' (or +'all_from' if you prefer) in Makefile.PL. +EOT + + if ( $self->tests ) { + my @tests = split ' ', $self->tests; + my %seen; + $args->{test} = { + TESTS => (join ' ', grep {!$seen{$_}++} @tests), + }; + } elsif ( $Module::Install::ExtraTests::use_extratests ) { + # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. + # So, just ignore our xt tests here. + } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { + $args->{test} = { + TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), + }; + } + if ( $] >= 5.005 ) { + $args->{ABSTRACT} = $self->abstract; + $args->{AUTHOR} = join ', ', @{$self->author || []}; + } + if ( $self->makemaker(6.10) ) { + $args->{NO_META} = 1; + #$args->{NO_MYMETA} = 1; + } + if ( $self->makemaker(6.17) and $self->sign ) { + $args->{SIGN} = 1; + } + unless ( $self->is_admin ) { + delete $args->{SIGN}; + } + if ( $self->makemaker(6.31) and $self->license ) { + $args->{LICENSE} = $self->license; + } + + my $prereq = ($args->{PREREQ_PM} ||= {}); + %$prereq = ( %$prereq, + map { @$_ } # flatten [module => version] + map { @$_ } + grep $_, + ($self->requires) + ); + + # Remove any reference to perl, PREREQ_PM doesn't support it + delete $args->{PREREQ_PM}->{perl}; + + # Merge both kinds of requires into BUILD_REQUIRES + my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); + %$build_prereq = ( %$build_prereq, + map { @$_ } # flatten [module => version] + map { @$_ } + grep $_, + ($self->configure_requires, $self->build_requires) + ); + + # Remove any reference to perl, BUILD_REQUIRES doesn't support it + delete $args->{BUILD_REQUIRES}->{perl}; + + # Delete bundled dists from prereq_pm, add it to Makefile DIR + my $subdirs = ($args->{DIR} || []); + if ($self->bundles) { + my %processed; + foreach my $bundle (@{ $self->bundles }) { + my ($mod_name, $dist_dir) = @$bundle; + delete $prereq->{$mod_name}; + $dist_dir = File::Basename::basename($dist_dir); # dir for building this module + if (not exists $processed{$dist_dir}) { + if (-d $dist_dir) { + # List as sub-directory to be processed by make + push @$subdirs, $dist_dir; + } + # Else do nothing: the module is already present on the system + $processed{$dist_dir} = undef; + } + } + } + + unless ( $self->makemaker('6.55_03') ) { + %$prereq = (%$prereq,%$build_prereq); + delete $args->{BUILD_REQUIRES}; + } + + if ( my $perl_version = $self->perl_version ) { + eval "use $perl_version; 1" + or die "ERROR: perl: Version $] is installed, " + . "but we need version >= $perl_version"; + + if ( $self->makemaker(6.48) ) { + $args->{MIN_PERL_VERSION} = $perl_version; + } + } + + if ($self->installdirs) { + warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; + $args->{INSTALLDIRS} = $self->installdirs; + } + + my %args = map { + ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) + } keys %$args; + + my $user_preop = delete $args{dist}->{PREOP}; + if ( my $preop = $self->admin->preop($user_preop) ) { + foreach my $key ( keys %$preop ) { + $args{dist}->{$key} = $preop->{$key}; + } + } - my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); - $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); + my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); + $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { - my $self = shift; - my $makefile_name = shift; - my $top_class = ref($self->_top) || ''; - my $top_version = $self->_top->VERSION || ''; - - my $preamble = $self->preamble - ? "# Preamble by $top_class $top_version\n" - . $self->preamble - : ''; - my $postamble = "# Postamble by $top_class $top_version\n" - . ($self->postamble || ''); - - local *MAKEFILE; - open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; - my $makefile = do { local $/; }; - close MAKEFILE or die $!; - - $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; - $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; - $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; - $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; - $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; - - # Module::Install will never be used to build the Core Perl - # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks - # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist - $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; - #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; - - # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. - $makefile =~ s/("?)-I\$\(PERL_LIB\)\1//g; - - # XXX - This is currently unused; not sure if it breaks other MM-users - # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; - - open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; - print MAKEFILE "$preamble$makefile$postamble" or die $!; - close MAKEFILE or die $!; + my $self = shift; + my $makefile_name = shift; + my $top_class = ref($self->_top) || ''; + my $top_version = $self->_top->VERSION || ''; + + my $preamble = $self->preamble + ? "# Preamble by $top_class $top_version\n" + . $self->preamble + : ''; + my $postamble = "# Postamble by $top_class $top_version\n" + . ($self->postamble || ''); + + local *MAKEFILE; + open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; + eval { flock MAKEFILE, LOCK_EX }; + my $makefile = do { local $/; }; + + $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; + $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; + $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; + $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; + $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; + + # Module::Install will never be used to build the Core Perl + # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks + # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist + $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; + #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; + + # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. + $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; + + # XXX - This is currently unused; not sure if it breaks other MM-users + # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; + + seek MAKEFILE, 0, SEEK_SET; + truncate MAKEFILE, 0; + print MAKEFILE "$preamble$makefile$postamble" or die $!; + close MAKEFILE or die $!; - 1; + 1; } sub preamble { - my ($self, $text) = @_; - $self->{preamble} = $text . $self->{preamble} if defined $text; - $self->{preamble}; + my ($self, $text) = @_; + $self->{preamble} = $text . $self->{preamble} if defined $text; + $self->{preamble}; } sub postamble { - my ($self, $text) = @_; - $self->{postamble} ||= $self->admin->postamble; - $self->{postamble} .= $text if defined $text; - $self->{postamble} + my ($self, $text) = @_; + $self->{postamble} ||= $self->admin->postamble; + $self->{postamble} .= $text if defined $text; + $self->{postamble} } 1; __END__ -#line 338 +#line 544 diff -Nru libcpanplus-perl-0.9162/inc/Module/Install/Metadata.pm libcpanplus-perl-0.9172/inc/Module/Install/Metadata.pm --- libcpanplus-perl-0.9162/inc/Module/Install/Metadata.pm 2013-05-12 15:21:47.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/Module/Install/Metadata.pm 2017-04-12 08:30:46.000000000 +0000 @@ -2,322 +2,721 @@ package Module::Install::Metadata; use strict 'vars'; -use Module::Install::Base; +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.65'; + $VERSION = '1.18'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; } +my @boolean_keys = qw{ + sign +}; + my @scalar_keys = qw{ - name module_name abstract author version license - distribution_type perl_version tests installdirs + name + module_name + abstract + version + distribution_type + tests + installdirs }; my @tuple_keys = qw{ - build_requires requires recommends bundles + configure_requires + build_requires + requires + recommends + bundles + resources +}; + +my @resource_keys = qw{ + homepage + bugtracker + repository +}; + +my @array_keys = qw{ + keywords + author +}; + +*authors = \&author; + +sub Meta { shift } +sub Meta_BooleanKeys { @boolean_keys } +sub Meta_ScalarKeys { @scalar_keys } +sub Meta_TupleKeys { @tuple_keys } +sub Meta_ResourceKeys { @resource_keys } +sub Meta_ArrayKeys { @array_keys } + +foreach my $key ( @boolean_keys ) { + *$key = sub { + my $self = shift; + if ( defined wantarray and not @_ ) { + return $self->{values}->{$key}; + } + $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); + return $self; + }; +} + +foreach my $key ( @scalar_keys ) { + *$key = sub { + my $self = shift; + return $self->{values}->{$key} if defined wantarray and !@_; + $self->{values}->{$key} = shift; + return $self; + }; +} + +foreach my $key ( @array_keys ) { + *$key = sub { + my $self = shift; + return $self->{values}->{$key} if defined wantarray and !@_; + $self->{values}->{$key} ||= []; + push @{$self->{values}->{$key}}, @_; + return $self; + }; +} + +foreach my $key ( @resource_keys ) { + *$key = sub { + my $self = shift; + unless ( @_ ) { + return () unless $self->{values}->{resources}; + return map { $_->[1] } + grep { $_->[0] eq $key } + @{ $self->{values}->{resources} }; + } + return $self->{values}->{resources}->{$key} unless @_; + my $uri = shift or die( + "Did not provide a value to $key()" + ); + $self->resources( $key => $uri ); + return 1; + }; +} + +foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { + *$key = sub { + my $self = shift; + return $self->{values}->{$key} unless @_; + my @added; + while ( @_ ) { + my $module = shift or last; + my $version = shift || 0; + push @added, [ $module, $version ]; + } + push @{ $self->{values}->{$key} }, @added; + return map {@$_} @added; + }; +} + +# Resource handling +my %lc_resource = map { $_ => 1 } qw{ + homepage + license + bugtracker + repository }; -sub Meta { shift } -sub Meta_ScalarKeys { @scalar_keys } -sub Meta_TupleKeys { @tuple_keys } - -foreach my $key (@scalar_keys) { - *$key = sub { - my $self = shift; - return $self->{values}{$key} if defined wantarray and !@_; - $self->{values}{$key} = shift; - return $self; - }; -} - -foreach my $key (@tuple_keys) { - *$key = sub { - my $self = shift; - return $self->{values}{$key} unless @_; - - my @rv; - while (@_) { - my $module = shift or last; - my $version = shift || 0; - if ( $module eq 'perl' ) { - $version =~ s{^(\d+)\.(\d+)\.(\d+)} - {$1 + $2/1_000 + $3/1_000_000}e; - $self->perl_version($version); - next; - } - my $rv = [ $module, $version ]; - push @rv, $rv; - } - push @{ $self->{values}{$key} }, @rv; - @rv; - }; +sub resources { + my $self = shift; + while ( @_ ) { + my $name = shift or last; + my $value = shift or next; + if ( $name eq lc $name and ! $lc_resource{$name} ) { + die("Unsupported reserved lowercase resource '$name'"); + } + $self->{values}->{resources} ||= []; + push @{ $self->{values}->{resources} }, [ $name, $value ]; + } + $self->{values}->{resources}; } +# Aliases for build_requires that will have alternative +# meanings in some future version of META.yml. +sub test_requires { shift->build_requires(@_) } +sub install_requires { shift->build_requires(@_) } + +# Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } -sub sign { - my $self = shift; - return $self->{'values'}{'sign'} if defined wantarray and !@_; - $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); - return $self; +sub dynamic_config { + my $self = shift; + my $value = @_ ? shift : 1; + if ( $self->{values}->{dynamic_config} ) { + # Once dynamic we never change to static, for safety + return 0; + } + $self->{values}->{dynamic_config} = $value ? 1 : 0; + return 1; } -sub dynamic_config { +# Convenience command +sub static_config { + shift->dynamic_config(0); +} + +sub perl_version { my $self = shift; - unless ( @_ ) { - warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; - return $self; + return $self->{values}->{perl_version} unless @_; + my $version = shift or die( + "Did not provide a value to perl_version()" + ); + + # Normalize the version + $version = $self->_perl_version($version); + + # We don't support the really old versions + unless ( $version >= 5.005 ) { + die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } - $self->{'values'}{'dynamic_config'} = $_[0] ? 1 : 0; - return $self; + + $self->{values}->{perl_version} = $version; } sub all_from { - my ( $self, $file ) = @_; + my ( $self, $file ) = @_; - unless ( defined($file) ) { - my $name = $self->name - or die "all_from called with no args without setting name() first"; - $file = join('/', 'lib', split(/-/, $name)) . '.pm'; - $file =~ s{.*/}{} unless -e $file; - die "all_from: cannot find $file from $name" unless -e $file; - } + unless ( defined($file) ) { + my $name = $self->name or die( + "all_from called with no args without setting name() first" + ); + $file = join('/', 'lib', split(/-/, $name)) . '.pm'; + $file =~ s{.*/}{} unless -e $file; + unless ( -e $file ) { + die("all_from cannot find $file from $name"); + } + } + unless ( -f $file ) { + die("The path '$file' does not exist, or is not a file"); + } - $self->version_from($file) unless $self->version; - $self->perl_version_from($file) unless $self->perl_version; + $self->{values}{all_from} = $file; - # The remaining probes read from POD sections; if the file - # has an accompanying .pod, use that instead - my $pod = $file; - if ( $pod =~ s/\.pm$/.pod/i and -e $pod ) { - $file = $pod; - } + # Some methods pull from POD instead of code. + # If there is a matching .pod, use that instead + my $pod = $file; + $pod =~ s/\.pm$/.pod/i; + $pod = $file unless -e $pod; + + # Pull the different values + $self->name_from($file) unless $self->name; + $self->version_from($file) unless $self->version; + $self->perl_version_from($file) unless $self->perl_version; + $self->author_from($pod) unless @{$self->author || []}; + $self->license_from($pod) unless $self->license; + $self->abstract_from($pod) unless $self->abstract; - $self->author_from($file) unless $self->author; - $self->license_from($file) unless $self->license; - $self->abstract_from($file) unless $self->abstract; + return 1; } sub provides { - my $self = shift; - my $provides = ( $self->{values}{provides} ||= {} ); - %$provides = (%$provides, @_) if @_; - return $provides; + my $self = shift; + my $provides = ( $self->{values}->{provides} ||= {} ); + %$provides = (%$provides, @_) if @_; + return $provides; } sub auto_provides { - my $self = shift; - return $self unless $self->is_admin; - - unless (-e 'MANIFEST') { - warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; - return $self; - } - - # Avoid spurious warnings as we are not checking manifest here. - - local $SIG{__WARN__} = sub {1}; - require ExtUtils::Manifest; - local *ExtUtils::Manifest::manicheck = sub { return }; - - require Module::Build; - my $build = Module::Build->new( - dist_name => $self->name, - dist_version => $self->version, - license => $self->license, - ); - $self->provides(%{ $build->find_dist_packages || {} }); + my $self = shift; + return $self unless $self->is_admin; + unless (-e 'MANIFEST') { + warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; + return $self; + } + # Avoid spurious warnings as we are not checking manifest here. + local $SIG{__WARN__} = sub {1}; + require ExtUtils::Manifest; + local *ExtUtils::Manifest::manicheck = sub { return }; + + require Module::Build; + my $build = Module::Build->new( + dist_name => $self->name, + dist_version => $self->version, + license => $self->license, + ); + $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { - my $self = shift; - my $name = shift; - my $features = ( $self->{values}{features} ||= [] ); - - my $mods; - - if ( @_ == 1 and ref( $_[0] ) ) { - # The user used ->feature like ->features by passing in the second - # argument as a reference. Accomodate for that. - $mods = $_[0]; - } else { - $mods = \@_; - } + my $self = shift; + my $name = shift; + my $features = ( $self->{values}->{features} ||= [] ); + my $mods; + + if ( @_ == 1 and ref( $_[0] ) ) { + # The user used ->feature like ->features by passing in the second + # argument as a reference. Accomodate for that. + $mods = $_[0]; + } else { + $mods = \@_; + } - my $count = 0; - push @$features, ( - $name => [ - map { - ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ - : @$_ - : $_ - } @$mods - ] - ); + my $count = 0; + push @$features, ( + $name => [ + map { + ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ + } @$mods + ] + ); - return @$features; + return @$features; } sub features { - my $self = shift; - while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { - $self->feature( $name, @$mods ); - } - return $self->{values}->{features} - ? @{ $self->{values}->{features} } - : (); + my $self = shift; + while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { + $self->feature( $name, @$mods ); + } + return $self->{values}->{features} + ? @{ $self->{values}->{features} } + : (); } sub no_index { - my $self = shift; - my $type = shift; - push @{ $self->{values}{no_index}{$type} }, @_ if $type; - return $self->{values}{no_index}; + my $self = shift; + my $type = shift; + push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; + return $self->{values}->{no_index}; } sub read { - my $self = shift; - $self->include_deps( 'YAML', 0 ); + my $self = shift; + $self->include_deps( 'YAML::Tiny', 0 ); - require YAML; - my $data = YAML::LoadFile('META.yml'); + require YAML::Tiny; + my $data = YAML::Tiny::LoadFile('META.yml'); - # Call methods explicitly in case user has already set some values. - while ( my ( $key, $value ) = each %$data ) { - next unless $self->can($key); - if ( ref $value eq 'HASH' ) { - while ( my ( $module, $version ) = each %$value ) { - $self->can($key)->($self, $module => $version ); - } - } - else { - $self->can($key)->($self, $value); - } - } - return $self; + # Call methods explicitly in case user has already set some values. + while ( my ( $key, $value ) = each %$data ) { + next unless $self->can($key); + if ( ref $value eq 'HASH' ) { + while ( my ( $module, $version ) = each %$value ) { + $self->can($key)->($self, $module => $version ); + } + } else { + $self->can($key)->($self, $value); + } + } + return $self; } sub write { - my $self = shift; - return $self unless $self->is_admin; - $self->admin->write_meta; - return $self; + my $self = shift; + return $self unless $self->is_admin; + $self->admin->write_meta; + return $self; } sub version_from { - my ( $self, $file ) = @_; - require ExtUtils::MM_Unix; - $self->version( ExtUtils::MM_Unix->parse_version($file) ); + require ExtUtils::MM_Unix; + my ( $self, $file ) = @_; + $self->version( ExtUtils::MM_Unix->parse_version($file) ); + + # for version integrity check + $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { - my ( $self, $file ) = @_; - require ExtUtils::MM_Unix; - $self->abstract( - bless( - { DISTNAME => $self->name }, - 'ExtUtils::MM_Unix' - )->parse_abstract($file) - ); -} - -sub _slurp { - my ( $self, $file ) = @_; - - local *FH; - open FH, "< $file" or die "Cannot open $file.pod: $!"; - do { local $/; }; + require ExtUtils::MM_Unix; + my ( $self, $file ) = @_; + $self->abstract( + bless( + { DISTNAME => $self->name }, + 'ExtUtils::MM_Unix' + )->parse_abstract($file) + ); +} + +# Add both distribution and module name +sub name_from { + my ($self, $file) = @_; + if ( + Module::Install::_read($file) =~ m/ + ^ \s* + package \s* + ([\w:]+) + [\s|;]* + /ixms + ) { + my ($name, $module_name) = ($1, $1); + $name =~ s{::}{-}g; + $self->name($name); + unless ( $self->module_name ) { + $self->module_name($module_name); + } + } else { + die("Cannot determine name from $file\n"); + } } -sub perl_version_from { - my ( $self, $file ) = @_; +sub _extract_perl_version { + if ( + $_[0] =~ m/ + ^\s* + (?:use|require) \s* + v? + ([\d_\.]+) + \s* ; + /ixms + ) { + my $perl_version = $1; + $perl_version =~ s{_}{}g; + return $perl_version; + } else { + return; + } +} - if ( - $self->_slurp($file) =~ m/ - ^ - use \s* - v? - ([\d_\.]+) - \s* ; - /ixms - ) - { - my $v = $1; - $v =~ s{_}{}g; - $self->perl_version($1); - } - else { - warn "Cannot determine perl version info from $file\n"; - return; - } +sub perl_version_from { + my $self = shift; + my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); + if ($perl_version) { + $self->perl_version($perl_version); + } else { + warn "Cannot determine perl version info from $_[0]\n"; + return; + } } sub author_from { - my ( $self, $file ) = @_; - my $content = $self->_slurp($file); - if ($content =~ m/ - =head \d \s+ (?:authors?)\b \s* - ([^\n]*) - | - =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* - .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* - ([^\n]*) - /ixms) { - my $author = $1 || $2; - $author =~ s{E}{<}g; - $author =~ s{E}{>}g; - $self->author($author); - } - else { - warn "Cannot determine author info from $file\n"; - } + my $self = shift; + my $content = Module::Install::_read($_[0]); + if ($content =~ m/ + =head \d \s+ (?:authors?)\b \s* + ([^\n]*) + | + =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* + .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* + ([^\n]*) + /ixms) { + my $author = $1 || $2; + + # XXX: ugly but should work anyway... + if (eval "require Pod::Escapes; 1") { + # Pod::Escapes has a mapping table. + # It's in core of perl >= 5.9.3, and should be installed + # as one of the Pod::Simple's prereqs, which is a prereq + # of Pod::Text 3.x (see also below). + $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } + { + defined $2 + ? chr($2) + : defined $Pod::Escapes::Name2character_number{$1} + ? chr($Pod::Escapes::Name2character_number{$1}) + : do { + warn "Unknown escape: E<$1>"; + "E<$1>"; + }; + }gex; + } + elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { + # Pod::Text < 3.0 has yet another mapping table, + # though the table name of 2.x and 1.x are different. + # (1.x is in core of Perl < 5.6, 2.x is in core of + # Perl < 5.9.3) + my $mapping = ($Pod::Text::VERSION < 2) + ? \%Pod::Text::HTML_Escapes + : \%Pod::Text::ESCAPES; + $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } + { + defined $2 + ? chr($2) + : defined $mapping->{$1} + ? $mapping->{$1} + : do { + warn "Unknown escape: E<$1>"; + "E<$1>"; + }; + }gex; + } + else { + $author =~ s{E}{<}g; + $author =~ s{E}{>}g; + } + $self->author($author); + } else { + warn "Cannot determine author info from $_[0]\n"; + } +} + +#Stolen from M::B +my %license_urls = ( + perl => 'http://dev.perl.org/licenses/', + apache => 'http://apache.org/licenses/LICENSE-2.0', + apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', + artistic => 'http://opensource.org/licenses/artistic-license.php', + artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', + lgpl => 'http://opensource.org/licenses/lgpl-license.php', + lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', + lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', + bsd => 'http://opensource.org/licenses/bsd-license.php', + gpl => 'http://opensource.org/licenses/gpl-license.php', + gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', + gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', + 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, +); + +sub license { + my $self = shift; + return $self->{values}->{license} unless @_; + my $license = shift or die( + 'Did not provide a value to license()' + ); + $license = __extract_license($license) || lc $license; + $self->{values}->{license} = $license; + + # Automatically fill in license URLs + if ( $license_urls{$license} ) { + $self->resources( license => $license_urls{$license} ); + } + + return 1; +} + +sub _extract_license { + my $pod = shift; + my $matched; + return __extract_license( + ($matched) = $pod =~ m/ + (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) + (=head \d.*|=cut.*|)\z + /xms + ) || __extract_license( + ($matched) = $pod =~ m/ + (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) + (=head \d.*|=cut.*|)\z + /xms + ); +} + +sub __extract_license { + my $license_text = shift or return; + my @phrases = ( + '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, + '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, + 'Artistic and GPL' => 'perl', 1, + 'GNU general public license' => 'gpl', 1, + 'GNU public license' => 'gpl', 1, + 'GNU lesser general public license' => 'lgpl', 1, + 'GNU lesser public license' => 'lgpl', 1, + 'GNU library general public license' => 'lgpl', 1, + 'GNU library public license' => 'lgpl', 1, + 'GNU Free Documentation license' => 'unrestricted', 1, + 'GNU Affero General Public License' => 'open_source', 1, + '(?:Free)?BSD license' => 'bsd', 1, + 'Artistic license 2\.0' => 'artistic_2', 1, + 'Artistic license' => 'artistic', 1, + 'Apache (?:Software )?license' => 'apache', 1, + 'GPL' => 'gpl', 1, + 'LGPL' => 'lgpl', 1, + 'BSD' => 'bsd', 1, + 'Artistic' => 'artistic', 1, + 'MIT' => 'mit', 1, + 'Mozilla Public License' => 'mozilla', 1, + 'Q Public License' => 'open_source', 1, + 'OpenSSL License' => 'unrestricted', 1, + 'SSLeay License' => 'unrestricted', 1, + 'zlib License' => 'open_source', 1, + 'proprietary' => 'proprietary', 0, + ); + while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { + $pattern =~ s#\s+#\\s+#gs; + if ( $license_text =~ /\b$pattern\b/i ) { + return $license; + } + } + return ''; } sub license_from { - my ( $self, $file ) = @_; + my $self = shift; + if (my $license=_extract_license(Module::Install::_read($_[0]))) { + $self->license($license); + } else { + warn "Cannot determine license info from $_[0]\n"; + return 'unknown'; + } +} + +sub _extract_bugtracker { + my @links = $_[0] =~ m#L<( + https?\Q://rt.cpan.org/\E[^>]+| + https?\Q://github.com/\E[\w_]+/[\w_]+/issues| + https?\Q://code.google.com/p/\E[\w_\-]+/issues/list + )>#gx; + my %links; + @links{@links}=(); + @links=keys %links; + return @links; +} + +sub bugtracker_from { + my $self = shift; + my $content = Module::Install::_read($_[0]); + my @links = _extract_bugtracker($content); + unless ( @links ) { + warn "Cannot determine bugtracker info from $_[0]\n"; + return 0; + } + if ( @links > 1 ) { + warn "Found more than one bugtracker link in $_[0]\n"; + return 0; + } + + # Set the bugtracker + bugtracker( $links[0] ); + return 1; +} - if ( - $self->_slurp($file) =~ m/ - ( - =head \d \s+ - (?:licen[cs]e|licensing|copyright|legal)\b - .*? - ) - (=head\\d.*|=cut.*|) - \z - /ixms - ) - { - my $license_text = $1; - my @phrases = ( - 'under the same (?:terms|license) as perl itself' => 'perl', - 'GNU public license' => 'gpl', - 'GNU lesser public license' => 'gpl', - 'BSD license' => 'bsd', - 'Artistic license' => 'artistic', - 'GPL' => 'gpl', - 'LGPL' => 'lgpl', - 'BSD' => 'bsd', - 'Artistic' => 'artistic', - 'MIT' => 'MIT', - ); - while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) { - $pattern =~ s{\s+}{\\s+}g; - if ( $license_text =~ /\b$pattern\b/i ) { - $self->license($license); - return 1; - } - } +sub requires_from { + my $self = shift; + my $content = Module::Install::_readperl($_[0]); + my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; + while ( @requires ) { + my $module = shift @requires; + my $version = shift @requires; + $self->requires( $module => $version ); + } +} + +sub test_requires_from { + my $self = shift; + my $content = Module::Install::_readperl($_[0]); + my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; + while ( @requires ) { + my $module = shift @requires; + my $version = shift @requires; + $self->test_requires( $module => $version ); + } +} + +# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to +# numbers (eg, 5.006001 or 5.008009). +# Also, convert double-part versions (eg, 5.8) +sub _perl_version { + my $v = $_[-1]; + $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; + $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; + $v =~ s/(\.\d\d\d)000$/$1/; + $v =~ s/_.+$//; + if ( ref($v) ) { + # Numify + $v = $v + 0; + } + return $v; +} + +sub add_metadata { + my $self = shift; + my %hash = @_; + for my $key (keys %hash) { + warn "add_metadata: $key is not prefixed with 'x_'.\n" . + "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; + $self->{values}->{$key} = $hash{$key}; } +} + + +###################################################################### +# MYMETA Support + +sub WriteMyMeta { + die "WriteMyMeta has been deprecated"; +} + +sub write_mymeta_yaml { + my $self = shift; + + # We need YAML::Tiny to write the MYMETA.yml file + unless ( eval { require YAML::Tiny; 1; } ) { + return 1; + } + + # Generate the data + my $meta = $self->_write_mymeta_data or return 1; + + # Save as the MYMETA.yml file + print "Writing MYMETA.yml\n"; + YAML::Tiny::DumpFile('MYMETA.yml', $meta); +} + +sub write_mymeta_json { + my $self = shift; + + # We need JSON to write the MYMETA.json file + unless ( eval { require JSON; 1; } ) { + return 1; + } + + # Generate the data + my $meta = $self->_write_mymeta_data or return 1; + + # Save as the MYMETA.yml file + print "Writing MYMETA.json\n"; + Module::Install::_write( + 'MYMETA.json', + JSON->new->pretty(1)->canonical->encode($meta), + ); +} + +sub _write_mymeta_data { + my $self = shift; + + # If there's no existing META.yml there is nothing we can do + return undef unless -f 'META.yml'; + + # We need Parse::CPAN::Meta to load the file + unless ( eval { require Parse::CPAN::Meta; 1; } ) { + return undef; + } + + # Merge the perl version into the dependencies + my $val = $self->Meta->{values}; + my $perl = delete $val->{perl_version}; + if ( $perl ) { + $val->{requires} ||= []; + my $requires = $val->{requires}; + + # Canonize to three-dot version after Perl 5.6 + if ( $perl >= 5.006 ) { + $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e + } + unshift @$requires, [ perl => $perl ]; + } + + # Load the advisory META.yml file + my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); + my $meta = $yaml[0]; + + # Overwrite the non-configure dependency hashes + delete $meta->{requires}; + delete $meta->{build_requires}; + delete $meta->{recommends}; + if ( exists $val->{requires} ) { + $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; + } + if ( exists $val->{build_requires} ) { + $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; + } - warn "Cannot determine license info from $file\n"; - return 'unknown'; + return $meta; } 1; diff -Nru libcpanplus-perl-0.9162/inc/Module/Install/Scripts.pm libcpanplus-perl-0.9172/inc/Module/Install/Scripts.pm --- libcpanplus-perl-0.9162/inc/Module/Install/Scripts.pm 2013-05-12 15:21:47.000000000 +0000 +++ libcpanplus-perl-0.9172/inc/Module/Install/Scripts.pm 2017-04-12 08:30:46.000000000 +0000 @@ -1,50 +1,29 @@ #line 1 package Module::Install::Scripts; -use strict; -use Module::Install::Base; -use File::Basename (); +use strict 'vars'; +use Module::Install::Base (); -use vars qw{$VERSION $ISCORE @ISA}; +use vars qw{$VERSION @ISA $ISCORE}; BEGIN { - $VERSION = '0.65'; + $VERSION = '1.18'; + @ISA = 'Module::Install::Base'; $ISCORE = 1; - @ISA = qw{Module::Install::Base}; -} - -sub prompt_script { - my ($self, $script_file) = @_; - - my ($prompt, $abstract, $default); - foreach my $line ( $self->_read_script($script_file) ) { - last unless $line =~ /^#/; - $prompt = $1 if $line =~ /^#\s*prompt:\s+(.*)/; - $default = $1 if $line =~ /^#\s*default:\s+(.*)/; - $abstract = $1 if $line =~ /^#\s*abstract:\s+(.*)/; - } - unless (defined $prompt) { - my $script_name = File::Basename::basename($script_file); - $prompt = "Do you want to install '$script_name'"; - $prompt .= " ($abstract)" if defined $abstract; - $prompt .= '?'; - } - return unless $self->prompt($prompt, ($default || 'n')) =~ /^[Yy]/; - $self->install_script($script_file); } sub install_script { - my $self = shift; - my $args = $self->makemaker_args; - my $exe_files = $args->{EXE_FILES} ||= []; - push @$exe_files, @_; -} - -sub _read_script { - my ($self, $script_file) = @_; - local *SCRIPT; - open SCRIPT, $script_file - or die "Can't open '$script_file' for input: $!\n"; - return