From: Matt S Trout <mst@shadowcat.co.uk>
Date: Sat, 20 Jun 2009 21:13:26 +0000 (-0400)
Subject: lewd warnication brings proof positive of lost weakness. ceci n'est pas un haiku
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d8576cdcd81336a292240910b7ee5c4ad4e11dc2;p=gitmo%2FMooseX-Antlers.git

lewd warnication brings proof positive of lost weakness. ceci n'est pas un haiku
---

diff --git a/tracer.pl b/tracer.pl
index 5c33ba2..a170ace 100644
--- a/tracer.pl
+++ b/tracer.pl
@@ -119,7 +119,10 @@ sub visit_ref {
 
   # have to test $_[0] directly since copying a weak ref gives a strong ref
 
+warn $self->_current_trace_name;
+warn $_[0];
   if (isweak $_[0]) {
+warn "got here";
     $self->weaken_these->{$self->_current_trace_name} = 1;
   }
 
@@ -136,6 +139,44 @@ sub visit_ref {
   return $self->next::method(@_);
 }
 
+sub _register_mapping { $_[2] }
+
+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(@_) }
@@ -143,7 +184,7 @@ 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 } ] },
@@ -184,3 +225,24 @@ foreach my $e (@expect) {
   is($map{$e},refaddr($value), "Result for ${e} ok");
 }
 
+my $flimflam = {
+  one => { two => three },
+  bard => $foo->{skald},
+  bard_guts => ${$foo->{skald}},
+  empty_now => $foo->{bar},
+};
+
+weaken($flimflam->{weak_one} = $flimflam->{one});
+
+my $replacer = Ref::Replacer->new({
+  external_mappings => $result,
+  root_name => '$final',
+});
+
+my $copyflam = $replacer->visit($flimflam);
+
+use Data::Dumper; $Data::Dumper::Indent = 1;
+
+warn Dumper($copyflam);
+
+warn $replacer->fixup_code;