Mungle/Compare/Struct.pm

##    --------------------------------------------------------------------------------
##    $Id: Struct.pm,v 1.1 2002/11/29 04:49:30 joko Exp $
##    --------------------------------------------------------------------------------
##    $Log: Struct.pm,v $
##    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";
  
  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 "empty: ", isEmpty($_), "\n";
      #$tc->{ok} = 1;
      $tc->{count}++;
      $tc->{empty}++ if isEmpty($_);
      #return $result if $result;
    }
    
    return 1 if ($tc->{count} == $tc->{empty});
    return 0;
    
  }

  if ($reftype eq 'HASH') {
    $found = 1;
    foreach (keys %$var) {
=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->{$_});
    }

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