squash perl 5.12 warning
[bioperl-db.git] / t / 15cluster.t
blob77ac23341f41b0495d1e6e6d2b0dff593c8cb6f0
1 # -*-Perl-*-
2 # $Id$
4 BEGIN {
5     use lib 't';
6     use Bio::Root::Test;
7     test_begin(-tests => 162);
9         use_ok('DBTestHarness');
10         use_ok('Bio::ClusterIO');
13 $biosql = DBTestHarness->new("biosql");
14 $db = $biosql->get_DBAdaptor();
15 ok $db;
17 my $objio = Bio::ClusterIO->new('-format' => 'unigene',
18                                 '-file' => test_input_file('unigene.data'));
19 my $clu = $objio->next_cluster();
20 ok $clu;
22 my $pclu = $db->create_persistent($clu);
23 ok $pclu;
24 isa_ok $pclu, "Bio::DB::PersistentObjectI";
25 isa_ok $pclu, "Bio::ClusterI";
27 $pclu->namespace("mytestnamespace");
28 $pclu->create();
29 my $dbid = $pclu->primary_key();
30 ok $dbid;
32 my $adp = $db->get_object_adaptor($clu);
33 ok $adp;
34 isa_ok $adp, "Bio::DB::PersistenceAdaptorI";
36 # try/finally
37 eval {
38     $dbclu = $adp->find_by_primary_key($dbid);
39     ok $dbclu;
41     is ($dbclu->display_id, $clu->display_id);
42     is ($dbclu->description, $clu->description);
43     is ($dbclu->size, $clu->size);
44     is (scalar($dbclu->get_members), scalar($clu->get_members));
45     is (scalar($dbclu->get_members), $clu->size);
46     is ($dbclu->species->binomial, $clu->species->binomial);
48     # check all annotation objects
49     my @dbkeys =
50         sort { $a cmp $b } $dbclu->annotation->get_all_annotation_keys();
51     my @keys =
52         sort { $a cmp $b } $clu->annotation->get_all_annotation_keys();
53     is (scalar(@dbkeys), scalar(@keys));
54     my $i = 0;
55     while($i < @dbkeys) {
56         is ($dbkeys[$i], $keys[$i]);
57         my @dbanns = sort {
58             $a->as_text cmp $b->as_text;
59         } $dbclu->annotation->get_Annotations($dbkeys[$i]);
60         my @anns = sort {
61             $a->as_text cmp $b->as_text;
62         } $clu->annotation->get_Annotations($dbkeys[$i]);
63         is (scalar(@dbanns), scalar(@anns),
64             "number of annotations don't match for key ".$dbkeys[$i]);
65         my $j = 0;
66         while($j < @dbanns) {
67             is ($dbanns[$j]->as_text, $anns[$j]->as_text,
68                 "values for annotation element $j don't match for key ".
69                 $dbkeys[$i]);
70             $j++;
71         }
72         $i++;
73     }
75     # check all members
76     my @dbmems = sort {
77         $a->accession_number() cmp $b->accession_number();
78     } $dbclu->get_members();
79     my @mems = sort {
80         $a->accession_number() cmp $b->accession_number();
81     } $clu->get_members();
82     $i = 0;
83     while(($i < @mems) && ($i < @dbmems)) {
84         is ($dbmems[$i]->accession_number, $mems[$i]->accession_number);
85         is ($dbmems[$i]->display_id, $mems[$i]->display_id);
86         is ($dbmems[$i]->namespace, $mems[$i]->namespace);
87         $i++;
88     }
90     # test cluster member association removal
91     ok $adp->remove_members($dbclu);
92     # re-fetch and test members
93     $dbclu = $adp->find_by_primary_key($dbid);
94     ok $dbclu;
95     is (scalar($dbclu->get_members()), 0);
96     # but the members should be still there (just not associated anymore)
97     my $seq = $dbmems[0]->adaptor->find_by_primary_key($dbmems[0]->primary_key);
98     ok $seq;
99     is ($seq->accession_number, $dbmems[0]->accession_number);
100     # and the original size is retained, like it or not
101     is ($dbclu->size, 29);
102     # now try to update the size (we should be able to do that in the
103     # absence of any members
104     $dbclu->size(10);
105     $dbclu->store();
106     # refetch and test
107     $dbclu = $adp->find_by_primary_key($dbid);
108     is ($dbclu->size, 10);
111 print STDERR $@ if $@;
113 # delete clu
114 is ($pclu->remove(), 1);
115 my $ns = Bio::DB::Persistent::BioNamespace->new(-identifiable => $pclu);
116 ok $ns = $db->get_object_adaptor($ns)->find_by_unique_key($ns);
117 ok $ns->primary_key();
118 is ($ns->remove(), 1);