Data-Visitor

 view release on metacpan or  search on metacpan

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

package Data::Visitor; # git description: v0.31-4-g7498abb
use Moose;
# ABSTRACT: Visitor style traversal of Perl data structures

our $VERSION = '0.32';
use Scalar::Util qw/blessed refaddr reftype weaken isweak/;
use overload ();
use Symbol ();

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

use constant HAS_DATA_ALIAS => eval { +require Data::Alias; 1 };

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

# currently broken
has weaken => (
	isa => "Bool",
	is  => "rw",
	default => 0,
);

sub trace {
	my ( $self, $category, @msg ) = @_;

	our %DEBUG;

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

	local $self->{depth} = (($self->{depth}||0) + 1) if DEBUG;
	my $seen_hash = local $self->{_seen} = ($self->{_seen} || {}); # delete it after we're done with the whole visit

	my @ret;

	foreach my $data ( @_ ) {
		$self->trace( flow => visit => $data ) if DEBUG;

		if ( my $refaddr = ref($data) && refaddr($data) ) { # only references need recursion checks
			$seen_hash->{weak} ||= isweak($data) if $self->weaken;

			if ( exists $seen_hash->{$refaddr} ) {
				$self->trace( mapping => found_mapping => from => $data, to => $seen_hash->{$refaddr} ) if DEBUG;
				push @ret, $self->visit_seen( $data, $seen_hash->{$refaddr} );
				next;
			} else {
				$self->trace( mapping => no_mapping => $data ) if DEBUG;
			}
		}

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

			foreach my $value ( Data::Alias::deref($proto) ) {
				if ( ref $value and isweak($value) ) {
					push @weak_refs, refaddr $value;
				}
			}

			if ( @weak_refs ) {
				my %targets = map { refaddr($_) => 1 } @{ $self->{_seen} }{@weak_refs};
				foreach my $value ( Data::Alias::deref($new) ) {
					if ( ref $value and $targets{refaddr($value)}) {
						push @{ $seen_hash->{weakened} ||= [] }, $value; # keep a ref around
						weaken($value);
					}
				}
			}
		}
		else {
			die "Found a weak reference, but Data::Alias is not installed. You must install Data::Alias in order for this to work.";
		}
	}

	# FIXME real magic, too

t/weak.t  view on Meta::CPAN

use warnings;

use Test::More;

BEGIN {
  plan skip_all => 'these tests require Data::Alias or fixes to use core aliasing' if "$]" >= '5.031002';
}

use Test::Needs 'Data::Alias';

use Scalar::Util qw(isweak weaken);

use Data::Visitor;

{
	my $ref = { };
	$ref->{foo} = $ref;
	weaken($ref->{foo});

	ok( isweak($ref->{foo}), "foo is weak" );

	my $v = Data::Visitor->new( weaken => 1 );

	my $copy = $v->visit($ref);

	is_deeply( $copy, $ref, "copy is equal" );

	ok( isweak($copy->{foo}), 'copy is weak' );
}

{
	my $ref = { foo => { } };
	$ref->{bar} = $ref->{foo};
	weaken($ref->{foo});

	ok(  isweak($ref->{foo}), "foo is weak" );
	ok( !isweak($ref->{bar}), "bar is not weak" );

	my $v = Data::Visitor->new( weaken => 1 );

	my $copy = $v->visit($ref);

	local $TODO = "can't tell apart different refs without making hash/array elems seen as scalar refs";
	ok( isweak($copy->{foo}), 'copy is weak' );
	is_deeply( $copy, $ref, "copy is equal" );
	ok( ref $copy->{bar} && !isweak($copy->{bar}), 'but not in bar' );
}

done_testing;