--- /dev/null
+package MooseX::Antlers::RefFilter;
+
+# 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
+#
+# better still, neither actually does the bloody cross refs properly - Dumper
+# emits them but the nature of the beast is that they don't eval back in
+# right, YAML::XS seems to make two aliases to one ref (Data::Alias-ish)
+# since when I weaken one both copies disappear on me. sigh.
+#
+# on the upside, we can use a really dumb dumper for the rest - JSON::XS
+# strikes me as an interesting possibility for speed reasons
+
+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 '_internal_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 => sub {
+ my ($orig, $self) = (shift, shift);
+ my $value = $_[0];
+
+ # note that we can't localize this one since it needs to be global
+ # across the entire structure - we could consider a weakref based trick
+ # like we use in the recorder but I don't -think- there's any need
+
+ # if we've already seen this reference, register a mapping for this
+ # copy of it so we fix it up afterwards (see visit_ref for the same process
+ # being used for references to be supplied externally at deserialize time
+ # and the top of the class for notes on how much I love serializers)
+
+ if (ref($value) && (my $m = $self->_internal_mappings->{refaddr $value})) {
+ $self->map_these->{$self->_current_trace_name} = $m;
+ return undef;
+ }
+
+ return $self->$orig(@_);
+};
+
+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;
+ }
+
+ $self->_internal_mappings->{refaddr $value} = $self->_current_trace_name;
+
+ 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 'MooseX::Antlers::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 {
+ my ($l, $r) = ($_, $ext->{$_});
+ # if the LHS is a scalarref deref then we actually
+ # need to strip that bit off and push the enref to the RHS since
+ # ${\undef} = "foo"
+ # is an attempt to modify a readonly value and perl will burst into tears
+ if ($l =~ m/^\${(.*)}$/) { $l = $1; $r = "\\".$r; }
+ $l.' = '.$r.';';
+ }
+ 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(@_) }
+
+1;
projects / gitmo/MooseX-Antlers.git / blobdiff