--- nfo/perl/libs/Data/Mungle/Compare/Struct.pm 2002/11/29 04:49:30 1.1 +++ nfo/perl/libs/Data/Mungle/Compare/Struct.pm 2004/05/12 13:53:19 1.6 @@ -1,14 +1,30 @@ ## -------------------------------------------------------------------------------- -## $Id: Struct.pm,v 1.1 2002/11/29 04:49:30 joko Exp $ +## $Id: Struct.pm,v 1.6 2004/05/12 13:53:19 jonen Exp $ ## -------------------------------------------------------------------------------- ## $Log: Struct.pm,v $ +## Revision 1.6 2004/05/12 13:53:19 jonen +## + bugfix related to declaration of arrays, +## solved error: 'Bizarre copy of ARRAY in aassign at...' +## +## Revision 1.5 2003/03/27 15:17:05 joko +## namespace fixes for Data::Mungle::* +## +## Revision 1.4 2002/12/19 01:06:27 joko +## + fixed isEmpty with ARRAYs +## +## Revision 1.3 2002/12/13 21:47:04 joko +## + fixes to 'sub isEmpty' +## +## Revision 1.2 2002/12/05 07:56:34 joko +## + updated/enhanced isEmpty (hacky?) +## ## Revision 1.1 2002/11/29 04:49:30 joko ## + initial check-in ## ## -------------------------------------------------------------------------------- -package Data::Compare::Struct; +package Data::Mungle::Compare::Struct; use strict; use warnings; @@ -29,7 +45,17 @@ my @a = @{$a_ref}; my @b = @{$b_ref}; - my @isect = my @diff = my @union = (); + # BUGFIX 2004-05-12: following declaration of arrays occures an strange perl error: + # 'Bizarre copy of ARRAY in aassign at ../ line ' + # (at PERL 5.8.4, Debian/unstable/experimental) + # + #my @isect = my @diff = my @union = (); + # + # so use normal declaration instead!! + my @isect = (); + my @diff = (); + my @union = (); + my $e; my %count; @@ -59,21 +85,90 @@ } sub isEmpty { + my $var = shift; - my $reftype = attributes::reftype($var); + my $ref = ref($var); + my $reftype = ''; + $reftype = attributes::reftype($var) if $ref; - if ($reftype eq 'HASH') { - foreach (keys %$var) { - return 0 if defined $var->{$_}; + #print "isEmpty is parsing variable ( ref $ref reftype $reftype )", "\n"; + +#print Dumper($var); + + my $found; + + if ($ref eq 'Set::Object') { + $found = 1; +#print "members:", "\n"; +#print Dumper($var->members()); +#print "\n"; + my $tc = { ok => 0, count => 0, empty => 0 }; + foreach ($var->members()) { +#print "member!!", "\n"; + #print "empty: ", isEmpty($_), "\n"; + #$tc->{ok} = 1; + $tc->{count}++; + $tc->{empty}++ if isEmpty($_); + #return $result if $result; } - } elsif ($reftype eq 'ARRAY') { - foreach (@$var) { - return 0 if defined $_; +#print Dumper($tc); + + return 1 if ($tc->{count} == $tc->{empty}); + return 0; + + } + + if ($reftype eq 'ARRAY') { + my @arr = @$var; + my $isReallyEmpty = ($#arr == -1 ? 1 : 0); + return 1 if $isReallyEmpty; + $found = 1; + foreach (@arr) { + #return 0 if defined $_; + #return 1 if isEmpty($_); + return 0 if !isEmpty($_); + } + + } elsif ($reftype eq 'HASH') { + my $empty = 1; + $found = 1; + foreach (keys %$var) { +# TODO: review and fix this! +=pod + # recursion + if (ref $var->{$_} eq 'Set::Object') { + print "==========set", "\n"; + if (isEmpty($var->{$_})) { + return 0; + #next; + } + } +=cut + next if ref $var->{$_} eq 'Set::Object'; + #return 0 if defined $var->{$_}; + #return 1 if isEmpty($var->{$_}); + my $elem_empty = isEmpty($var->{$_}); + +#print "elem: $elem_empty\n"; + $empty &&= $elem_empty; } + return $empty; + #return 0; + + } else { + $found = 1; + return 0 if defined $var; + } + + if (!$found) { + print "isEmpty could not parse variable ( ref $ref reftype $reftype )", "\n"; } + #print "EMPTY!!!", "\n"; + return 1; + } 1;