The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#-*-perl-*-
# testing HIVQueryHelper.pm and lanl-schema.xml indirectly
# $Id: HIVQueryHelper.t 231 2008-12-11 14:32:00Z maj $

use strict;
use warnings;

BEGIN {
    use Bio::Root::Test;
    test_begin(
	-tests => 40,
	-requires_modules => [qw( Bio::Root::Root XML::Simple)]
	);
    use_ok('Bio::DB::HIV::HIVQueryHelper');
}


# lanl-schema.xml characteristics as of $Date: 2008-12-11 08:05:24 -0500 (Thu, 11 Dec 2008) $
my ($naliases, $nfields, $ntables) = (165, 97, 14);
my ($Q, $r, $q);
# object tests
isa_ok(new HIVSchema(), "HIVSchema");
isa_ok($Q = new QRY(), "QRY");
isa_ok($r = new R(), "R");
isa_ok($q = new Q(), "Q");

#HIVSchema tests
my $tobj;
ok( $tobj = new HIVSchema(Bio::Root::IO->catfile(qw(Bio DB HIV lanl-schema.xml))), "schema load");

# methods
can_ok( $tobj, qw (
                   tables
                   columns
                   fields
                   options
                   aliases
                   ankh
                   tablepart
                   tbl
                   columnpart
                   col
                   primarykey
                   pk
                   foreignkey
                   fk
                   foreigntable
                   ftbl
                   loadSchema
                   _sfieldh
                   loadHIVSchema
                   ));

# lanl-schema.xml tests
is( scalar $tobj->fields, $nfields, "fields complete");
is( scalar $tobj->tables, $ntables, "tables complete");
is( scalar $tobj->aliases, $naliases, "aliases complete");
my ($tbl, $fld, $col, $als);
ok( ($fld) = grep /sequenceentry.se_sequence/, $tobj->fields, "test field present");
ok( $tbl = $tobj->tablepart($fld), "test field syntax ok");
ok( $col = $tobj->columnpart($fld), "test field syntax ok");
ok( $als = $tobj->aliases($fld), "test alias by field name");
is( $tobj->primarykey($tbl), 'sequenceentry.se_id', "correct primary key for SequenceEntry");
is( scalar $tobj->foreignkey('author'), 2, "correct number of foreign keys for AUthor");
is( $tobj->foreigntable(($tobj->foreignkey('author'))[1]), 'publication', "correct foreign table for au_pub_id");
is_deeply( {$tobj->ankh('seq_sample.ssam_second_receptor')}, 
{'seq_sample.ssam_second_receptor' => {'ankey'=>'coreceptor','antype'=>'Virus'}}, "correct annotation key hash");


#Query parser tests

#methods
can_ok($Q, qw(
              requests
              put_requests
              isnull
              A
              len
              clone
              ));
can_ok($r, qw(
              atoms
              put_atoms
              del_atoms
              fields
              isnull
              A
              len
              clone
              ));
can_ok($q, qw(
              fld
              dta
              A
              clone
              ));
# operations tests
ok($Q->isnull, "null QRY");
ok($r->isnull, "null R (request object)");
ok($q->isnull, "null Q (atomic query object)");

my ($R1, $R2);
ok($R1 = new R( new Q('X', 'a b c') ), "R obj create and init (1)");
ok($R2 = new R( new Q('X', 'a'), new Q('Y', 'u v w') ), "R obj create and init (2)");
ok(R::In($R2, $R1), "R::In");
ok(!R::In($R1, $R2), "!R::In");
ok(R::Eq($R1, $R1->clone), "R::Eq");
my ($Q1, $Q2, $Q3);
ok($Q1 = new QRY( $R1 ), "QRY obj create and init (1)");
ok($Q2 = new QRY( $R2 ), "QRY obj create and init (2)");
ok($Q3 = new QRY( new R( new Q('X', 'a'), new Q('Y', 'w v u'))), "QRY obj create and init (3)");

ok(QRY::Eq($Q1 | $Q1, $Q1), "QRY overload |");
ok(QRY::Eq($Q1 & $Q1,$Q1), "QRY overload &");
ok(QRY::Eq($Q1 & $Q2, $Q3), "QRY nontrivial &"); 

# parse and make query tests

my $pt;
ok($pt=QRY::_parse_q("('odds bodkins', a)[X] m[Y] u[Z] OR 'b'[X] {A B [C] [D]}"), "parse: ('odds bodkins', a)[X] m[Y] u[Z] OR 'b'[X] {A B [C] [D]} ");
is(scalar QRY::_make_q($pt), 2, "make: 2 queries returned");
is_deeply((QRY::_make_q($pt))[0]->{annot}, ['A','B','C','D'], "{annotation fields} parsed correctly");
ok($pt=QRY::_parse_q("('odds bodkins', a)[X] m[Y] u[Z] AND b[X] {A B [C] [D]}"), "parse: ('odds bodkins', a)[X] m[Y] u[Z] AND b[X] {A B [C] [D]} ");
is_deeply((QRY::_make_q($pt))[0],{}, "above query is null");