Skip Menu |
 

This queue is for tickets about the XML-Generator-PerlData CPAN distribution.

Report information
The Basics
Id: 55330
Status: new
Priority: 0/
Queue: XML-Generator-PerlData

People
Owner: Nobody in particular
Requestors: michael [...] zedeler.dk
Cc:
AdminCc:

Bug Information
Severity: Important
Broken in: 0.91
Fixed in: (no value)



Download (untitled) / with headers
text/plain 212b
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
Download PerlData.pm.patch
text/x-diff 1.5k
*** /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
Download 14_circular.t
text/x-perl 793b
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 $@); } ####################################################


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.