view release on metacpan or  search on metacpan

lib/Array/Compare.pm  view on Meta::CPAN

Passed two arrays and returns true if they are of different lengths.

This is just the inverse of C<compare_len> (which is badly named).

=cut

sub different_len {
  my $self = shift;
  return ! $self->compare_len(@_);
}

=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<simple_compare>
and L<full_compare> 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 a 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<Note:> 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.