r2645 - in /packages/libdata-visitor-perl/trunk: Changes META.yml
SIGNATURE
debian/changelog 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:07:53 UTC 2006
Author: eloy
Date: Wed Apr 26 08:07:48 2006
New Revision: 2645
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=2645
Log:
eloy: new upstream version
Modified:
packages/libdata-visitor-perl/trunk/Changes
packages/libdata-visitor-perl/trunk/META.yml
packages/libdata-visitor-perl/trunk/SIGNATURE
packages/libdata-visitor-perl/trunk/debian/changelog
packages/libdata-visitor-perl/trunk/lib/Data/Visitor.pm
packages/libdata-visitor-perl/trunk/lib/Data/Visitor/Callback.pm
packages/libdata-visitor-perl/trunk/t/callback.t
packages/libdata-visitor-perl/trunk/t/circular_refs.t
Modified: packages/libdata-visitor-perl/trunk/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/trunk/Changes?rev=2645&op=diff
==============================================================================
--- packages/libdata-visitor-perl/trunk/Changes (original)
+++ packages/libdata-visitor-perl/trunk/Changes Wed Apr 26 08:07:48 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/trunk/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/trunk/META.yml?rev=2645&op=diff
==============================================================================
--- packages/libdata-visitor-perl/trunk/META.yml (original)
+++ packages/libdata-visitor-perl/trunk/META.yml Wed Apr 26 08:07:48 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/trunk/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/trunk/SIGNATURE?rev=2645&op=diff
==============================================================================
--- packages/libdata-visitor-perl/trunk/SIGNATURE (original)
+++ packages/libdata-visitor-perl/trunk/SIGNATURE Wed Apr 26 08:07:48 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/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/trunk/debian/changelog?rev=2645&op=diff
==============================================================================
--- packages/libdata-visitor-perl/trunk/debian/changelog (original)
+++ packages/libdata-visitor-perl/trunk/debian/changelog Wed Apr 26 08:07:48 2006
@@ -1,3 +1,9 @@
+libdata-visitor-perl (0.05-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Krzysztof Krzyzaniak (eloy) <eloy at debian.org> Wed, 26 Apr 2006 10:02:01 +0200
+
libdata-visitor-perl (0.04-1) unstable; urgency=low
* New upstream release
Modified: packages/libdata-visitor-perl/trunk/lib/Data/Visitor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/trunk/lib/Data/Visitor.pm?rev=2645&op=diff
==============================================================================
--- packages/libdata-visitor-perl/trunk/lib/Data/Visitor.pm (original)
+++ packages/libdata-visitor-perl/trunk/lib/Data/Visitor.pm Wed Apr 26 08:07:48 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/trunk/lib/Data/Visitor/Callback.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/trunk/lib/Data/Visitor/Callback.pm?rev=2645&op=diff
==============================================================================
--- packages/libdata-visitor-perl/trunk/lib/Data/Visitor/Callback.pm (original)
+++ packages/libdata-visitor-perl/trunk/lib/Data/Visitor/Callback.pm Wed Apr 26 08:07:48 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/trunk/t/callback.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/trunk/t/callback.t?rev=2645&op=diff
==============================================================================
--- packages/libdata-visitor-perl/trunk/t/callback.t (original)
+++ packages/libdata-visitor-perl/trunk/t/callback.t Wed Apr 26 08:07:48 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/trunk/t/circular_refs.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libdata-visitor-perl/trunk/t/circular_refs.t?rev=2645&op=diff
==============================================================================
--- packages/libdata-visitor-perl/trunk/t/circular_refs.t (original)
+++ packages/libdata-visitor-perl/trunk/t/circular_refs.t Wed Apr 26 08:07:48 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