redistributing modifications to alternative method executions brings gratification

[gitmo/MooseX-Antlers.git] / tracer.pl

diff --git a/tracer.pl b/tracer.pl
index 4cee5c5..fbc08e5 100644 (file)
--- a/tracer.pl
+++ b/tracer.pl
@@ -49,6 +49,8 @@ extends 'Data::Visitor';
 
 with '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 { {} });
 
@@ -94,13 +96,112 @@ package Ref::Replacer;
 # actually be faster for reconstructing structures but it's fairly academic
 # as yet
 
-#use Moose;
-#use Variable::Magic qw(getdata);
+use Moose;
+use Scalar::Util qw(refaddr isweak);
+use namespace::clean -except => 'meta';
+
+extends 'Data::Visitor';
+
+# we need name tracking but have to apply the role at the end of the file
+# so that our around modifiers end up within the name tracking around
+# instead of outside - otherwise e.g. array value weakening goes wrong
+
+has 'external_mappings' => (is => 'ro', lazy => 1, default => sub { {} });
+has 'weaken_these' => (is => 'ro', lazy => 1, default => sub { {} });
+has 'map_these' => (is => 'ro', lazy => 1, default => sub { {} });
+
+around visit_ref => sub {
+  my ($orig, $self) = (shift, shift);
+  my $value = $_[0];
+
+  # if we've got a mapping for a reference (i.e. it's supplied from
+  # somewhere else) then we need to record where we are and then
+  # return undef for the fmap process so we serialize an undefined
+  # value and the fixup puts the external reference back in later
+
+  if (my $m = $self->external_mappings->{refaddr $value}) {
+    $self->map_these->{$self->_current_trace_name} = $m;
+    return undef;
+  }
+
+  return $self->$orig(@_);
+};
+
+around visit_hash_value => sub {
+  my ($orig, $self) = (shift, shift);
+  my ($value, $key, $hash) = @_;
+  if (isweak $hash->{$key}) {
+    $self->weaken_these->{$self->_current_trace_name} = 1;
+  }
+  return $self->$orig(@_);
+};
+
+around visit_array_entry => sub {
+  my ($orig, $self) = (shift, shift);
+  my ($value, $index, $array) = @_;
+  if (isweak $array->[$index]) {
+    $self->weaken_these->{$self->_current_trace_name} = 1;
+  }
+  return $self->$orig(@_);
+};
+
+around visit_scalar => sub {
+  my ($orig, $self) = (shift, shift);
+  my $scalar = $_[0];
+  if (isweak $$scalar) {
+    $self->weaken_these->{$self->_current_trace_name} = 1;
+  }
+  return $self->$orig(@_);
+};
+
+# now it's safe to apply the role
+
+with 'Visitor::NameTracking';
+
+sub fixup_code {
+  my $self = shift;
+  join("\n\n",
+    grep defined,
+      map $self->${\"_fixup_code_for_$_"},
+        qw(externals weakrefs)
+  );
+}
+
+sub _fixup_code_for_externals {
+  my $self = shift;
+  my $ext = $self->map_these;
+  return unless keys %$ext;
+  join("\n",
+    qq{# fixup code for external references},
+    map {
+      $_.' = '.$ext->{$_}.';';
+    }
+    sort keys %$ext
+  );
+}
+
+sub _fixup_code_for_weakrefs {
+  my $self = shift;
+  my $weaken = $self->weaken_these;
+  return unless keys %$weaken;
+  join("\n",
+    qq{# fixup code for weak references},
+    'use Scalar::Util ();',
+    map {
+      'Scalar::Util::weaken('.$_.');';
+    }
+    sort keys %$weaken
+  );
+}
+
+# force recursion into objects (Data::Visitor doesn't by default)
+
+sub visit_object { shift->visit_ref(@_) }
 
 }
 
 use Test::More qw(no_plan);
-use Scalar::Util qw(refaddr);
+use Scalar::Util qw(refaddr weaken);
 
 my $foo = {
   bar => { baz => [ 'quux', { fleem => 1 } ] },
@@ -141,25 +242,26 @@ foreach my $e (@expect) {
   is($map{$e},refaddr($value), "Result for ${e} ok");
 }
 
-=pod
-  
-use Data::Dumper; $Data::Dumper::Indent = 1;
+my $flimflam = {
+  one => { two => three },
+  bard => $foo->{skald},
+  bard_guts => ${$foo->{skald}},
+  empty_now => $foo->{bar},
+};
 
-warn Dumper($tracer->_traced_refs);
-warn Dumper($tracer->_traced_names);
+weaken($flimflam->{weak_one} = $flimflam->{one});
+weaken($flimflam->{weak_member}[0] = $flimflam->{bard});
+weaken(${$flimflam->{weak_scalar}} = $flimflam->{bard_guts});
 
-=pod
+my $replacer = Ref::Replacer->new({
+  external_mappings => $result,
+  root_name => '$final',
+});
 
-cmp_ok(
-  scalar(@expect), '==', scalar(@{$tracer->_traced_refs}),
-  'Right number of traced refs',
-);
+my $copyflam = $replacer->visit($flimflam);
+
+use Data::Dumper; $Data::Dumper::Indent = 1;
 
-my $reflist = $tracer->_traced_refs;
+warn Dumper($copyflam);
 
-foreach my $i (0 .. $#expect) {
-  my $tail = "at list pos $i";
-  is($e[$i], $reflist[$i], "Correct ref $e[$i] at $tail");
-  my $data = getdata $reflist[$i], Trace::Constants::TRACE_WIZ;
-  is($data->[0], 'Blue', "tag ok at $tail");
-  cmp_ok($data->[1], '==', $i, "Index ok at $i");
+warn $replacer->fixup_code;