File Coverage

blib/lib/File/Cmp.pm

Criterion	Covered	Total	%
statement	65	65	100.0
branch	41	48	85.4
condition	14	20	70.0
subroutine	7	7	100.0
pod	1	1	100.0
total	128	141	90.7

# -*- Perl -*-
#
# File::Cmp - 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.09';

# 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] ) // -1 ) != ( ( -s $files[1] ) // -2 ) ) {
        ${ $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__