The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl 1.t'

#########################

# change 'tests => 1' to 'tests => last_test_to_print';

use Test::More tests => 25;
use File::Signature;

#########################

sub touch_testfile { 
    my $file = shift || './testfile';
    open F, '>>', $file or die "Couldn't open $file: $!"; #return undef; 
    print F "\n";
    close F;
    return 1;
}

sub remove_testfile { unlink './testfile' if -e './testfile' }
 
SKIP: {
    touch_testfile() or skip "couldn't create test file";
    my $obj = File::Signature->new('./testfile'); 
    ok( !$obj->changed , "hasn't changed" );
       ($o,$n) = $obj->old_and_new('pathname'); is( $o, $n, 'check pathnames' );
       ($o,$n) = $obj->old_and_new('digest');   is( $o, $n, 'check digests' );
       ($o,$n) = $obj->old_and_new('ino');      is( $o, $n, 'check inodes' );
       ($o,$n) = $obj->old_and_new('mode');     is( $o, $n, 'check modes' );
       ($o,$n) = $obj->old_and_new('uid');      is( $o, $n, 'check uids' );
       ($o,$n) = $obj->old_and_new('gid');      is( $o, $n, 'check gids' );
       ($o,$n) = $obj->old_and_new('size');     is( $o, $n, 'check sizes' );
       ($o,$n) = $obj->old_and_new('mtime');    is( $o, $n, 'check mtimes' );
    remove_testfile();
}

SKIP: {
    touch_testfile() or skip "couldn't create test file";
    my $obj = File::Signature->new('./testfile'); 
    sleep 1; 
    touch_testfile() or skip "couldn't touch test file";
    ok( $obj->changed , "has changed" );
    my ($o,$n) = $obj->old_and_new('pathname');  is( $o, $n, 'same pathnames' );
       ($o,$n) = $obj->old_and_new('digest');  isnt( $o, $n, 'digests differ' );
       ($o,$n) = $obj->old_and_new('ino');       is( $o, $n, 'same inodes' );
       ($o,$n) = $obj->old_and_new('mode');      is( $o, $n, 'same modes' );
       ($o,$n) = $obj->old_and_new('uid');       is( $o, $n, 'same uids' );
       ($o,$n) = $obj->old_and_new('gid');       is( $o, $n, 'same gids' );
       ($o,$n) = $obj->old_and_new('size');    isnt( $o, $n, 'sizes differ' );
       ($o,$n) = $obj->old_and_new('mtime');   isnt( $o, $n, 'mtimes differ' );
    chmod 0700, './testfile' or skip "can't chmod";
    ok( $obj->changed , "has changed again" );
       ($o,$n) = $obj->old_and_new('pathname');  is( $o, $n, 'same pathnames' );
       ($o,$n) = $obj->old_and_new('mode');    isnt( $o, $n, 'modes differ' );
    touch_testfile("./testfile2") or skip "couldn't create new test file";
    unlink './testfile';
    rename './testfile2', './testfile';
    ok( $obj->changed , "has changed yet again" );
       ($o,$n) = $obj->old_and_new('pathname');  is( $o, $n, 'same pathnames' );
       ($o,$n) = $obj->old_and_new('ino');     isnt( $o, $n, 'inodes differ' );
    remove_testfile();
}

my $err = File::Signature->new('nonexistent'); 
eval { $err->old_and_new('pathname') };
like( $@, qr/bad method call/, 'threw exception');