File Coverage

blib/lib/File/Cmp.pm

Criterion	Covered	Total	%
statement	63	63	100.0
branch	33	48	68.7
condition	9	16	56.2
subroutine	6	6	100.0
pod	0	1	0.0
total	111	134	82.8

# -*- Perl -*-
#
# Compare two files character by character like cmp(1).

package File::Cmp;

use 5.008000;
use strict;
use warnings;

use Carp qw/croak/;
use Scalar::Util qw/reftype/;

require Exporter;
our @ISA       = qw(Exporter);
our @EXPORT_OK = qw/&fcmp/;

our $VERSION = '1.06';

# XXX 'skip' and 'limit' might be good parameters to add, to skip X
# initial bytes, limit work to Y bytes of data to check
sub fcmp {
  croak 'fcmp needs two files' if @_ < 2;
  my @files = splice @_, 0, 2;
  my $param = ( @_ == 1 and ref $_[0] eq 'HASH' ) ? $_[0] : {@_};

  $param->{sizecheck} = 1 unless exists $param->{sizecheck};
  $param->{sizecheck} = 0 if exists $param->{tells};

  if ( $param->{fscheck} ) {
    my @statbuf;
    for my $f (@files) {
      # stat has the handy property of chasing symlinks for us
      my @devino = ( stat $f )[ 0, 1 ] or croak "could not stat: $!";
      push @statbuf, \@devino;
    }
    if (  $statbuf[0][0] == $statbuf[1][0]
      and $statbuf[0][1] == $statbuf[1][1] ) {
      ${ $param->{reason} } = 'fscheck' if exists $param->{reason};
      return 1;    # assume files identical as both dev and inode match
    }
  }

  # The files are probably not identical if they differ in size;
  # however, offer means to turn this check off if -s for some reason is
  # incorrect (or if 'tells' is on so we need to find roughly where the
  # difference is in the files).
  if ( $param->{sizecheck} and -s $files[0] != -s $files[1] ) {
    ${ $param->{reason} } = 'size' if exists $param->{reason};
    return 0;
  }

  my @fhs;
  for my $f (@files) {
    if ( !defined reftype $f) {
      open my $fh, '<', $f or croak "could not open $f: $!";
      push @fhs, $fh;
    } else {
      # Assume is a GLOB or something can readline on, XXX might want to
      # better check this
      push @fhs, $f;
    }
    if ( exists $param->{binmode} ) {
      binmode $fhs[-1], $param->{binmode} or croak "binmode failed: $!";
    }
  }

  local $/ = $param->{RS} if exists $param->{RS};

  while (1) {
    my $eof1 = eof $fhs[0];
    my $eof2 = eof $fhs[1];
    # Done if both files are at EOF; otherwise assume they differ if one
    # completes before the other (this second case would normally be
    # optimized away by the -s test, above).
    last if $eof1 and $eof2;
    if ( $eof1 xor $eof2 ) {
      ${ $param->{reason} } = 'eof' if exists $param->{reason};
      @{ $param->{tells} } = ( tell $fhs[0], tell $fhs[1] )
        if exists $param->{tells};
      return 0;
    }

    my $this = readline $fhs[0];
    croak "error reading from first file: $!" if !defined $this;
    my $that = readline $fhs[1];
    croak "error reading from second file: $!" if !defined $that;

    if ( $this ne $that ) {
      @{ $param->{tells} } = ( tell $fhs[0], tell $fhs[1] )
        if exists $param->{tells};
      ${ $param->{reason} } = 'diff' if exists $param->{reason};
      return 0;
    }
  }

  return 1;    # assume files identical if get this far
}

1;
__END__