slightly more convenience

[gitmo/MooseX-Antlers.git] / lib / MooseX / Antlers / RefTracker.pm

package MooseX::Antlers::RefTracker;

use Moose;
use Scalar::Util qw(weaken refaddr);
use namespace::clean -except => 'meta';

extends 'Data::Visitor';

with 'MooseX::Antlers::Visitor::NameTracking';

# dump the lazy when we get a sensible version of D::V on the dev system

has '_traced_refs' => (is => 'ro', lazy => 1, default => sub { {} });
has '_traced_names' => (is => 'ro', lazy => 1, default => sub { {} });

sub trace_refs {
  my ($class, $name, $refs) = @_;
  my $self = $class->new({ root_name => $name });
  $self->visit($refs);
  return $self->traced_ref_map;
}

before visit_ref => sub {
  my ($self, $data) = @_;

  # can't just rely on refaddr because it may get re-used if the data goes
  # out of scope (we could play clever games with free magic on the wizard
  # or whatever but KISS) - but we -can- keep a weak reference which will
  # turn to undef if the variable disappears

  weaken($self->_traced_refs->{refaddr $data} = $data);

  $self->_traced_names->{refaddr $data} = $self->_current_trace_name;
};

sub traced_ref_map {
  my $self = shift;
  my $refs = $self->_traced_refs;
  my $names = $self->_traced_names;

  # nuke keys where the traced refs entry is undef since they indicate
  # "went out of scope" so the name is no longer valid. however if we
  # do still have a refs entry we know the name is valid because if it
  # didn't go out of scope that refaddr can't have been re-used.
  # (NB: I don't care if this works under ithreads)

  delete @{$names}{grep !defined($refs->{$_}), keys %$names};
  $names;
}

# force recursion into objects (Data::Visitor doesn't by default)

sub visit_object { shift->visit_ref(@_) }

1;