# -*- perl -*-


use strict;
# for emacs debugger
#use lib "../blib/lib";
#use lib ".";
use lib "t/springfield";
use Springfield qw(stdpop %id leaked @kids);

# This is set to 1 by iarray.t
use vars qw( $intrusive );

BEGIN {
    my $tests = ($intrusive ? 49 : 57);
    eval "use Test::More tests => $tests;"; die $@ if $@;
}

#$intrusive = 1;
#$Tangram::TRACE = \*STDOUT;

my $children = $intrusive ? 'ia_children' : 'children';

sub NaturalPerson::children
{
    my ($self) = @_;
    join(' ', map { $_->{firstName} || '' } @{ $self->{$children} } )
}

sub marge_test
{
    my $storage = shift;
    SKIP:
    unless ($intrusive)
    {
	#skip("n/a to Intrusive Tests", 1) if $intrusive;
	is( $storage->load( $id{Marge} )->children,
	    'Bart Lisa Maggie',
	    "Marge's children all found" );
    }
}

#=====================================================================
#  TESTING BEGINS
#=====================================================================

# insert the test data
stdpop($children);

is(leaked, 0, "Nothing leaked yet!");

# Test that updates notice changes to collections
{
    my $storage = Springfield::connect;
    my $homer = $storage->load( $id{Homer} );
    ok($homer, "Homer still exists!");

    is($homer->children, 'Bart Lisa Maggie', "array auto-vivify 1" );
    marge_test( $storage );

    @{ $homer->{$children} }[0, 2] = @{ $homer->{$children} }[2, 0];
    $storage->update( $homer );

    $storage->disconnect;
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;
    my $homer = $storage->load( $id{Homer} );

    is($homer->children, 'Maggie Lisa Bart', "array update test 1");
    marge_test( $storage );

    pop @{ $homer->{$children} };
    $storage->update( $homer );

    $storage->disconnect;
}

###############################################
# insert

{
    my $storage = Springfield::connect;
    my $homer = $storage->load($id{Homer}) or die;

    is( $homer->children, 'Maggie Lisa',
	"array update test 2 (pop)" );

    shift @{ $homer->{$children} };
    $storage->update($homer);

    $storage->disconnect;
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;
    my $homer = $storage->load($id{Homer}) or die;
    is( $homer->children, 'Lisa',
	"array update test 2 (shift)" );
    $storage->disconnect;
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;
    my $homer = $storage->load($id{Homer}) or die;
    shift @{ $homer->{$children} };
    $storage->update($homer);
    $storage->disconnect;
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;
    my $homer = $storage->load($id{Homer}) or die;

    is( $homer->children, "", "array update test 3 (all gone)");

    push @{ $homer->{$children} }, $storage->load( $id{Bart} );
    $storage->update($homer);

    $storage->disconnect;
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;
    my $homer = $storage->load($id{Homer}) or die;

    is( $homer->children, 'Bart', "array insert test 1"  );

    push ( @{ $homer->{$children} },
	   $storage->load( @id{qw(Lisa Maggie)} ) );
    $storage->update($homer);

    $storage->disconnect;
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;
    my $homer = $storage->load( $id{Homer} );

    is( $homer->children, 'Bart Lisa Maggie', "array insert test 2" );
    marge_test( $storage );

    $storage->disconnect;
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;
    my $homer = $storage->load( $id{Homer} );

    is( $homer->children, 'Bart Lisa Maggie', "still there" );
    marge_test( $storage );

    $storage->unload();
    undef $homer;

    is(leaked, 0, "leaktest (unload)");

    $storage->disconnect;
}

###########
# back-refs
SKIP:
if ($intrusive)
{
    skip("Intr types test only", 2) unless $intrusive;

    my $storage = Springfield::connect;
    my $bart = $storage->load( $id{Bart} );

    is($bart->{ia_parent}{firstName}, 'Homer', "array back-refs" );
    marge_test( $storage );

    $storage->disconnect;
}

is(leaked, 0, "leaktest");

##########
# prefetch
# FIXME - add documentation to Tangram::Storage for prefetch
{
    my $storage = Springfield::connect;

    my @prefetch = $storage->prefetch( 'NaturalPerson', $children );

    my $homer = $storage->load( $id{Homer} );

    is( $homer->children, 'Bart Lisa Maggie',
	"prefetch test returned same results");

    marge_test( $storage );

    $storage->disconnect();
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;

    my $person = $storage->remote('NaturalPerson');
    my @prefetch = $storage->prefetch( 'NaturalPerson', $children );

    my $homer = $storage->load( $id{Homer} );

    is( $homer->children, 'Bart Lisa Maggie',
	"prefetch test returned same results");
    marge_test( $storage );

    $storage->disconnect();
}

is(leaked, 0, "leaktest");

#########
# queries

my $parents = $intrusive ? 'Homer' : 'Homer Marge';
my $pops = $intrusive ? 'Abraham Homer' : 'Abraham Homer Marge';

{
    my $storage = Springfield::connect;
    my ($parent, $child)
	= $storage->remote(qw( NaturalPerson NaturalPerson ));

    ##local($Tangram::TRACE) = \*STDERR;

    my @results = $storage->select
	(
	 $parent,
	 $parent->{$children}->includes( $child )
	 & $child->{firstName} eq 'Bart'
	);

    is(join( ' ', sort map { $_->{firstName} } @results ),
       $parents, "Query (array->includes(t2) & t2->{foo} eq Bar)" );

    $storage->disconnect();
}

is(leaked, 0, "leaktest");

SKIP:
{
    skip "SQLite doesn't like IN having a non hard-coded list", 1
	if DBConfig->dialect =~ /sqlite/i;

    my $storage = Springfield::connect;
    my ($parent, $child1, $child2)
	= $storage->remote(qw( NaturalPerson NaturalPerson NaturalPerson ));

    #local($Tangram::TRACE) = \*STDERR;

    my @results = $storage->select
	(
	 $parent,
	 $parent->{$children}->includes_or( $child1, $child2
					  )
	 # note the caveat - both these conditions must hold for one
	 # row, although this may not be the one selected; ie, if I
	 # replace "Homer" with "Montgomery", I get *NO* results -
	 # RDBMSes suck :-)
	 & $child1->{firstName} eq 'Bart'
	 & $child2->{firstName} eq 'Homer'
	);

    is(join( ' ', sort map { $_->{firstName} } @results ),
       $pops, "Query (includes_or with two remotes)" );

    $storage->disconnect();
}

is(leaked, 0, "leaktest");
#diag("-"x69);

{
    my $storage = Springfield::connect;
    my ($parent, $child)
	= $storage->remote(qw( NaturalPerson NaturalPerson ));

    my @males = $storage->select
	(
	 $child,
	 $child->{firstName} eq 'Bart'
	 | $child->{firstName} eq 'Homer'
	);

    #local($Tangram::TRACE) = \*STDERR;

    my @results = $storage->select
	(
	 $parent,
	 $parent->{$children}->includes_or( @males )
	);

    is(join( ' ', sort map { $_->{firstName} } @results ),
       $pops, "Query (includes_or with two objects)" );

    $storage->disconnect();
}

is(leaked, 0, "leaktest");
#diag("-"x69);

SKIP:{
    skip "SQLite doesn't like IN having a non hard-coded list", 1
	if DBConfig->dialect =~ /sqlite/i;
    skip "Oracle doesn't like DISTINCT on CLOBs; we need a new test suite ;)", 1
	if DBConfig->dialect =~ /oracle/i;
    my $storage = Springfield::connect;
    my ($parent, $child )
	= $storage->remote(qw( NaturalPerson NaturalPerson ));

    my @male = $storage->select
	(
	 $parent,
	 $parent->{firstName} eq 'Bart'
	);

    #local($Tangram::TRACE) = \*STDERR;

    my @results = $storage->select
	(
	 $parent,
	 filter => ($parent->{$children}->includes_or( @male, $child ) &
		    ($child->{firstName} eq "Homer")),
	 distinct => 1,
	);

    is(join( ' ', sort map { $_->{firstName} } @results ),
       $pops, "Query (includes_or with one objects & one remote)" );

    $storage->disconnect();
}

is(leaked, 0, "leaktest");

{
    my $storage = Springfield::connect;
    my $parent = $storage->remote( 'NaturalPerson' );
    my $bart = $storage->load( $id{Bart} );

    my @results = $storage->select
	(
	 $parent,
	 $parent->{$children}->includes( $bart )
	);

    is(join( ' ', sort map { $_->{firstName} } @results ),
       $parents, 'Query (array->includes($dbobj))' );
    $storage->disconnect();
}

is(leaked, 0, "leaktest");

#############
# aggreg => 1
{
    my $storage = Springfield::connect_empty;

    my @children = (map { NaturalPerson->new( firstName => $_ ) }
		    @kids);

    my $homer = NaturalPerson->new
	(
	 firstName => 'Homer',
	 $children => [ map { NaturalPerson->new( firstName => $_ ) }
			@kids ]
	);

    my $abe = NaturalPerson->new( firstName => 'Abe',
				  $children => [ $homer ] );

    $id{Abe} = $storage->insert($abe);

    $storage->disconnect();
}

is(leaked, 0, "leaktest");

SKIP:
{
    my $storage = Springfield::connect;

    $storage->erase( $storage->load( $id{Abe} ) );

    my @pop = $storage->select('NaturalPerson');
    is(@pop, 0, "aggreg deletes children via arrays");

    #skip( "n/a to Intrusive Tests", 1 ) if $intrusive;
    unless ($intrusive) {

	is($storage->connection()->selectall_arrayref
	   ("SELECT COUNT(*) FROM a_children")->[0][0],
	   0, "Link table cleared successfully after remove");
    }

    $storage->disconnect();
}

is(leaked, 0, "leaktest");


#############################################################################
# Tx

SKIP:
{
    skip "No transactions configured/supported", ($intrusive ? 9 : 11)
	if $Springfield::no_tx;

    stdpop($children);

    # check rollback of DB tx
    is(leaked, 0, "leaktest");

    {
	my $storage = Springfield::connect;
	my $homer = $storage->load( $id{Homer} );

	$storage->tx_start();

	shift @{ $homer->{$children} };
	$storage->update( $homer );

	$storage->tx_rollback();

	$storage->disconnect;
    }

    is(leaked, 0, "leaktest");


    # storage should still contain 3 children

    {
	my $storage = Springfield::connect;
	my $homer = $storage->load( $id{Homer} );

	is( $homer->children, 'Bart Lisa Maggie', "rollback 1" );
	marge_test( $storage );

	$storage->disconnect;
    }

    is(leaked, 0, "leaktest");


    # check that DB and collection state remain in synch in case of rollback
    {
	my $storage = Springfield::connect;
	my $homer = $storage->load( $id{Homer} );

	$storage->tx_start();

	shift @{ $homer->{$children} };
	$storage->update( $homer );

	$storage->tx_rollback();

	$storage->update( $homer );

	$storage->disconnect;
    }

    # Bart should no longer be Homer's child
    {
	my $storage = Springfield::connect;
	my $homer = $storage->load( $id{Homer} );

	is( $homer->children, 'Lisa Maggie',
	    "auto-commit on disconnect" );
	marge_test( $storage );

	$storage->disconnect;
    }

    is(leaked, 0, "leaktest");

}

1;