package ATR::DatasetTest;

use strict;
use warnings;
use base qw(McaTestCase);

# $Source: /nfs/disk54/badger/cvs/AniTrack/testlib/ATR/DatasetTest.pm,v $
# $Revision: 1.22 $ $Date: 2005/08/18 15:54:37 $

use ATR::Dataset;

{
    my %replaced;
    my %replace_with = ('ATR::Dataset::_new' => \&_Dataset_new,
			'ATR::Dataset::DESTROY' => \&_Dataset_DESTROY);
    my @prob;

    sub set_up {
	my $self = shift;
	@prob = ();
	$self->SUPER::set_up;

	foreach my $name (keys %replace_with) {
	    next if $replaced{$name};
	    no strict 'refs';
	    $replaced{$name} = *{$name}{CODE};
	    $replaced{$name} ||= \&__do_nothing; # allows the replacement to just call it
	    no warnings;
	    *{$name} = $replace_with{$name};
	}
    }

    sub __do_nothing { }

    sub tear_down {
	my $self = shift;

	foreach my $name (keys %replaced) {
	    my $old = delete $replaced{$name};

	    no strict 'refs';
	    no warnings;
	    *tmp = *{$name};
	    if ($old == \&__do_nothing) {
		# Don't leave our empty code in, it may upset an inheritance hierarchy
		# (during interception, the replacement CODE is responsible for keeping that working)
		*tmp = sub {};
#XXX: Argh, how do you do this?
		# DNW: delete $tmp{CODE};
	    } else {
		*tmp = $old;
	    }
	}
	$self->SUPER::tear_down;
	$self->_check_flags;
    }

    # Keep track of objects made & destroyed; check they all went away
    my %dataset; # key = stringified object, value = creator
    sub _Dataset_new {
	my $obj = $replaced{'ATR::Dataset::_new'}->(@_);
	warn "Repeat visit on object '$obj', flags $dataset{$obj}" if exists $dataset{$obj};
	my @caller = caller(1);
	$dataset{$obj} = "$caller[1] line $caller[2]";
	return $obj;
    }

    sub _Dataset_DESTROY {
	push @prob, "Destroy for $_[0] which didn't exist\n"
	  unless delete $dataset{$_[0]};
	$replaced{'ATR::Dataset::DESTROY'}->(@_);
    }

    sub _check_flags {
	my $self = shift;
	foreach my $key (keys %dataset) {
	    push @prob, "Dataset '$key' remains, made at $dataset{$key}\n";
	    delete $dataset{$key};
	}
	$self->fail("Leak check failed:\n@prob") if @prob;
    }
}

#----------------------------------------------------------------------------

sub test_plain_get {
    my $self = shift;

    my $o = ATR::Dataset->new_sqlfetch
      ('testobj',
       [qw[ foo bar baz ]],
       [ [ 1,2,3,4],
	 [ 5,6,7,8],
	 [ 9,10,11,12] ]);
    $self->column_map_check($o);

    $self->assert_str_equals( 'testobj', $o->name );

    $self->assert_str_equals( 'bar', $o->colnum2name(1) );
    $self->assert_str_equals( 2, $o->colid2num('baz') );

    my $col4 = $o->colnum2name(3); # should be a generated column name
    $self->assert_not_null($col4, "colname(3)");

    $self->assert_str_equals("foo,bar,baz,$col4", join ",", $o->colnames);

    $self->assert_str_equals( 3, $o->rowCount );

    $self->assert_str_equals( 4, $o->get(3, 0) );
    $self->assert_str_equals( 5, $o->get('foo', 1) );
    $self->assert_str_equals( 10, $o->get('bar', 2) );

    $self->assert_str_equals( "0:1:2",
			      (join ":", $o->rowList));

# Convenience wrappers for 'get'
    $self->assert_deep_equals( [ 12,11,10,9],
			       [ $o->getcols(2, reverse $o->colnames) ]);
    $self->assert_deep_equals( [],          [ $o->getcols(2) ] );

    $self->assert_deep_equals( [1, 5, 9],   [ $o->getrows('foo', 0,1,2) ] );
    $self->assert_deep_equals( [4, 8, 12],  [ $o->getrows(    3, 0,1,2) ] );
    $self->assert_deep_equals( [9, 5, 1],   [ $o->getrows('foo', 2,1,0) ] );
    $self->assert_deep_equals( [],          [ $o->getrows('foo'       ) ] );

    $self->assert_deep_equals( [ foo => 5, bar => 6, baz => 7, $col4 => 8 ],
			       [ $o->getcolshash(1) ]);

# Assorted error catching
    $self->assert_dies( qr/Unknown column id/,
			sub { local $SIG{__WARN__} = sub {}; $o->get(undef, 0) },
			sub { $o->get('wibble', 0) },
			sub { $o->get(4, 0) });
    $self->assert_dies( qr/get for 'testobj'/,
			sub { local $SIG{__WARN__} = sub {}; $o->get(0, undef) },
			sub { $o->get(3, 4) });
    $self->assert_dies( qr/method needs 2/,
			sub { local $SIG{__WARN__} = sub {}; $o->get },
			sub { $o->get(3) },
			sub { $o->get(1,2,3) });
}

sub test_wide {
    my $self = shift;
    my $alphabet = "abcdefghijklmnopqrstuvwxyz";
    my $wide = ATR::Dataset->new_sqlfetch('wide',
					  [split //, $alphabet],
					  [ [split //, uc($alphabet)], # one row
					  ]);
    $self->column_map_check($wide);
}

sub test_colmap {
    my $self = shift;

    my $o1 = ATR::Dataset->new_sqlfetch
      ('o1', [qw[o1a o1b]], [ [1,2], [3,4], [5,6] ]);
    $self->column_map_check($o1);

    my $o2 = ATR::Dataset->new_sqlfetch
      ('o2', [qw[o2a o2b]], [ [15,16] ]);
    $self->column_map_check($o2);

    my $o3 = ATR::Dataset->new_sqlfetch
      ('o3', [qw[o3a]], [ [17], [18], [19] ]);
    $self->column_map_check($o3);

    my $sum = ATR::Dataset->new_colmap
      ('sum', $o1, add => sub {
	   my ($me, $rowId) = @_;
	   return $me->get('o1a', $rowId) + $me->get('o1b', $rowId);
       },
      down_the_well => sub {
	  my ($me, $rowId) = @_;
	  my %all_columns_including_this_one = $me->getcolshash($rowId);
	  $self->fail('Should not finish down_the_well');
      });
    $self->column_map_check($sum);

    $self->assert_deep_equals( [ 3, 4, 7],
			       [ $sum->get('o1a', 1),
				 $sum->get('o1b', 1),
				 $sum->get('add', 1) ] );
    $self->assert_str_equals("o1a,o1b,add,down_the_well", join ",", $sum->colnames);
    $self->assert_dies( qr/Unknown column id/, sub { $sum->get('foo', 1) });

    $self->assert_str_equals( 'CODE', ref($sum->colname2info('add')) );

    $self->assert_str_equals( 11, $sum->get(2, 2) );

    $self->assert_str_equals( "0:1:2",
			      (join ":", $sum->rowList));

# Numeric column access (needs to map to name before going over to joinee, else we use colnum from the colmap object)
    my $join = ATR::Dataset->new_colmap('join', $o3, $o1);
    $self->column_map_check($join);

    $self->assert_str_equals("o3a:o1a:o1b", join ":", $join->colnames);
    $self->assert_str_equals("18:3:4", join ":", $join->getcols(1, 0..2));

    # and for set...
    $self->fail("can't set join(2 = o1b)") unless $join->canSet(2);
    $join->set(2,1, 400); # 4 -> 400
    $self->assert_str_equals("3:400", join ":", $o1->getcols(1, $o1->colnames));

# Error catching
    $self->assert_dies( qr/getcolshash choked on deep recursion/,
			sub {
			    local $SIG{__WARN__} = sub {}; # hide the inevitable warnings
			    $sum->get('down_the_well', 1);
			});
    $self->assert_dies( qr/forgot the.*name.*parameter/,
			sub {
			    $sum->new_colmap(wibble => sub { "foo" })
			});
    $self->assert_dies( qr/Unknown column id/, sub { $sum->get('wibble', 0) });

    $self->assert_dies( qr/Conflicting row counts/, sub { $o1->new_colmap('rows_mismatched', $o2) });

# Notice when the original object rowset changes
# XXX: no legitimate way to do this yet, so hack it
    push @{ $o1->{rows} }, [ 10, 20 ];
    $self->assert_str_equals( "0:1:2:3",
			      (join ":", $sum->rowList));
    $self->assert_str_equals( 30, $sum->get(2, 3) );

}

sub test_rowmap {
    my $self = shift;

    my $o1 = ATR::Dataset->new_sqlfetch
      ('o1',
       [qw[o1a I o1b]],
       [ [9, 'foo', 2],
	 [3, 'bar', 4],
	 [7, 'BAR', 4],
	 [5, 'baz', 6] ]);
    $self->column_map_check($o1);

# Hash style
    my $o2 = $o1->map_colhash('o1I', 'I');
    $self->column_map_check($o2);

    my @get_o1b = (bar => 4,
		   BAR => 4,
		   baz => 6);
    while (my ($k, $v) = splice(@get_o1b, 0, 2)) {
	$self->assert_str_equals($v, $o2->get('o1b', $k));
	$self->assert_str_equals($k, $o2->get('I',   $k));
    }
    $self->assert_dies( qr/'BAZ' not found/, sub { $o2->get('o1b', 'BAZ') });

    $self->assert_str_equals("", $o2->hasRow('BAZ')); # XXX: hasRow not tested for rowlist Rowmaps
    $self->assert_str_equals(1, $o2->hasRow('baz'));
    $self->assert_str_equals(1, $o2->hasRow('BAR'));

    $self->assert_dies( qr/Key conflict/, sub { $o1->map_colhash('o1b_idx', 'o1b') });

    my $o1ai = $o1->map_colhash('o1a_idx', 'o1a');
    $self->column_map_check($o1ai);

    $self->assert_str_equals( "0:1:2:3", (join ":", $o1->rowList));
    $self->assert_str_equals( "3:5:7:9", (join ":", sort $o1ai->rowList));

# List style
    my $o3 = $o1->map_rowlist('o1L', 3,1,2);  # "filter and re-order"
    $self->column_map_check($o3);
    $self->assert_str_equals( "0:1:2", (join ":", $o3->rowList));
    $self->assert_str_equals( "baz:bar:BAR", (join ":", map { $o3->get('I', $_) } (0 .. 2)));

# Composite
    my $o4 = $o3->map_colhash('o3_1', 'o1a');
    $self->column_map_check($o4);
    $self->assert_str_equals(6, $o4->get('o1b', 5));
    $self->assert_dies( qr/'9' not found/, sub { $o4->get('o1b', 9) });
}

sub test_set {
    my $self = shift;

    my $o = ATR::Dataset->new_sqlfetch
      ('fbb',
       [qw[ foo bar baz ]],
       [ [ 1,2,3],
	 [ 5,6,7],
	 [ 9,10,11] ]);
    $self->column_map_check($o);

    my $sum = $o->new_colmap('sum', sum3 => sub {
				 my ($me, $rowId) = @_;
				 return ($me->get('foo',$rowId) +
					 $me->get('bar',$rowId) +
					 $me->get('baz',$rowId) );
			     });
    $self->column_map_check($sum);

    my $index = $sum->map_colhash('sum_idx', 'sum3');
    $self->column_map_check($index);

    my $filter = $sum->map_rowlist('onerow', 1); # 5,6,7,(sum)
    $self->column_map_check($filter);

    my $rowsSums = sub {
	my $dataset = shift;
	my @sums = $dataset->getrows('sum3', $dataset->rowList);
	return join ":", @sums;
    };

    $self->assert_str_equals("6:18:30", $rowsSums->($sum));
    $self->assert_str_equals("18", $rowsSums->($filter));

    # Change some numbers
    $o     ->set('foo', 0, 12); #  1 -> 12
    $sum   ->set('baz', 2,  4); # 11 ->  4
    $filter->set('bar', 0,  8); #  6 ->  8

    $self->assert_str_equals("17:20:23", $rowsSums->($sum));

    # passes, but is incorrect behaviour:
    $self->assert_str_equals( 12, $index->get('foo',  6) ); # the static indexed behaviour: look up current data using original (stale) rowId

    # fails, but is better behaviour:
    $self->{annotate}->{not_found} = 'EXPECTED';
    $self->assert_str_equals( 12, $index->get('foo', 17) ); # the dynamic indexed behaviour: look up using new (current) values
}


sub test_rowchange {
    my $self = shift;

    my $o = ATR::Dataset->new_sqlfetch
      ('o', [qw[ a b c ]],
       [ [1,2,3], [4,5,6], [7,8,9] ]);
    $self->column_map_check($o);

    $self->assert_deep_equals([1,4,7],  [$o->getrows('a', $o->rowList)]);
    $self->assert_deep_equals([1,2,3],  [$o->getcols(0,   $o->colnames)]);

    $o->replace_rows([ [10,20,30], [40,50,60], [70,80,90] ]);
    $self->assert_deep_equals([10,40,70],  [$o->getrows('a', $o->rowList)]);
    $self->assert_deep_equals([10,20,30],  [$o->getcols(0,   $o->colnames)]);

    my $new1 = $o->append_row([91,92,93]);
    $self->assert_dies( qr/Column count \d should be 3/,
			sub { $o->append_row([1,2,3,4]) },
			sub { $o->append_row([1,2    ]) } );
    $self->assert_dies( qr/Unknown column id 'e'/,
			sub { $o->append_row({ a => 4, e => 6 }) } );

    my $new2 = $o->append_row({ a => 94, c => 96 });
    $self->assert_deep_equals([10,40,70,91,94],     [$o->getrows('a', $o->rowList)]);
    $self->assert_deep_equals([20,50,80,92,undef],  [$o->getrows('b', $o->rowList)]);

    $self->assert_str_equals("3:4", join ":", $new1, $new2); # the new rownum values

    $self->fail("check colmap works; rowmap won't yet");
}

#sub test_set_indexed {
#    my $self = shift;
#
#    my $o = ATR::Dataset->new_sqlfetch
#      ('abc', [qw[a b c]],
#       [ [4,5,6], [7,8,9] ]);
#    $self->column_map_check($o);
#
#    my $idx = $o->
#}


sub column_map_check {
    my ($self, $dataset) = @_;
    my @caller = caller();
    $self->{annotate}->{caller} = "$caller[1] line $caller[2]";
    $self->{annotate}->{dataset} = $dataset->name.", type ".ref($dataset);

    my @colnames = $dataset->colnames;
#    $self->assert_deep_equals(\@colnames, [ $dataset->colnames ]);

    for (my $i=0; $i<@colnames; $i++) {
	$self->{annotate}->{i} = $i;
	$self->assert_str_equals($colnames[$i], $dataset->colnum2name($i));
	$self->assert_str_equals($i, $dataset->colid2num($i));
	my $N = $colnames[$i];
	$self->assert_str_equals($i, $dataset->colid2num($N));
	$self->assert(scalar $dataset->hasColid($i), "hasColid($i) false");
	$self->assert(scalar $dataset->hasColid($N), "hasColid($N) false");

	# Don't care whether it's writable, but ensure it's consistent and no error
	$self->assert_str_equals(scalar $dataset->canSet($i),
				 scalar $dataset->canSet($N));
    }

    $self->assert((! $dataset->hasColid(scalar @colnames)), "hasColid(N+1) true");
    $self->assert((! $dataset->hasColid("column_map_check")), "hasColid('column_map_check') true");

    delete @{ $self->{annotate} }{qw{caller i dataset}};
}


1;
