Commit upstream/0.05 - libdata-visitor-perl

+6

-0

Changes less more

	0	0.05
	1	- Added support for using class names as callbacks in
	2	Data::Visitor::Callback
	3	- Improved semantics of multiple instances of the same reference in a depe
	4	structure (will be mapped once, same mapped value used per each instance)
	5
0	6	0.04
1	7	- Specified that the Test::MockObject dep need 1.04
2	8

+2

-2

META.yml less more

0	0	---
1	1	name: Data-Visitor
2		version: 0.04
	2	version: 0.05
3	3	author:
4	4	- 'Yuval Kogman <nothingmuch@woobling.org>'
5	5	abstract: Visitor style traversal of Perl data structures

14	14	provides:
15	15	Data::Visitor:
16	16	file: lib/Data/Visitor.pm
17		version: 0.04
	17	version: 0.05
18	18	Data::Visitor::Callback:
19	19	file: lib/Data/Visitor/Callback.pm
20	20	generated_by: Module::Build version 0.2611

+9

-9

SIGNATURE less more

14	14	Hash: SHA1
15	15
16	16	SHA1 06f5b6d95515ba96f5959689229f21b3170f5dfd Build.PL
17		SHA1 92556b1da696ac12d880194f7dc60f5c4b61715d Changes
	17	SHA1 53f8448f047d96020f991b32dda4cf8be1226668 Changes
18	18	SHA1 a067314adf7a4d16b1576c149abc7621cda096b3 MANIFEST
19		SHA1 1e3c9ba576b12fc0674fa78946d6d8be3d1ec605 META.yml
	19	SHA1 c81a2f91d8059165f8c6ebc8622b20dd93d8bf18 META.yml
20	20	SHA1 79359b08955f73774b2515dbf25deb7a28195cd3 Makefile.PL
21		SHA1 9e1925d5eb338398d7d3f6d67a3aa2156310dfbb lib/Data/Visitor.pm
22		SHA1 5713e1145bf7b9a3a81564d42e73148b445cb718 lib/Data/Visitor/Callback.pm
	21	SHA1 8597a454f955abd8ee6097a1e3301e09d06267af lib/Data/Visitor.pm
	22	SHA1 daa5c3b3a4d1b917ddf824805e2b8f81b6d24d63 lib/Data/Visitor/Callback.pm
23	23	SHA1 3180f412df2834d1f1c9290e9b8726d0b374afc2 t/base.t
24	24	SHA1 257c858e1bc12c1039e93cac62a0d37f2e0d804d t/bugs.t
25		SHA1 915e0a329acabb60b35f61ffef7d97a8bee57da0 t/callback.t
	25	SHA1 2ddc55b7127db5216879fce4c165b360923eca18 t/callback.t
26	26	SHA1 7e59409671d0147236beef17a6dfdc0997d6a97a t/callback_aliasing.t
27		SHA1 ae984fed9ab572d06d3cdc86f61aa4f1594d2447 t/circular_refs.t
	27	SHA1 9f6dff4facaf491f3776fec263d13acd4448de33 t/circular_refs.t
28	28	SHA1 54affd2088fa25d8eec562fb8d39e1abd0d123c7 t/globs.t
29	29	-----BEGIN PGP SIGNATURE-----
30	30	Version: GnuPG v1.4.1 (Darwin)
31	31
32		iD8DBQFEL4cNVCwRwOvSdBgRAv8OAJ4t5y8xYgEN29YnZa5dQmsBBiBTfgCffKme
33		L1XdJHBzZdO9e0Vno3xMjoU=
34		=UW9k
	32	iD8DBQFESje9VCwRwOvSdBgRAjwhAKC4ZT+AXcfVUWKR8RQOJ3V9rzB/JQCgqmfX
	33	IdKDpoCeuMIDi4hYmI9Dc+s=
	34	=TXup
35	35	-----END PGP SIGNATURE-----

+20

-4

lib/Data/Visitor/Callback.pm less more

5	5	use strict;
6	6	use warnings;
7	7
8		__PACKAGE__->mk_accessors( qw/callbacks ignore_return_values/ );
	8	use Scalar::Util qw/blessed/;
	9
	10	__PACKAGE__->mk_accessors( qw/callbacks class_callbacks ignore_return_values/ );
9	11
10	12	sub new {
11	13	my ( $class, %callbacks ) = @_;

15	17	$ignore_ret = delete $callbacks{ignore_return_values};
16	18	}
17	19
	20	my @class_callbacks = grep { $_->can("isa") } keys %callbacks;
	21
18	22	$class->SUPER::new({
19	23	ignore_return_values => $ignore_ret,
20	24	callbacks => \%callbacks,
	25	class_callbacks => \@class_callbacks,
21	26	});
22	27	}
23	28

36	41
37	42	sub visit_object {
38	43	my ( $self, $data ) = @_;
39		$self->callback( object => $data );
	44	$data = $self->callback( object => $data );
	45
	46	foreach my $class ( @{ $self->class_callbacks } ) {
	47	$data = $self->callback( $class => $data ) if $data->isa($class);
	48	}
	49
	50	$data;
40	51	}
41	52
42	53	BEGIN {

47	58	my ( $self, $data ) = @_;
48	59	my $new_data = $self->callback( '.$reftype.' => $data );
49	60	if ( ref $data eq ref $new_data ) {
50		$self->SUPER::visit_'.$reftype.'( $new_data );
	61	return $self->SUPER::visit_'.$reftype.'( $new_data );
51	62	} else {
52		$self->SUPER::visit( $new_data );
	63	return $self->SUPER::visit( $new_data );
53	64	}
54	65	}
55	66	' \|\| die $@;

156	167
157	168	Called for blessed objects.
158	169
	170	=item Some::Class
	171
	172	You can use any class name as a clalback. This is clled only after the
	173	C<object> callback.
	174
159	175	=item array
160	176
161	177	Called for array references.

+29

-6

lib/Data/Visitor.pm less more

5	5	use strict;
6	6	use warnings;
7	7
8		use Scalar::Util ();
	8	use Scalar::Util qw/blessed refaddr/;
9	9	use overload ();
10	10	use Symbol ();
11	11
12		our $VERSION = "0.04";
	12	our $VERSION = "0.05";
13	13
14	14	sub visit {
15	15	my ( $self, $data ) = @_;
16	16
17		local $self->{_seen} = ($self->{_seen} \|\| {});
18		return $data if ref $data and $self->{_seen}{ overload::StrVal( $data ) }++;
19
20		if ( Scalar::Util::blessed( $data ) ) {
	17	my $seen_hash = local $self->{_seen} = ($self->{_seen} \|\| {}); # delete it after we're done with the whole visit
	18	if ( ref $data ) { # only references need recursion checks
	19	if ( exists $seen_hash->{ refaddr( $data ) } ) { # if it's been seen
	20	return $seen_hash->{ refaddr( $data ) }; # return whatever it was mapped to
	21	} else {
	22	my $seen = \( $seen_hash->{ refaddr( $data ) } );
	23	$$seen = $data;
	24
	25	if ( defined wantarray ) {
	26	return $$seen = $self->visit_no_rec_check( $data );
	27	} else {
	28	return $self->visit_no_rec_check( $data );
	29	}
	30	}
	31	} else {
	32	return $self->visit_no_rec_check( $data );
	33	}
	34	}
	35
	36	sub visit_no_rec_check {
	37	my ( $self, $data ) = @_;
	38
	39	if ( blessed( $data ) ) {
21	40	return $self->visit_object( $data );
22	41	} elsif ( my $reftype = ref $data ) {
23	42	if ( $reftype eq "HASH" or $reftype eq "ARRAY" or $reftype eq "GLOB" or $reftype eq "SCALAR") {

173	192	behavior, make sure to retain the functionality of C<visit_array> and
174	193	C<visit_hash>.
175	194
	195	=head1 TODO
	196
	197	Add support for "natural" visiting of trees.
	198
176	199	=head1 SEE ALSO
177	200
178	201	L<Tree::Simple::VisitorFactory>, L<Data::Traverse>

+18

-2

t/callback.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 11;
	5	use Test::More tests => 12;
6	6
7	7
8	8	my $m; use ok $m = "Data::Visitor::Callback";

24	24	hash
25	25	glob
26	26	scalar
	27	Moose
	28	Mammal
27	29	),
28	30	);
29	31

58	60	plain_value => 1,
59	61	});
60	62
61		counters_are( bless({}, "Moose"), "objecct", {
	63	{
	64	package Mammal;
	65	package Moose;
	66	our @ISA = ("Mammal");
	67	}
	68
	69	counters_are( bless({}, "Moose"), "object", {
62	70	visit => 1,
63	71	object => 1,
	72	Moose => 1,
	73	Mammal => 1,
	74	});
	75
	76	counters_are( bless({}, "Mammal"), "object", {
	77	visit => 1,
	78	object => 1,
	79	Mammal => 1,
64	80	});
65	81
66	82	counters_are( \10, "scalar_ref", {

+19

-3

t/circular_refs.t less more

2	2	use strict;
3	3	use warnings;
4	4
5		use Test::More tests => 3;
	5	use Test::More tests => 5;
6	6
7	7
8		my $m; use ok $m = "Data::Visitor";
	8	use ok "Data::Visitor";
	9	use ok "Data::Visitor::Callback";
9	10
10	11	my $structure = {
11	12	foo => {

15	16
16	17	$structure->{foo}{bar} = $structure;
17	18
18		my $o = $m->new;
	19	my $o = Data::Visitor->new;
19	20
20	21	{
21	22	alarm 1;

26	27
27	28	is_deeply( $o->visit( $structure ), $structure, "Structure recreated" );
28	29
	30
	31	my $orig = {
	32	one => [ ],
	33	two => [ ],
	34	};
	35
	36	$orig->{one}[0] = $orig->{two}[0] = bless {}, "yyy";
	37
	38	my $c = Data::Visitor::Callback->new(
	39	object => sub { bless {}, "zzzzz" },
	40	);
	41
	42	my $copy = $c->visit( $orig );
	43
	44	is( $copy->{one}[0], $copy->{two}[0], "copy of object is a mapped copy" );