This module doesn't handle circular references.
I'd suggest silently ignoring them by skipping any reference that has
been processed before. One could make this behaviour optional.
See attached test and patch.
| Subject: | PerlData.pm.patch |
*** /tmp/XML-Generator-PerlData-0.91/PerlData.pm 2007-08-04 14:57:00.000000000 +0200
--- PerlData.pm 2010-03-08 12:12:51.000000000 +0100
***************
*** 4,9 ****
--- 4,10 ----
use XML::SAX::Base;
use vars qw($VERSION @ISA $NS_XMLNS $NS_XML);
use Data::Dumper;
+ use Scalar::Util qw(refaddr);
# some globals
$VERSION = '0.91';
@ISA = qw( XML::SAX::Base );
***************
*** 47,52 ****
--- 48,54 ----
$self->{RootName} ||= 'document';
$self->{DefaultElementName} ||= 'default';
$self->{TokenReplacementChar} ||= '_';
+ $self->{Seen} ||= {};
if ( defined $args{namespaces} ) {
foreach my $uri ( keys( %{$args{namespaces}} )) {
***************
*** 162,167 ****
--- 164,178 ----
}
}
+ # Check if we have visited a given reference before
+ sub circular {
+ my($self, $ref) = @_;
+ my $addr = refaddr($ref);
+ my $result = $self->{Seen}->{$addr};
+ $self->{Seen}->{$addr} = 1;
+ return $result;
+ }
+
sub hashref2SAX {
my $self = shift;
***************
*** 169,174 ****
--- 180,187 ----
my $char_data = '';
+ return if $self->circular($hashref);
+
ELEMENT: foreach my $key (keys (%{$hashref} )) {
my $value = $hashref->{$key};
my $element_name = $self->_keymapped_name( $key );
***************
*** 233,238 ****
--- 246,253 ----
my $passed_name = shift || $self->{_Parents}->[-1];
my $temp_name = $self->_keymapped_name( $passed_name );
+ return if $self->circular($arrayref);
+
my $element_name;
my $i;
| Subject: | 14_circular.t |
use strict;
use warnings;
use Test;
use XML::Generator::PerlData;
BEGIN { plan tests => 2 }
my $pd = XML::Generator::PerlData->new();
####################################################
# circular hashref
###################################################
{
my $a = {b => {}};
$a->{b}->{a} = $a;
eval {
local $SIG{ALRM} = sub { die 'TIMEOUT' };
alarm 3;
$pd->parse($a);
};
ok(not $@);
}
####################################################
# circular arrayref
###################################################
{
my $a = [[]];
$a->[0]->[0] = $a;
eval {
local $SIG{ALRM} = sub { die 'TIMEOUT' };
alarm 3;
$pd->parse($a);
};
ok(not $@);
}
####################################################