Bio/Seq/RichSeq.pm

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