File Coverage

blib/lib/Data/Comparator.pm

Criterion	Covered	Total	%
statement	64	66	96.9
branch	27	30	90.0
condition	19	28	67.8
subroutine	8	8	100.0
pod	0	5	0.0
total	118	137	86.1

#!/usr/bin/perl -w
#!/usr/bin/perl -d:ptkdb -w
#
# This is module is based on a module with the same name, implemented
# when working for Newtec Cy, located in Belgium,
# http://www.newtec.be/.
#

package Data::Comparator;


#
# The main entry point for this module is the sub data_comparator().
# It compares two sets of (structured) data and reports on the
# differences found with a differences describing data structure.
#
# The algorithm used is of a subtractive kind.  It subtracts the first
# data structure given from the second one.  This means that, since it
# not possible to subtract what is not yet there, not all differences
# are reported.  To have a report of all differences between
# structures A and B, first subtract A from B, next subtract B from A.
# The two result sets are an exact description of the differences
# between A and B (or should be, untested for the moment).
#


use strict;


use Clone 'clone';

use Data::Differences;


# require Exporter;

our @ISA = qw(Exporter);

our @EXPORT_OK = qw(
		    array_comparator
		    hash_comparator
		    data_comparator
		   );


#
# array_comparator()
#
# Compare two arrays, report on the differences found by returning an
# array describing the differences between the two arrays.
#

sub array_comparator
{
    my $array1 = shift;

    my $array2 = shift;

#     my $result = { adder_operand => [], subtractor_operand => [], };

    my $result = [];

    foreach my $index (0 .. $#$array1)
    {
	if (exists $array2->[$index])
	{
	    my $index_result = data_comparator($array1->[$index], $array2->[$index]);

	    if (!$index_result->is_empty())
	    {
		$result->[$index] = $index_result;
	    }
	}
	else
	{
	    $result->[$index]
		= Data::Differences->new(clone(\$array1->[$index]));
	}
    }

    foreach my $index ($#$array1 + 1 .. $#$array2)
    {
	$result->[$index]
	    = Data::Differences->new(clone(\$array2->[$index]));
    }

    return Data::Differences->new($result);
}


=head1 NAME

Data::Comparator - recursively compare Perl datatypes

=head1 SYNOPSIS

  use Data::Comparator qw(data_comparator);

  $a = { 'foo' => 'bar', 'move' => 'zig' };
  $b = [ 'alpha', 'beta', 'gamma', 'vlissides' ];

  $diff = data_comparator($a, $b);

  use Data::Dumper;

  print Dumper($diff);

  if ($diff->is_empty())
  {
      print '$a and $b are alike\n';
  }
  else
  {
      print '$a and $b are not alike\n';
  }

=head1 DESCRIPTION

Compare two sets of (structured) data, report on the differences found
with a differences describing data structure.  Additionally a set of
expected differences may be given in the form of a differences
describing data structure.

Returns a differences describing data structure, which is empty if no
differences are found.  The type of the result is the same as the type
of the second data structure given.

The algorithm used is of a subtractive kind.  It subtracts the first
data structure given from the second one.  This means that, since it
is not possible to subtract what is not given in the subtractor, not
all differences are reported.  To have a report of all differences
between structures A and B, first subtract A from B, next subtract B
from A, using this module.  The two result sets are an exact
description of the differences between A and B.

It is possible to add any of the methods array_comparator(),
hash_comparator(), data_comparator() to an existing object, or to use
these as regular subs.

=head1 NOTE

This module is used in the tests for Data::Merger(3) and
Data::Transformator(3).

=head1 BUGS

Does only work with scalars, hashes and arrays.  Does not work on
self-referential structures.

=head1 AUTHOR

Hugo Cornelis, [e-mail]

Copyright 2007 Hugo Cornelis.

This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=head1 SEE ALSO

Data::Merger(3), Data::Transformator(3), Data::Differences(3),
Clone(3)

=cut

sub data_comparator
{
    my $data1 = shift;

    my $data2 = shift;

    my $expected_differences = shift;

    my $result;

    # get the types for the different arguments

    my $data_type1 = (ref $data1 && "$data1") || '';

    my $data_type2 = (ref $data2 && "$data2") || '';

    # first compare comparables

    # try to compare two hashes

    if ($data_type1 =~ /HASH/
        && $data_type2 =~ /HASH/)
    {
	$result = hash_comparator($data1, $data2);
    }

    # or try to compare two arrays

    elsif ($data_type1 =~ /ARRAY/
	   && $data_type2 =~ /ARRAY/)
    {
	$result = array_comparator($data1, $data2);
    }

    # or try to compare two scalars

    elsif ($data_type1 =~ /SCALAR/
	   && $data_type2 =~ /SCALAR/)
    {
	$result = scalar_ref_comparator($data1, $data2);
    }

    # or try to compare two referenced references

    elsif ($data_type1 =~ /REF/
	   && $data_type2 =~ /REF/)
    {
	$result = data_comparator($$data1, $$data2);
    }

    # or try to compare two non references

    elsif (!$data_type1
	   && !$data_type2)
    {
	$result = scalar_comparator($data1, $data2);
    }

    # second, for non-comparables

    else
    {
	# simply clone second argument

	$result = Data::Differences->new(clone(\$data2));
    }

    # if the user was already expecting differences

    if (defined $expected_differences)
    {
	# compare the result with the expected differences

	$result = data_comparator($expected_differences, $result);
    }

    return $result;
}


#
# hash_comparator()
#
# Compare two hashes, report on the differences found by returning an
# hash describing the differences between the two hashes.
#

sub hash_comparator
{
    my $hash1 = shift;

    my $hash2 = shift;

    my $result = {};

    foreach my $key (keys %$hash1)
    {
	if (exists $hash2->{$key})
	{
	    my $key_result = data_comparator($hash1->{$key}, $hash2->{$key});

	    if (!$key_result->is_empty())
	    {
		$result->{$key} = $key_result;
	    }
	}
    }

    foreach my $key (grep { !exists $hash1->{$_} } keys %$hash2)
    {
	$result->{$key}
	    = Data::Differences->new(clone(\$hash2->{$key}));
    }

    return Data::Differences->new($result);
}


#
# scalar_comparator()
#
# Compare two scalar values, report on the differences found by
# returning the second scalar value if it is different from the first
# scalar value.
#

sub scalar_comparator
{
    my $scalar1 = shift;

    my $scalar2 = shift;

    #t two undefs is illegal.

    if (!defined $scalar1 && !defined $scalar2)
    {
	return Data::Differences->new(clone(\undef));
    }

    if (!defined $scalar2)
    {
	return Data::Differences->new(clone(\$scalar2));
    }

    if (($scalar1 cmp $scalar2) eq 0)
    {
	return Data::Differences->new(clone(\undef));
    }
    else
    {
	return Data::Differences->new(clone(\$scalar2));
    }
}


#
# scalar_ref_comparator()
#
# Compare two references to scalar values, report on the differences
# found by returning the second reference if it is different from the
# first reference.
#

sub scalar_ref_comparator
{
    my $scalar1 = shift;

    my $scalar2 = shift;

    my $value1 = $$scalar1;

    my $value2 = $$scalar2;


    # for two undefs

    if (!defined $value1
	&& !defined $value2)
    {
	# return equality

	return Data::Differences->new(clone(\undef));
    }

    # for one undef

    elsif (!defined $value1
	   || !defined $value2)
    {
	# return different

	return Data::Differences->new(clone(\$scalar2));
    }

    # in other cases

    else
    {
	# do a normal comparison by calling the generic comparator

	return data_comparator($value1, $value2);

# 	if (($value1 cmp $value2) eq 0)
# 	{
# 	    return Data::Differences->new(clone(\undef));
# 	}
# 	else
# 	{
# 	    return Data::Differences->new(clone(\$scalar2));
# 	}
    }
}


1;