package ATR::MicePE::MatingPairTest;

use strict;
use warnings;
use base qw(ATR::DatabaseTestCase);

use ATR::MicePE::MatingPair;
use ATR::GTx; # for constants
use ATR::BioTablesTest; # for test constants
use ATR::Util;

#----------------------------------------------------------------------------
#
# createNamed and findByName

sub test_Make_Find {
    my $self = shift;

    my $colony = "EZPZ";
    my $cardname = ATR::MicePE::MatingPair->getNextName($colony);

    my $find1 = ATR::MicePE::MatingPair->findByName($cardname);
    $self->assert_null($find1);

    my $made = ATR::MicePE::MatingPair->createBlank($colony, $cardname);
    $self->check_card($made,
		      tst => 'made',
		      name => $cardname);

    $find1 = ATR::MicePE::Mouse->findByName($cardname); # should be no mouse with the card name!
    $self->assert_null($find1);

    my $find2 = ATR::MicePE::MatingPair->findByName($cardname);
    $self->check_card($find2,
		      tst => 'found',
		      name => $cardname,
		      colony => $colony);

    # Check debug strings
    $self->assert_matches( qr/^mouse mating pair card \(name='$cardname', barcode=\w{2}\d+, peid=\d+\)$/,
			   $find2->debugId );
    $self->assert_matches( qr/^mouse card class ATR::MicePE::MatingPair$/,
			   ref($find2)->debugId );

    # tear_down rolls back
}

sub test_details {
    my $self = shift;
    my $dsess = ATR::DataSession->new;

    # Stuff we're going to expect
    my %fresh = ( #state_str => 'Created',
		  #state_id  => ATR::GTx::STATUS_MOUSEPAIR_CREATED,
		  tst => 'made',
		  colony => 'BFG',
		  l_pil => undef,
		  l_ppl => undef,
		  l_19b => undef,
		  l_user => undef,
		);

    my %checks = ( #state_str => 'Set up',
		   #state_id  => ATR::GTx::STATUS_MOUSEPAIR_SETUP,
		   l_pil => 'abc123',
		   l_ppl => 'def456',
		   l_19b => '7.3f',
		   l_user => 'Lilly the Labbie',
		   colony => $fresh{colony},
		 );

    $checks{name} = $fresh{name} = ATR::MicePE::MatingPair->getNextName($fresh{colony});

    # Make one
    my $made = ATR::MicePE::MatingPair->createBlank($fresh{colony}, $fresh{name});
    my ($bar_pfx, $bar_num) = $made->getBarcode;
    $self->assert_matches(qr{^\d{1,9}$},  $bar_num);
    $self->assert_matches(qr{^[A-Z]{2}$}, $bar_pfx);
    $self->check_card($made, %fresh);

    $checks{bar_num} = $bar_num;

    $made->setLicencePIL($checks{l_pil});
    $made->setLicencePPL($checks{l_ppl});
    $made->setLicence19b($checks{l_19b});
    $made->setLicenceUser($checks{l_user});

    $self->check_card($made, tst => 'set values', %checks);

    # Put parents in
    my @mice_names = ("Minnie Duck", "Donald Duck", "Goofy the Postman");
    my @mice = safemap { my $n=shift; ATR::MicePE::Mouse->createNamed($n, $dsess) } @mice_names;
    $mice[0]->setSex('F');
    $mice[1]->setSex('M');
    $mice[2]->setSex('M');

    # Set up valid pair
    $made->addParent(-mouse => $mice[0], -slot => 'F');
    $made->addParent(-mouse => $mice[1], -slot => 'M');

    $self->assert_dies( qr/Mating pair already contains two mice/,
			sub { $made->addParent(-mouse => $mice[2], -slot => 'F') } );

    # Remove and restore, by name
    $made->removeParent($mice_names[1]);

    $self->assert_dies( qr/Mating pair consists of '$mice_names[1]' and '$mice_names[0]'.  Make another to involve '$mice_names[2]'/,
			sub { $made->addParent(-mouse => $mice_names[2], -slot => 'M') } );

    $made->addParent(-mouse => $mice_names[1], -slot => 'M');

    undef $made;

    # Get it by name, check it
    my $adopted = ATR::MicePE::MatingPair->findByName($fresh{name});
    $self->check_card($made, tst => 'adopted', %checks);

    # XXX: Find by barcode
}

sub test_mating_pair {
}

sub check_card {
    my ($self, $card, %checks) = @_;

    # Let the tester know what we're checking
    my @c = caller();
    my $caller = join ":", $c[1], $c[2], (delete $checks{tst} || '[not specified]');
    $self->{annotate}->{caller} = $caller;

    # Check card type
    $self->assert_str_equals('ATR::MicePE::MatingPair', ref($card));

    # Check name
    if (exists $checks{name}) {
	my $expect = delete $checks{name};
	$self->assert_str_equals($expect, scalar $card->getMatingName);
    }

    # Check colony
    if (exists $checks{colony}) {
	my $expect = delete $checks{colony};
	$self->assert_str_equals($expect, scalar $card->getColonyName);
    }

    # Check barcode
    if (exists $checks{bar_num}) {
	my $expect = delete $checks{bar_num};
	$self->assert_str_equals($expect, scalar $card->getBarcode);
	my @bar = $card->getBarcode;
	$self->assert_str_equals($expect, $bar[1]);
	$self->assert_str_equals("AM", $bar[0]);
    }

    # Check licence parts
    my %methods = ( l_pil  => 'getLicencePIL',
		    l_ppl  => 'getLicencePPL',
		    l_19b  => 'getLicence19b',
		    l_user => 'getLicenceUser' );
    my $A = $self->{annotate};
    foreach my $check_key (keys %methods) {
	next unless exists $checks{$check_key};
	my $expect = delete $checks{$check_key};
	my $method = $methods{$check_key};
	@{$A}{"check_key", "method"} = ($check_key, $method);
	my $actual = $card->$method;
	if (!defined $expect) {
	    $self->assert_null($actual);
	} else {
	    $self->assert_str_equals($expect, $actual);
	}
    }
    delete @{$A}{"check_key", "method"};

    # Check we've done all the checks
    my @checks_remain = keys %checks;
    local $" = ", ";
    $self->fail("Checks not done: @checks_remain") if @checks_remain;

    # Tidy up
    delete $self->{annotate}->{caller};
}

# XXX: Test litters come back; test they sort correctly when the init dates are the same; test that init dates are "now" not GT compile time.

#----------------------------------------------------------------------------
#
# Class methods

1;
