X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMooseX-Antlers.git;a=blobdiff_plain;f=lib%2FMooseX%2FAntlers%2FVisitor%2FNameTracking.pm;fp=lib%2FMooseX%2FAntlers%2FVisitor%2FNameTracking.pm;h=770da8b8fe067efe53d2136cb78b3a469ed932b4;hp=0000000000000000000000000000000000000000;hb=0373380cd9656a6a2be0e85483348a66396fb192;hpb=9831d16561549202379d782f8905b9d2f7b70cd9

diff --git a/lib/MooseX/Antlers/Visitor/NameTracking.pm b/lib/MooseX/Antlers/Visitor/NameTracking.pm
new file mode 100644
index 0000000..770da8b
--- /dev/null
+++ b/lib/MooseX/Antlers/Visitor/NameTracking.pm
@@ -0,0 +1,39 @@
+package MooseX::Antlers::Visitor::NameTracking;
+
+use Moose::Role;
+use B qw(perlstring);
+use namespace::clean -except => 'meta';
+
+has '_current_trace_name' => (is => 'ro');
+has 'root_name' => (is => 'ro');
+
+around visit => sub {
+  my ($orig, $self) = (shift, shift);
+  local $self->{_current_trace_name}
+    = ($self->{_current_trace_name}||$self->root_name);
+  return $self->$orig(@_);
+};
+
+around visit_hash_entry => sub {
+  my ($orig, $self) = (shift, shift);
+  my $key = $_[0]; # $key, $value
+  local $self->{_current_trace_name}
+    = $self->{_current_trace_name}.'->{'.(perlstring $key).'}';
+  return $self->$orig(@_);
+};
+
+around visit_array_entry => sub {
+  my ($orig, $self) = (shift, shift);
+  my $index = $_[1]; # $value, $index
+  local $self->{_current_trace_name}
+    = $self->{_current_trace_name}.'->['.$index.']';
+  return $self->$orig(@_);
+};
+
+around visit_scalar => sub {
+  my ($orig, $self) = (shift, shift);
+  local $self->{_current_trace_name} = '${'.$self->{_current_trace_name}.'}';
+  return $self->$orig(@_);
+};
+
+1;