#!/usr/bin/perl

use strict;
use warnings;

use Test::More 'no_plan';
use lib qw(t t/data/static);
use Utils;
use version;


##############################################################
# Tests compilation of Module::ScanDeps
##############################################################
BEGIN { use_ok( 'Module::ScanDeps' ); }



##############################################################
# Static dependency check of a script that doesn't use
# anything with basic cache_cb test added
##############################################################
my @roots1 = qw(t/data/static/null.pl);
my $expected_rv1 =
{
  "null.pl" => {
                 file => generic_abs_path("t/data/static/null.pl"),
                 key => "null.pl",
                 type => "data",
               },
};
expected_cache_cb_args({key  => 'null.pl',
                        file => 't/data/static/null.pl',
                    });

my $rv1 = scan_deps(files => \@roots1,
                    cache_cb => \&cache_cb
                );
compare_scandeps_rvs($rv1, $expected_rv1, \@roots1);

### check if we can use M::SD::Cache
my $skip_cache_tests = 1;
eval {require Module::ScanDeps::Cache;};
unless ($@){
    $skip_cache_tests = Module::ScanDeps::Cache::prereq_missing();
    warn $skip_cache_tests, "\n";
}
my $cache_file = 'deps_cache.dat';

for my $t(qw/write_cache use_cache/){

  SKIP:
    {
     skip "Skipping M:SD::Cache tests" , 289 if $skip_cache_tests;

     ##############################################################
     # Static dependency check of a circular dependency:
     #        ___
     #     |/_   \
     #     M     _M
     #      \____/|
     #
     ##############################################################
     my @roots2 = qw(t/data/static/egg.pm);
     my $expected_rv2 =
         {
          "chicken.pm" => {
                           file    => generic_abs_path("t/data/static/chicken.pm"),
                           key     => "chicken.pm",
                           type    => "module",
                           used_by => ["egg.pm"],
                           uses    => ["egg.pm"],
                       },
          "egg.pm"     => {
                           file    => generic_abs_path("t/data/static/egg.pm"),
                           key     => "egg.pm",
                           type    => "module",
                           used_by => ["chicken.pm"],
                           uses    => ["chicken.pm"],
                       },
      };

     # Functional i/f
     my $rv2 = scan_deps(files => \@roots2,
                         cache_file => $cache_file,
                         recurse => 1,
                     );
     compare_scandeps_rvs($rv2, $expected_rv2, \@roots2);
   
     ##############################################################
     # Static dependency check of the following dependency tree
     #
     #                            M
     #                           /|\
     #                          / | \
     #                         /  |  \
     #                        /   M   \
     #                       /   / \   \
     #                      /   /   \   \
     #                     M   M     M   M
     #                      \   \   /   /
     #                       \   \ /   /
     #                        \   M   /
     #                         \  |  /
     #                          \ | /
     #                            M
     #
     #   With dependencies always going from the top downwards
     ##############################################################
     my @roots3 = qw(t/data/static/outer_diamond_N.pm);
     my $expected_rv3 =
         {
          "inner_diamond_E.pm" => {
                                   file    => generic_abs_path("t/data/static/inner_diamond_E.pm"),
                                   key     => "inner_diamond_E.pm",
                                   type    => "module",
                                   used_by => ["inner_diamond_N.pm"],
                                   uses    => ["inner_diamond_S.pm"],
                               },
          "inner_diamond_N.pm" => {
                                   file    => generic_abs_path("t/data/static/inner_diamond_N.pm"),
                                   key     => "inner_diamond_N.pm",
                                   type    => "module",
                                   used_by => ["outer_diamond_N.pm"],
                                   uses    => ["inner_diamond_E.pm", "inner_diamond_W.pm"],
                               },
          "inner_diamond_S.pm" => {
                                   file    => generic_abs_path("t/data/static/inner_diamond_S.pm"),
                                   key     => "inner_diamond_S.pm",
                                   type    => "module",
                                   used_by => ["inner_diamond_W.pm", "inner_diamond_E.pm"],
                                   uses    => ["outer_diamond_S.pm"],
                               },
          "inner_diamond_W.pm" => {
                                   file    => generic_abs_path("t/data/static/inner_diamond_W.pm"),
                                   key     => "inner_diamond_W.pm",
                                   type    => "module",
                                   used_by => ["inner_diamond_N.pm"],
                                   uses    => ["inner_diamond_S.pm"],
                               },
          "outer_diamond_E.pm" => {
                                   file    => generic_abs_path("t/data/static/outer_diamond_E.pm"),
                                   key     => "outer_diamond_E.pm",
                                   type    => "module",
                                   used_by => ["outer_diamond_N.pm"],
                                   uses    => ["outer_diamond_S.pm"],
                               },
          "outer_diamond_N.pm" => {
                                   file => generic_abs_path("t/data/static/outer_diamond_N.pm"),
                                   key  => "outer_diamond_N.pm",
                                   type => "module",
                                   uses => ["inner_diamond_N.pm", "outer_diamond_E.pm", "outer_diamond_W.pm"],
                               },
          "outer_diamond_S.pm" => {
                                   file    => generic_abs_path("t/data/static/outer_diamond_S.pm"),
                                   key     => "outer_diamond_S.pm",
                                   type    => "module",
                                   used_by => ["outer_diamond_E.pm", "outer_diamond_W.pm", "inner_diamond_S.pm"],
                               },
          "outer_diamond_W.pm" => {
                                   file    => generic_abs_path("t/data/static/outer_diamond_W.pm"),
                                   key     => "outer_diamond_W.pm",
                                   type    => "module",
                                   used_by => ["outer_diamond_N.pm"],
                                   uses    => ["outer_diamond_S.pm"],
                               },
      };

     # Functional i/f
     my $rv3 = scan_deps(cache_file => $cache_file,
                         recurse => 1,
                         files => \@roots3);
     compare_scandeps_rvs($rv3, $expected_rv3, \@roots3);
   

     ##############################################################
     # Static dependency check of the following dependency tree
     # (i.e. multiple inputs)
     #
     #     InputA.pl       InputB.pl   InputC.pl
     #       /  \             \           /
     #      /    \             \         /
     #     /      \             \       /
     # TestA.pm  TestB.pm   TestC.pm   /
     #                            \   /
     #                             \ /
     #                          TestD.pm
     #
     ##############################################################
     my @roots4 = qw(t/data/static/InputA.pl
                     t/data/static/InputB.pl
                     t/data/static/InputC.pl);
     my $expected_rv4 =
         {
          "InputA.pl" => {
                          file => generic_abs_path("t/data/static/InputA.pl"),
                          key  => "InputA.pl",
                          type => "data",
                          uses => ["TestA.pm", "TestB.pm"],
                      },
          "InputB.pl" => {
                          file => generic_abs_path("t/data/static/InputB.pl"),
                          key  => "InputB.pl",
                          type => "data",
                          uses => ["TestC.pm"],
                      },
          "InputC.pl" => {
                          file => generic_abs_path("t/data/static/InputC.pl"),
                          key  => "InputC.pl",
                          type => "data",
                          uses => ["TestD.pm"],
                      },
          "TestA.pm"  => {
                          file    => generic_abs_path("t/data/static/TestA.pm"),
                          key     => "TestA.pm",
                          type    => "module",
                          used_by => ["InputA.pl"],
                      },
          "TestB.pm"  => {
                          file    => generic_abs_path("t/data/static/TestB.pm"),
                          key     => "TestB.pm",
                          type    => "module",
                          used_by => ["InputA.pl"],
                      },
          "TestC.pm"  => {
                          file    => generic_abs_path("t/data/static/TestC.pm"),
                          key     => "TestC.pm",
                          type    => "module",
                          used_by => ["InputB.pl"],
                          uses    => ["TestD.pm"],
                      },
          "TestD.pm"  => {
                          file    => generic_abs_path("t/data/static/TestD.pm"),
                          key     => "TestD.pm",
                          type    => "module",
                          used_by => ["InputC.pl", "TestC.pm"],
                      },
      };

     # Functional i/f
     my $rv4 = scan_deps(cache_file => $cache_file,
                         recurse => 1,
                         files => \@roots4);
     compare_scandeps_rvs($rv4, $expected_rv4, \@roots4);


     ##############################################################
     # Static dependency check of the following dependency tree
     # Tests the .pm only lists the .pl once in it's used_by entries
     #
     #   Duplicator.pl
     #       /  \
     #      /    \
     #     /      \
     #     \      /
     #      \    /
     #       \  /
     #   Duplicated.pm
     #
     ##############################################################
     my @roots5 = qw(t/data/static/Duplicator.pl);
     my $expected_rv5 =
         {
          "Duplicated.pm" => {
                              file    => generic_abs_path("t/data/static/Duplicated.pm"),
                              key     => "Duplicated.pm",
                              type    => "module",
                              used_by => ["Duplicator.pl"],
                          },
          "Duplicator.pl" => {
                              file => generic_abs_path("t/data/static/Duplicator.pl"),
                              key  => "Duplicator.pl",
                              type => "data",
                              uses => ["Duplicated.pm"],
                          },
      };

     # Functional i/f
     my $rv5 = scan_deps(cache_file => $cache_file,
                         recurse => 1,
                         files => \@roots5);
     compare_scandeps_rvs($rv5, $expected_rv5, \@roots5);


   }  ### SKIP block wrapping M::SD::Cache tests
}     ### end of for (qw/write_cache use_cache/)





### cache testing helper functions ###
{
my ($cb_args, $expecting_write);

sub expected_cache_cb_args{
    $cb_args = shift;
}
sub cache_cb{
    my %args = @_;
    is($args{key}, $cb_args->{key}, "check arg 'key' in cache_cb.");
    is($args{file}, $cb_args->{file}, "check arg 'file' in cache_cb.");
    if ( $expecting_write ){
        is($args{action}, 'write', "expecting write action");
    }
    if ($args{action} eq 'read'){
        $expecting_write = 1;
        return 0;
    }
    elsif ( $args{action} eq 'write' ){
        $expecting_write = 0;
        return 1
    }
    my $action  = $args{action};
    ok( 0, "wrong action: got [$action] must be 'read' or 'write'");
}


}### end cache testing helper functions ###

### test Module::ScanDeps::Cache.pm

SKIP:
{
    skip "Skipping M:SD::Cache tests" , 9 if $skip_cache_tests;
    my %files = ('file1.pl' => "use TestModule;\n",
                 'file2.pl' => "use TestModule;\n",
                 'file3.pl' => "use TestModule;\n return 0;\n");
 
    for my $name (keys %files){
        open my $fh, '>', $name or die "Can not open file $name: $!";
        print $fh $files{$name};
        close $fh or die "Can not close file $name: $!";
    }
    
    my $cb = Module::ScanDeps::Cache::get_cache_cb();
    my $mod = [];
    my $ret = $cb->(key     => 'testfile',
                    file    => 'file1.pl',
                    action  => 'read',
                    modules => $mod
                );
    is( $ret, 0, "File not present in cache");
    $ret = $cb->(key     => 'testfile',
                 file    => 'file1.pl',
                 modules => [qw /TestModule.pm/],
                 action  => 'write',
            );
    is( $ret, 1, "Writing file to cache");
    $ret = $cb->(key     => 'testfile',
                 file    => 'file1.pl',
                 action  => 'read',
                 modules => $mod
             );
    is( $ret, 1, "File is present in cache");
    is( $mod->[0], 'TestModule.pm', "cache_cb sets modules 1");
    $mod = [];
    $ret = $cb->(key     => 'testfile',
                 file    => 'file2.pl',
                 action  => 'read',
                 modules => $mod
             );
    is( $ret, 1, "Identical file returns the same dependencies from cache");
    is( $mod->[0], 'TestModule.pm', "cache_cb sets modules 2");
    $mod = [];
    $ret = $cb->(key     => 'testfile',
                 file    => 'file3.pl',
                 action  => 'read',
                 modules => $mod
             );
    is( $ret, 0, "No cached deps returned for file with different content");
    is( @$mod, 0, "cache_cb does not set modules if no deps found");

    eval {$cb->(action => 'foo')};
    ok ($@ =~ /must be read or write/, "cache_cb dies on wrong action");
    for my $name (keys %files){
        unlink $name or die "Could not unlink file $name: $!";
    }
}

unlink( $cache_file );
__END__