From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

SENDU / bioperl-db-1.5.2_100 / t / 15cluster.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125

              
# -*-Perl-*-
# $Id: 15cluster.t,v 1.1 2005/01/30 08:04:58 lapp Exp $
use lib 't';
BEGIN {
    # to handle systems with no installed Test module
    # we include the t dir (where a copy of Test.pm is located)
    # as a fallback
    eval { require Test; };
    use Test;
    plan tests => 160;
}
use DBTestHarness;
use Bio::ClusterIO;
use Bio::Root::IO;
$biosql = DBTestHarness->new("biosql");
$db = $biosql->get_DBAdaptor();
ok $db;
my $objio = Bio::ClusterIO->new('-format' => 'unigene',
                                '-file' => Bio::Root::IO->catfile(
                                                 't','data','unigene.data'));
my $clu = $objio->next_cluster();
ok $clu;
my $pclu = $db->create_persistent($clu);
ok $pclu;
ok $pclu->isa("Bio::DB::PersistentObjectI");
ok $pclu->isa("Bio::ClusterI");
$pclu->namespace("mytestnamespace");
$pclu->create();
my $dbid = $pclu->primary_key();
ok $dbid;
my $adp = $db->get_object_adaptor($clu);
ok $adp;
ok $adp->isa("Bio::DB::PersistenceAdaptorI");
# try/finally
eval {
    $dbclu = $adp->find_by_primary_key($dbid);
    ok $dbclu;
    ok ($dbclu->display_id, $clu->display_id);
    ok ($dbclu->description, $clu->description);
    ok ($dbclu->size, $clu->size);
    ok (scalar($dbclu->get_members), scalar($clu->get_members));
    ok (scalar($dbclu->get_members), $clu->size);
    ok ($dbclu->species->binomial, $clu->species->binomial);
    # check all annotation objects
    my @dbkeys =
        sort { $a cmp $b } $dbclu->annotation->get_all_annotation_keys();
    my @keys =
        sort { $a cmp $b } $clu->annotation->get_all_annotation_keys();
    ok (scalar(@dbkeys), scalar(@keys));
    my $i = 0;
    while($i < @dbkeys) {
        ok ($dbkeys[$i], $keys[$i]);
        my @dbanns = sort {
            $a->as_text cmp $b->as_text;
        } $dbclu->annotation->get_Annotations($dbkeys[$i]);
        my @anns = sort {
            $a->as_text cmp $b->as_text;
        } $clu->annotation->get_Annotations($dbkeys[$i]);
        ok (scalar(@dbanns), scalar(@anns),
            "number of annotations don't match for key ".$dbkeys[$i]);
        my $j = 0;
        while($j < @dbanns) {
            ok ($dbanns[$j]->as_text, $anns[$j]->as_text,
                "values for annotation element $j don't match for key ".
                $dbkeys[$i]);
            $j++;
        }
        $i++;
    }
    # check all members
    my @dbmems = sort {
        $a->accession_number() cmp $b->accession_number();
    } $dbclu->get_members();
    my @mems = sort {
        $a->accession_number() cmp $b->accession_number();
    } $clu->get_members();
    $i = 0;
    while(($i < @mems) && ($i < @dbmems)) {
        ok ($dbmems[$i]->accession_number, $mems[$i]->accession_number);
        ok ($dbmems[$i]->display_id, $mems[$i]->display_id);
        ok ($dbmems[$i]->namespace, $mems[$i]->namespace);
        $i++;
    }
    # test cluster member association removal
    ok $adp->remove_members($dbclu);
    # re-fetch and test members
    $dbclu = $adp->find_by_primary_key($dbid);
    ok $dbclu;
    ok (scalar($dbclu->get_members()), 0);
    # but the members should be still there (just not associated anymore)
    my $seq = $dbmems[0]->adaptor->find_by_primary_key($dbmems[0]->primary_key);
    ok $seq;
    ok ($seq->accession_number, $dbmems[0]->accession_number);
    # and the original size is retained, like it or not
    ok ($dbclu->size, 29);
    # now try to update the size (we should be able to do that in the
    # absence of any members
    $dbclu->size(10);
    $dbclu->store();
    # refetch and test
    $dbclu = $adp->find_by_primary_key($dbid);
    ok ($dbclu->size, 10);
};
print STDERR $@ if $@;
# delete clu
ok ($pclu->remove(), 1);
my $ns = Bio::DB::Persistent::BioNamespace->new(-identifiable => $pclu);
ok $ns = $db->get_object_adaptor($ns)->find_by_unique_key($ns);
ok $ns->primary_key();
ok ($ns->remove(), 1);