#!/usr/bin/perl

use strict;
use warnings;
use Storable qw(freeze thaw);
use Data::Dumper;
use File::Spec;
use File::Path;
use File::Monitor;
use Test::More tests => 26;

sub with_open {
  my ( $name, $mode, $cb ) = @_;
  if ( $mode =~ />/ ) {

    # Writing so make sure the directory exists
    my ( $vol, $dir, $leaf ) = File::Spec->splitpath( $name );
    my $new_dir = File::Spec->catpath( $vol, $dir, '' );
    mkpath( $new_dir );
  }

  open( my $fh, $mode, $name )
   or die "Can't open \"$name\" for $mode ($!)\n";
  $cb->( $fh );
  close( $fh );
}

sub touch_file {
  my $name = shift;
  with_open( $name, '>>', sub { } );
}

sub sort_arrays {
  my $obj = shift;

  if ( ref $obj eq 'ARRAY' ) {
    return sort @$obj;
  }
  elsif ( ref $obj eq 'HASH' ) {
    while ( my ( $n, $v ) = each %$obj ) {
      $obj->{$n} = sort_arrays( $v );
    }
  }
  else {
    $obj ||= '(undef)';
    die "Can't sort $obj\n";
  }
}

SKIP: {
  my $tmp_dir = File::Spec->tmpdir;

  skip "Can't find temporary directory", 26
   unless defined $tmp_dir;

  my $test_base = File::Spec->catdir( $tmp_dir, "fmtest-$$" );

  my $next_suff = 1;

  my $next_dir = sub {
    return File::Spec->catdir( $test_base,
      sprintf( "dir%03d", $next_suff++ ) );
  };

  my $test_dir = $next_dir->();

  my $fix_name = sub {
    my $name = shift;
    return File::Spec->catfile( $test_dir, split( /\//, $name ) );
  };

  my $fix_dir = sub {
    my $name = shift;
    return File::Spec->catdir( $test_dir, split( /\//, $name ) );
  };

  my %change = ();

  my %action = (
    add_dir => sub {
      my $dirs = shift;
      for my $dir ( @$dirs ) {
        my $name = $fix_dir->( $dir );
        mkpath( $name );
      }
    },
    add_file => sub {
      my $files = shift;
      for my $file ( @$files ) {
        my $name = $fix_name->( $file );
        touch_file( $name );
      }
    },
    rm_dir => sub {
      my $dirs = shift;
      for my $dir ( @$dirs ) {
        my $name = $fix_dir->( $dir );
        rmtree( $name );
      }
    },
    rm_file => sub {
      my $files = shift;
      for my $file ( @$files ) {
        my $name = $fix_name->( $file );
        unlink $name or die "Can't delete $name ($!)\n";
      }
    },
  );

  my @schedule = (
    {
      name    => 'Create directories',
      add_dir => [qw( a b/c d/e/f )],
    },
    {
      name     => 'Create files',
      add_file => [qw( a/f1 b/c/f2 d/e/f/f3 )],
    },
    {
      name    => 'Create more directories',
      add_dir => [qw( g/h i )],
    },
    {
      name    => 'Delete files',
      rm_file => [qw( b/c/f2 d/e/f/f3)],
    },
    {
      name   => 'Delete directories',
      rm_dir => [qw( g/h i /b/c d/e/f)],
    },
  );

  my $thawed = File::Monitor->new( { base => $test_dir } );
  $thawed->watch( { name => $test_dir, recurse => 1 } );

  my @changed = $thawed->scan;
  is_deeply \@changed, [], 'first scan, no changes';

  for my $test ( @schedule ) {
    %change = ();
    my $name = delete $test->{name};
    while ( my ( $act, $arg ) = each %$test ) {
      my $code = $action{$act} || die "No action $act defined";
      $code->( $arg );
      push @{ $change{$act} }, @$arg;
    }

    # Relocate the test directory
    my $new_dir = $next_dir->();
    rename( $test_dir, $new_dir )
     or die "Can't rename $test_dir to $new_dir ($!)\n";

    my $frozen = eval { freeze $thawed };
    ok !$@, "$name: freeze OK" or diag "Error from freeze: $@";

    my $thawed = eval { thaw $frozen };
    ok !$@, "$name: thaw OK" or diag "Error from thaw: $@";
    isa_ok $thawed, 'File::Monitor';

    $thawed->base( $new_dir );
    $test_dir = $new_dir;

    is $thawed->base, $test_dir, "$name: monitor relocated";

    my %expect = ();

    # Get the expected changes
    for
     my $mode ( [ 'add', 'files_created' ], [ 'rm', 'files_deleted' ] )
    {
      my ( $act, $key ) = @$mode;
      for my $type ( [ 'dir', $fix_dir ], [ 'file', $fix_name ] ) {
        my ( $typ, $fix ) = @$type;
        push @{ $expect{$key} },
         map { $fix->( $_ ) } @{ $change{"${act}_${typ}"} || [] };
      }
    }

    # Get the changes
    my %got     = ();
    my @changes = $thawed->scan();
    for my $change ( @changes ) {
      for my $meth ( qw ( files_created files_deleted ) ) {
        push @{ $got{$meth} }, $change->$meth;
      }
    }

    my $r_got    = sort_arrays( \%got );
    my $r_expect = sort_arrays( \%expect );
    unless ( is_deeply $r_got, $r_expect, "$name: changes match" ) {
      diag( Data::Dumper->Dump( [$r_got],    ['$got'] ) );
      diag( Data::Dumper->Dump( [$r_expect], ['$expect'] ) );
    }
  }

  rmtree( $test_base );

}