Array-Compare-2.11000755001750001750 012413061270 13114 5ustar00davedave000000000000Array-Compare-2.11/MANIFEST000555001750001750 16712413061270 14371 0ustar00davedave000000000000Build.PL Makefile.PL Changes lib/Array/Compare.pm MANIFEST META.yml README t/pod.t t/test.t t/pod_coverage.t META.json Array-Compare-2.11/Changes000444001750001750 722012413061270 14545 0ustar00davedave000000000000Dave Cross 2014-10-01 Finish removing Moose Dave Cross 2014-10-01 File permission fixes Dave Cross 2014-10-01 Ported from Moose to Moo Dave Cross 2014-01-10 Added .travis.yml Dave Cross 2011-12-15 More fixes for undef values. Merge: 22c8987 4e26a0a Dave Cross 2011-12-15 Merge branch 'master' of github.com:davorg/array-compare Dave Cross 2011-12-15 Tests and fixes for RT bug 73287 (thanks to Andrew Solomon) Bump version number Dave Cross 2011-12-15 Tests and fixes for RT bug 73287 (thanks to Andrew Soloman) Bump version number Dave Cross 2011-02-17 Removed old Perl 4-ish test comments. Dave Cross 2009-09-02 Correct documentation of 'WhiteSpace' option. Dave Cross 2009-08-29 Bump version number. Dave Cross 2009-08-09 Corrected version number. Dave Cross 2009-08-09 Bumped version number. Dave Cross 2009-08-09 Switched to using Moose. Dave Cross 2009-06-14 Renames README.xml Dave Cross 2009-06-14 Bump version number for release. Dave Cross 2009-06-14 Added version number. Fixed https://rt.cpan.org/Ticket/Display.html?id=45145 Dave Cross 2009-06-14 Moved version setting into .pm. Dave Cross 2009-02-21 Removed execute bit. Dave Cross 2008-06-29 Added LICENSE section (for cpants). Dave Cross 2008-03-06 Increment version number Dave Cross 2008-03-06 Fix prerequisites Dave Cross 2008-03-06 Require Perl 5.6 so we can use warnings and our. Dave Cross 2007-04-04 Another attempt at removing the execute bit Dave Cross 2007-04-02 Made Build.PL non-executable Dave Cross 2007-04-01 Updated copyright dates Dave Cross 2007-04-01 Changed $VERSION definition Dave Cross 2007-04-01 Changed create_makefile_pl parameter to 'traditional' Dave Cross 2005-10-01 Reordering Dave Cross 2005-09-21 Documentation fix Dave Cross 2005-07-10 Added t/pod_coverage to MANIFEST Dave Cross 2005-07-10 Removed Makefile.PL (which is autogenerated) Dave Cross 2005-03-01 Changes to pass Pod::Coverage tests (and, hence, increase kwalitee) Dave Cross 2004-10-23 Improved test coverage Dave Cross 2004-10-22 Improved docs for full comparison Dave Cross 2004-10-22 Updated pod tests Dave Cross 2004-05-13 Small formatting changes Dave Cross 2004-05-12 Added Makefile.PL Dave Cross 2004-05-12 Added various files to cvs Dave Cross 2003-09-19 Bring CVS version into line with old file Dave Cross 2003-09-19 Bit of an overhaul Dave Cross 2002-03-29 Test version Dave Cross 2002-03-29 README input file Dave Cross 2002-03-29 Test script. Dave Cross 2002-01-09 Small cleanups Dave Cross 2001-12-09 Cleanup. (no author) <(no author)> 2001-12-09 New repository initialized by cvs2svn. Array-Compare-2.11/Build.PL000555001750001750 76412413061270 14537 0ustar00davedave000000000000use Module::Build; my $build = Module::Build->new( module_name => 'Array::Compare', license => 'perl', requires => { perl => '5.6.0', Carp => 0, Moo => 0, Types::Standard => 0, }, build_requires => { Test::NoWarnings => 0, }, build_recommends => { Test::Pod => 0, Test::Pod::Coverage => 0, }, create_makefile_pl => 'traditional', ); $build->create_build_script; Array-Compare-2.11/META.yml000444001750001750 114312413061270 14521 0ustar00davedave000000000000--- abstract: 'Perl extension for comparing arrays.' author: - 'Dave Cross ' build_requires: Test::NoWarnings: 0 configure_requires: Module::Build: 0.40 dynamic_config: 1 generated_by: 'Module::Build version 0.4007, CPAN::Meta::Converter version 2.132140' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Array-Compare provides: Array::Compare: file: lib/Array/Compare.pm version: 2.11 requires: Carp: 0 Moo: 0 Types::Standard: 0 perl: v5.6.0 resources: license: http://dev.perl.org/licenses/ version: 2.11 Array-Compare-2.11/Makefile.PL000444001750001750 72512413061270 15207 0ustar00davedave000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4007 require 5.006000; use ExtUtils::MakeMaker; WriteMakefile ( 'NAME' => 'Array::Compare', 'VERSION_FROM' => 'lib/Array/Compare.pm', 'PREREQ_PM' => { 'Carp' => 0, 'Moo' => 0, 'Test::NoWarnings' => 0, 'Types::Standard' => 0 }, 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {} ) ; Array-Compare-2.11/META.json000444001750001750 211312413061270 14667 0ustar00davedave000000000000{ "abstract" : "Perl extension for comparing arrays.", "author" : [ "Dave Cross " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4007, CPAN::Meta::Converter version 2.132140", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Array-Compare", "prereqs" : { "build" : { "requires" : { "Test::NoWarnings" : "0" } }, "configure" : { "requires" : { "Module::Build" : "0.40" } }, "runtime" : { "requires" : { "Carp" : "0", "Moo" : "0", "Types::Standard" : "0", "perl" : "v5.6.0" } } }, "provides" : { "Array::Compare" : { "file" : "lib/Array/Compare.pm", "version" : "2.11" } }, "release_status" : "stable", "resources" : { "license" : [ "http://dev.perl.org/licenses/" ] }, "version" : "2.11" } Array-Compare-2.11/README000555001750001750 342412413061270 14137 0ustar00davedave000000000000 Array::Compare -------------- NAME Array::Compare DESCRIPTION WHAT IS Array::Compare? Array::Compare is a Perl module which allows you to compare two arrays. It has a number of features which allow you to control the way that the arrays are compared: * white space in array elements can be significant or ignored. * particular columns in the arrays can be ignored. Additionally you can get a simple true/false return value or the number of columns which differ or an array containing the indexes of the differing columns. HOW DO I INSTALL IT? Array::Compare uses the standard Perl module architecture and can therefore by installed using the standard Perl method which, in brief, goes something like this: gzip -cd Array-Compare-X.XX.tar.gz | tar xvf - cd Array-Compare-X.XX perl Makefile.PL make make test make install Where X.XX is the version number of the module which you are installing. If this doesn't work for you then creating a directory called Array somewhere in your Perl library path (@INC) and copying the Compare.pm file into this directory should also do the trick. WHERE IS THE DOCUMENTATION? All of the documentation is currently in POD format in the Compare.pm file. If you install the module using the standard method you should be able to read it by typing perldoc Array::Compare at a comand prompt. LATEST VERSION The latest version of this module will always be available from CPAN. COPYRIGHT Copyright (C) 2003-7, Magnum Solutions Ltd. All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. ANYTHING ELSE? If you have any further questions, please contact the author. AUTHOR Dave Cross Array-Compare-2.11/lib000755001750001750 012413061270 13662 5ustar00davedave000000000000Array-Compare-2.11/lib/Array000755001750001750 012413061270 14740 5ustar00davedave000000000000Array-Compare-2.11/lib/Array/Compare.pm000555001750001750 3152412413061270 17051 0ustar00davedave000000000000# # $Id$ # =head1 NAME Array::Compare - Perl extension for comparing arrays. =head1 SYNOPSIS use Array::Compare; my $comp1 = Array::Compare->new; $comp->Sep('|'); $comp->Skip({3 => 1, 4 => 1}); $comp->WhiteSpace(0); $comp->Case(1); my $comp2 = Array::Compare->new(Sep => '|', WhiteSpace => 0, Case => 1, Skip => {3 => 1, 4 => 1}); my @arr1 = 0 .. 10; my @arr2 = 0 .. 10; $comp1->compare(\@arr1, \@arr2); $comp2->compare(\@arr1, \@arr2); =head1 DESCRIPTION If you have two arrays and you want to know if they are the same or different, then Array::Compare will be useful to you. All comparisons are carried out via a comparator object. In the simplest usage, you can create and use a comparator object like this: my @arr1 = 0 .. 10; my @arr2 = 0 .. 10; my $comp = Array::Compare->new; if ($comp->compare(\@arr1, \@arr2)) { print "Arrays are the same\n"; } else { print "Arrays are different\n"; } Notice that you pass references to the two arrays to the comparison method. Internally the comparator compares the two arrays by using C to turn both arrays into strings and comparing the strings using C. In the joined strings, the elements of the original arrays are separated with the C<^G> character. This can cause problems if your array data contains C<^G> characters as it is possible that two different arrays can be converted to the same string. To avoid this, it is possible to override the default separator character, either by passing and alternative to the C function my $comp = Array::Compare->new(Sep => '|'); or by changing the seperator for an existing comparator object $comp->Sep('|'); In general you should choose a separator character that won't appear in your data. You can also control whether or not whitespace within the elements of the arrays should be considered significant when making the comparison. The default is that all whitespace is significant. The alternative is for all consecutive white space characters to be converted to a single space for the pruposes of the comparison. Again, this can be turned on when creating a comparator object: my $comp = Array::Compare->new(WhiteSpace => 0); or by altering an existing object: $comp->WhiteSpace(0); You can also control whether or not the case of the data is significant in the comparison. The default is that the case of data is taken into account. This can be changed in the standard ways when creating a new comparator object: my $comp = Array::Compare->new(Case => 0); or by altering an existing object: $comp->Case(0); In addition to the simple comparison described above (which returns true if the arrays are the same and false if they're different) there is also a full comparison which returns a list containing the indexes of elements which differ between the two arrays. If the arrays are the same it returns an empty list. In scalar context the full comparison returns the length of this list (i.e. the number of elements that differ). You can access the full comparision in two ways. Firstly, there is a C attribute. If this is C then a full comparison if carried out whenever the C method is called. my $comp = Array::Compare->new(DefFull => 1); $comp->compare(\@arr1, \@arr2); # Full comparison $comp->DefFull(0); $comp->compare(\@arr1, \@arr2); # Simple comparison $comp->DefFull(1); $comp->compare(\@arr1, \@arr2); # Full comparison again Secondly, you can access the full comparison method directly $comp->full_compare(\@arr1, \@arr2); For symmetry, there is also a direct method to use to call the simple comparison. $comp->simple_compare(\@arr1, \@arr2); The final complication is the ability to skip elements in the comparison. If you know that two arrays will always differ in a particular element but want to compare the arrays I this element, you can do it with Array::Compare without taking array slices. To do this, a comparator object has an optional attribute called C which is a reference to a hash. The keys in this hash are the indexes of the array elements and the values should be any true value for elements that should be skipped. For example, if you want to compare two arrays, ignoring the values in elements two and four, you can do something like this: my %skip = (2 => 1, 4 => 1); my @a = (0, 1, 2, 3, 4, 5); my @b = (0, 1, X, 3, X, 5); my $comp = Array::Compare->new(Skip => \%skip); $comp->compare(\@a, \@b); This should return I, as we are explicitly ignoring the columns which differ. Of course, having created a comparator object with no skip hash, it is possible to add one later: $comp->Skip({1 => 1, 2 => 1}); or: my %skip = (1 => 1, 2 => 2); $comp->Skip(\%skip); To reset the comparator so that no longer skips elements, set the skip hash to an empty hash. $comp->Skip({}); You can also check to see if one array is a permutation of another, i.e. they contain the same elements but in a different order. if ($comp->perm(\@a, \@b) { print "Arrays are perms\n"; else { print "Nope. Arrays are completely different\n"; } In this case the values of C and C are still used, but C is ignored for, hopefully, obvious reasons. =head1 METHODS =cut package Array::Compare; require 5.006_000; use strict; use warnings; our ($VERSION, $AUTOLOAD); use Moo; use Types::Standard qw(Str Bool HashRef); use Carp; $VERSION = '2.11'; has Sep => ( is => 'rw', isa => Str, default => '^G' ); has WhiteSpace => ( is => 'rw', isa => Bool, default => 1 ); has Case => ( is => 'rw', isa => Bool, default => 1 ); has DefFull => ( is => 'rw', isa => Bool, default => 0 ); has Skip => ( is => 'rw', isa => HashRef, default => sub { {} } ); =head2 new [ %OPTIONS ] Constructs a new comparison object. Takes an optional hash containing various options that control how comparisons are carried out. Any omitted options take useful defaults. =over 4 =item Sep This is the value that is used to separate fields when the array is joined into a string. It should be a value which doesn't appear in your data. Default is '^G'. =item WhiteSpace Flag that indicates whether or not whitespace is significant in the comparison. If this value is false then all multiple whitespace characters are changed into a single space before the comparison takes place. Default is 1 (whitespace is significant). =item Case Flag that indicates whther or not the case of the data should be significant in the comparison. Default is 1 (case is significant). =item Skip a reference to a hash which contains the numbers of any columns that should be skipped in the comparison. Default is an empty hash (all columns are significant). =item DefFull Flag which indicates whether the default comparison is simple (just returns true if the arrays are the same or false if they're not) or full (returns an array containing the indexes of the columns that differ). Default is 0 (simple comparison). =back =cut # # Utility function to check the arguments to any of the comparison # function. Ensures that there are two arguments and that they are # both arrays. # sub _check_args { my $self = shift; croak('Must compare two arrays.') unless @_ == 2; croak('Argument 1 is not an array') unless ref($_[0]) eq 'ARRAY'; croak('Argument 2 is not an array') unless ref($_[1]) eq 'ARRAY'; return; } =head2 compare_len \@ARR1, \@ARR2 Very simple comparison. Just checks the lengths of the arrays are the same. =cut sub compare_len { my $self = shift; $self->_check_args(@_); return @{$_[0]} == @{$_[1]}; } =head2 compare \@ARR1, \@ARR2 Compare the values in two arrays and return a data indicating whether the arrays are the same. The exact return values differ depending on the comparison method used. See the descriptions of L and L for details. Uses the value of DefFull to determine which comparison routine to use. =cut sub compare { my $self = shift; if ($self->DefFull) { return $self->full_compare(@_); } else { return $self->simple_compare(@_); } } =head2 simple_compare \@ARR1, \@ARR2 Compare the values in two arrays and return a flag indicating whether or not the arrays are the same. Returns true if the arrays are the same or false if they differ. Uses the values of 'Sep', 'WhiteSpace' and 'Skip' to influence the comparison. =cut sub simple_compare { my $self = shift; $self->_check_args(@_); my ($row1, $row2) = @_; # No point in continuing if the number of elements is different. return unless $self->compare_len(@_); # @check contains the indexes into the two arrays, i.e. the numbers # from 0 to one less than the number of elements. my @check = 0 .. $#$row1; my ($pkg, $caller) = (caller(1))[0, 3]; $caller = '' unless defined $caller; my $perm = $caller eq __PACKAGE__ . "::perm"; # Filter @check so it only contains indexes that should be compared. # N.B. Makes no sense to do this if we are called from 'perm'. unless ($perm) { @check = grep {!(exists $self->Skip->{$_} && $self->Skip->{$_}) } @check if keys %{$self->Skip}; } # Build two strings by taking array slices containing only the columns # that we shouldn't skip and joining those array slices using the Sep # character. Hopefully we can then just do a string comparison. # Note: this makes the function liable to errors if your arrays # contain the separator character. my $str1 = join($self->Sep, map { defined $_ ? $_ : '' } @{$row1}[@check]); my $str2 = join($self->Sep, map { defined $_ ? $_ : '' } @{$row2}[@check]); # If whitespace isn't significant, collapse it unless ($self->WhiteSpace) { $str1 =~ s/\s+/ /g; $str2 =~ s/\s+/ /g; } # If case isn't significant, change to lower case unless ($self->Case) { $str1 = lc $str1; $str2 = lc $str2; } return $str1 eq $str2; } =head2 full_compare \@ARR1, \@ARR2 Do a full comparison between two arrays. Checks each individual column. In scalar context returns the number of columns that differ (zero if the arrays are the same). In list context returns an list containing the indexes of the columns that differ (an empty list if the arrays are the same). Uses the values of 'Sep' and 'WhiteSpace' to influence the comparison. B If the two arrays are of different lengths then this method just returns the indexes of the elements that appear in one array but not the other (i.e. the indexes from the longer array that are beyond the end of the shorter array). This might be a little counter-intuitive. =cut sub full_compare { my $self = shift; $self->_check_args(@_); my ($row1, $row2) = @_; # No point in continuing if the number of elements is different. # Because of the expected return value from this function we can't # just say 'the arrays are different'. We need to do some work to # calculate a meaningful return value. # If we've been called in array context we return a list containing # the number of the columns that appear in the longer list and aren't # in the shorter list. If we've been called in scalar context we # return the difference in the lengths of the two lists. unless ($self->compare_len(@_)) { if (wantarray) { my ($max, $min); if ($#{$row1} > $#{$row2}) { ($max, $min) = ($#{$row1}, $#{$row2} + 1); } else { ($max, $min) = ($#{$row2}, $#{$row1} + 1); } return ($min .. $max); } else { return abs(@{$row1} - @{$row2}); } } my ($arr1, $arr2) = @_; my @diffs = (); foreach (0 .. $#{$arr1}) { next if keys %{$self->Skip} && $self->Skip->{$_}; my ($val1, $val2) = ($arr1->[$_], $arr2->[$_]); next unless defined $val1 or defined $val2; if ((defined $val1 and not defined $val2) or (defined $val2 and not defined $val1)) { push @diffs, $_; next; } unless ($self->WhiteSpace) { $val1 =~ s/\s+/ /g; $val2 =~ s/\s+/ /g; } unless ($self->Case) { $val1 = lc $val1; $val2 = lc $val2; } push @diffs, $_ unless $val1 eq $val2; } return wantarray ? @diffs : scalar @diffs; } =head2 perm \@ARR1, \@ARR2 Check to see if one array is a permutation of the other (i.e. contains the same set of elements, but in a different order). We do this by sorting the arrays and passing references to the assorted versions to simple_compare. There are also some small changes to simple_compare as it should ignore the Skip hash if we are called from perm. =cut sub perm { my $self = shift; return $self->simple_compare([sort @{$_[0]}], [sort @{$_[1]}]); } 1; __END__ =head1 AUTHOR Dave Cross =head1 SEE ALSO perl(1). =head1 COPYRIGHT AND LICENSE Copyright (C) 2000-2005, Magnum Solutions Ltd. All Rights Reserved. This script is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Array-Compare-2.11/t000755001750001750 012413061270 13357 5ustar00davedave000000000000Array-Compare-2.11/t/pod.t000555001750001750 20112413061270 14437 0ustar00davedave000000000000use Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Array-Compare-2.11/t/test.t000555001750001750 573512413061270 14675 0ustar00davedave000000000000 use Test::More 'no_plan'; use Test::NoWarnings; use_ok('Array::Compare'); my $comp = Array::Compare->new; my @A = qw/0 1 2 3 4 5 6 7 8/; my @B = qw/0 1 2 3 4 5 X 7 8/; my @C = @A; my %skip1 = (6 => 1); my %skip2 = (5 => 1); my %skip3 = (6 => 0); # Compare two different arrays - should fail ok(not $comp->compare(\@A, \@B)); # Compare two different arrays but ignore differing column - should succeed $comp->Skip(\%skip1); ok($comp->compare(\@A, \@B)); # compare two different arrays but ignore non-differing column - should fail $comp->Skip(\%skip2); ok(not $comp->compare(\@A, \@B)); # Compare two different arrays but ignore differing column (badly) # - should fail as skip value is 0 $comp->Skip(\%skip3); ok(not $comp->compare(\@A, \@B)); # Change separator and compare two identical arrays - should succeed $comp->Sep('|'); ok($comp->compare(\@A, \@C)); # These tests should generate fatal errors - hence the evals # Compare a number with an array eval { print $comp->compare(1, \@A) }; ok($@); # Compare an array with a number eval { print $comp->compare(\@A, 1) }; ok($@); # Call compare with only one argument eval { print $comp->compare(\@A) }; ok($@); # Switch to full comparison $comp->DefFull(1); ok($comp->DefFull); $comp->Skip({}); # @A and @B differ in column 6 # Array context my @diffs = $comp->compare(\@A, \@B); ok(scalar @diffs == 1 && $diffs[0] == 6); # Scalar context my $diffs = $comp->compare(\@A, \@B); ok($diffs); # @A and @B differ in column 6 (which we ignore) $comp->Skip(\%skip1); # Array context @diffs = $comp->compare(\@A, \@B); ok(not @diffs); # Scalar context $diffs = $comp->compare(\@A, \@B); ok(not $diffs); # @A and @C are the same # Array context @diffs = $comp->compare(\@A, \@C); ok(not @diffs); # Scalar context $diffs = $comp->compare(\@A, \@C); ok(not $diffs); # Test arrays of differing length my @D = (0 .. 5); my @E = (0 .. 10); $comp->DefFull(0); ok( not $comp->compare(\@D, \@E)); $comp->DefFull(1); @diffs = $comp->compare(\@D, \@E); ok(@diffs == 5); @diffs = $comp->compare(\@E, \@D); ok(@diffs == 5); $diffs = $comp->compare(\@D, \@E); ok($diffs == 5); # Test Perms my @F = (1 .. 5); my @G = qw(5 4 3 2 1); my @H = qw(3 4 1 2 5); my @I = qw(4 3 6 5 2); ok($comp->perm(\@F, \@G)); ok($comp->perm(\@F, \@H)); ok(not $comp->perm(\@F, \@I)); my @J = ('array with', 'white space'); my @K = ('array with', 'white space'); ok($comp->compare(\@J, \@K)); # Turn off whitespace $comp->WhiteSpace(0); ok(not $comp->compare(\@J, \@K)); $comp->DefFull(0); ok($comp->compare(\@J, \@K)); # Turn on whitespace $comp->WhiteSpace(1); ok(not $comp->compare(\@J, \@K)); my @L = qw(ArRay WiTh DiFfErEnT cAsEs); my @M = qw(aRrAY wItH dIfFeReNt CaSeS); ok(not $comp->compare(\@L, \@M)); # Turn of case sensitivity $comp->Case(0); ok($comp->compare(\@L, \@M)); $comp->DefFull(1); ok(not $comp->compare(\@L, \@M)); my @N = (undef, 1 .. 3); my @O = (undef, 1 .. 3); $comp->DefFull(0); ok($comp->compare(\@N, \@O)); $comp->DefFull(1); ok(not $comp->compare(\@N, \@O)); Array-Compare-2.11/t/pod_coverage.t000555001750001750 24112413061270 16316 0ustar00davedave000000000000use Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok();