r11670 - in /branches/upstream/libdata-visitor-perl/current: Changes META.yml SIGNATURE lib/Data/Visitor.pm lib/Data/Visitor/Callback.pm t/callback_aliasing.t t/circular_refs.t
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Wed Dec 26 16:37:44 UTC 2007
Author: gregoa-guest
Date: Wed Dec 26 16:37:43 2007
New Revision: 11670
URL: http://svn.debian.org/wsvn/?sc=1&rev=11670
Log:
[svn-upgrade] Integrating new upstream version, libdata-visitor-perl (0.10)
Modified:
branches/upstream/libdata-visitor-perl/current/Changes
branches/upstream/libdata-visitor-perl/current/META.yml
branches/upstream/libdata-visitor-perl/current/SIGNATURE
branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor.pm
branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor/Callback.pm
branches/upstream/libdata-visitor-perl/current/t/callback_aliasing.t
branches/upstream/libdata-visitor-perl/current/t/circular_refs.t
Modified: branches/upstream/libdata-visitor-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-visitor-perl/current/Changes?rev=11670&op=diff
==============================================================================
--- branches/upstream/libdata-visitor-perl/current/Changes (original)
+++ branches/upstream/libdata-visitor-perl/current/Changes Wed Dec 26 16:37:43 2007
@@ -1,3 +1,6 @@
+0.10
+ - Fix buggy behavior for duplicate and circular values
+
0.09
- add visit_hash_entry and visit_array_entry
Modified: branches/upstream/libdata-visitor-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-visitor-perl/current/META.yml?rev=11670&op=diff
==============================================================================
--- branches/upstream/libdata-visitor-perl/current/META.yml (original)
+++ branches/upstream/libdata-visitor-perl/current/META.yml Wed Dec 26 16:37:43 2007
@@ -1,9 +1,10 @@
--- #YAML:1.0
name: Data-Visitor
-version: 0.09
+version: 0.10
abstract: ~
license: ~
-generated_by: ExtUtils::MakeMaker version 6.32
+author: ~
+generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
Class::Accessor: 0
@@ -11,5 +12,5 @@
Test::More: 0
Test::use::ok: 0
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.2.html
- version: 1.2
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: branches/upstream/libdata-visitor-perl/current/SIGNATURE
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-visitor-perl/current/SIGNATURE?rev=11670&op=diff
==============================================================================
--- branches/upstream/libdata-visitor-perl/current/SIGNATURE (original)
+++ branches/upstream/libdata-visitor-perl/current/SIGNATURE Wed Dec 26 16:37:43 2007
@@ -14,23 +14,23 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 a5cff2c8fcbcf93991fa554379ba5f1698be76fd Changes
+SHA1 6e15db1a3fad01606944096ed44e105bcaef19ee Changes
SHA1 adbdb1d57cfa058d1ced16b5767527d0dfb6a253 MANIFEST
SHA1 ddb918d4e02cc06f4b9fe77adeca65403f8fdd56 MANIFEST.SKIP
-SHA1 c3fe5f0877ea45b9469805ffd5404471dc99a889 META.yml
+SHA1 158b2d3c82db5e835e55737229c66f2327305472 META.yml
SHA1 7e820fe45a90871dcc686bd3ffd7897444a6ea30 Makefile.PL
-SHA1 5274ce8ed2b538a82ddb1131a24cdb2c992e4920 lib/Data/Visitor.pm
-SHA1 909ce30088a2be5675c7ec0c7e0299dfdbc06d7a lib/Data/Visitor/Callback.pm
+SHA1 e269b1fe9f66e3f8d5e62c4ece40d6d16025b4da lib/Data/Visitor.pm
+SHA1 dc8f7e873d72f84892fac84ad6205f95f6b50363 lib/Data/Visitor/Callback.pm
SHA1 dfba09a3df7adaf6d0369a4745e6e336272c405d t/base.t
SHA1 257c858e1bc12c1039e93cac62a0d37f2e0d804d t/bugs.t
SHA1 74100f842ec1699a35958a59c39d434a84dfc501 t/callback.t
-SHA1 7e59409671d0147236beef17a6dfdc0997d6a97a t/callback_aliasing.t
-SHA1 9f6dff4facaf491f3776fec263d13acd4448de33 t/circular_refs.t
+SHA1 3836b0eeb006cc4984e80dec1a537b808c3173d2 t/callback_aliasing.t
+SHA1 8498703c0e3e9f3265237d5288bec4c33ed3b3f6 t/circular_refs.t
SHA1 54affd2088fa25d8eec562fb8d39e1abd0d123c7 t/globs.t
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.7 (Darwin)
-iD8DBQFHCWHzVCwRwOvSdBgRAtHfAJ9iQFFsizOH/MoJl7ELAevVJSKqUACZAXO0
-UrVHeFU9HKod5jYodLrt0SY=
-=YwOY
+iD8DBQFHcSElVCwRwOvSdBgRAtFYAJ0SZy0xZuOjbhD4iM5ENFUy9dPPywCeJL3y
+7me5pt32qGq9S7HI64GLJB0=
+=0wL1
-----END PGP SIGNATURE-----
Modified: branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor.pm?rev=11670&op=diff
==============================================================================
--- branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor.pm (original)
+++ branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor.pm Wed Dec 26 16:37:43 2007
@@ -10,59 +10,62 @@
use overload ();
use Symbol ();
-our $VERSION = "0.09";
+our $VERSION = "0.10";
sub visit {
my ( $self, $data ) = @_;
my $seen_hash = local $self->{_seen} = ($self->{_seen} || {}); # delete it after we're done with the whole visit
if ( ref $data ) { # only references need recursion checks
- if ( exists $seen_hash->{ refaddr( $data ) } ) { # if it's been seen
- return $seen_hash->{ refaddr( $data ) }; # return whatever it was mapped to
- } else {
- my $seen = \( $seen_hash->{ refaddr( $data ) } );
- $$seen = $data;
-
- if ( defined wantarray ) {
- return $$seen = $self->visit_no_rec_check( $data );
- } else {
- return $self->visit_no_rec_check( $data );
- }
+ if ( exists $seen_hash->{ refaddr($data) } ) {
+ return $seen_hash->{ refaddr($data) }; # return whatever it was mapped to
}
- } else {
- return $self->visit_no_rec_check( $data );
- }
+ }
+
+ return $self->visit_no_rec_check( $data );
+}
+
+sub _get_mapping {
+ my ( $self, $data ) = @_;
+ $self->{_seen}{ refaddr($data) };
+}
+
+sub _register_mapping {
+ my ( $self, $data, $new_data ) = @_;
+ $self->{_seen}{ refaddr($data) } = $new_data;
}
sub visit_no_rec_check {
my ( $self, $data ) = @_;
- if ( blessed( $data ) ) {
- return $self->visit_object( $data );
+ if ( blessed($data) ) {
+ return $self->visit_object($data);
} elsif ( ref $data ) {
- return $self->visit_ref( $data );
+ return $self->visit_ref($data);
}
- return $self->visit_value( $data );
+ return $self->visit_value($data);
}
sub visit_object {
my ( $self, $object ) = @_;
- return $self->visit_value( $object );
+ return $self->_register_mapping( $object, $self->visit_value($object) );
}
sub visit_ref {
my ( $self, $data ) = @_;
- my $reftype = reftype $data;
+ my $reftype = reftype $data;
+
+ $reftype = "SCALAR" if $reftype =~ /^(?:REF|LVALUE|VSTRING)$/;
my $method = lc "visit_$reftype";
if ( $self->can($method) ) {
- return $self->$method( $data );
+ return $self->_register_mapping( $data, $self->$method($data) );
} else {
- return $self->visit_value($data);
+ return $self->_register_mapping( $data, $self->visit_value($data) );
}
}
@@ -77,11 +80,15 @@
my ( $self, $hash ) = @_;
if ( not defined wantarray ) {
+ $self->_register_mapping( $hash, $hash );
foreach my $key ( keys %$hash ) {
$self->visit_hash_entry( $key, $hash->{$key}, $hash );
}
} else {
- return $self->retain_magic( $hash, { map { $self->visit_hash_entry( $_, $hash->{$_}, $hash ) } keys %$hash } );
+ my $new_hash = {};
+ $self->_register_mapping( $hash, $new_hash );
+ %$new_hash = map { $self->visit_hash_entry( $_, $hash->{$_}, $hash ) } keys %$hash;
+ return $self->retain_magic( $hash, $new_hash );
}
}
@@ -108,9 +115,13 @@
my ( $self, $array ) = @_;
if ( not defined wantarray ) {
+ $self->_register_mapping( $array, $array );
$self->visit_array_entry( $array->[$_], $_, $array ) for 0 .. $#$array
} else {
- return $self->retain_magic( $array, [ map { $self->visit_array_entry( $array->[$_], $_, $array ) } 0 .. $#$array ] );
+ my $new_array = [];
+ $self->_register_mapping( $array, $new_array );
+ @$new_array = map { $self->visit_array_entry( $array->[$_], $_, $array ) } 0 .. $#$array;
+ return $self->retain_magic( $array, $new_array );
}
}
@@ -121,13 +132,23 @@
sub visit_scalar {
my ( $self, $scalar ) = @_;
- return $self->retain_magic( $scalar, \$self->visit( $$scalar ) );
+ my $new_scalar;
+ $self->_register_mapping( $scalar, \$new_scalar );
+ $new_scalar = $self->visit( $$scalar );
+ return $self->retain_magic( $scalar, \$new_scalar );
+}
+
+sub visit_code {
+ my ( $self, $code ) = @_;
+ $self->visit_value($code);
}
sub visit_glob {
my ( $self, $glob ) = @_;
my $new_glob = Symbol::gensym();
+
+ $self->_register_mapping( $glob, $new_glob );
no warnings 'misc'; # Undefined value assigned to typeglob
*$new_glob = $self->visit( *$glob{$_} || next ) for qw/SCALAR ARRAY HASH/;
Modified: branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor/Callback.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor/Callback.pm?rev=11670&op=diff
==============================================================================
--- branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor/Callback.pm (original)
+++ branches/upstream/libdata-visitor-perl/current/lib/Data/Visitor/Callback.pm Wed Dec 26 16:37:43 2007
@@ -6,7 +6,7 @@
use strict;
use warnings;
-use Scalar::Util qw/blessed/;
+use Scalar::Util qw/blessed refaddr/;
__PACKAGE__->mk_accessors( qw/callbacks class_callbacks ignore_return_values/ );
@@ -29,8 +29,20 @@
sub visit {
my ( $self, $data ) = @_;
+
+ my $replaced_hash = local $self->{_replaced} = ($self->{_replaced} || {}); # delete it after we're done with the whole visit
+
local *_ = \$_[1]; # alias $_
- $self->SUPER::visit( $self->callback( visit => $data ) );
+
+ if ( ref $data and exists $replaced_hash->{ refaddr($data) } ) {
+ return $_[1] = $replaced_hash->{ refaddr($data) };
+ } else {
+ my $ret = $self->SUPER::visit( $self->callback( visit => $data ) );
+
+ $replaced_hash->{ refaddr($data) } = $_ if ref $data and ( not ref $_ or refaddr($data) ne refaddr($_) );
+
+ return $ret;
+ }
}
sub visit_value {
@@ -46,6 +58,7 @@
my $ignore = $self->ignore_return_values;
my $new_data = $self->callback( object => $data );
+ $self->_register_mapping( $data, $new_data );
$data = $new_data unless $ignore;
foreach my $class ( @{ $self->class_callbacks } ) {
@@ -58,16 +71,17 @@
}
BEGIN {
- foreach my $reftype ( qw/array hash glob scalar/ ) {
+ foreach my $reftype ( qw/array hash glob scalar code/ ) {
no strict 'refs';
*{"visit_$reftype"} = eval '
sub {
my ( $self, $data ) = @_;
my $new_data = $self->callback( '.$reftype.' => $data );
+ $self->_register_mapping( $data, $new_data );
if ( ref $data eq ref $new_data ) {
- return $self->SUPER::visit_'.$reftype.'( $new_data );
+ return $self->_register_mapping( $data, $self->SUPER::visit_'.$reftype.'( $new_data ) );
} else {
- return $self->SUPER::visit( $new_data );
+ return $self->_register_mapping( $data, $self->visit( $new_data ) );
}
}
' || die $@;
Modified: branches/upstream/libdata-visitor-perl/current/t/callback_aliasing.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-visitor-perl/current/t/callback_aliasing.t?rev=11670&op=diff
==============================================================================
--- branches/upstream/libdata-visitor-perl/current/t/callback_aliasing.t (original)
+++ branches/upstream/libdata-visitor-perl/current/t/callback_aliasing.t Wed Dec 26 16:37:43 2007
@@ -15,7 +15,7 @@
my $o = $m->new(
ignore_return_values => 0,
- plain_value => sub { s/b/m/g; "laaa" },
+ plain_value => sub { no warnings 'uninitialized'; s/b/m/g; "laaa" },
array => sub { $_ = 42; undef},
);
Modified: branches/upstream/libdata-visitor-perl/current/t/circular_refs.t
URL: http://svn.debian.org/wsvn/branches/upstream/libdata-visitor-perl/current/t/circular_refs.t?rev=11670&op=diff
==============================================================================
--- branches/upstream/libdata-visitor-perl/current/t/circular_refs.t (original)
+++ branches/upstream/libdata-visitor-perl/current/t/circular_refs.t Wed Dec 26 16:37:43 2007
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More tests => 11;
use ok "Data::Visitor";
@@ -28,18 +28,63 @@
is_deeply( $o->visit( $structure ), $structure, "Structure recreated" );
+is( $structure, $structure->{foo}{bar}, "circular address" );
-my $orig = {
- one => [ ],
- two => [ ],
-};
+my $visited = $o->visit( $structure );
-$orig->{one}[0] = $orig->{two}[0] = bless {}, "yyy";
+is( $visited, $visited->{foo}{bar}, "circular address" );
-my $c = Data::Visitor::Callback->new(
- object => sub { bless {}, "zzzzz" },
-);
+{
+ my $orig = {
+ one => [ ],
+ two => [ ],
+ };
-my $copy = $c->visit( $orig );
+ my $hash = $orig->{one}[0] = $orig->{two}[0] = bless {}, "yyy";
-is( $copy->{one}[0], $copy->{two}[0], "copy of object is a mapped copy" );
+ my $c = Data::Visitor::Callback->new(
+ object => sub { bless {}, "zzzzz" },
+ );
+
+ my $copy = $c->visit( $orig );
+
+ is( $copy->{one}[0], $copy->{two}[0], "copy of object is a mapped copy" );
+}
+
+
+{
+ my $orig = [
+ [ ],
+ [ ],
+ ];
+
+ my $hash = $orig->[0][0] = $orig->[1][0] = { };
+
+ my $c = Data::Visitor::Callback->new(
+ hash => sub { $_ = { foo => "bar" } },
+ );
+
+ $c->visit( $orig );
+
+ is( $orig->[0][0], $orig->[1][0], "equality preserved" );
+
+ isnt( $orig->[0][0], $hash, "original replaced" );
+
+ is_deeply( $orig->[0][0], { foo => "bar" }, "data is as expected" );
+}
+
+{
+ my $orig = {
+ foo => { obj => bless {}, "blah" },
+ misc => bless {}, "oink",
+ };
+
+ $orig->{foo}{self} = $orig;
+ $orig->{foo}{foo} = $orig->{foo};
+
+ my $c = Data::Visitor::Callback->new();
+
+ my $copy = $c->visit( $orig );
+
+ is_deeply( $copy, $orig, "structure retained" );
+}
More information about the Pkg-perl-cvs-commits
mailing list