#!/usr/bin/perl

####################################################################
# This test tests the repository (Froody::Repository)
####################################################################

use strict;
use warnings;

# use the local directory.  Note that this doesn't work

# useful diagnostic modules that's good to have loaded
use Data::Dumper;
use Devel::Peek;

# colourising the output if we want to
use Term::ANSIColor qw(:constants);
$Term::ANSIColor::AUTORESET = 1;

###################################
# user editable parts

# start the tests
use Test::More tests => 72;
use Test::Exception;

use_ok("Froody::Repository");
use_ok("Froody::Method");
use_ok("Froody::ErrorType");

use Froody::Error qw(err);

########
# create a repository
########

my $repos = Froody::Repository->new();
isa_ok($repos, "Froody::Repository");

########
# do we have the default stuff in there?
########

lives_ok {
  my @methods = $repos->get_methods();
  is(@methods, 4, "right number of default methods");
  isa_ok($_, "Froody::Method", "got a froody method back")
    foreach (@methods);
  is_deeply([ sort map { $_->full_name } @methods], [qw(
    froody.reflection.getErrorTypeInfo
    froody.reflection.getErrorTypes
    froody.reflection.getMethodInfo
    froody.reflection.getMethods
  )], "right default methods returned");
} "got default methods back without dieing";

lives_ok {
  my $errortype = $repos->get_errortype("");
  isa_ok($errortype, "Froody::ErrorType", "got right error type back");
  is($errortype->name, "", "error type of no name returns");
};

#######
# inserting and getting methods
#######

{

# stuff a couple of methods into it
my $fish = Froody::Method->new
                         ->full_name("bungle.wibble.fish");
my $fosh = Froody::Method->new
                         ->full_name("bungle.wibble.fosh");

lives_ok {
  $repos->register_method($fish);
  $repos->register_method($fosh);
} "stuffed methods in okay";

# we can't just stuff any old junk in here can we?

dies_ok {
  $repos->register_method("this is just a string");
} "dies when registering a string";
ok(err("perl.methodcall.param"), "bad param me no like!")
 or diag($@);

dies_ok {
  $repos->register_method();
} "dies when registering emptyness";
ok(err("perl.methodcall.param"), "bad param me no like!")
 or diag($@);

dies_ok {
  $repos->register_method(bless {}, "Frood::ErrorType");
} "dies when registering wrong object type";
ok(err("perl.methodcall.param"), "bad param me no like!")
 or diag($@);

# can we get those methods back?

lives_ok {
  my $fish2 = $repos->get_method("bungle.wibble.fish");
  my $fosh2 = $repos->get_method("bungle.wibble.fosh");
  isa_ok($fish2, "Froody::Method");
  isa_ok($fosh2, "Froody::Method");
  is($fish2->full_name, "bungle.wibble.fish", "fish came out okay");
  is($fosh2->full_name, "bungle.wibble.fosh", "fosh came out okay");
} "lives when getting methods";

# can we not get back some made up method name?

dies_ok {
  $repos->get_method("some made up string!");
} "getting made up method name!";
ok(err("froody.invoke.nosuchmethod"), "bad param me no like!")
 or diag($@);

# can we get back our methods using a regular expression?
lives_ok {
  my ($fish2, $fosh2) =
    sort { $a->full_name cmp $b->full_name } $repos->get_methods(qr/bungle/);
  isa_ok($fish2, "Froody::Method");
  isa_ok($fosh2, "Froody::Method");
  is($fish2->full_name, "bungle.wibble.fish", "fish came out okay");
  is($fosh2->full_name, "bungle.wibble.fosh", "fosh came out okay");
} "lives when getting methods with regexp";

# can we get back our methods using a wildcard expression?
lives_ok {
  my ($fish2, $fosh2) =
    sort { $a->full_name cmp $b->full_name } $repos->get_methods("bungle.wibble.*");
  isa_ok($fish2, "Froody::Method");
  isa_ok($fosh2, "Froody::Method");
  is($fish2->full_name, "bungle.wibble.fish", "fish came out okay");
  is($fosh2->full_name, "bungle.wibble.fosh", "fosh came out okay");
} "lives when getting methods with wildcard";

}

#######
# inserting and getting errors
#######

{
# stuff a couple of methods into it
my $fish = Froody::ErrorType->new
                         ->name("zippy.wibble.fish");
my $fosh = Froody::ErrorType->new
                         ->name("zippy.wibble.fosh");

lives_ok {
  $repos->register_errortype($fish);
  $repos->register_errortype($fosh);
} "stuffed ets in okay";

# we can't just stuff any old junk in here can we?

dies_ok {
  $repos->register_errortype("this is just a string");
} "dies when registering a string";
ok(err("perl.methodcall.param"), "bad param me no like!")
 or diag($@);


dies_ok {
  $repos->register_errortype();
} "dies when registering emptyness";
ok(err("perl.methodcall.param"), "bad param me no like!")
 or diag($@);

dies_ok {
  $repos->register_errortype(bless {}, "Froody::Method");
} "dies when registering wrong method type";
ok(err("perl.methodcall.param"), "bad param me no like!")
 or diag($@);


# can we get those methods back?

lives_ok {
  my $fish2 = $repos->get_errortype("zippy.wibble.fish");
  my $fosh2 = $repos->get_errortype("zippy.wibble.fosh");
  isa_ok($fish2, "Froody::ErrorType");
  isa_ok($fosh2, "Froody::ErrorType");
  is($fish2->name, "zippy.wibble.fish", "fish came out okay");
  is($fosh2->name, "zippy.wibble.fosh", "fosh came out okay");
} "lives when getting methods";

# can we get back our methods using a regular expression?
lives_ok {
  my ($fish2, $fosh2) =
    sort { $a->name cmp $b->name } $repos->get_errortypes(qr/zippy/);
  isa_ok($fish2, "Froody::ErrorType");
  isa_ok($fosh2, "Froody::ErrorType");
  is($fish2->name, "zippy.wibble.fish", "fish came out okay");
  is($fosh2->name, "zippy.wibble.fosh", "fosh came out okay");
} "lives when getting methods with regexp";

# can we get back our methods using a wildcard expression?
lives_ok {
  my ($fish2, $fosh2) =
    sort { $a->name cmp $b->name } $repos->get_errortypes("zippy.wibble.*");
  isa_ok($fish2, "Froody::ErrorType");
  isa_ok($fosh2, "Froody::ErrorType");
  is($fish2->name, "zippy.wibble.fish", "fish came out okay");
  is($fosh2->name, "zippy.wibble.fosh", "fosh came out okay");
} "lives when getting methods with wildcard";

}

#######
# nearest matching for error things
#######

{

# stuff a couple of methods into it
foreach (qw(one.alpha.antman one.alpha.batman one.beta.antman
            one.beta.batman one.alpha one))
{
  $repos->register_errortype(Froody::ErrorType->new->name($_));
};

my %hash = (

  # things that are just in there are things that just things that are in there

 'one.alpha.antman' => 'one.alpha.antman',
 'one.alpha.batman' => 'one.alpha.batman',
 'one.beta.antman' => 'one.beta.antman',
 'one.beta.batman' => 'one.beta.batman',
 'one.alpha' => 'one.alpha',
 'one' => 'one',
 
 # something that doesn't match anything goes back to the default
 "three" => "",
 
 # something that doesn't exist goes back to the right level
 "one.alpha.spiderman"                => "one.alpha",
 "one.alpha.spiderman.amazingfriends" => "one.alpha",
 "one.beta"                           => "one",
 "one.beta.spiderman"                 => "one",
 "two.alpha.antman"                   => "",
);

foreach (keys %hash)
{
   my $et = $repos->get_closest_errortype( $_ );
   is($et->name, $hash{ $_ }, "closest error type for '$_'?");
}

}