r28449 - in /trunk/libdata-visitor-perl: Changes META.yml SIGNATURE debian/changelog lib/Data/Visitor.pm lib/Data/Visitor/Callback.pm t/callback.t t/callback_aliasing.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sun Dec 21 21:50:54 UTC 2008
Author: gregoa
Date: Sun Dec 21 21:50:51 2008
New Revision: 28449
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=28449
Log:
new upstream release, Data::Alias still required
Modified:
trunk/libdata-visitor-perl/Changes
trunk/libdata-visitor-perl/META.yml
trunk/libdata-visitor-perl/SIGNATURE
trunk/libdata-visitor-perl/debian/changelog
trunk/libdata-visitor-perl/lib/Data/Visitor.pm
trunk/libdata-visitor-perl/lib/Data/Visitor/Callback.pm
trunk/libdata-visitor-perl/t/callback.t
trunk/libdata-visitor-perl/t/callback_aliasing.t
Modified: trunk/libdata-visitor-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdata-visitor-perl/Changes?rev=28449&op=diff
==============================================================================
--- trunk/libdata-visitor-perl/Changes (original)
+++ trunk/libdata-visitor-perl/Changes Sun Dec 21 21:50:51 2008
@@ -1,3 +1,6 @@
+0.22
+ - add a no warnings 'recursion', deep recursion is legitimate in most cases
+
0.21
- Fix a bug in Data::Visitor::Callback WRT returning non reference values
from callbacks (#38306).
Modified: trunk/libdata-visitor-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdata-visitor-perl/META.yml?rev=28449&op=diff
==============================================================================
--- trunk/libdata-visitor-perl/META.yml (original)
+++ trunk/libdata-visitor-perl/META.yml Sun Dec 21 21:50:51 2008
@@ -1,19 +1,25 @@
--- #YAML:1.0
-name: Data-Visitor
-version: 0.21
-abstract: ~
-license: ~
-author: ~
-generated_by: ExtUtils::MakeMaker version 6.44
-distribution_type: module
-requires:
- Mouse: 0.06
- namespace::clean: 0.08
- Task::Weaken: 0
- Test::MockObject: 1.04
- Test::More: 0
- Test::use::ok: 0
- Tie::ToObject: 0.01
+name: Data-Visitor
+version: 0.22
+abstract: ~
+author: []
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Mouse: 0.06
+ namespace::clean: 0.08
+ Task::Weaken: 0
+ Test::MockObject: 1.04
+ Test::More: 0
+ Test::use::ok: 0
+ Tie::ToObject: 0.01
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.48
meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.3.html
- version: 1.3
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Modified: trunk/libdata-visitor-perl/SIGNATURE
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdata-visitor-perl/SIGNATURE?rev=28449&op=diff
==============================================================================
--- trunk/libdata-visitor-perl/SIGNATURE (original)
+++ trunk/libdata-visitor-perl/SIGNATURE Sun Dec 21 21:50:51 2008
@@ -14,18 +14,18 @@
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
-SHA1 540130e615abd56c3f3f8fe780f4239bda2e35a9 Changes
+SHA1 789c2b9f7592b5b0359af84a0bad9f518ec63e63 Changes
SHA1 106762d02554191b029a90b21c412fcdeb7a0db3 MANIFEST
SHA1 e8482690dad0ff3aaa335aa5b8b650851e504871 MANIFEST.SKIP
-SHA1 ff8b6b589050387ba8ce949cfff8f42c81d39b24 META.yml
+SHA1 2c87ce7daf991be303b52a411f67d09f0c0c2a97 META.yml
SHA1 77503aee33fccc87148e852ef51462bd6fcbe3ce Makefile.PL
SHA1 6cf45b4e947e1bb11fd188e9866d73eabc936ead TODO
-SHA1 8b70a4559b107f90d89808bfaf5859d4969019d0 lib/Data/Visitor.pm
-SHA1 844edf4f5a2cbdf77e96620c2812f875f99988ae lib/Data/Visitor/Callback.pm
+SHA1 f11c62761248892161c2dfa09f7ac157eccbd780 lib/Data/Visitor.pm
+SHA1 7e00d4c11ea3fcbf59e7919dce782401b65828b3 lib/Data/Visitor/Callback.pm
SHA1 5979c9ecf150b843cb7750f761c0a9c0c1211a41 t/base.t
SHA1 85ffd870fe37f7fd4ce1fc783f366bc50c253a02 t/bugs.t
-SHA1 e4b813021fa680c61cb4229a9ddeb0a22ec5bf82 t/callback.t
-SHA1 3836b0eeb006cc4984e80dec1a537b808c3173d2 t/callback_aliasing.t
+SHA1 a784785f789346f921612b88468e040dc5273bc3 t/callback.t
+SHA1 7868c691e6865c8e19be0030435f8a1524f6d237 t/callback_aliasing.t
SHA1 ba502603afe759f9f22026c8c6527d1753fa6174 t/circular_refs.t
SHA1 54affd2088fa25d8eec562fb8d39e1abd0d123c7 t/globs.t
SHA1 8bd93450c072afbef10a423dd360e8f55cdacd40 t/magic.t
@@ -33,7 +33,7 @@
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.7 (Darwin)
-iD8DBQFIzrMEVCwRwOvSdBgRAhxuAJ4tz/nrKuUOWRz0geJm1/CD6WzBOwCgtrTP
-QRAGjEssTlCNGoUYWYyEa3Y=
-=HixG
+iD8DBQFJSv7FVCwRwOvSdBgRAp82AJ9d3yIA66HnqKbs1aMdo1HY/2fjawCgvyLE
+MidMj+8+0QJ/x1cqitl+8+Y=
+=In2L
-----END PGP SIGNATURE-----
Modified: trunk/libdata-visitor-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdata-visitor-perl/debian/changelog?rev=28449&op=diff
==============================================================================
--- trunk/libdata-visitor-perl/debian/changelog (original)
+++ trunk/libdata-visitor-perl/debian/changelog Sun Dec 21 21:50:51 2008
@@ -1,4 +1,4 @@
-libdata-visitor-perl (0.21-1) UNRELEASED; urgency=low
+libdata-visitor-perl (0.22-1) UNRELEASED; urgency=low
TODO: There is still one unmet B-D; Data-Alias
I did not fill any ITP yet so anyone feel free to go ahead
Modified: trunk/libdata-visitor-perl/lib/Data/Visitor.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdata-visitor-perl/lib/Data/Visitor.pm?rev=28449&op=diff
==============================================================================
--- trunk/libdata-visitor-perl/lib/Data/Visitor.pm (original)
+++ trunk/libdata-visitor-perl/lib/Data/Visitor.pm Sun Dec 21 21:50:51 2008
@@ -9,12 +9,14 @@
use Tie::ToObject;
+no warnings 'recursion';
+
use namespace::clean -except => 'meta';
# the double not makes this no longer undef, so exempt from useless constant warnings in older perls
use constant DEBUG => not not our $DEBUG || $ENV{DATA_VISITOR_DEBUG};
-our $VERSION = "0.21";
+our $VERSION = "0.22";
has tied_as_objects => (
isa => "Bool",
@@ -655,7 +657,9 @@
=head1 AUTHOR
-Yuval Kogman <nothingmuch at woobling.org>
+Yuval Kogman C<< <nothingmuch at woobling.org> >>
+
+Marcel GrE<uuml>nauer, C<< <marcel at cpan.org> >>
=head1 COPYRIGHT & LICENSE
Modified: trunk/libdata-visitor-perl/lib/Data/Visitor/Callback.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdata-visitor-perl/lib/Data/Visitor/Callback.pm?rev=28449&op=diff
==============================================================================
--- trunk/libdata-visitor-perl/lib/Data/Visitor/Callback.pm (original)
+++ trunk/libdata-visitor-perl/lib/Data/Visitor/Callback.pm Sun Dec 21 21:50:51 2008
@@ -7,6 +7,8 @@
use Carp qw(carp);
use Scalar::Util qw/blessed refaddr reftype/;
+
+no warnings 'recursion';
use namespace::clean -except => 'meta';
@@ -101,6 +103,18 @@
}
return ( @_ == 1 ? $ret[0] : @ret );
+}
+
+sub visit_ref {
+ my ( $self, $data ) = @_;
+
+ my $mapped = $self->callback( ref => $data );
+
+ if ( ref $mapped ) {
+ return $self->SUPER::visit_ref($mapped);
+ } else {
+ return $self->visit($mapped);
+ }
}
sub visit_seen {
@@ -199,15 +213,46 @@
}
}
+sub visit_hash_entry {
+ my ( $self, $key, $value, $hash ) = @_;
+
+ my ( $new_key, $new_value ) = $self->callback( hash_entry => $_[1], $_[2], $_[3] );
+
+ unless ( $self->ignore_return_values ) {
+ no warnings 'uninitialized';
+ if ( ref($value) and refaddr($value) != refaddr($new_value) ) {
+ $self->_register_mapping( $value, $new_value );
+ if ( $key ne $new_key ) {
+ return $self->SUPER::visit_hash_entry($new_key, $new_value, $_[3]);
+ } else {
+ return $self->SUPER::visit_hash_entry($_[1], $new_value, $_[3]);
+ }
+ } else {
+ if ( $key ne $new_key ) {
+ return $self->SUPER::visit_hash_entry($new_key, $_[2], $_[3]);
+ } else {
+ return $self->SUPER::visit_hash_entry($_[1], $_[2], $_[3]);
+ }
+ }
+ } else {
+ return $self->SUPER::visit_hash_entry($_[1], $_[2], $_[3]);
+ }
+}
+
sub callback {
my ( $self, $name, $data, @args ) = @_;
if ( my $code = $self->callbacks->{$name} ) {
$self->trace( flow => callback => $name, on => $data ) if DEBUG;
- my $ret = $self->$code( $data, @args );
- return $self->ignore_return_values ? $data : $ret ;
+ if ( wantarray ) {
+ my @ret = $self->$code( $data, @args );
+ return $self->ignore_return_values ? ( $data, @args ) : @ret;
+ } else {
+ my $ret = $self->$code( $data, @args );
+ return $self->ignore_return_values ? $data : $ret ;
+ }
} else {
- return $data;
+ return wantarray ? ( $data, @args ) : $data;
}
}
Modified: trunk/libdata-visitor-perl/t/callback.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdata-visitor-perl/t/callback.t?rev=28449&op=diff
==============================================================================
--- trunk/libdata-visitor-perl/t/callback.t (original)
+++ trunk/libdata-visitor-perl/t/callback.t Sun Dec 21 21:50:51 2008
@@ -3,35 +3,12 @@
use strict;
use warnings;
-use Test::More tests => 12;
+use Test::More tests => 13;
my $m; use ok $m = "Data::Visitor::Callback";
can_ok($m, "new");
-
-my $counters;
-my %callbacks = (
- map {
- my $name = $_;
- $name => sub { $counters->{$name}++; $_[1] }
- } qw(
- visit
- value
- ref_value
- plain_value
- object
- array
- hash
- glob
- scalar
- Moose
- Mammal
- Unrelated::Class
- ),
-);
-
-isa_ok(my $o = $m->new( %callbacks ), $m);
counters_are( "foo", "string", {
visit => 1,
@@ -47,16 +24,19 @@
counters_are( [], "array", {
visit => 1,
+ ref => 1,
array => 1,
});
counters_are( {}, "hash", {
visit => 1,
+ ref => 1,
hash => 1,
});
counters_are( [ "foo" ], "deep array", {
visit => 2,
+ ref => 1,
array => 1,
value => 1,
plain_value => 1,
@@ -86,6 +66,7 @@
counters_are( \10, "scalar_ref", {
visit => 2,
+ ref => 1,
'scalar' => 1,
value => 1,
plain_value => 1,
@@ -95,6 +76,7 @@
our %FOO = ( "foo" => undef );
counters_are( \*FOO, "glob", {
+ ref => 3,
visit => 6,
'scalar' => 1,
hash => 1,
@@ -103,10 +85,51 @@
'glob' => 1,
});
+counters_are( sub { }, "code", {
+ visit => 1,
+ value => 1,
+ ref => 1,
+ ref_value => 1,
+});
+
+counters_are( qr/foo/, "regex", {
+ visit => 1,
+ object => 1,
+});
+
sub counters_are {
my ( $data, $desc, $expected_counters ) = @_;
- $counters = {};
- $o->visit( $data );
+
+ my %counters;
+
+ my %callbacks = (
+ map {
+ my $name = $_;
+ $name => sub { $counters{$name}++ }
+ } qw(
+ visit
+ value
+ ref
+ ref_value
+ plain_value
+ object
+ array
+ hash
+ glob
+ scalar
+ Moose
+ Mammal
+ Unrelated::Class
+ ),
+ );
+
+ my $v = $m->new(
+ ignore_return_values => 1,
+ %callbacks,
+ );
+
+ $v->visit( $data );
+
local $Test::Builder::Level = 2;
- is_deeply( $counters, $expected_counters, $desc );
+ is_deeply( \%counters, $expected_counters, $desc );
}
Modified: trunk/libdata-visitor-perl/t/callback_aliasing.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdata-visitor-perl/t/callback_aliasing.t?rev=28449&op=diff
==============================================================================
--- trunk/libdata-visitor-perl/t/callback_aliasing.t (original)
+++ trunk/libdata-visitor-perl/t/callback_aliasing.t Sun Dec 21 21:50:51 2008
@@ -3,34 +3,36 @@
use strict;
use warnings;
-use Test::More tests => 4;
+use Test::More tests => 7;
my $m; use ok $m = "Data::Visitor::Callback";
-my $structure = {
- foo => "bar",
- gorch => [ "baz", 1 ],
-};
+foreach my $ignore ( 0, 1 ) {
+ my $structure = {
+ foo => "bar",
+ gorch => [ "baz", 1 ],
+ };
-my $o = $m->new(
- ignore_return_values => 0,
- plain_value => sub { no warnings 'uninitialized'; s/b/m/g; "laaa" },
- array => sub { $_ = 42; undef},
-);
+ my $o = $m->new(
+ ignore_return_values => $ignore,
+ plain_value => sub { no warnings 'uninitialized'; s/b/m/g; "laaa" },
+ array => sub { $_ = 42; undef },
+ );
-$o->visit( $structure );
+ $_ = "original";
-$_ = "original";
+ $o->visit( $structure );
-is_deeply( $structure, {
- foo => "mar",
- gorch => 42,
-}, "values were modified" );
+ is( $_, "original", '$_ unchanged in outer scope');
-is( $_, "original", '$_ unchanged in outer scope');
+ is_deeply( $structure, {
+ foo => "mar",
+ gorch => 42,
+ }, "values were modified" );
-$o->callbacks->{hash} = sub { $_ = "value" };
-$o->visit( $structure );
-is( $structure, "value", "entire structure can also be changed");
+ $o->callbacks->{hash} = sub { $_ = "value" };
+ $o->visit( $structure );
+ is( $structure, "value", "entire structure can also be changed");
+}
More information about the Pkg-perl-cvs-commits
mailing list