BEGIN {
-package Ref::Tracer;
+package Visitor::NameTracking;
-use Moose;
+use Moose::Role;
use B qw(perlstring);
-use Scalar::Util qw(weaken refaddr);
use namespace::clean -except => 'meta';
-extends 'Data::Visitor';
-
-has '_traced_refs' => (is => 'ro', lazy => 1, default => sub { {} });
-has '_traced_names' => (is => 'ro', lazy => 1, default => sub { {} });
has '_current_trace_name' => (is => 'ro');
has 'root_name' => (is => 'ro');
-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;
-};
-
around visit => sub {
my ($orig, $self) = (shift, shift);
local $self->{_current_trace_name}
return $self->$orig(@_);
};
+package Ref::Tracer;
+
+use Moose;
+use Scalar::Util qw(weaken refaddr);
+use namespace::clean -except => 'meta';
+
+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 { {} });
+
+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;
sub visit_object { shift->visit_ref(@_) }
-#package Ref::Replacer;
+package Ref::Replacer;
+
+# note: we actually handle weaken as well as external refs because I intend
+# to use Data::Dumper as a first pass and YAML::XS as a second and neither
+# of them know how to deal with weak references
+#
+# I'm faintly curious to see if manual cross-ref-ification nad JSON::XS will
+# actually be faster for reconstructing structures but it's fairly academic
+# as yet
+
+use Moose;
+# ensure we have next::method available - just because Moose loads it
+# as a side effect doesn't mean it's clever to rely on that
+use MRO::Compat ();
+use Scalar::Util qw(refaddr isweak);
+use namespace::clean -except => 'meta';
+
+extends 'Data::Visitor';
+
+with 'Visitor::NameTracking';
+
+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 { {} });
+
+# fairly sure an around modifier will get severely fucked up here
+# in that the copying of @_ will lose the weakness we need to check
+
+sub visit_ref {
+ my $self = shift;
+
+ # 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;
+ }
+
+ # 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 $_[0]}) {
+ $self->map_these->{$self->_current_trace_name} = $m;
+ return undef;
+ }
-#use Moose;
-#use Variable::Magic qw(getdata);
+ 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(@_) }
}
use Test::More qw(no_plan);
-use Scalar::Util qw(refaddr);
+use Scalar::Util qw(refaddr weaken);
my $foo = {
bar => { baz => [ 'quux', { fleem => 1 } ] },
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});
-=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;
projects / gitmo/MooseX-Antlers.git / blobdiff