lib/MooseX/Antlers/RefTracker.pm

   1 package MooseX::Antlers::RefTracker;
   2
   3 use Moose;
   4 use Scalar::Util qw(weaken refaddr);
   5 use namespace::clean -except => 'meta';
   6
   7 extends 'Data::Visitor';
   8
   9 with 'MooseX::Antlers::Visitor::NameTracking';
  10
  11 # dump the lazy when we get a sensible version of D::V on the dev system
  12
  13 has '_traced_refs' => (is => 'ro', lazy => 1, default => sub { {} });
  14 has '_traced_names' => (is => 'ro', lazy => 1, default => sub { {} });
  15
  16 sub trace_refs {
  17   my ($class, $name, $refs) = @_;
  18   my $self = $class->new({ root_name => $name });
  19   $self->visit($refs);
  20   return $self->traced_ref_map;
  21 }
  22
  23 before visit_ref => sub {
  24   my ($self, $data) = @_;
  25
  26   # can't just rely on refaddr because it may get re-used if the data goes
  27   # out of scope (we could play clever games with free magic on the wizard
  28   # or whatever but KISS) - but we -can- keep a weak reference which will
  29   # turn to undef if the variable disappears
  30
  31   weaken($self->_traced_refs->{refaddr $data} = $data);
  32
  33   $self->_traced_names->{refaddr $data} = $self->_current_trace_name;
  34 };
  35
  36 sub traced_ref_map {
  37   my $self = shift;
  38   my $refs = $self->_traced_refs;
  39   my $names = $self->_traced_names;
  40
  41   # nuke keys where the traced refs entry is undef since they indicate
  42   # "went out of scope" so the name is no longer valid. however if we
  43   # do still have a refs entry we know the name is valid because if it
  44   # didn't go out of scope that refaddr can't have been re-used.
  45   # (NB: I don't care if this works under ithreads)
  46
  47   delete @{$names}{grep !defined($refs->{$_}), keys %$names};
  48   $names;
  49 }
  50
  51 # force recursion into objects (Data::Visitor doesn't by default)
  52
  53 sub visit_object { shift->visit_ref(@_) }
  54
  55 1;