#! /usr/bin/perl -w
use strict;

# $Id: syncer_link.t 1285 2010-11-04 18:06:52Z abeltje $

use Config;
use File::Spec;
use Cwd 'abs_path';
use lib File::Spec->rel2abs( 't', abs_path() );
use TestLib;

my $win32_fat;
BEGIN { $win32_fat = $^O eq 'MSWin32' && Win32::FsType() ne 'NTFS' }

use Test::More $win32_fat
    ? ( skip_all => 'Win32 fat filesystem not supported' )
    : ( tests => 12 );

use_ok( 'Test::Smoke::Syncer' );

my $verbose = $ENV{SMOKE_VERBOSE} ? $ENV{SMOKE_VERBOSE} : 0;
{
    my $syncer = Test::Smoke::Syncer->new( hardlink => { v => $verbose,
        ddir => File::Spec->catdir(qw( t perl-current )),
        hdir => File::Spec->catdir(qw( t perl )),
    } );

    isa_ok( $syncer, 'Test::Smoke::Syncer' );
    isa_ok( $syncer, 'Test::Smoke::Syncer::Hardlink' );
}

{ # check that it croak()s
#line 100
    my $syncer = eval { Test::Smoke::Syncer->new( hardlink => { v => $verbose,
        ddir => File::Spec->catdir(qw( t perl-current )),
    } ) };

    ok( $@, "croak on omitted {hdir}" );
    like( $@, "/No source-directory.*?at \Q$0\E line 100/", "It's a croak()" );
}

SKIP: {
# Try to find tar/gzip, Archive::Tar/Compress::Zlib
# When found, t/ftppub/snap/perl@20000.tgz can be extracted
# and used as a base for the hardlink sync

    my $to_skip = 4;
    $Config{d_link} or skip "No links on $^O", $to_skip;
    my $tar = find_uncompress() or
        skip "Cannot find decompression stuff", $to_skip;

    do_uncompress( $tar, 't',
                   File::Spec->catfile(qw( ftppub snap perl@20000.tgz )) ) or
        skip "Cannot decompress testsnapshot", $to_skip;

    ok( -d File::Spec->catdir(qw( t perl )), "snapshot OK" );

    my $syncer = Test::Smoke::Syncer->new( hardlink => { v=> $verbose,
        ddir => File::Spec->catdir(abs_path(), qw( t perl-current )),
        hdir => File::Spec->catdir(abs_path(), qw( t perl )),
    } );

    my %perl = map { ($_ => 1) } get_dir( $syncer->{hdir} );
    $syncer->sync();
    my %perl_current = map { ($_ => 1) } get_dir( $syncer->{ddir} );

    is( scalar keys %perl_current, scalar keys %perl,
        "number of files the same" );
    is_deeply( \%perl_current, \%perl, "Same files in the two dirs" );

    if ( $^O ne 'MSWin32' ) {
        is_deeply( inodes( $syncer->{ddir} ), inodes( $syncer->{hdir} ),
                   "check inodes of hardlinks" );
    } else {
        skip "Cannot check inodes on Windows-fs", 1;
    }

    rmtree( File::Spec->catdir(qw( t perl )), $syncer->{v} );
    rmtree( File::Spec->catdir(qw( t perl-current )), $syncer->{v} );
}

SKIP: { # Check that the same works for {haslink} == 0
# Try to find tar/gzip, Archive::Tar/Compress::Zlib
# When found, t/ftppub/snap/perl@20000.tgz can be extracted
# and used as a base for the hardlink sync

    my $to_skip = 3;
    $Config{d_link} or skip "No links on $^O", $to_skip;
    my $tar = find_uncompress() or
        skip "Cannot find decompression stuff", $to_skip;

    do_uncompress( $tar, 't', 
                   File::Spec->catfile(qw( ftppub snap perl@20000.tgz )) ) or
        skip "Cannot decompress testsnapshot", $to_skip;

    ok( -d File::Spec->catdir(qw( t perl )), "snapshot OK" );

    my $syncer = Test::Smoke::Syncer->new( hardlink => { v=> $verbose,
        ddir    => File::Spec->catdir(abs_path(), qw( t perl-current )),
        hdir    => File::Spec->catdir(abs_path(), qw( t perl )),
        haslink => 0,
    } );

    my %perl = map { ($_ => 1) } get_dir( $syncer->{hdir} );
    $syncer->sync();
    my %perl_current = map { ($_ => 1) } get_dir( $syncer->{ddir} );

    is( scalar keys %perl_current, scalar keys %perl,
        "number of files the same [nolink]" );
    is_deeply( \%perl_current, \%perl, "Same files in the two dirs [nolink]" );


    rmtree( File::Spec->catdir(qw( t perl )), $syncer->{v} );
    rmtree( File::Spec->catdir(qw( t perl-current )), $syncer->{v} );
}

sub inodes {
    my $dir = shift;

    require File::Find;
    my %inodes;
    File::Find::find( sub {
        -f or return;
        $inodes{ (stat _)[1] } = 1;
    }, $dir );

    return \%inodes;
}

sub find_uncompress {
    return find_untargz;
}

sub do_uncompress {
    my( $tar, $ddir, $sfile ) = @_;

    chdir $ddir or do {
        warn "Cannot chdir($ddir): $!";
        return;
    };

    do_untargz( $tar, $sfile );

    # I cannot use Test::Smoke::Syncer::Snapshot to extract
    # but I need check_dot_patch() for the tests
    my $syncer = Test::Smoke::Syncer->new( snapshot => { 
        v    => 2,
        ddir => 'perl',
    });
    $syncer->check_dot_patch();

    chdir File::Spec->updir;

    return 1;
}