Bio/Seq/RichSeq.pm

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