1#!/opt/bin/perl -w 2 3# Tests of object-level fetches and following 4######################### We start with some black magic to print on failure. 5use lib '../blib/lib','../blib/arch'; 6use constant HOST => $ENV{ACEDB_HOST} || 'aceserver.cshl.org'; 7use constant PORT => $ENV{ACEDB_PORT} || 2007; 8 9BEGIN {$| = 1; print "1..36\n"; } 10END {print "not ok 1\n" unless $loaded;} 11use Ace; 12use constant TEST_CACHE=>0; 13 14$loaded = 1; 15print "ok 1\n"; 16 17######################### End of black magic. 18 19sub test { 20 local($^W) = 0; 21 my($num, $true,$msg) = @_; 22 print($true ? "ok $num\n" : "not ok $num $msg\n"); 23} 24 25# Test code: 26my ($db,$obj,@obj,$lab); 27my $DATA = q{Address Mail The Sanger Centre 28 Hinxton Hall 29 Hinxton 30 Cambridge CB10 1SA 31 U.K. 32 E_mail jes@sanger.ac.uk 33 Phone 1223-834244 34 1223-494958 35 Fax 1223-494919 36}; 37my @args = (-host=>HOST,-port=>PORT,-timeout=>50); 38push @args,(-cache=>{} 39 ) if TEST_CACHE || $ENV{TEST_CACHE}; 40Ace->debug(0); 41test(2,$db = Ace->connect(@args),"connection failure"); 42die "Couldn't establish connection to database. Aborting tests.\n" unless $db; 43test(3,$obj = $db->fetch('Author','Sulston JE'),"fetch failure"); 44print STDERR "\n ...Failed to get test object. Wrong database?\n Expect more failures... " 45 unless $obj; 46test(4,defined($obj) && $obj eq 'Sulston JE',"string overload failure"); 47test(5,@obj = $db->fetch('Author','Sulston*'),"wildcard failure"); 48test(6,@obj==2,"failed to recover two authors from Sulston*"); 49test(7,defined($obj) && $obj->right eq 'Also_known_as',"auto fill failure"); 50test(8,defined($obj) && $obj->Also_known_as eq 'John Sulston',"automatic method generation failure"); 51test(9,defined($obj) && $obj->Also_known_as->pick eq 'John Sulston',"pick failure"); 52test(10,defined($obj) && (@obj = $obj->Address(2)) == 9,"col failure"); 53test(11,defined($obj) && ($lab = $obj->Laboratory),"fetch failure"); 54test(12,defined($lab) && join(' ',sort($lab->tags)) =~ /^Address CGC Staff$/,"tags failure"); 55test(13,defined($lab) && $lab->at('CGC.Allele_designation')->at eq 'e',"compound path failure"); 56test(14,defined($obj) && $obj->Address(0)->asString eq $DATA,"asString() method"); 57test(15,$db->ping,"can't ping"); 58test(16,$db->classes,"can't count classes"); 59test(17,defined($obj) && join(' ',sort $obj->fetch('Laboratory')->tags) =~ /^Address CGC Staff/,"fetch failure"); 60test(18,defined($obj) && join(' ',$obj->Address(0)->row) eq "Address Mail The Sanger Centre","row() failure"); 61test(19,defined($obj) && join(' ',$obj->Address(0)->row(1)) eq "Mail The Sanger Centre","row() failure"); 62test(20,defined($obj) && (@h=$obj->Address(2)),"tag[2] failure"); 63test(21,defined($obj) && (@h==9),"tag[2] failure"); 64test(22,$iterator1 = $db->fetch_many('Author','S*'),"fetch_many() failure (1)"); 65test(23,$iterator2 = $db->fetch_many('Clone','*'),"fetch_many() failure (2)"); 66test(24,$obj1 = $iterator1->next,"iterator failure (1)"); 67test(25,!$obj1->filled,"got filled object, expected unfilled"); 68test(26,($obj2 = $iterator1->next) && $obj1 ne $obj2,"iterator failure (2)"); 69test(27,($obj3 = $iterator2->next) && $obj3->class eq 'Clone',"iterator failure (3)"); 70test(28,($obj4 = $iterator1->next) && $obj4->class eq 'Author',"iterator failure (4)"); 71test(29,$iterator1 = $db->fetch_many(-class=>'Author',-name=>'S*',-filled=>1),"fetch_many(filled) failure"); 72test(30,($obj1 = $iterator1->next) && $obj1 && $obj1->filled,"expected filled object, got unfilled or null"); 73# test scalar/array contexts 74$obj = $db->fetch('Author','S*'); 75test(31,$obj=~/^\d+$/,"did not get object count in scalar context with wildcard"); 76$obj = $db->fetch('Author','Sulston JE'); 77test(32,$obj eq 'Sulston JE',"did not get object in scalar context without wildcard"); 78@obj = $db->fetch('Author','Su*'); 79test(33,@obj>1,"did not get list of objects in array context with wildcard"); 80@papers = $obj->follow('Paper'); 81test(34,@papers>1,"did not get list of papers from follow()"); 82test(35,@papers && $papers[0]->Title,"did not get title from first paper"); 83@papers_new = $db->find(-query=>qq{Author IS "Sulston JE" ; >Paper}); 84test(36,@papers == @papers_new,"find() did not find right number of papers") 85