~ubuntu-branches/ubuntu/trusty/bioperl/trusty-proposed

« back to all changes in this revision

Viewing changes to Bio/Ontology/Term.pm

  • Committer: Bazaar Package Importer
  • Author(s): Charles Plessy
  • Date: 2009-03-10 07:19:11 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20090310071911-fukqzw54pyb1f0bd
Tags: 1.6.0-2
* Removed patch system (not used):
  - removed instuctions in debian/rules;
  - removed quilt from Build-Depends in debian/control.
* Re-enabled tests:
  - uncommented test command in debian/rules;
  - uncommented previously missing build-dependencies in debian/control.
  - Re-enabled tests and uncommented build-dependencies accordingly.
* Removed libmodule-build-perl and libtest-harness-perl from
  Build-Depends-Indep (provided by perl-modules).
* Better cleaning of empty directories using find -type d -empty -delete
  instead of rmdir in debian/rules (LP: #324001).

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
# $Id: Term.pm,v 1.31.4.1 2006/10/02 23:10:22 sendu Exp $
 
1
# $Id: Term.pm 14708 2008-06-10 00:08:17Z heikki $
2
2
#
3
3
# BioPerl module for Bio::Ontology::Term
4
4
#
93
93
use strict;
94
94
use Bio::Ontology::Ontology;
95
95
use Bio::Ontology::OntologyStore;
 
96
use Bio::Annotation::DBLink;
 
97
use Data::Dumper;
96
98
 
97
99
use constant TRUE    => 1;
98
100
use constant FALSE   => 0;
99
101
 
100
102
use base qw(Bio::Root::Root Bio::Ontology::TermI Bio::IdentifiableI Bio::DescribableI);
101
103
 
102
 
 
103
 
 
104
104
=head2 new
105
105
 
106
106
 Title   : new
136
136
 
137
137
    my $self = $class->SUPER::new( @args );
138
138
    my ( $identifier,
139
 
         $name,
140
 
         $definition,
141
 
         $category,
142
 
                        $ont,
143
 
         $version,
144
 
         $is_obsolete,
145
 
         $comment,
146
 
                        $dblinks,
147
 
                        $references)
148
 
        = $self->_rearrange( [ qw( IDENTIFIER
149
 
                                                                                NAME
150
 
                                                                                DEFINITION
151
 
                                                                                CATEGORY
152
 
                                                                                ONTOLOGY
153
 
                                                                                VERSION
154
 
                                                                                IS_OBSOLETE
155
 
                                                                                COMMENT
156
 
                                                                                DBLINKS
157
 
                                                                                REFERENCES
 
139
        $name,
 
140
        $definition,
 
141
        $category,
 
142
        $ont,
 
143
        $version,
 
144
        $is_obsolete,
 
145
        $comment,
 
146
        $dblinks,
 
147
        $dbxrefs,
 
148
        $references)
 
149
        = $self->_rearrange( [
 
150
        qw(IDENTIFIER
 
151
        NAME
 
152
        DEFINITION
 
153
        CATEGORY
 
154
        ONTOLOGY
 
155
        VERSION
 
156
        IS_OBSOLETE
 
157
        COMMENT
 
158
        DBLINKS
 
159
        DBXREFS
 
160
        REFERENCES
158
161
       ) ], @args );
159
162
 
160
163
    $self->init();
167
170
    defined($version)      && $self->version( $version );
168
171
    defined($is_obsolete)  && $self->is_obsolete( $is_obsolete );
169
172
    defined($comment)      && $self->comment( $comment  );
 
173
    defined($dbxrefs)      && $self->add_dbxref(-dbxrefs => $dbxrefs);
 
174
    # deprecated methods, allow to pass on to get the dep. notification
170
175
    ref($dblinks)          && $self->add_dblink(@$dblinks);
171
176
    ref($references)       && $self->add_reference(@$references);
172
177
 
186
191
    $self->ontology(undef);
187
192
    $self->is_obsolete(0);
188
193
    $self->remove_synonyms();
189
 
    $self->remove_dblinks();
 
194
    $self->remove_dbxrefs();
190
195
    $self->remove_references;
191
196
    $self->remove_secondary_ids();
192
197
 
292
297
    return $self->{"_ontology"};
293
298
} # ontology
294
299
 
295
 
 
296
300
=head2 version
297
301
 
298
302
 Title   : version
312
316
    return $self->{'version'};
313
317
} # version
314
318
 
315
 
 
316
 
 
317
319
=head2 is_obsolete
318
320
 
319
321
 Title   : is_obsolete
353
355
    return $self->{'comment'};
354
356
} # comment
355
357
 
356
 
 
357
 
 
358
 
 
359
358
=head2 get_synonyms
360
359
 
361
360
 Title   : get_synonyms
427
426
 Returns : A list of dblinks [array of [scalars]].
428
427
 Args    : A scalar indicating the context (optional).
429
428
           If omitted, all dblinks will be returned.
 
429
 Note    : deprecated method due to past use of mixed data types; use
 
430
           get_dbxrefs() instead, which handles both strings and DBLink
 
431
           instances
430
432
 
431
433
=cut
432
434
 
433
435
sub get_dblinks {
434
 
    my $self = shift;
435
 
    my $context = shift;
436
 
 
437
 
    if (defined($context)) {
438
 
        return @{$self->{_dblinks}->{$context}}
439
 
            if exists($self->{_dblinks}->{$context});
440
 
    } else {
441
 
        return map { @$_ } values %{$self->{_dblinks}};
442
 
    }
443
 
    return ();
 
436
    my ($self, $context) = @_;
 
437
    $self->deprecated("Use of get_dblinks is deprecated.  Note that prior use\n".
 
438
                      "of this method could return either simple scalar values\n".
 
439
                      "or Bio::Annotation::DBLink instances; only \n".
 
440
                      "Bio::Annotation::DBLink is now supported.\n ".
 
441
                      "Use get_dbxrefs() instead");
 
442
    $self->get_dbxrefs($context);
444
443
} # get_dblinks
445
444
 
 
445
=head2 get_dbxrefs
 
446
 
 
447
 Title   : get_dbxrefs()
 
448
 Usage   : @ds = $term->get_dbxrefs();
 
449
 Function: Returns a list of each link for this term.
 
450
 
 
451
           If an implementor of this interface permits modification of
 
452
           this array property, the class should define at least
 
453
           methods add_dbxref() and remove_dbxrefs(), with obvious
 
454
           functionality.
 
455
 
 
456
 Returns : A list of L<Bio::Annotation::DBLink> instances
 
457
 Args    : [optional] string which specifies context (default : returns all dbxrefs)
 
458
 
 
459
=cut
 
460
 
 
461
sub get_dbxrefs {
 
462
    my ($self, $context) = shift;
 
463
    my @dbxrefs;
 
464
    if (defined($context)) {
 
465
        if (exists($self->{_dblinks}->{$context})) {
 
466
            @dbxrefs =  @{$self->{_dblinks}->{$context}};
 
467
        }
 
468
    } else {
 
469
        @dbxrefs = map { @$_ } values %{$self->{_dblinks}} ;
 
470
    }
 
471
    return @dbxrefs;
 
472
} # get_dbxrefs
446
473
 
447
474
=head2 get_dblink_context
448
475
 
451
478
  Function: Return all context existing in Term
452
479
  Returns : a list of scalar
453
480
  Args    : [none]
 
481
  Note    : deprecated method due to past use of mixed data types; use
 
482
            get_dbxref_context() instead
454
483
 
455
484
=cut
456
485
 
457
486
sub get_dblink_context {
458
487
    my $self=shift;
 
488
    $self->deprecated("Use of get_dblink_context() is deprecated; use get_dbxref_context() instead");
 
489
    return $self->get_dbxref_context(@_);
 
490
}
 
491
 
 
492
=head2 get_dbxref_context
 
493
 
 
494
  Title   : get_dbxref_context
 
495
  Usage   : @context = $term->get_dbxref_context;
 
496
  Function: Return all context strings existing in Term
 
497
  Returns : a list of scalars
 
498
  Args    : [none]
 
499
 
 
500
=cut
 
501
 
 
502
sub get_dbxref_context {
 
503
    my $self=shift;
459
504
    return keys %{$self->{_dblinks}};
460
505
}
461
506
 
467
512
           $term->add_dblink( $dbl );
468
513
 Function: Pushes one or more dblinks onto the list of dblinks.
469
514
 Returns :
470
 
 Args    : One  dblink [scalar] or a list of
471
 
            dblinks [array of [scalars]].
 
515
 Args    : One or more L<Bio::Annotation::DBLink> instances
 
516
 Note    : deprecated method due to past use of mixed data types; use
 
517
           add_dbxref() instead, which handles both strings and
 
518
           DBLink instances
472
519
 
473
520
=cut
474
521
 
475
522
sub add_dblink {
476
523
    my $self = shift;
477
 
    $self->add_dblink_context($_,'_default') foreach @_;
 
524
    $self->deprecated("Use of simple strings and add_dblink() is deprecated; use\n".
 
525
                      "Bio::Annotation::DBLink instances and add_dbxref() instead");
 
526
    # here we're assuming the data is in a simple DB:ID format
 
527
    my @dbxrefs;
 
528
    for my $string (@_) {
 
529
        my ($db, $id) = split(':',$string);
 
530
        push @dbxrefs, Bio::Annotation::DBLink->new(-database => $db, -primary_id => $id);
 
531
    }
 
532
    return $self->add_dbxref(-dbxrefs => \@dbxrefs, -context => '_default');
478
533
} # add_dblink
479
534
 
 
535
=head2 add_dbxref
 
536
 
 
537
 Title   : add_dbxref
 
538
 Usage   : $term->add_dbxref( @dbls );
 
539
           or
 
540
           $term->add_dbxref( $dbl );
 
541
 Function: Pushes one or more dblinks onto the list of dblinks.
 
542
 Returns :
 
543
 Args    : -dbxrefs : array ref of Bio::Annotation::DBLink instances
 
544
           -context : string designating the context for the DBLink
 
545
                       (default : '_default' - contextless)
 
546
 
 
547
=cut
 
548
 
 
549
sub add_dbxref {
 
550
    my $self = shift;
 
551
    my ($links, $context) = $self->_rearrange([qw(DBXREFS CONTEXT)],@_);
 
552
    return unless defined $links;
 
553
    $context ||= '_default';
 
554
    $self->throw("DBLinks must be passed as an array reference") if ref $links ne 'ARRAY';
 
555
    foreach my $dbxref (@{$links}) {
 
556
        $self->throw("$dbxref is not a DBLink") unless ref $dbxref &&
 
557
            $dbxref->isa('Bio::Annotation::DBLink');
 
558
        $self->throw("'all' is a reserved word for context.") if $context eq 'all';
 
559
        if (! exists($self->{_dblinks}->{$context})) {
 
560
            $self->{_dblinks}->{$context} = [];
 
561
        }
 
562
        my $linktext = ref $dbxref ? $dbxref->display_text : $dbxref;
 
563
        if (grep {$_->display_text eq $linktext}
 
564
            @{$self->{_dblinks}->{$context}})
 
565
        {
 
566
            $self->warn("DBLink exists in the dblink of $context");
 
567
        }
 
568
        push @{$self->{_dblinks}->{$context}}, $dbxref;    
 
569
    }
 
570
} # add_dbxref
480
571
 
481
572
=head2 has_dblink
482
573
 
485
576
  Function: Checks if a DBXref is already existing in the OBOterm object
486
577
  Return  : TRUE/FALSE
487
578
  Args    : [arg1] A DBxref identifier
 
579
  Note    : deprecated method due to past use of mixed data types; use
 
580
            has_dbxref() instead, which handles both strings and
 
581
            DBLink instances
488
582
 
489
583
=cut
490
584
 
491
585
sub has_dblink {
492
586
    my ( $self, $value ) = @_;
 
587
    $self->deprecated("use of has_dblink() is deprecated; use has_dbxref() instead");
 
588
    return $self->has_dbxref($value);
 
589
}
 
590
 
 
591
=head2 has_dbxref
 
592
 
 
593
  Title   : has_dbxref
 
594
  Usage   : $term->has_dbxref($dbxref);
 
595
  Function: Checks if a dbxref string is already existing in the OBOterm object
 
596
  Return  : TRUE/FALSE
 
597
  Args    : [arg1] A DBxref identifier (string).
 
598
            Bio::Annotation::DBLink::display_text() is used for comparison
 
599
            against the string.
 
600
 
 
601
=cut
 
602
 
 
603
sub has_dbxref {
 
604
    my ( $self, $value ) = @_;
493
605
    return unless defined $value;
494
606
    my $context = "_default";
495
607
    $self->throw("'all' is a reserved word for context.") if $context eq 'all';
496
608
    $context ||= '_default';
497
 
    if ( ( $self->{_dblinks}->{$context} ) && grep { $_ eq $value }
 
609
    if ( ( $self->{_dblinks}->{$context} ) &&
 
610
        grep { $_->display_text eq $value } 
498
611
        @{ $self->{_dblinks}->{$context} } )
499
612
    {
500
613
        return TRUE;
504
617
    }
505
618
}
506
619
 
507
 
 
508
620
=head2 add_dblink_context
509
621
 
510
622
  Title   : add_dblink_context
511
623
  Usage   : $term->add_dblink_context($db, $context);
512
624
  Function: add a dblink with its context
513
625
  Return  : [none]
514
 
  Args    : [arg1] an object of Bio::Annotation::DBLink
 
626
  Args    : [arg1] a Bio::Annotation::DBLink instance
515
627
            [arg2] a string for context; if omitted, the
516
628
                   default/context-less one will be used.
 
629
  Note    : deprecated method due to past use of mixed data types; use
 
630
            add_dbxref() instead
517
631
 
518
632
=cut
519
633
 
520
634
sub add_dblink_context {
521
 
    my ($self, $value, $context)=@_;
522
 
    return unless defined $value;
523
 
    $self->throw("'all' is a reserved word for context.") if $context eq 'all';
524
 
    $context ||= '_default';
525
 
    if (! exists($self->{_dblinks}->{$context})) {
526
 
        $self->{_dblinks}->{$context} = [];
527
 
    }
528
 
    if (grep {$_ eq $value} @{$self->{_dblinks}->{$context}}) {
529
 
        $self->warn("$value exists in the dblink of $context");
530
 
    }
531
 
    push @{$self->{_dblinks}->{$context}}, $value;
 
635
    my ($self, $value, $context) = @_;
 
636
    $self->deprecated("Use of simple strings and add_dblink_context() is deprecated; use\n
 
637
                      Bio::Annotation::DBLink instances and add_dbxref() instead");
 
638
    return $self->add_dbxref([$value],$context);
532
639
}
533
640
 
534
641
=head2 remove_dblinks
539
646
 Returns : A list of definition references [array of [scalars]].
540
647
 Args    : Context. If omitted or equal to 'all', all dblinks
541
648
           will be removed.
 
649
 Note    : deprecated method due to past use of mixed data types; use
 
650
           remove_dblinks() instead, which handles both strings and
 
651
           DBLink instances
542
652
 
543
653
=cut
544
654
 
545
655
sub remove_dblinks {
546
656
    my ($self, $context) = @_;
 
657
    $self->deprecated("use of remove_dblinks() is deprecated; use remove_dbxrefs() instead");
 
658
    return $self->remove_dbxrefs(@_);
 
659
} # remove_dblinks
 
660
 
 
661
=head2 remove_dbxrefs
 
662
 
 
663
 Title   : remove_dbxrefs()
 
664
 Usage   : $term->remove_dbxrefs();
 
665
 Function: Deletes (and returns) the definition references of this GO term.
 
666
 Returns : A list of definition references [array of [scalars]].
 
667
 Args    : Context. If omitted or equal to 'all', all dblinks
 
668
           will be removed.
 
669
 
 
670
=cut
 
671
 
 
672
sub remove_dbxrefs {
 
673
    my ($self, $context) = @_;
547
674
    $context = undef if $context && ($context eq "all");
548
 
    my @old = $self->get_dblinks($context);
 
675
    my @old = $self->get_dbxrefs($context);
549
676
    if (defined($context)) {
550
677
        $self->{_dblinks}->{$context}=[];
551
678
    } else {
552
679
        $self->{_dblinks} = {};
553
680
    }
554
681
    return @old;
555
 
} # remove_dblinks
556
 
 
 
682
} # remove_dbxrefs
557
683
 
558
684
=head2 get_references
559
685
 
586
712
    return unless @values;
587
713
    # avoid duplicates and undefs
588
714
    foreach my $reference (@values){
589
 
        next unless $reference;
 
715
        $self->throw("Passed data not an Bio::Annotation::Reference") unless ref $reference &&
 
716
            $reference->isa('Bio::AnnotationI');
 
717
        next unless defined $reference;
590
718
        next if grep{$_ eq $reference} @{$self->{_references}};
591
719
        push @{$self->{_references}}, $reference;
592
720
    }
818
946
 
819
947
=cut
820
948
 
 
949
sub each_dblink {shift->throw("use of each_dblink() is deprecated; use get_dbxrefs() instead")} 
 
950
sub add_dblinks {shift->throw("use of add_dblinks() is deprecated; use add_dbxref() instead")}
821
951
*each_synonym = \&get_synonyms;
822
952
*add_synonyms = \&add_synonym;
823
 
*each_dblink = \&get_dblinks;
824
 
*add_dblinks = \&add_dblink;
825
953
 
826
954
1;