t/RemoteDB/HIV/HIVQueryHelper.t

   1 #-*-perl-*-
   2 # testing HIVQueryHelper.pm and lanl-schema.xml indirectly
   3 # $Id: HIVQueryHelper.t 231 2008-12-11 14:32:00Z maj $
   4
   5 use strict;
   6 use warnings;
   7
   8 BEGIN {
   9     use Bio::Root::Test;
  10     test_begin(
  11         -tests => 40,
  12         -requires_modules => [qw( Bio::Root::Root XML::Simple)]
  13         );
  14     use_ok('Bio::DB::HIV::HIVQueryHelper');
  15 }
  16
  17
  18 # lanl-schema.xml characteristics as of 1/23/18
  19 my ($naliases, $nfields, $ntables) = (166, 100, 14);
  20 my ($Q, $r, $q);
  21 # object tests
  22 isa_ok(new HIVSchema(), "HIVSchema");
  23 isa_ok($Q = new QRY(), "QRY");
  24 isa_ok($r = new R(), "R");
  25 isa_ok($q = new Q(), "Q");
  26
  27 #HIVSchema tests
  28 my $tobj;
  29 ok( $tobj = new HIVSchema(Bio::Root::IO->catfile(qw(Bio DB HIV lanl-schema.xml))), "schema load");
  30
  31 # methods
  32 can_ok( $tobj, qw (
  33                    tables
  34                    columns
  35                    fields
  36                    options
  37                    aliases
  38                    ankh
  39                    tablepart
  40                    tbl
  41                    columnpart
  42                    col
  43                    primarykey
  44                    pk
  45                    foreignkey
  46                    fk
  47                    foreigntable
  48                    ftbl
  49                    loadSchema
  50                    _sfieldh
  51                    loadHIVSchema
  52                    ));
  53
  54 # lanl-schema.xml tests
  55 is( scalar $tobj->fields, $nfields, "fields complete");
  56 is( scalar $tobj->tables, $ntables, "tables complete");
  57 is( scalar $tobj->aliases, $naliases, "aliases complete");
  58 my ($tbl, $fld, $col, $als);
  59 ok( ($fld) = grep /sequenceentry.se_sequence/, $tobj->fields, "test field present");
  60 ok( $tbl = $tobj->tablepart($fld), "test field syntax ok");
  61 ok( $col = $tobj->columnpart($fld), "test field syntax ok");
  62 ok( $als = $tobj->aliases($fld), "test alias by field name");
  63 is( $tobj->primarykey($tbl), 'sequenceentry.se_id', "correct primary key for SequenceEntry");
  64 is( scalar $tobj->foreignkey('author'), 2, "correct number of foreign keys for AUthor");
  65 is( $tobj->foreigntable(($tobj->foreignkey('author'))[1]), 'publication', "correct foreign table for au_pub_id");
  66 is_deeply( {$tobj->ankh('seq_sample.ssam_second_receptor')},
  67 {'seq_sample.ssam_second_receptor' => {'ankey'=>'coreceptor','antype'=>'Virus'}}, "correct annotation key hash");
  68
  69
  70 #Query parser tests
  71
  72 #methods
  73 can_ok($Q, qw(
  74               requests
  75               put_requests
  76               isnull
  77               A
  78               len
  79               clone
  80               ));
  81 can_ok($r, qw(
  82               atoms
  83               put_atoms
  84               del_atoms
  85               fields
  86               isnull
  87               A
  88               len
  89               clone
  90               ));
  91 can_ok($q, qw(
  92               fld
  93               dta
  94               A
  95               clone
  96               ));
  97 # operations tests
  98 ok($Q->isnull, "null QRY");
  99 ok($r->isnull, "null R (request object)");
 100 ok($q->isnull, "null Q (atomic query object)");
 101
 102 my ($R1, $R2);
 103 ok($R1 = new R( new Q('X', 'a b c') ), "R obj create and init (1)");
 104 ok($R2 = new R( new Q('X', 'a'), new Q('Y', 'u v w') ), "R obj create and init (2)");
 105 ok(R::In($R2, $R1), "R::In");
 106 ok(!R::In($R1, $R2), "!R::In");
 107 ok(R::Eq($R1, $R1->clone), "R::Eq");
 108 my ($Q1, $Q2, $Q3);
 109 ok($Q1 = new QRY( $R1 ), "QRY obj create and init (1)");
 110 ok($Q2 = new QRY( $R2 ), "QRY obj create and init (2)");
 111 ok($Q3 = new QRY( new R( new Q('X', 'a'), new Q('Y', 'w v u'))), "QRY obj create and init (3)");
 112
 113 ok(QRY::Eq($Q1 | $Q1, $Q1), "QRY overload |");
 114 ok(QRY::Eq($Q1 & $Q1,$Q1), "QRY overload &");
 115 ok(QRY::Eq($Q1 & $Q2, $Q3), "QRY nontrivial &");
 116
 117 # parse and make query tests
 118
 119 my $pt;
 120 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]} ");
 121 is(scalar QRY::_make_q($pt), 2, "make: 2 queries returned");
 122 is_deeply((QRY::_make_q($pt))[0]->{annot}, ['A','B','C','D'], "{annotation fields} parsed correctly");
 123 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]} ");
 124 is_deeply((QRY::_make_q($pt))[0],{}, "above query is null");
 125
 126