--- nfo/perl/libs/Data/Mungle/Compare/Struct.pm 2002/12/05 07:56:34 1.2 +++ nfo/perl/libs/Data/Mungle/Compare/Struct.pm 2004/10/07 14:06:46 1.8 @@ -1,7 +1,26 @@ ## -------------------------------------------------------------------------------- -## $Id: Struct.pm,v 1.2 2002/12/05 07:56:34 joko Exp $ +## $Id: Struct.pm,v 1.8 2004/10/07 14:06:46 jonen Exp $ ## -------------------------------------------------------------------------------- ## $Log: Struct.pm,v $ +## Revision 1.8 2004/10/07 14:06:46 jonen +## minor changes, comment-out debug dumper +## +## Revision 1.7 2004/07/07 03:13:43 joko +## minor fix for "sub isEmpty" +## +## 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?) ## @@ -11,7 +30,7 @@ ## -------------------------------------------------------------------------------- -package Data::Compare::Struct; +package Data::Mungle::Compare::Struct; use strict; use warnings; @@ -32,7 +51,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; @@ -70,30 +99,48 @@ #print "isEmpty is parsing variable ( ref $ref reftype $reftype )", "\n"; +#print Dumper($ref); + my $found; if ($ref eq 'Set::Object') { $found = 1; - #print "members:", "\n"; - #print Dumper($var->members()); - #print "\n"; +#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; } + +#print Dumper($tc); return 1 if ($tc->{count} == $tc->{empty}); return 0; } - if ($reftype eq 'HASH') { + 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') { @@ -106,24 +153,27 @@ =cut next if ref $var->{$_} eq 'Set::Object'; #return 0 if defined $var->{$_}; - return 1 if isEmpty($var->{$_}); - } - - } elsif ($reftype eq 'ARRAY') { - $found = 1; - foreach (@$var) { - return 0 if defined $_; + #return 1 if isEmpty($var->{$_}); + my $elem_empty = isEmpty($var->{$_}); + +#print "elem: $elem_empty\n"; + $empty &&= $elem_empty; } + return $empty; + #return 0; - } else { + # check for empty string + } elsif (defined $var) { $found = 1; - return 0 if defined $var; + return 0 if $var ne ''; } if (!$found) { - print "isEmpty could not parse variable ( ref $ref reftype $reftype )", "\n"; + #print "isEmpty could not parse variable ( ref $ref reftype $reftype )", "\n"; } + #print "EMPTY!!!", "\n"; + return 1; }