diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm | 58 |
1 files changed, 38 insertions, 20 deletions
diff --git a/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm b/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm index 03806bc82bf..0a52dcc2e6e 100644 --- a/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm +++ b/Master/tlpkg/tlperl/lib/CPAN/Meta/Converter.pm @@ -3,7 +3,7 @@ use strict; use warnings; package CPAN::Meta::Converter; -our $VERSION = '2.150005'; +our $VERSION = '2.150010'; #pod =head1 SYNOPSIS #pod @@ -43,22 +43,36 @@ BEGIN { # Perl 5.10.0 didn't have "is_qv" in version.pm *_is_qv = version->can('is_qv') ? sub { $_[0]->is_qv } : sub { exists $_[0]->{qv} }; +# We limit cloning to a maximum depth to bail out on circular data +# structures. While actual cycle detection might be technically better, +# we expect circularity in META data structures to be rare and generally +# the result of user error. Therefore, a depth counter is lower overhead. +our $DCLONE_MAXDEPTH = 1024; +our $_CLONE_DEPTH; + sub _dclone { - my $ref = shift; - - # if an object is in the data structure and doesn't specify how to - # turn itself into JSON, we just stringify the object. That does the - # right thing for typical things that might be there, like version objects, - # Path::Class objects, etc. - no warnings 'once'; - no warnings 'redefine'; - local *UNIVERSAL::TO_JSON = sub { "$_[0]" }; - - my $json = Parse::CPAN::Meta->json_backend()->new - ->utf8 - ->allow_blessed - ->convert_blessed; - $json->decode($json->encode($ref)) + my ( $ref ) = @_; + return $ref unless my $reftype = ref $ref; + + local $_CLONE_DEPTH = defined $_CLONE_DEPTH ? $_CLONE_DEPTH - 1 : $DCLONE_MAXDEPTH; + die "Depth Limit $DCLONE_MAXDEPTH Exceeded" if $_CLONE_DEPTH == 0; + + return [ map { _dclone( $_ ) } @{$ref} ] if 'ARRAY' eq $reftype; + return { map { $_ => _dclone( $ref->{$_} ) } keys %{$ref} } if 'HASH' eq $reftype; + + if ( 'SCALAR' eq $reftype ) { + my $new = _dclone(${$ref}); + return \$new; + } + + # We can't know if TO_JSON gives us cloned data, so refs must recurse + if ( eval { $ref->can('TO_JSON') } ) { + my $data = $ref->TO_JSON; + return ref $data ? _dclone( $data ) : $data; + } + + # Just stringify everything else + return "$ref"; } my %known_specs = ( @@ -333,7 +347,7 @@ sub _no_index_directory { my ($element, $key, $meta, $version) = @_; return unless $element; - # cleanup wrong format + # clean up wrong format if ( ! ref $element ) { my $item = $element; $element = { directory => [ $item ], file => [ $item ] }; @@ -421,7 +435,7 @@ sub _version_map { } elsif ( ref $element eq 'ARRAY' ) { my $hashref = { map { $_ => 0 } @$element }; - return _version_map($hashref); # cleanup any weird stuff + return _version_map($hashref); # clean up any weird stuff } elsif ( ref $element eq '' && length $element ) { return { $element => 0 } @@ -1499,7 +1513,7 @@ CPAN::Meta::Converter - Convert CPAN distribution metadata structures =head1 VERSION -version 2.150005 +version 2.150010 =head1 SYNOPSIS @@ -1622,11 +1636,15 @@ David Golden <dagolden@cpan.org> Ricardo Signes <rjbs@cpan.org> +=item * + +Adam Kennedy <adamk@cpan.org> + =back =head1 COPYRIGHT AND LICENSE -This software is copyright (c) 2010 by David Golden and Ricardo Signes. +This software is copyright (c) 2010 by David Golden, Ricardo Signes, Adam Kennedy and Contributors. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. |