Bio/Seq/RichSeq.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::Seq::RichSeq
   4 #
   5 # Cared for by Ewan Birney <birney@ebi.ac.uk>
   6 #
   7 # Copyright Ewan Birney
   8 #
   9 # You may distribute this module under the same terms as perl itself
  10
  11 # POD documentation - main docs before the code
  12
  13 =head1 NAME
  14
  15 Bio::Seq::RichSeq - Module implementing a sequence created from a rich
  16 sequence database entry
  17
  18 =head1 SYNOPSIS
  19
  20 See L<Bio::Seq::RichSeqI> and documentation of methods.
  21
  22 =head1 DESCRIPTION
  23
  24 This module implements Bio::Seq::RichSeqI, an interface for sequences
  25 created from or created for entries from/of rich sequence databanks,
  26 like EMBL, GenBank, and SwissProt. Methods added to the Bio::SeqI
  27 interface therefore focus on databank-specific information. Note that
  28 not every rich databank format may use all of the properties provided.
  29
  30 =head1 Implemented Interfaces
  31
  32 This class implementes the following interfaces.
  33
  34 =over 4
  35
  36 =item Bio::Seq::RichSeqI
  37
  38 Note that this includes implementing Bio::PrimarySeqI and Bio::SeqI.
  39
  40 =item Bio::IdentifiableI
  41
  42 =item Bio::DescribableI
  43
  44 =item Bio::AnnotatableI
  45
  46 =back
  47
  48 =head1 FEEDBACK
  49
  50 =head2 Mailing Lists
  51
  52 User feedback is an integral part of the evolution of this
  53 and other Bioperl modules. Send your comments and suggestions preferably
  54  to one of the Bioperl mailing lists.
  55 Your participation is much appreciated.
  56
  57   bioperl-l@bioperl.org                  - General discussion
  58   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  59
  60 =head2 Reporting Bugs
  61
  62 Report bugs to the Bioperl bug tracking system to help us keep track
  63 the bugs and their resolution.  Bug reports can be submitted via the
  64 web:
  65
  66   http://bugzilla.open-bio.org/
  67
  68 =head1 AUTHOR - Ewan Birney
  69
  70 Email birney@ebi.ac.uk
  71
  72 =head1 APPENDIX
  73
  74 The rest of the documentation details each of the object
  75 methods. Internal methods are usually preceded with a _
  76
  77 =cut
  78
  79
  80 # Let the code begin...
  81
  82
  83 package Bio::Seq::RichSeq;
  84 use vars qw($AUTOLOAD);
  85 use strict;
  86
  87
  88
  89 use base qw(Bio::Seq Bio::Seq::RichSeqI);
  90
  91
  92 =head2 new
  93
  94  Title   : new
  95  Usage   : $seq    = Bio::Seq::RichSeq->new( -seq => 'ATGGGGGTGGTGGTACCCT',
  96                                              -id  => 'human_id',
  97                                              -accession_number => 'AL000012',
  98                                             );
  99
 100  Function: Returns a new seq object from
 101            basic constructors, being a string for the sequence
 102            and strings for id and accession_number
 103  Returns : a new Bio::Seq::RichSeq object
 104
 105 =cut
 106
 107 sub new {
 108     # standard new call..
 109     my($caller,@args) = @_;
 110     my $self = $caller->SUPER::new(@args);
 111
 112     $self->{'_dates'} = [];
 113     $self->{'_secondary_accession'} = [];
 114
 115     my ($dates, $xtra, $sv,
 116         $keywords, $pid, $mol,
 117         $division ) = $self->_rearrange([qw(DATES
 118                                             SECONDARY_ACCESSIONS
 119                                             SEQ_VERSION
 120                                             KEYWORDS
 121                                             PID
 122                                             MOLECULE
 123                                             DIVISION
 124                                             )],
 125                                         @args);
 126     defined $division && $self->division($division);
 127     defined $mol && $self->molecule($mol);
 128     if(defined($keywords)) {
 129         if(ref($keywords) && (ref($keywords) eq "ARRAY")) {
 130             $self->add_keyword(@$keywords);
 131         } else {
 132             # got a string - use the old API
 133             $self->keywords($keywords);
 134         }
 135     }
 136     defined $sv && $self->seq_version($sv);
 137     defined $pid && $self->pid($pid);
 138
 139     if( defined $dates ) {
 140         if( ref($dates) eq "ARRAY" ) {
 141             foreach ( @$dates) {
 142                 $self->add_date($_);
 143             }
 144         } else {
 145             $self->add_date($dates);
 146         }
 147     }
 148
 149     if( defined $xtra ) {
 150         if( ref($xtra) eq "ARRAY" ) {
 151             foreach ( @$xtra) {
 152                 $self->add_secondary_accession($_);
 153             }
 154         } else {
 155             $self->add_secondary_accession($xtra);
 156         }
 157     }
 158
 159     return $self;
 160 }
 161
 162
 163 =head2 division
 164
 165  Title   : division
 166  Usage   : $obj->division($newval)
 167  Function:
 168  Returns : value of division
 169  Args    : newvalue (optional)
 170
 171
 172 =cut
 173
 174 sub division {
 175    my $obj = shift;
 176    if( @_ ) {
 177       my $value = shift;
 178       $obj->{'_division'} = $value;
 179     }
 180     return $obj->{'_division'};
 181
 182 }
 183
 184 =head2 molecule
 185
 186  Title   : molecule
 187  Usage   : $obj->molecule($newval)
 188  Function:
 189  Returns : type of molecule (DNA, mRNA)
 190  Args    : newvalue (optional)
 191
 192
 193 =cut
 194
 195 sub molecule {
 196    my $obj = shift;
 197    if( @_ ) {
 198       my $value = shift;
 199       $obj->{'_molecule'} = $value;
 200     }
 201     return $obj->{'_molecule'};
 202
 203 }
 204
 205 =head2 add_date
 206
 207  Title   : add_date
 208  Usage   : $self->add_date($datestr)
 209  Function: adds one or more dates
 210
 211            This implementation stores dates as keyed annotation, the
 212            key being 'date_changed'. You can take advantage of this
 213            fact when accessing the annotation collection directly.
 214
 215  Example :
 216  Returns :
 217  Args    : a date string or an array of such strings
 218
 219
 220 =cut
 221
 222 sub add_date {
 223     return shift->_add_annotation_value('date_changed',@_);
 224 }
 225
 226 =head2 get_dates
 227
 228  Title   : get_dates
 229  Usage   : my @dates = $seq->get_dates;
 230  Function: Get the dates of the sequence (usually, when it was created and
 231            changed.
 232  Returns : an array of date strings
 233  Args    :
 234
 235
 236 =cut
 237
 238 sub get_dates{
 239     return shift->_get_annotation_values('date_changed');
 240 }
 241
 242
 243 =head2 pid
 244
 245  Title   : pid
 246  Usage   : my $pid = $seq->pid();
 247  Function: Get (and set, depending on the implementation) the PID property
 248            for the sequence.
 249  Returns : a string
 250  Args    :
 251
 252
 253 =cut
 254
 255 sub pid{
 256     my $self = shift;
 257
 258     return $self->{'_pid'} = shift if @_;
 259     return $self->{'_pid'};
 260 }
 261
 262
 263 =head2 accession
 264
 265  Title   : accession
 266  Usage   : $obj->accession($newval)
 267  Function: Whilst the underlying sequence object does not
 268            have an accession, so we need one here.
 269
 270            In this implementation this is merely a synonym for
 271            accession_number().
 272  Example :
 273  Returns : value of accession
 274  Args    : newvalue (optional)
 275
 276
 277 =cut
 278
 279 sub accession {
 280    my ($obj,@args) = @_;
 281    return $obj->accession_number(@args);
 282 }
 283
 284 =head2 add_secondary_accession
 285
 286  Title   : add_secondary_accession
 287  Usage   : $self->add_domment($ref)
 288  Function: adds a secondary_accession
 289
 290            This implementation stores secondary accession numbers as
 291            keyed annotation, the key being 'secondary_accession'. You
 292            can take advantage of this fact when accessing the
 293            annotation collection directly.
 294
 295  Example :
 296  Returns :
 297  Args    : a string or an array of strings
 298
 299
 300 =cut
 301
 302 sub add_secondary_accession {
 303     return shift->_add_annotation_value('secondary_accession',@_);
 304 }
 305
 306 =head2 get_secondary_accessions
 307
 308  Title   : get_secondary_accessions
 309  Usage   : my @acc = $seq->get_secondary_accessions();
 310  Function: Get the secondary accession numbers as strings.
 311  Returns : An array of strings
 312  Args    : none
 313
 314
 315 =cut
 316
 317 sub get_secondary_accessions{
 318     return shift->_get_annotation_values('secondary_accession');
 319 }
 320
 321 =head2 seq_version
 322
 323  Title   : seq_version
 324  Usage   : $obj->seq_version($newval)
 325  Function: Get/set the sequence version
 326  Returns : value of seq_version (a scalar)
 327  Args    : on set, new value (a scalar or undef, optional)
 328
 329
 330 =cut
 331
 332 sub seq_version{
 333     my $self = shift;
 334
 335     return $self->{'_seq_version'} = shift if @_;
 336     return $self->{'_seq_version'};
 337 }
 338
 339
 340 =head2 add_keyword
 341
 342  Title   : add_keyword
 343  Usage   : $obj->add_keyword($newval)
 344  Function: Add a new keyword to the annotation of the sequence.
 345
 346            This implementation stores keywords as keyed annotation,
 347            the key being 'keyword'. You can take advantage of this
 348            fact when accessing the annotation collection directly.
 349
 350  Returns :
 351  Args    : value to be added (optional) (a string)
 352
 353
 354 =cut
 355
 356 sub add_keyword {
 357     return shift->_add_annotation_value('keyword',@_);
 358 }
 359
 360 =head2 get_keywords
 361
 362  Title   : get_keywords
 363  Usage   : $obj->get_keywords($newval)
 364  Function: Get the keywords for this sequence as an array of strings.
 365  Returns : an array of strings
 366  Args    :
 367
 368
 369 =cut
 370
 371 sub get_keywords {
 372     return shift->_get_annotation_values('keyword');
 373 }
 374
 375 =head1 Private methods and synonyms for backward compatibility
 376
 377 =cut
 378
 379 =head2 _add_annotation_value
 380
 381  Title   : _add_annotation_value
 382  Usage   :
 383  Function: Adds a value to the annotation collection under the specified
 384            key. Note that this is not a public method.
 385  Returns :
 386  Args    : key (a string), value(s) (one or more scalars)
 387
 388
 389 =cut
 390
 391 sub _add_annotation_value{
 392     my $self = shift;
 393     my $key  = shift;
 394
 395     foreach my $val (@_) {
 396         $self->annotation->add_Annotation(
 397                         Bio::Annotation::SimpleValue->new(-tagname => $key,
 398                                                           -value => $val)
 399                                           );
 400     }
 401 }
 402
 403 =head2 _get_annotation_values
 404
 405  Title   : _get_annotation_values
 406  Usage   :
 407  Function: Gets the values of a specific annotation as identified by the
 408            key from the annotation collection. Note that this is not a
 409            public method.
 410  Example :
 411  Returns : an array of strings
 412  Args    : the key (a string)
 413
 414
 415 =cut
 416
 417 sub _get_annotation_values{
 418     my $self = shift;
 419
 420     return map { $_->value(); } $self->annotation->get_Annotations(shift);
 421 }
 422
 423 #
 424 ##
 425 ### Deprecated methods kept for ease of transition
 426 ##
 427 #
 428
 429 sub keywords {
 430     my $self = shift;
 431
 432     # have we been called in set mode?
 433     if(@_) {
 434         # yes; translate to the new API
 435         foreach my $kwd (@_) {
 436             $self->add_keyword(split(/\s*;\s*/,$kwd));
 437         }
 438     } else {
 439         # no; translate read-only to the new API
 440         return join("; ",$self->get_keywords());
 441     }
 442 }
 443
 444 sub each_date {
 445    my ($self) = @_;
 446    $self->warn("Deprecated method... please use get_dates");
 447    return $self->get_dates;
 448 }
 449
 450
 451 sub each_secondary_accession {
 452    my ($self) = @_;
 453    $self->warn("each_secondary_accession - deprecated method. use get_secondary_accessions");
 454    return $self->get_secondary_accessions;
 455
 456 }
 457
 458 sub sv {
 459    my ($obj,$value) = @_;
 460    $obj->warn("sv - deprecated method. use seq_version");
 461    $obj->seq_version($value);
 462 }
 463
 464
 465 1;