Mungle/Compare/Struct.pm

##    --------------------------------------------------------------------------------
##    $Id: Struct.pm,v 1.3 2002/12/13 21:47:04 joko Exp $
##    --------------------------------------------------------------------------------
##    $Log: Struct.pm,v $
##    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;

use strict;
use warnings;

require Exporter;
our @ISA = qw( Exporter );
our @EXPORT_OK = qw( 
  &getRelations 
  &getDifference 
  &isEmpty
);

use Data::Dumper;

sub getRelations {
  my $a_ref = shift;
  my $b_ref = shift;
  my @a = @{$a_ref};
  my @b = @{$b_ref};

  my @isect = my @diff = my @union = ();
  my $e;
  my %count;
  
  foreach $e (@a, @b) { $count{$e}++ }

  foreach $e (keys %count) {
      push(@union, $e);
      push @{ $count{$e} == 2 ? \@isect : \@diff }, $e;
  }

  # bugfix: a diff is no diff if we don't even have an isect
  @diff = undef if !@isect;
  
  my $result = {
    union => \@union,
    isect => \@isect,
    diff => \@diff,
  };
  
  return $result;

}

sub getDifference {
  my $res = getRelations(shift, shift);
  return $res->{diff};
}

sub isEmpty {

  my $var = shift;
  my $ref = ref($var);
  my $reftype = '';
  $reftype = attributes::reftype($var) if $ref;

  #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;
    }

#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;
1	joko	1.1	## --------------------------------------------------------------------------------
2	joko	1.4	## $Id: Struct.pm,v 1.3 2002/12/13 21:47:04 joko Exp $
3	joko	1.1	## --------------------------------------------------------------------------------
4	joko	1.2	## $Log: Struct.pm,v $
5	joko	1.4	## Revision 1.3 2002/12/13 21:47:04 joko
6			## + fixes to 'sub isEmpty'
7			##
8	joko	1.3	## Revision 1.2 2002/12/05 07:56:34 joko
9			## + updated/enhanced isEmpty (hacky?)
10			##
11	joko	1.2	## Revision 1.1 2002/11/29 04:49:30 joko
12			## + initial check-in
13			##
14	joko	1.1	## --------------------------------------------------------------------------------
15
16
17			package Data::Compare::Struct;
18
19			use strict;
20			use warnings;
21
22			require Exporter;
23			our @ISA = qw( Exporter );
24			our @EXPORT_OK = qw(
25			&getRelations
26			&getDifference
27			&isEmpty
28			);
29
30			use Data::Dumper;
31
32			sub getRelations {
33			my $a_ref = shift;
34			my $b_ref = shift;
35			my @a = @{$a_ref};
36			my @b = @{$b_ref};
37
38			my @isect = my @diff = my @union = ();
39			my $e;
40			my %count;
41
42			foreach $e (@a, @b) { $count{$e}++ }
43
44			foreach $e (keys %count) {
45			push(@union, $e);
46			push @{ $count{$e} == 2 ? \@isect : \@diff }, $e;
47			}
48
49			# bugfix: a diff is no diff if we don't even have an isect
50			@diff = undef if !@isect;
51
52			my $result = {
53			union => \@union,
54			isect => \@isect,
55			diff => \@diff,
56			};
57
58			return $result;
59
60			}
61
62			sub getDifference {
63			my $res = getRelations(shift, shift);
64			return $res->{diff};
65			}
66
67			sub isEmpty {
68	joko	1.2
69	joko	1.1	my $var = shift;
70	joko	1.2	my $ref = ref($var);
71			my $reftype = '';
72			$reftype = attributes::reftype($var) if $ref;
73
74			#print "isEmpty is parsing variable ( ref $ref reftype $reftype )", "\n";
75
76	joko	1.3	#print Dumper($var);
77
78	joko	1.2	my $found;
79
80			if ($ref eq 'Set::Object') {
81			$found = 1;
82	joko	1.3	#print "members:", "\n";
83			#print Dumper($var->members());
84			#print "\n";
85	joko	1.2	my $tc = { ok => 0, count => 0, empty => 0 };
86			foreach ($var->members()) {
87	joko	1.3	#print "member!!", "\n";
88	joko	1.2	#print "empty: ", isEmpty($_), "\n";
89			#$tc->{ok} = 1;
90			$tc->{count}++;
91			$tc->{empty}++ if isEmpty($_);
92			#return $result if $result;
93			}
94	joko	1.3
95			#print Dumper($tc);
96	joko	1.2
97			return 1 if ($tc->{count} == $tc->{empty});
98			return 0;
99
100			}
101	joko	1.1
102	joko	1.3	if ($reftype eq 'ARRAY') {
103			my @arr = @$var;
104			my $isReallyEmpty = ($#arr == -1 ? 1 : 0);
105			return 1 if $isReallyEmpty;
106			$found = 1;
107	joko	1.4	foreach (@arr) {
108			#return 0 if defined $_;
109			#return 1 if isEmpty($_);
110			return 0 if !isEmpty($_);
111	joko	1.3	}
112
113			} elsif ($reftype eq 'HASH') {
114			my $empty = 1;
115	joko	1.2	$found = 1;
116	joko	1.1	foreach (keys %$var) {
117	joko	1.3	# TODO: review and fix this!
118	joko	1.2	=pod
119			# recursion
120			if (ref $var->{$_} eq 'Set::Object') {
121			print "==========set", "\n";
122			if (isEmpty($var->{$_})) {
123			return 0;
124			#next;
125			}
126			}
127			=cut
128			next if ref $var->{$_} eq 'Set::Object';
129			#return 0 if defined $var->{$_};
130	joko	1.3	#return 1 if isEmpty($var->{$_});
131			my $elem_empty = isEmpty($var->{$_});
132
133			#print "elem: $elem_empty\n";
134			$empty &&= $elem_empty;
135	joko	1.1	}
136	joko	1.3	return $empty;
137			#return 0;
138	joko	1.2
139			} else {
140			$found = 1;
141			return 0 if defined $var;
142			}
143
144			if (!$found) {
145			print "isEmpty could not parse variable ( ref $ref reftype $reftype )", "\n";
146	joko	1.1	}
147	joko	1.4
148			#print "EMPTY!!!", "\n";
149	joko	1.1
150			return 1;
151	joko	1.2
152	joko	1.1	}
153
154			1;
MailToCvsAdmin">MailToCvsAdmin	ViewVC Help
Powered by ViewVC 1.1.26