libstruct-compare-perl-1.0.1/0000755000175000017500000000000010661050131015111 5ustar zobelzobellibstruct-compare-perl-1.0.1/t/0000755000175000017500000000000007253645036015375 5ustar zobelzobellibstruct-compare-perl-1.0.1/t/core.t0000644000175000017500000000751107251265675016523 0ustar zobelzobel# -*- perl -*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) BEGIN { $| = 1; print "1..23\n"; } END {print "not ok 1\n" unless $loaded;} use Struct::Compare; $loaded = 1; print "ok 1\n"; my $testnum = 2; sub assert($$) { my $mesg = shift; my $test = shift; print "\n$mesg\n"; if ($test) { print "ok $testnum\n"; } else { print "not ok $testnum\n"; } $testnum++; } ######################### End of black magic. # Insert your test code below (better if it prints "ok 13" # (correspondingly "not ok 13") depending on the success of chunk 13 # of the test code): ############################################################ # Simple Scalars assert("Simple scalar diff must return true when two numbers are the same", compare(1, 1)); assert("Simple scalar diff must return true when two strings are the same", compare("1", "1")); assert("Simple scalar diff must return false when two numbers differ", ! compare(1, 2)); assert("Simple scalar diff must return false when two strings differ", ! compare("1", "12")); assert("Simple scalar diff must return false the LHS value is undef", ! compare(undef, 1)); assert("Simple scalar diff must return false the RHS value is undef", ! compare(1, undef)); ############################################################ # Array Refs: assert("Simple array refs must return true when they are both empty", compare([], [])); assert("Simple array refs must return false when they are differing sizes", ! compare([1, 2, 3], [1, 2])); assert("Simple array refs must return false when they are differing order", ! compare([1, 2, 3], [3, 2, 1])); assert("Simple array refs must return false when they are differing values", ! compare([1, 2, 3], [3, 2, 0])); assert("Simple array refs must return true when they are the same", compare([1, 2, 3], [1, 2, 3])); ############################################################ # Hash Refs: assert("Simple hash refs must return true when they are both empty", compare({}, {})); assert("Simple hash refs must return false when they are differing sizes", ! compare({'a' => 1}, {'a' => 1, 'b' => 2})); assert("Simple hash refs must return false when they are differing values", ! compare({'a' => 1, 'b' => 2}, {'a' => 1, 'b' => 3})); assert("Simple hash refs must return true when they are the same", compare({'a' => 1, 'b' => 2}, {'a' => 1, 'b' => 2})); ############################################################ # Complex(er) types: my $a = {'a' => [ 1, 2, [ 3 ], { 'b' => 4 } ], 'c' => 42, 'd' => { 'e' => { 'f' => [] } } }; my $b = {'a' => [ 1, 2, [ 3 ], { 'b' => 4 } ], 'c' => 42, 'd' => { 'e' => { 'f' => [] } } }; my $c = {'a' => [ 1, 2, [ 3 ], { 'b' => 4 } ], 'c' => 42, 'd' => { 'e' => { 'f' => [ "this is different" ] } } }; assert("This is a quicky, I think it will work", compare($a, $b)); assert("This is a quicky, I think it will work", compare($b, $a)); assert("This is a quicky, I think it will work", ! compare($a, $c)); assert("This is a quicky, I think it will work", ! compare($c, $a)); ############################################################ # Differing types: assert("Simple scalar diff must return true if string and number are the same", compare(1, "1")); assert("Empty hash and array refs must return false when they are both empty", ! compare({}, [])); ############################################################ # TEMPLATE: copy only assert("Array refs must return XXX when they are both empty", compare([], [])); libstruct-compare-perl-1.0.1/Changes0000644000175000017500000000024007253641263016417 0ustar zobelzobelRevision history for Perl extension Struct::Compare. 1.0.1 - 2001-03-09 Improved POD docs, added license, released. 1.0.0 - 2001-01-17 Original version. libstruct-compare-perl-1.0.1/Compare.pm0000644000175000017500000000736407253641264017067 0ustar zobelzobelpackage Struct::Compare; =head1 NAME Struct::Compare - Recursive diff for perl structures. =head1 SYNOPSIS use Struct::Compare; my $is_different = compare($ref1, $ref2); =head1 DESCRIPTION Compares two values of any type and structure and returns true if they are the same. It does a deep comparison of the structures, so a hash of a hash of a whatever will be compared correctly. This is especially useful for writing unit tests for your modules! =head1 PUBLIC FUNCTIONS =over 4 =cut use strict; require Exporter; use vars qw($VERSION @ISA @EXPORT); use Carp qw(croak); @ISA = qw(Exporter); @EXPORT = qw(compare); $VERSION = '1.0.1'; # TODO: document use constant FALSE=>0; use constant TRUE =>1; use constant DEBUG=>0; =item * $bool = compare($var1, $var2) Recursively compares $var1 to $var2, returning false if either structure is different than the other at any point. If both are undefined, it returns true as well, because that is considered equal. =cut sub compare { my $x = shift; my $y = shift; if (@_) { croak "Too many items sent to compare"; } return FALSE if defined $x xor defined $y; return TRUE if ! defined $x and ! defined $y; my $a = ref $x ? $x : \$x; my $b = ref $y ? $y : \$y; print "\$a is a ", ref $a, "\n" if DEBUG; print "\$b is a ", ref $b, "\n" if DEBUG; return FALSE unless ref $a eq ref $b; if (ref $a eq 'SCALAR') { print "a = $$a, b = $$b\n" if DEBUG; return $$a eq $$b; } if (ref $a eq 'HASH') { my @keys = keys %{$a}; my $max = scalar(@keys); return FALSE if $max != scalar(keys %{$b}); return TRUE if $max == 0; # first just look to see if there are any keys not in the other; my $found = 0; foreach my $key (@keys) { $found++ if exists $b->{$key}; } return FALSE if $found != $max; # now compare the values foreach my $key (@keys) { # WARN: recursion may get really deep. return FALSE unless compare($a->{$key}, $b->{$key}); } return TRUE; } if (ref $a eq 'ARRAY') { my $max = scalar(@{$a}); return FALSE if $max != scalar(@{$b}); return TRUE if $max == 0; for (my $i = 0; $i < $max; ++$i) { # WARN: recursion may get really deep. return FALSE unless compare($a->[$i], $b->[$i]); } return TRUE; } # FIX: doesn't deal with non-basic types... see if you can fake it. return FALSE; } 1; __END__ =back =head1 BUGS/NEEDED ENHANCEMENTS =item * blessed references compare currently does not deal with blessed references. I need to look into how to deal with this. =head1 LICENSE (The MIT License) Copyright (c) 2001 Ryan Davis, Zen Spider Software Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. =head1 AUTHOR Ryan Davis Zen Spider Software =cut libstruct-compare-perl-1.0.1/MANIFEST0000644000175000017500000000006107251265670016260 0ustar zobelzobelChanges Compare.pm MANIFEST Makefile.PL t/core.t libstruct-compare-perl-1.0.1/Makefile.PL0000644000175000017500000000036107251265672017106 0ustar zobelzobeluse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Struct::Compare', 'VERSION_FROM' => 'Compare.pm', # finds $VERSION );