t/15cluster.t

   1 # -*-Perl-*-
   2 # $Id$
   3
   4 BEGIN {
   5     use lib 't';
   6     use Bio::Root::Test;
   7     test_begin(-tests => 162);
   8
   9         use_ok('DBTestHarness');
  10         use_ok('Bio::ClusterIO');
  11 }
  12
  13 $biosql = DBTestHarness->new("biosql");
  14 $db = $biosql->get_DBAdaptor();
  15 ok $db;
  16
  17 my $objio = Bio::ClusterIO->new('-format' => 'unigene',
  18                                 '-file' => test_input_file('unigene.data'));
  19 my $clu = $objio->next_cluster();
  20 ok $clu;
  21
  22 my $pclu = $db->create_persistent($clu);
  23 ok $pclu;
  24 isa_ok $pclu, "Bio::DB::PersistentObjectI";
  25 isa_ok $pclu, "Bio::ClusterI";
  26
  27 $pclu->namespace("mytestnamespace");
  28 $pclu->create();
  29 my $dbid = $pclu->primary_key();
  30 ok $dbid;
  31
  32 my $adp = $db->get_object_adaptor($clu);
  33 ok $adp;
  34 isa_ok $adp, "Bio::DB::PersistenceAdaptorI";
  35
  36 # try/finally
  37 eval {
  38     $dbclu = $adp->find_by_primary_key($dbid);
  39     ok $dbclu;
  40
  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);
  47
  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     }
  74
  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     }
  89
  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);
 109 };
 110
 111 print STDERR $@ if $@;
 112
 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);