← Back to branch summary

~ubuntu-branches/ubuntu/raring/bioperl/raring

« back to all changes in this revision

Viewing changes to Bio/Ontology/OntologyStore.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2008-03-18 14:44:57 UTC
  • mfrom: (4 hardy)
  • mto: This revision was merged to the branch mainline in revision 6.
  • Revision ID: james.westby@ubuntu.com-20080318144457-1jjoztrvqwf0gruk
http://bugs.debian.org/448890
* debian/control:
  - Removed MIA Matt Hope (dopey) from the Uploaders field.
    Thank you for your work, Matt. I hope you are doing well.
  - Downgraded some recommended package to the 'Suggests' priority,
    according to the following discussion on Upstream's mail list.
    http://bioperl.org/pipermail/bioperl-l/2008-March/027379.html
    (Closes: #448890)
* debian/copyright converted to machine-readable format.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Bio/Ontology/OntologyStore.pm
1
 
# $Id: OntologyStore.pm,v 1.1 2003/02/28 05:15:42 lapp Exp $
 
1
# $Id: OntologyStore.pm,v 1.13.4.1 2006/10/02 23:10:22 sendu Exp $
2
2
#
3
3
# BioPerl module for Bio::Ontology::OntologyStore
4
4
#
16
16
 
17
17
=head1 SYNOPSIS
18
18
 
19
 
    # see documentation of methods
 
19
  #----------
 
20
  #SCENARIO 1
 
21
  #----------
 
22
 
 
23
  #make an ontology object manually. via OntologyIO
 
24
  my $io = Bio::OntologyIO->new(
 
25
                                #params to fetch Cell Ontology here
 
26
                               );
 
27
  my $cell_ontology = $io->next_ontology;
 
28
 
 
29
  #this is a singleton that caches the fact that you've created
 
30
  #a 'Cell Ontology' intance...
 
31
  my $store = Bio::Ontology::OntologyStore->get_instance();
 
32
 
 
33
  #...and it can hand you back a copy of it at any time.
 
34
  my $cell_ontology_copy = $store->get_ontology('Cell Ontology');
 
35
 
 
36
 
 
37
  #----------
 
38
  #SCENARIO 2
 
39
  #----------
 
40
 
 
41
  my $store = Bio::Ontology::OntologyStore->get_instance();
 
42
  #this use case allows the construction of an ontology on
 
43
  #demand just by supplying the name.
 
44
  my $ontology = $store->get_ontology('Sequence Ontology');
 
45
 
20
46
 
21
47
=head1 DESCRIPTION
22
48
 
28
54
Ontology object. The latter would almost inevitably lead to memory
29
55
cycles, and would therefore potentially blow up an application.
30
56
 
31
 
As a user of Ontology objects and Term objects you almost certainly
32
 
will not need to deal with this module.
33
 
 
34
57
=head1 FEEDBACK
35
58
 
36
59
=head2 Mailing Lists
39
62
Bioperl modules. Send your comments and suggestions preferably to
40
63
the Bioperl mailing list.  Your participation is much appreciated.
41
64
 
42
 
  bioperl-l@bioperl.org              - General discussion
43
 
  http://bioperl.org/MailList.shtml  - About the mailing lists
 
65
  bioperl-l@bioperl.org                  - General discussion
 
66
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
44
67
 
45
68
=head2 Reporting Bugs
46
69
 
48
71
of the bugs and their resolution. Bug reports can be submitted via
49
72
the web:
50
73
 
51
 
  http://bugzilla.bioperl.org/
 
74
  http://bugzilla.open-bio.org/
52
75
 
53
76
=head1 AUTHOR - Hilmar Lapp
54
77
 
55
 
Email hlapp at gmx.net
56
 
 
57
 
=head1 CONTRIBUTORS
58
 
 
59
 
Additional contributors names and emails here
 
78
  Hilmar Lapp E<lt>hlapp@gmx.netE<gt>
 
79
  Allen Day E<lt>allenday@ucla.eduE<gt>
60
80
 
61
81
=head1 APPENDIX
62
82
 
70
90
 
71
91
 
72
92
package Bio::Ontology::OntologyStore;
73
 
use vars qw(@ISA);
74
93
use strict;
75
94
 
76
95
# Object preamble - inherits from Bio::Root::Root
77
96
 
78
 
use Bio::Root::Root;
79
 
 
80
 
 
81
 
@ISA = qw(Bio::Root::Root );
 
97
use Bio::Ontology::DocumentRegistry;
 
98
use Bio::OntologyIO;
 
99
use FileHandle;
 
100
use File::Spec::Functions;
 
101
 
 
102
 
 
103
use base qw(Bio::Root::Root);
82
104
 
83
105
# these are the static ontology stores by name and by identifier - there is
84
106
# only one of each in any application
85
107
my %ont_store_by_name = ();
86
108
my %ont_store_by_id = ();
 
109
my %ont_aliases = (
 
110
                   'Gene Ontology' => 'Gene_Ontology'
 
111
                    );
87
112
# also, this is really meant as a singleton object, so we try to enforce it
88
113
my $instance = undef;
89
114
 
103
128
 Returns : an instance of Bio::Ontology::OntologyStore
104
129
 Args    :
105
130
 
106
 
 
107
131
=cut
108
132
 
109
133
sub new {
127
151
 Returns : an instance of this class
128
152
 Args    : named parameters, if any (currently, there are no 
129
153
           class-specific parameters other than those accepted by
130
 
           L<Bio::Root::Root>.
 
154
           Bio::Root::Root.
131
155
 
 
156
See L<Bio::Root::Root>.
132
157
 
133
158
=cut
134
159
 
158
183
           name, without dereferencing an object.
159
184
 
160
185
 Example :
161
 
 Returns : a L<Bio::Ontology::OntologyI> implementing object, or undef
 
186
 Returns : a Bio::Ontology::OntologyI implementing object, or undef
162
187
           if the query could not be satisfied
163
188
 Args    : Named parameters specifying the query. The following parameters
164
189
           are recognized:
167
192
           If both are specified, an implicit AND logical operator is
168
193
           assumed.
169
194
 
 
195
See L<Bio::Ontology::OntologyI>.
 
196
 
170
197
=cut
171
198
 
172
199
sub get_ontology{
173
 
    my ($self,@args) = @_;
174
 
    my $ont;
175
 
 
176
 
    my ($name,$id) = $self->_rearrange([qw(NAME ID)], @args);
177
 
    if($id) {
178
 
        $ont = $ont_store_by_id{$id};
179
 
        return unless $ont; # no AND can be satisfied in this case
180
 
    }
181
 
    if($name) {
182
 
        my $o = $ont_store_by_name{$name};
183
 
        if((! $ont) || ($ont->identifier() eq $o->identifier())) {
184
 
            $ont = $o;
185
 
        } else {
186
 
            $ont = undef;
187
 
        }
188
 
    }
189
 
    return $ont;
 
200
  my ($self,@args) = @_;
 
201
  my $ont;
 
202
 
 
203
  my ($name,$id) = $self->_rearrange([qw(NAME ID)], @args);
 
204
  if($id) {
 
205
    $ont = $ont_store_by_id{$id};
 
206
    return unless $ont; # no AND can be satisfied in this case
 
207
  }
 
208
 
 
209
  if($name) {
 
210
    my $o = $ont_store_by_name{$name};
 
211
 
 
212
    if(!$o){
 
213
      my $doc_registry = Bio::Ontology::DocumentRegistry->get_instance();
 
214
      my($url,$def,$fmt) = $doc_registry->documents($name);
 
215
 
 
216
      if(ref($url) eq 'ARRAY'){
 
217
        my $io = Bio::OntologyIO->new(-url      => $url,
 
218
                                      -defs_url => $def,
 
219
                                      -format   => $fmt,
 
220
                                     );
 
221
 
 
222
        $o = $io->next_ontology();
 
223
        $ont_store_by_name{$name} = $o;
 
224
      } elsif($url){
 
225
        my $io = Bio::OntologyIO->new(-url      => $url,
 
226
                                      -defs_url => $def,
 
227
                                      -format   => $fmt,
 
228
                                     );
 
229
        $o = $io->next_ontology;
 
230
        $ont_store_by_name{$name} = $o;
 
231
      }
 
232
    }
 
233
 
 
234
    if((! $ont) || ($ont->identifier() eq $o->identifier())) {
 
235
      $ont = $o;
 
236
    } else {
 
237
      $ont = undef;
 
238
    }
 
239
  }
 
240
  
 
241
  return $ont;
190
242
}
191
243
 
192
244
=head2 register_ontology
198
250
 
199
251
 Example :
200
252
 Returns : TRUE on success and FALSE otherwise
201
 
 Args    : the L<Bio::Ontology::OntologyI> object(s) to register
 
253
 Args    : the Bio::Ontology::OntologyI object(s) to register
202
254
 
 
255
See L<Bio::Ontology::OntologyI>.
203
256
 
204
257
=cut
205
258
 
206
 
sub register_ontology{
207
 
    my ($self,@args) = @_;
208
 
    my $ret = 1;
 
259
sub register_ontology {
 
260
  my ($self,@args) = @_;
 
261
  my $ret = 1;
 
262
  foreach my $ont (@args) {
 
263
    if(ref($ont) && $ont->isa('Bio::Ontology::OntologyI')){
 
264
      $ont_store_by_name{$ont->name()} = $ont if $ont->name;
 
265
      next;
 
266
    }
209
267
 
210
 
    foreach my $ont (@args) {
211
268
        if(! (ref($ont) && $ont->isa("Bio::Ontology::OntologyI"))) {
212
 
            $self->throw((ref($ont) ? ref($ont) : $ont)." does not implement ".
213
 
                         "Bio::Ontology::OntologyI or is not an object");
 
269
      $self->throw((ref($ont) ? ref($ont) : $ont)." does not implement ".
 
270
                   "Bio::Ontology::OntologyI or is not an object");
214
271
        }
215
272
        if($self->get_ontology(-name => $ont->name())) {
216
 
            $self->warn("ontology with name \"".$ont->name().
217
 
                        "\" already exists in the store, ignoring new one");
218
 
            $ret = 0;
219
 
            next;
 
273
      $self->warn("ontology with name \"".$ont->name().
 
274
                  "\" already exists in the store, ignoring new one");
 
275
      $ret = 0;
 
276
      next;
220
277
        }
221
278
        if($self->get_ontology(-id => $ont->identifier())) {
222
 
            $self->warn("ontology with id \"".$ont->identifier().
223
 
                        "\" already exists in the store, ignoring new one");
224
 
            $ret = 0;
225
 
            next;
 
279
      $self->warn("ontology with id \"".$ont->identifier().
 
280
                  "\" already exists in the store, ignoring new one");
 
281
      $ret = 0;
 
282
      next;
226
283
        }
227
284
        $ont_store_by_name{$ont->name()} = $ont;
228
285
        $ont_store_by_id{$ont->identifier()} = $ont;
229
 
    }
230
 
    return $ret;
 
286
  }
 
287
  return $ret;
231
288
}
232
289
 
233
290
=head2 remove_ontology
237
294
 Function: Remove the specified ontology from the store.
238
295
 Example :
239
296
 Returns : TRUE on success and FALSE otherwise
240
 
 Args    : the L<Bio::Ontology::OntologyI> implementing object(s)
 
297
 Args    : the Bio::Ontology::OntologyI implementing object(s)
241
298
           to be removed from the store
242
299
 
 
300
See L<Bio::Ontology::OntologyI>.
243
301
 
244
302
=cut
245
303
 
257
315
    return 1;
258
316
}
259
317
 
 
318
=head2 guess_ontology()
 
319
 
 
320
 Usage   : my $ontology = 
 
321
           Bio::Ontology::OntologyStore->guess_ontology('GO:0000001');
 
322
 Function: tries to guess which ontology a term identifier comes from, 
 
323
           loads it as necessary,
 
324
           and returns it as a Bio::Ontology::Ontology object.
 
325
 Example :
 
326
 Returns : a Bio::Ontology::Ontology object, or warns and returns undef
 
327
 Args    : an ontology term identifier in XXXX:DDDDDDD format.  
 
328
           Guessing is based on the XXXX string before the colon.
 
329
 
 
330
=cut
 
331
 
 
332
sub guess_ontology {
 
333
  my ($self,$id) = @_;
 
334
 
 
335
  my($prefix) = $id =~ /^(.+?):.+$/;
 
336
 
 
337
  my %prefix = (
 
338
                SO => 'Sequence Ontology',
 
339
                SOFA => 'Sequence Ontology Feature Annotation',
 
340
                GO => 'Gene Ontology',
 
341
               );
 
342
 
 
343
  return $prefix{$prefix} || undef;
 
344
}
 
345
 
260
346
1;