r2643 - in /packages/libdata-visitor-perl/branches/upstream/current: Changes META.yml SIGNATURE lib/Data/Visitor.pm lib/Data/Visitor/Callback.pm t/callback.t t/circular_refs.t

eloy at users.alioth.debian.org eloy at users.alioth.debian.org
Wed Apr 26 08:01:51 UTC 2006


Author: eloy
Date: Wed Apr 26 08:01:47 2006
New Revision: 2643

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=2643
Log:
Load /tmp/tmp.QB07PS/libdata-visitor-perl-0.05 into
packages/libdata-visitor-perl/branches/upstream/current.

Modified:
    packages/libdata-visitor-perl/branches/upstream/current/Changes
    packages/libdata-visitor-perl/branches/upstream/current/META.yml
    packages/libdata-visitor-perl/branches/upstream/current/SIGNATURE
    packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor.pm
    packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor/Callback.pm
    packages/libdata-visitor-perl/branches/upstream/current/t/callback.t
    packages/libdata-visitor-perl/branches/upstream/current/t/circular_refs.t

Modified: packages/libdata-visitor-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/branches/upstream/current/Changes?rev=2643&op=diff
==============================================================================
--- packages/libdata-visitor-perl/branches/upstream/current/Changes (original)
+++ packages/libdata-visitor-perl/branches/upstream/current/Changes Wed Apr 26 08:01:47 2006
@@ -1,3 +1,9 @@
+0.05
+	- Added support for using class names as callbacks in
+	  Data::Visitor::Callback
+	- Improved semantics of multiple instances of the same reference in a depe
+	  structure (will be mapped once, same mapped value used per each instance)
+
 0.04
 	- Specified that the Test::MockObject dep need 1.04
 

Modified: packages/libdata-visitor-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/branches/upstream/current/META.yml?rev=2643&op=diff
==============================================================================
--- packages/libdata-visitor-perl/branches/upstream/current/META.yml (original)
+++ packages/libdata-visitor-perl/branches/upstream/current/META.yml Wed Apr 26 08:01:47 2006
@@ -1,6 +1,6 @@
 ---
 name: Data-Visitor
-version: 0.04
+version: 0.05
 author:
   - 'Yuval Kogman <nothingmuch at woobling.org>'
 abstract: Visitor style traversal of Perl data structures
@@ -15,7 +15,7 @@
 provides:
   Data::Visitor:
     file: lib/Data/Visitor.pm
-    version: 0.04
+    version: 0.05
   Data::Visitor::Callback:
     file: lib/Data/Visitor/Callback.pm
 generated_by: Module::Build version 0.2611

Modified: packages/libdata-visitor-perl/branches/upstream/current/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/branches/upstream/current/SIGNATURE?rev=2643&op=diff
==============================================================================
--- packages/libdata-visitor-perl/branches/upstream/current/SIGNATURE (original)
+++ packages/libdata-visitor-perl/branches/upstream/current/SIGNATURE Wed Apr 26 08:01:47 2006
@@ -15,22 +15,22 @@
 Hash: SHA1
 
 SHA1 06f5b6d95515ba96f5959689229f21b3170f5dfd Build.PL
-SHA1 92556b1da696ac12d880194f7dc60f5c4b61715d Changes
+SHA1 53f8448f047d96020f991b32dda4cf8be1226668 Changes
 SHA1 a067314adf7a4d16b1576c149abc7621cda096b3 MANIFEST
-SHA1 1e3c9ba576b12fc0674fa78946d6d8be3d1ec605 META.yml
+SHA1 c81a2f91d8059165f8c6ebc8622b20dd93d8bf18 META.yml
 SHA1 79359b08955f73774b2515dbf25deb7a28195cd3 Makefile.PL
-SHA1 9e1925d5eb338398d7d3f6d67a3aa2156310dfbb lib/Data/Visitor.pm
-SHA1 5713e1145bf7b9a3a81564d42e73148b445cb718 lib/Data/Visitor/Callback.pm
+SHA1 8597a454f955abd8ee6097a1e3301e09d06267af lib/Data/Visitor.pm
+SHA1 daa5c3b3a4d1b917ddf824805e2b8f81b6d24d63 lib/Data/Visitor/Callback.pm
 SHA1 3180f412df2834d1f1c9290e9b8726d0b374afc2 t/base.t
 SHA1 257c858e1bc12c1039e93cac62a0d37f2e0d804d t/bugs.t
-SHA1 915e0a329acabb60b35f61ffef7d97a8bee57da0 t/callback.t
+SHA1 2ddc55b7127db5216879fce4c165b360923eca18 t/callback.t
 SHA1 7e59409671d0147236beef17a6dfdc0997d6a97a t/callback_aliasing.t
-SHA1 ae984fed9ab572d06d3cdc86f61aa4f1594d2447 t/circular_refs.t
+SHA1 9f6dff4facaf491f3776fec263d13acd4448de33 t/circular_refs.t
 SHA1 54affd2088fa25d8eec562fb8d39e1abd0d123c7 t/globs.t
 -----BEGIN PGP SIGNATURE-----
 Version: GnuPG v1.4.1 (Darwin)
 
-iD8DBQFEL4cNVCwRwOvSdBgRAv8OAJ4t5y8xYgEN29YnZa5dQmsBBiBTfgCffKme
-L1XdJHBzZdO9e0Vno3xMjoU=
-=UW9k
+iD8DBQFESje9VCwRwOvSdBgRAjwhAKC4ZT+AXcfVUWKR8RQOJ3V9rzB/JQCgqmfX
+IdKDpoCeuMIDi4hYmI9Dc+s=
+=TXup
 -----END PGP SIGNATURE-----

Modified: packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor.pm?rev=2643&op=diff
==============================================================================
--- packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor.pm (original)
+++ packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor.pm Wed Apr 26 08:01:47 2006
@@ -6,19 +6,38 @@
 use strict;
 use warnings;
 
-use Scalar::Util ();
+use Scalar::Util qw/blessed refaddr/;
 use overload ();
 use Symbol ();
 
-our $VERSION = "0.04";
+our $VERSION = "0.05";
 
 sub visit {
 	my ( $self, $data ) = @_;
 
-	local $self->{_seen} = ($self->{_seen} || {});
-	return $data if ref $data and $self->{_seen}{ overload::StrVal( $data ) }++;
-
-	if ( Scalar::Util::blessed( $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 );
+			}
+		}
+	} else {
+		return $self->visit_no_rec_check( $data );
+	}
+}
+
+sub visit_no_rec_check {
+	my ( $self, $data ) = @_;
+
+	if ( blessed( $data ) ) {
 		return $self->visit_object( $data );
 	} elsif ( my $reftype = ref $data ) {
 		if ( $reftype eq "HASH" or $reftype eq "ARRAY" or $reftype eq "GLOB" or $reftype eq "SCALAR") {
@@ -174,6 +193,10 @@
 behavior, make sure to retain the functionality of C<visit_array> and
 C<visit_hash>.
 
+=head1 TODO
+
+Add support for "natural" visiting of trees.
+
 =head1 SEE ALSO
 
 L<Tree::Simple::VisitorFactory>, L<Data::Traverse>

Modified: packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor/Callback.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor/Callback.pm?rev=2643&op=diff
==============================================================================
--- packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor/Callback.pm (original)
+++ packages/libdata-visitor-perl/branches/upstream/current/lib/Data/Visitor/Callback.pm Wed Apr 26 08:01:47 2006
@@ -6,7 +6,9 @@
 use strict;
 use warnings;
 
-__PACKAGE__->mk_accessors( qw/callbacks ignore_return_values/ );
+use Scalar::Util qw/blessed/;
+
+__PACKAGE__->mk_accessors( qw/callbacks class_callbacks ignore_return_values/ );
 
 sub new {
 	my ( $class, %callbacks ) = @_;
@@ -16,9 +18,12 @@
 		$ignore_ret = delete $callbacks{ignore_return_values};
 	}
 
+	my @class_callbacks = grep { $_->can("isa") } keys %callbacks;
+
 	$class->SUPER::new({
 		ignore_return_values => $ignore_ret,
 		callbacks => \%callbacks,
+		class_callbacks => \@class_callbacks,
 	});
 }
 
@@ -37,7 +42,13 @@
 
 sub visit_object {
 	my ( $self, $data ) = @_;
-	$self->callback( object => $data );
+	$data = $self->callback( object => $data );
+
+	foreach my $class ( @{ $self->class_callbacks } ) {
+		$data = $self->callback( $class => $data ) if $data->isa($class);
+	}
+
+	$data;
 }
 
 BEGIN {
@@ -48,9 +59,9 @@
 				my ( $self, $data ) = @_;
 				my $new_data = $self->callback( '.$reftype.' => $data );
 				if ( ref $data eq ref $new_data ) {
-					$self->SUPER::visit_'.$reftype.'( $new_data );
+					return $self->SUPER::visit_'.$reftype.'( $new_data );
 				} else {
-					$self->SUPER::visit( $new_data );
+					return $self->SUPER::visit( $new_data );
 				}
 			}
 		' || die $@;
@@ -157,6 +168,11 @@
 
 Called for blessed objects.
 
+=item Some::Class
+
+You can use any class name as a clalback. This is clled only after the
+C<object> callback.
+
 =item array
 
 Called for array references.

Modified: packages/libdata-visitor-perl/branches/upstream/current/t/callback.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/branches/upstream/current/t/callback.t?rev=2643&op=diff
==============================================================================
--- packages/libdata-visitor-perl/branches/upstream/current/t/callback.t (original)
+++ packages/libdata-visitor-perl/branches/upstream/current/t/callback.t Wed Apr 26 08:01:47 2006
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 11;
+use Test::More tests => 12;
 
 
 my $m; use ok $m = "Data::Visitor::Callback";
@@ -25,6 +25,8 @@
 		hash
 		glob
 		scalar
+		Moose
+		Mammal
 	),
 );
 
@@ -59,9 +61,23 @@
 	plain_value => 1,
 });
 
-counters_are( bless({}, "Moose"), "objecct", {
+{
+	package Mammal;
+	package Moose;
+	our @ISA = ("Mammal");
+}
+
+counters_are( bless({}, "Moose"), "object", {
 	visit => 1,
 	object => 1,
+	Moose => 1,
+	Mammal => 1,
+});
+
+counters_are( bless({}, "Mammal"), "object", {
+	visit => 1,
+	object => 1,
+	Mammal => 1,
 });
 
 counters_are( \10, "scalar_ref", {

Modified: packages/libdata-visitor-perl/branches/upstream/current/t/circular_refs.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/branches/upstream/current/t/circular_refs.t?rev=2643&op=diff
==============================================================================
--- packages/libdata-visitor-perl/branches/upstream/current/t/circular_refs.t (original)
+++ packages/libdata-visitor-perl/branches/upstream/current/t/circular_refs.t Wed Apr 26 08:01:47 2006
@@ -3,10 +3,11 @@
 use strict;
 use warnings;
 
-use Test::More tests => 3;
+use Test::More tests => 5;
 
 
-my $m; use ok $m = "Data::Visitor";
+use ok "Data::Visitor";
+use ok "Data::Visitor::Callback";
 
 my $structure = {
 	foo => {
@@ -16,7 +17,7 @@
 
 $structure->{foo}{bar} = $structure;
 
-my $o = $m->new;
+my $o = Data::Visitor->new;
 
 {
 	alarm 1;
@@ -27,3 +28,18 @@
 
 is_deeply( $o->visit( $structure ), $structure, "Structure recreated" );
 
+
+my $orig = {
+	one => [ ],
+	two => [ ],
+};
+
+$orig->{one}[0] = $orig->{two}[0] = bless {}, "yyy";
+
+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" );




More information about the Pkg-perl-cvs-commits mailing list