Mungle/Compare/Struct.pm

##    --------------------------------------------------------------------------------
##    $Id: Struct.pm,v 1.2 2002/12/05 07:56:34 joko Exp $
##    --------------------------------------------------------------------------------
##    $Log: Struct.pm,v $
##    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 (@$var) {
      return 0 if defined $_;
    }

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

  return 1;
  
}

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