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 Module-List-Pluggable.t"

use warnings;
use strict;
$|=1;
my $DEBUG = 0;
use Data::Dumper;

use Test::More;
BEGIN { plan tests => 23 };

use File::Find;
use FindBin qw($Bin);

# There's an argument that this is more robust (so let's do both)
use vars qw( $RealBin );
BEGIN {
  use File::Spec::Functions qw( rel2abs splitpath catpath);
  $RealBin = catpath ((splitpath (rel2abs ($0)))[0,1]);
}

use lib "../../List-Filter/lib"; # development only
use lib "$Bin/../lib", "$RealBin/../lib";
use lib "$Bin/dat/lib", "$RealBin/dat/lib";

my $test_lib = "$Bin/dat/lib"; # same as use lib value above

#1
BEGIN {
  use_ok( 'Module::List::Pluggable', ':all');
}

# 2
ok(1, "Traditional: If we made it this far, we're ok.");

($DEBUG) && print STDERR "test_lib: $test_lib\n";

{#3, #4
  my $testname = "Testing list_modules_under";
  my @modules_via_file_find = ();
  my $module_count_file_find = 0;

  my @dirs = ("$test_lib/Nada");
  find( sub {
          push @modules_via_file_find, $File::Find::name if m{\.pm$}x;
        }, @dirs);

  $module_count_file_find = scalar( @modules_via_file_find );

  my $plugin_root = 'Nada';
  my $plugin_exceptions = [ 'Nada::Zero' ];

  my @expected_modules = sort qw(
                                  Nada::Nuttin
                                  Nada::Zero
                                  Nada::Zip
                                  Nada::Zip::Bupkes
                               );
  # Excludes "Nada" itself, because we're looking under "Nada::"

  my $modules =  list_modules_under($plugin_root);
  ($DEBUG) && print "plugins: ", Dumper($modules), "\n";

  my @mods = @{ $modules };
  my $count = scalar( @mods );
  is( $count, $module_count_file_find,
      "$testname: number of modules looks right: $count");

  my @modules_sorted = sort @mods ;
  is_deeply( \@modules_sorted, \@expected_modules,
             "$testname: names of modules look right" );
}

{#5, 6
  my $testname = "Testing import_modules: using a sub from a plugin";
  my $plugin_root = "DummyPlugins";
  my $plugin_exceptions = undef;

  import_modules( $plugin_root,
                  { exceptions => $plugin_exceptions,
                  } );

  my $result = nothing_much({});
  is( $result, "Nothing much. What's with you?", "$testname: nothing_much");

  my $string = 'Ut!';
  $result = back_atcha({}, $string);
  is( $result, "Do you say: $string", "$testname: back_atcha");

}

SKIP:
{#7, #8
  my $testname = "Testing import_modules: using a module that uses a sub from a plugin";

  my $how_many = 2;
  my $test_module = 'DummyProject::Modulular::Stuff';
  eval "require $test_module";
  skip "because $test_module is not available ", $how_many if $@;

  my $plugin_root = "DummyPlugins";
  my $plugin_exceptions  = undef;

  my $obj = DummyProject::Modulular::Stuff->new(
                                   { plugin_root        => $plugin_root,
                                     plugin_exceptions  => $plugin_exceptions,
                                   });

  ok( $obj->test_method_nothing_much(),
      "$testname: nothing_much");

  ok( $obj->test_method_back_atcha('Ooga'),
      "$testname: back_atcha");
}

SKIP:
{#9
  my $testname = "Testing import_modules: importing a routine from the List::Filter project.";

  my $plugin_root = "List::Filter::Filters";
  my $plugin_exceptions = undef;

  # if there are no plugins located there, just skip this test.
  my $modules =  list_modules_under($plugin_root);
  ($DEBUG) && print "plugins: ", Dumper($modules), "\n";
  my $count = scalar( @{ $modules } );
  unless( $count ) {
    skip "because the List::Filter plugins are not available.", 1;
  }

  import_modules( $plugin_root,
                  { exceptions => $plugin_exceptions,
                  } );

  my $aref_in = [ qw(
                    blah.vb
                    bah.js
                    real_stuff.pl
                    GoodStuff.pm
                    fergetit.vb
                    okay.txt
                    README.not
                 ) ];

  my $regexps = ['\.vb$', '\.js$'];
  my $aref_out = skip_any( {}, { terms=>$regexps }, $aref_in );

  my @expected = sort( (
                        'real_stuff.pl',
                        'GoodStuff.pm',
                        'okay.txt',
                        'README.not',
                      ) );


  my @result = sort @{ $aref_out };

  is_deeply( \@result, \@expected, "$testname");
}

{#10
  my $testname = "Testing list_exports";
  my $plugin_root = "DummyPlugins";

  my $methods = list_exports( $plugin_root );

  ($DEBUG) && print STDERR Dumper( $methods ), "\n";

  my @methods = sort @{ $methods };

  my @expected = (
                  'back_atcha',
                  'nothing_much',
                 );

  is_deeply(\@methods, \@expected,
            "$testname");
}

{#11

  my $testname = "Testing report_export_locations";
  my $plugin_root = "DummyPlugins";

  my $report = report_export_locations( $plugin_root );

  ($DEBUG) && print STDERR Dumper( $report ), "\n";

  my $expected = {
          'back_atcha' => [
                            'DummyPlugins::SomeSubs'
                          ],
          'nothing_much' => [
                              'DummyPlugins::SomeSubs'
                            ]
        };

  is_deeply( $report, $expected, "$testname");
}

{#12

  my $testname = "Testing report_export_locations again";
  my $plugin_root = "Clash::Stub::Plugins";

  my $report = report_export_locations( $plugin_root );

  ($DEBUG) && print STDERR Dumper( $report ), "\n";

  my $expected = {
          'back_atcha' => [
                            'Clash::Stub::Plugins::Alpha'
                          ],
          'maximal_nihilility' => [
                                    'Clash::Stub::Plugins::Epsilon'
                                  ],
          'nada' => [
                      'Clash::Stub::Plugins::Gamma'
                    ],
          'accidents_happen' => [
                                  'Clash::Stub::Plugins::Beta',
                                  'Clash::Stub::Plugins::Gamma'
                                ],
          'parrot_but_not_that_parrot' => [
                                            'Clash::Stub::Plugins::Alpha'
                                          ],
          'much_bupkes' => [
                             'Clash::Stub::Plugins::Beta'
                           ],
          'nothing_much' => [
                              'Clash::Stub::Plugins::Alpha'
                            ]
        };

  @{ $report->{accidents_happen} } = sort @{ $report->{accidents_happen} };

  is_deeply( $report, $expected, "$testname");
}

{#13, #14

  my $testname = "Testing check_plugin_exports";

  my $plugin_root = "Clash::Stub::Plugins";

  my $err_mess = '';
  my $ret = 0;
  eval {

    $ret =
      check_plugin_exports( $plugin_root );
  };
  if ($@) {
    $err_mess = $@;
  }
  is( $ret, 0, "$testname: return code indicates conflict");

  ($DEBUG) && print STDERR "check_plugin_exports:\n$err_mess\n";

  like( $err_mess,
        qr{ ^ Multiple \s+ definitions  \s+ of  \s+ (\w*?) \s+ from \s+ plugins: \s+ }x,
        "$testname: error message looks right");

}

{#15, #16

  my $testname = "Testing check_plugin_exports using exceptions to fix problem";

  my $plugin_root = "Clash::Stub::Plugins";
  my $plugin_exceptions = ['Clash::Stub::Plugins::Beta'];

  my $err_mess = '';
  my $ret = 0;
  eval {

    $ret =
      check_plugin_exports( $plugin_root,
                                  { exceptions => $plugin_exceptions,
                                    });
  };
  if ($@) {
    $err_mess = $@;
  }

  is( $ret, 1, "$testname: return code looks good");

  ($DEBUG) && print STDERR "check_plugin_exports:\n$err_mess\n";

  is( $err_mess, '', "$testname: no error message.");
}

{#17, #18, #19, #20, #21

  my $testname = "Testing import_modules using exceptions to dodge conflict";

  my $plugin_root = "Clash::Stub::Plugins";
  my $plugin_exceptions = ['Clash::Stub::Plugins::Beta'];

  print STDERR "\nNOTE: You may see some \"Subroutine redefined\" warnings: these can be ignored\n";

  my $err_mess = '';
  my $ret = 0;
  eval {
    $ret =
      import_modules( $plugin_root,
                      { exceptions => $plugin_exceptions,
                      } );
  };
  if ($@) {
    $err_mess = $@;
  }
  print STDERR "\n";

  cmp_ok($ret, '>=', 1,
         "$testname: positive count of imported modules: $ret");

  is( $err_mess, '', "$testname: no error message.");

  my $result = nothing_much({});
  is( $result, "Nothing much. What's with you?", "$testname: nothing_much");

  my $string = 'Ut!';
  $result = back_atcha({}, $string);
  is( $result, "Do you say: $string", "$testname: back_atcha");

  chomp(
        my $quip = accidents_happen({})
       );
  $quip =~ s{ ^ \s* }{}x;
  is( $quip, "But sometimes they happen on purpose.", "$testname: accidents_happen");
}

{#22
  my $testname = "Testing that import_modules tosses error on export conflict";
  my $plugin_root = "Clash::Stub::Plugins";

  my $err_mess = '';
  my $ret = 0;
  eval {
    $ret =
      import_modules( $plugin_root );
  };
  if ($@) {
    $err_mess = $@;
  }

  # my $DEBUG = 1;
  ($DEBUG) && print STDERR "import_modules:\n$err_mess\n";

  like( $err_mess,
        qr{ ^ Multiple \s+ definitions  \s+ of  \s+ (\w*?) \s+ from \s+ plugins: \s+ }x,
        "$testname: error message looks right");
}

{#23
  my $testname = "Testing that import_modules of a broken plugin reports problem.";

  my $plugin_root = 'Tree::Limb';

  my $err_mess = '';
  my $ret = 0;
  eval {

    $ret =
      import_modules( $plugin_root );
  };
  if ($@) {
    $err_mess = $@;
  }

  # my $DEBUG = 1;
  ($DEBUG) && print STDERR "$err_mess\n";

   like( $err_mess,
         qr{ \b report_export_locations: \s+ Tree::Limb::Broken: \s+ }x,
         "$testname: error message looks right");
}