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