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