e.g. something like this...
diff -u -x .yo -x .git -x CVS -x .svn -x '*~' -x '.*.swp' -Nr RPC-XML-0.74/lib/RPC/XML.pm RPC-XML-0.74_jwb/lib/RPC/XML.pm
--- RPC-XML-0.74/lib/RPC/XML.pm 2011-01-22 21:59:45.000000000 +0100
+++ RPC-XML-0.74_jwb/lib/RPC/XML.pm 2011-01-26 00:00:26.322306185 +0100
@@ -27,7 +27,7 @@
use warnings;
use vars qw(@EXPORT_OK %EXPORT_TAGS $VERSION $ERROR
%XMLMAP $XMLRE $ENCODING $FORCE_STRING_ENCODING $ALLOW_NIL);
-use subs qw(time2iso8601 smart_encode utf8_downgrade);
+use subs qw(time2iso8601 smart_encode smart_encode_weak utf8_downgrade);
use base 'Exporter';
use Scalar::Util qw(blessed reftype);
@@ -53,7 +53,7 @@
\&utf8::downgrade : sub { };
}
-@EXPORT_OK = qw(time2iso8601 smart_encode
+@EXPORT_OK = qw(time2iso8601 smart_encode smart_encode_weak
RPC_BOOLEAN RPC_INT RPC_I4 RPC_DOUBLE RPC_DATETIME_ISO8601
RPC_BASE64 RPC_STRING RPC_NIL
$ENCODING $FORCE_STRING_ENCODING $ALLOW_NIL);
@@ -148,18 +148,29 @@
my $MAX_DOUBLE = 1e37;
my $MIN_DOUBLE = $MAX_DOUBLE * -1;
- sub smart_encode ## no critic (ProhibitExcessComplexity)
+ sub smart_encode_weak ## no critic (ProhibitExcessComplexity)
{
- my @values = @_;
+ my ($values, $weak_refs) = @_;
my ($type, $seenrefs, @newvalues);
+ #take care of weak references
+ my $weak;
+ #seems to be a recursive call, weak refs is an existing hash
+ if(ref $weak_refs eq 'HASH') {
+ $weak = $weak_refs;
+ }
+ #api call, create a hash for easy checking
+ elsif( ref $weak_refs eq 'ARRAY') {
+ $weak = { map { $_ => 1} @{$weak_refs} };
+ }
+
# Look for sooper-sekrit pseudo-blessed hashref as first argument.
# It means this is a recursive call, and it contains a map of any
# references we've already seen.
- if ((blessed $values[0]) && ($values[0]->isa('RPC::XML::refmap')))
+ if ((blessed $values->[0]) && ($values->[0]->isa('RPC::XML::refmap')))
{
# Peel it off of the list
- $seenrefs = shift @values;
+ $seenrefs = shift @{$values};
}
else
{
@@ -167,7 +178,7 @@
$seenrefs = bless {}, 'RPC::XML::refmap';
}
- foreach (@values)
+ foreach (@{$values})
{
if (! defined $_) ## no critic (ProhibitCascadingIfElse)
{
@@ -177,7 +188,7 @@
elsif (ref $_)
{
# Skip any that we've already seen
- next if $seenrefs->{$_}++;
+ next if( $seenrefs->{$_}++ && !exists($weak->{$_}));
if (blessed($_) && ## no critic (ProhibitCascadingIfElse)
($_->isa('RPC::XML::datatype') || $_->isa('DateTime')))
@@ -210,7 +221,7 @@
# test be true even if the return value is a hard
# undef. Only if the return value is an empty list
# should this evaluate as false...
- if (my @value = smart_encode($seenrefs, $_->{$key}))
+ if (my @value = smart_encode_weak([$seenrefs, $_->{$key}], $weak))
{
$newhash{$key} = $value[0];
}
@@ -227,7 +238,7 @@
# (see RT 35106)
# Per RT 41063, looks like I get to deref $_ after all...
$type = RPC::XML::array->new(
- from => [ smart_encode($seenrefs, @{$_}) ]
+ from => [ smart_encode_weak([$seenrefs, @{$_}], $weak) ]
);
}
elsif (reftype($_) eq 'SCALAR')
@@ -235,7 +246,7 @@
# This is a rare excursion into recursion, since the scalar
# nature (de-refed from the object, so no longer magic)
# will prevent further recursing.
- $type = smart_encode($seenrefs, ${$_});
+ $type = smart_encode_weak([$seenrefs, ${$_}], $weak);
}
else
{
@@ -301,6 +312,8 @@
return (wantarray ? @newvalues : $newvalues[0]);
}
+
+ sub smart_encode { return smart_encode_weak([ @_ ]); }
}
# This is a (mostly) empty class used as a common superclass for simple and
diff -u -x .yo -x .git -x CVS -x .svn -x '*~' -x '.*.swp' -Nr RPC-XML-0.74/t/36_same_reference.t RPC-XML-0.74_jwb/t/36_same_reference.t
--- RPC-XML-0.74/t/36_same_reference.t 1970-01-01 01:00:00.000000000 +0100
+++ RPC-XML-0.74_jwb/t/36_same_reference.t 2011-01-26 00:04:05.650965670 +0100
@@ -0,0 +1,23 @@
+use warnings;
+use strict;
+use Test::More qw/no_plan/;
+
+BEGIN { use_ok('RPC::XML', qw/smart_encode_weak/); }
+
+my $array_ref = [ "aa", "bb", "cc" ];
+
+my $data1 = {
+ a => $array_ref,
+ b => $array_ref,
+};
+
+my $data2 = {
+ a => [ @{$array_ref} ],
+ b => [ @{$array_ref} ],
+};
+
+my $encoded_data1 = smart_encode_weak([$data1],[$array_ref]);
+my $encoded_data2 = smart_encode_weak([$data2]);
+is_deeply($encoded_data1, $encoded_data2, "use same reference in data structure twice or more with weak");
+
+1;
