Data-Visitor

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN


0.31      2020-08-02 22:39:31Z
    - updated distribution tooling (resolves RT#133059, a problem with the
      compilation test when the installed perl has whitespace in its path)

0.30  2013-06-24
    - doy/data-visitor should probably be the canonical repository at this
      point

0.29  2013-06-24
    - The class callbacks to be run for an object are now chosen once, at the
      start of visiting that object. Previously, it always looked through the
      entire list of callbacks every time, in a loop in which the object in
      question could be changed by the callback. Since the class callbacks are
      only partially ordered, this lead to differences in whether a callback
      would be called or not based on hash order. reported by Robin Smidsrød.

0.28  2012-02-12
    - convert to dzil
    - bump namespace::clean dep
    - better error message if Data::Alias isn't found
    - doc fixes

0.27    2010-02-03

Changes  view on Meta::CPAN

0.24    2009-04-11
	- use get_all_attributes instead of the deprecated
	  compute_all_applicable_attributes (rafl)
	- Switch to Any::Moose

0.22    2008-12-19
	- add a no warnings 'recursion', deep recursion is legitimate in most cases

0.21    2008-09-15
	- Fix a bug in Data::Visitor::Callback WRT returning non reference values
	  from callbacks (#38306).
	- Refactor the visit_tied split
	- Propagation of void context

0.20    2008-09-12
	- Split visit_tied into methods per each reftype, to make it possible to
	  return something that is an object but still doesn't get tied.

0.19    2008-08-26
	- Support multiple arguments to visit()
	- use BUILDARGS for argument processing

Changes  view on Meta::CPAN

	- Weak reference support

0.17    2008-07-19
	- More void context correctness fixes WRT tied values
	- Overzealous seen value mappings made by Callback were removed

0.16    2008-07-19
	- Fix passing of void context when visiting hashes/arrays (perf
	  optimization to avoid unnecessary cloning)
	- Added 'visit_seen' and a 'seen' callback for circular structures
	- Class callbacks are now fired from least derived to most derived, not in
	  hash key order

0.15    2008-01-15
	- Fixed a compilation warning under 5.6.2
	- Disabled consistent replacement of values when assigning to $_ under
	  5.6.2 due to a limitation. 5.8 is required for that feature to work
	  properly. Instead, a warning will be issued and the value will be
	  revisited.

0.14    2008-01-13

Changes  view on Meta::CPAN

	- add retain_magic and use it to keep blessedness of mapped objects that
	  were forced into being visited by "regular" ref visitor methods

0.07    2007-05-20
	- Refactor visit_ref
	- Removed build_requires, to try and eliminate some odd installation
	  problems. This also fixes the Class::Accessor dep which was in the wrong
	  slot anyway ;-)

0.05    2006-04-22
	- 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    2006-04-02
	- Specified that the Test::MockObject dep need 1.04

0.03    2006-03-22
	- add Class::Accessor to requirements

lib/Data/Visitor/Callback.pm  view on Meta::CPAN

package Data::Visitor::Callback;
use Moose;
# ABSTRACT: A Data::Visitor with callbacks.

our $VERSION = '0.32';
use Data::Visitor ();

use Carp qw(carp);
use Scalar::Util qw/blessed refaddr reftype/;

no warnings 'recursion';

use namespace::clean -except => 'meta';

use constant DEBUG => Data::Visitor::DEBUG();
use constant FIVE_EIGHT => ( $] >= 5.008 );

extends qw(Data::Visitor);

has callbacks => (
	isa => "HashRef",
	is  => "rw",
	default => sub { {} },
);

has class_callbacks => (
	isa => "ArrayRef",
	is  => "rw",
	default => sub { [] },
);

has ignore_return_values => (
	isa => "Bool",
	is  => "rw",
);

sub BUILDARGS {
	my ( $class, @args ) = @_;

	my $args = $class->SUPER::BUILDARGS(@args);

	my %init_args = map { $_->init_arg => undef } $class->meta->get_all_attributes;

	my %callbacks = map { $_ => $args->{$_} } grep { not exists $init_args{$_} } keys %$args;

	my @class_callbacks = do {
		no strict 'refs';
		grep {
			# this check can be half assed because an ->isa check will be
			# performed later. Anything that cold plausibly be a class name
			# should be included in the list, even if the class doesn't
			# actually exist.

			m{ :: | ^[A-Z] }x # if it looks kinda lack a class name
				or
			scalar keys %{"${_}::"} # or it really is a class
		} keys %callbacks;
	};

	# sort from least derived to most derived
	@class_callbacks = sort { !$a->isa($b) <=> !$b->isa($a) } @class_callbacks;

	return {
		%$args,
		callbacks       => \%callbacks,
		class_callbacks => \@class_callbacks,
	};
}

sub visit {
	my $self = shift;

	my $replaced_hash = local $self->{_replaced} = ($self->{_replaced} || {}); # delete it after we're done with the whole visit

	my @ret;

lib/Data/Visitor/Callback.pm  view on Meta::CPAN


sub visit_object {
	my ( $self, $data ) = @_;

	$self->trace( flow => visit_object => $data ) if DEBUG;

	$data = $self->callback_and_reg( object => $data );

	my $class_cb = 0;

	foreach my $class ( grep { $data->isa($_) } @{ $self->class_callbacks } ) {
		last unless blessed($data);
		die "Unexpected object $data found"
			unless $data->isa($class);
		$self->trace( flow => class_callback => $class, on => $data ) if DEBUG;

		$class_cb++;
		$data = $self->callback_and_reg( $class => $data );
	}

	$data = $self->callback_and_reg( object_no_class => $data ) unless $class_cb;

lib/Data/Visitor/Callback.pm  view on Meta::CPAN

			}
		}
	} 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;
		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 wantarray ? ( $data, @args ) : $data;

lib/Data/Visitor/Callback.pm  view on Meta::CPAN

__PACKAGE__;

__END__

=pod

=encoding UTF-8

=head1 NAME

Data::Visitor::Callback - A Data::Visitor with callbacks.

=head1 VERSION

version 0.32

=head1 SYNOPSIS

	use Data::Visitor::Callback;

	my $v = Data::Visitor::Callback->new(
		# you can provide callbacks
		# $_ will contain the visited value

		value => sub { ... },
		array => sub { ... },


		# you can also delegate to method names
		# this specific example will force traversal on objects, by using the
		# 'visit_ref' callback which normally traverse unblessed references

		object => "visit_ref",


		# you can also use class names as callbacks
		# the callback will be invoked on all objects which inherit that class

		'Some::Class' => sub {
			my ( $v, $obj ) = @_; # $v is the visitor

			...
		},
	);

	$v->visit( $some_perl_value );

=head1 DESCRIPTION

This is a L<Data::Visitor> subclass that lets you invoke callbacks instead of
needing to subclass yourself.

=head1 METHODS

=over 4

=item new %opts, %callbacks

Construct a new visitor.

The options supported are:

=over 4

=item ignore_return_values

When this is true (off by default) the return values from the callbacks are
ignored, thus disabling the fmapping behavior as documented in
L<Data::Visitor>.

This is useful when you want to modify $_ directly

=item tied_as_objects

Whether or not to visit the L<perlfunc/tied> of a tied structure instead of
pretending the structure is just a normal one.

See L<Data::Visitor/visit_tied>.

=back

=back

=head1 CALLBACKS

Use these keys for the corresponding callbacks.

The callback is in the form:

	sub {
		my ( $visitor, $data ) = @_;

		# or you can use $_, it's aliased

		return $data; # or modified data
	}

lib/Data/Visitor/Callback.pm  view on Meta::CPAN

It is recommended that you specify the classes (or base classes) you want
though, instead of just visiting any object forcefully.

=item Some::Class

You can use any class name as a callback. This is called only after the
C<object> callback.

If the object C<isa> the class then the callback will fire.

These callbacks are called from least derived to most derived by comparing the
classes' C<isa> at construction time.

=item object_no_class

Called for every object that did not have a class callback.

=item object_final

The last callback called for objects, useful if you want to post process the
output of any class callbacks.

=item array

Called for array references.

=item hash

Called for hash references.

=item glob

t/bugs.t  view on Meta::CPAN


sub newcb { Data::Visitor::Callback->new( @_ ) }
ok( !newcb()->ignore_return_values, "ignore_return_values defaults to false" );
is( newcb( ignore_return_values => 1 )->ignore_return_values, 1, "but can be set as initial param" );

{
	my $data = {
		action => 'original'
	};

	my $callbacks = {
		value => sub {
			my( $visitor, $data ) = @_;
# program gets to here and $data eq 'original'
			return 'modified';
		}
	};

	my $v = Data::Visitor::Callback->new( %$callbacks );

	is_deeply( $v->visit($data), { modified => "modified" } );
}

done_testing;

t/callback.t  view on Meta::CPAN

counters_are( qr/foo/, "regex", {
	visit => 1,
	object => 1,
});

sub counters_are {
	my ( $data, $desc, $expected_counters ) = @_;

	my %counters;

	my %callbacks = (
		map {
			my $name = $_;
			$name => sub { $counters{$name}++ }
		} qw(
			visit
			value
			ref
			ref_value
			plain_value
			object

t/callback.t  view on Meta::CPAN

			glob
			scalar
			Moose
			Mammal
			Unrelated::Class
		),
	);

	my $v = Data::Visitor::Callback->new(
		ignore_return_values => 1,
		%callbacks,
	);

	$v->visit( $data );

	local $Test::Builder::Level = 2;
	is_deeply( \%counters, $expected_counters, $desc );
}

done_testing

t/callback_aliasing.t  view on Meta::CPAN


	$o->visit( $structure );

	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");
}

done_testing;



( run in 4.940 seconds using v1.01-cache-2.11-cpan-9b1e4054eb1 )