Bio/PrimarySeqI.pm

   1 # $Id$
   2 #
   3 # BioPerl module for Bio::PrimarySeqI
   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::PrimarySeqI - Interface definition for a Bio::PrimarySeq
  18
  19 =head1 SYNOPSIS
  20
  21     # Bio::PrimarySeqI is the interface class for sequences.
  22     # If you are a newcomer to bioperl, you might want to start with
  23     # Bio::Seq documentation.
  24
  25     # Test if this is a seq object
  26     $obj->isa("Bio::PrimarySeqI") ||
  27       $obj->throw("$obj does not implement the Bio::PrimarySeqI interface");
  28
  29     # Accessors
  30     $string    = $obj->seq();
  31     $substring = $obj->subseq(12,50);
  32     $display   = $obj->display_id();       # for human display
  33     $id        = $obj->primary_id();       # unique id for this object,
  34                                            # implementation defined
  35     $unique_key= $obj->accession_number(); # unique biological id
  36
  37
  38     # Object manipulation
  39     eval {
  40            $rev = $obj->revcom();
  41     };
  42     if( $@ ) {
  43            $obj->throw("Could not reverse complement. ".
  44                     "Probably not DNA. Actual exception\n$@\n");
  45     }
  46
  47     $trunc = $obj->trunc(12,50);
  48     # $rev and $trunc are Bio::PrimarySeqI compliant objects
  49
  50
  51 =head1 DESCRIPTION
  52
  53 This object defines an abstract interface to basic sequence
  54 information - for most users of the package the documentation (and
  55 methods) in this class are not useful - this is a developers-only
  56 class which defines what methods have to be implmented by other Perl
  57 objects to comply to the Bio::PrimarySeqI interface. Go "perldoc
  58 Bio::Seq" or "man Bio::Seq" for more information on the main class for
  59 sequences.
  60
  61 PrimarySeq is an object just for the sequence and its name(s), nothing
  62 more. Seq is the larger object complete with features. There is a pure
  63 perl implementation of this in L<Bio::PrimarySeq>. If you just want to
  64 use L<Bio::PrimarySeq> objects, then please read that module first. This
  65 module defines the interface, and is of more interest to people who
  66 want to wrap their own Perl Objects/RDBs/FileSystems etc in way that
  67 they "are" bioperl sequence objects, even though it is not using Perl
  68 to store the sequence etc.
  69
  70 This interface defines what bioperl considers necessary to "be" a
  71 sequence, without providing an implementation of this, an
  72 implementation is provided in L<Bio::PrimarySeq>. If you want to provide
  73 a Bio::PrimarySeq-compliant object which in fact wraps another
  74 object/database/out-of-perl experience, then this is the correct thing
  75 to wrap, generally by providing a wrapper class which would inherit
  76 from your object and this Bio::PrimarySeqI interface. The wrapper class
  77 then would have methods lists in the "Implementation Specific
  78 Functions" which would provide these methods for your object.
  79
  80 =head1 FEEDBACK
  81
  82 =head2 Mailing Lists
  83
  84 User feedback is an integral part of the evolution of this and other
  85 Bioperl modules. Send your comments and suggestions preferably to one
  86 of the Bioperl mailing lists.  Your participation is much appreciated.
  87
  88   bioperl-l@bioperl.org                  - General discussion
  89   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
  90
  91 =head2 Support
  92
  93 Please direct usage questions or support issues to the mailing list:
  94
  95 L<bioperl-l@bioperl.org>
  96
  97 rather than to the module maintainer directly. Many experienced and
  98 reponsive experts will be able look at the problem and quickly
  99 address it. Please include a thorough description of the problem
 100 with code and data examples if at all possible.
 101
 102 =head2 Reporting Bugs
 103
 104 Report bugs to the Bioperl bug tracking system to help us keep track
 105 the bugs and their resolution.  Bug reports can be submitted via the
 106 web:
 107
 108   http://bugzilla.open-bio.org/
 109
 110 =head1 AUTHOR - Ewan Birney
 111
 112 Email birney@ebi.ac.uk
 113
 114 =head1 APPENDIX
 115
 116 The rest of the documentation details each of the object
 117 methods. Internal methods are usually preceded with a _
 118
 119 =cut
 120
 121
 122 # Let the code begin...
 123
 124
 125 package Bio::PrimarySeqI;
 126 use strict;
 127 use Bio::Tools::CodonTable;
 128
 129 use base qw(Bio::Root::RootI);
 130
 131 =head1 Implementation Specific Functions
 132
 133 These functions are the ones that a specific implementation must
 134 define.
 135
 136 =head2 seq
 137
 138  Title   : seq
 139  Usage   : $string = $obj->seq()
 140  Function: Returns the sequence as a string of letters. The
 141            case of the letters is left up to the implementer.
 142            Suggested cases are upper case for proteins and lower case for
 143            DNA sequence (IUPAC standard), but implementations are suggested to
 144            keep an open mind about case (some users... want mixed case!)
 145  Returns : A scalar
 146  Status  : Virtual
 147
 148 =cut
 149
 150 sub seq {
 151    my ($self) = @_;
 152    $self->throw_not_implemented();
 153 }
 154
 155 =head2 subseq
 156
 157  Title   : subseq
 158  Usage   : $substring = $obj->subseq(10,40);
 159  Function: Returns the subseq from start to end, where the first base
 160            is 1 and the number is inclusive, i.e. 1-2 are the first two
 161            bases of the sequence.
 162
 163            Start cannot be larger than end but can be equal.
 164
 165  Returns : A string
 166  Args    :
 167  Status  : Virtual
 168
 169 =cut
 170
 171 sub subseq{
 172    my ($self) = @_;
 173    $self->throw_not_implemented();
 174 }
 175
 176 =head2 display_id
 177
 178  Title   : display_id
 179  Usage   : $id_string = $obj->display_id();
 180  Function: Returns the display id, also known as the common name of the Sequence
 181            object.
 182
 183            The semantics of this is that it is the most likely string
 184            to be used as an identifier of the sequence, and likely to
 185            have "human" readability.  The id is equivalent to the ID
 186            field of the GenBank/EMBL databanks and the id field of the
 187            Swissprot/sptrembl database. In fasta format, the >(\S+) is
 188            presumed to be the id, though some people overload the id
 189            to embed other information. Bioperl does not use any
 190            embedded information in the ID field, and people are
 191            encouraged to use other mechanisms (accession field for
 192            example, or extending the sequence object) to solve this.
 193
 194            Notice that $seq->id() maps to this function, mainly for
 195            legacy/convenience reasons.
 196  Returns : A string
 197  Args    : None
 198  Status  : Virtual
 199
 200
 201 =cut
 202
 203 sub display_id {
 204    my ($self) = @_;
 205    $self->throw_not_implemented();
 206 }
 207
 208
 209 =head2 accession_number
 210
 211  Title   : accession_number
 212  Usage   : $unique_biological_key = $obj->accession_number;
 213  Function: Returns the unique biological id for a sequence, commonly
 214            called the accession_number. For sequences from established
 215            databases, the implementors should try to use the correct
 216            accession number. Notice that primary_id() provides the
 217            unique id for the implemetation, allowing multiple objects
 218            to have the same accession number in a particular implementation.
 219
 220            For sequences with no accession number, this method should return
 221            "unknown".
 222  Returns : A string
 223  Args    : None
 224  Status  : Virtual
 225
 226
 227 =cut
 228
 229 sub accession_number {
 230    my ($self,@args) = @_;
 231    $self->throw_not_implemented();
 232 }
 233
 234
 235
 236 =head2 primary_id
 237
 238  Title   : primary_id
 239  Usage   : $unique_implementation_key = $obj->primary_id;
 240  Function: Returns the unique id for this object in this
 241            implementation. This allows implementations to manage their
 242            own object ids in a way the implementaiton can control
 243            clients can expect one id to map to one object.
 244
 245            For sequences with no accession number, this method should
 246            return a stringified memory location.
 247
 248  Returns : A string
 249  Args    : None
 250  Status  : Virtual
 251
 252
 253 =cut
 254
 255 sub primary_id {
 256    my ($self,@args) = @_;
 257    $self->throw_not_implemented();
 258 }
 259
 260
 261 =head2 can_call_new
 262
 263  Title   : can_call_new
 264  Usage   : if( $obj->can_call_new ) {
 265              $newobj = $obj->new( %param );
 266          }
 267  Function: Can_call_new returns 1 or 0 depending
 268            on whether an implementation allows new
 269            constructor to be called. If a new constructor
 270            is allowed, then it should take the followed hashed
 271            constructor list.
 272
 273            $myobject->new( -seq => $sequence_as_string,
 274                            -display_id  => $id
 275                            -accession_number => $accession
 276                            -alphabet => 'dna',
 277                            );
 278  Returns : 1 or 0
 279  Args    :
 280
 281
 282 =cut
 283
 284 sub can_call_new{
 285    my ($self,@args) = @_;
 286
 287    # we default to 0 here
 288
 289    return 0;
 290 }
 291
 292 =head2 alphabet
 293
 294  Title   : alphabet
 295  Usage   : if( $obj->alphabet eq 'dna' ) { /Do Something/ }
 296  Function: Returns the type of sequence being one of
 297            'dna', 'rna' or 'protein'. This is case sensitive.
 298
 299            This is not called "type" because this would cause
 300            upgrade problems from the 0.5 and earlier Seq objects.
 301
 302  Returns : A string either 'dna','rna','protein'. NB - the object must
 303            make a call of the alphabet, if there is no alphabet specified it
 304            has to guess.
 305  Args    : None
 306  Status  : Virtual
 307
 308
 309 =cut
 310
 311 sub alphabet{
 312     my ( $self ) = @_;
 313     $self->throw_not_implemented();
 314 }
 315
 316 =head2 moltype
 317
 318  Title   : moltype
 319  Usage   : Deprecated. Use alphabet() instead.
 320
 321 =cut
 322
 323 sub moltype{
 324    my ($self,@args) = @_;
 325
 326    $self->warn("moltype: pre v1.0 method. Calling alphabet() instead...");
 327    $self->alphabet(@args);
 328 }
 329
 330
 331 =head1 Optional Implementation Functions
 332
 333 The following functions rely on the above functions. An
 334 implementing class does not need to provide these functions, as they
 335 will be provided by this class, but is free to override these
 336 functions.
 337
 338 The revcom(), trunc(), and translate() methods create new sequence
 339 objects. They will call new() on the class of the sequence object
 340 instance passed as argument, unless can_call_new() returns FALSE. In
 341 the latter case a Bio::PrimarySeq object will be created. Implementors
 342 which really want to control how objects are created (eg, for object
 343 persistence over a database, or objects in a CORBA framework), they
 344 are encouraged to override these methods
 345
 346 =head2 revcom
 347
 348  Title   : revcom
 349  Usage   : $rev = $seq->revcom()
 350  Function: Produces a new Bio::PrimarySeqI implementing object which
 351            is the reversed complement of the sequence. For protein
 352            sequences this throws an exception of "Sequence is a
 353            protein. Cannot revcom".
 354
 355            The id is the same id as the original sequence, and the
 356            accession number is also indentical. If someone wants to
 357            track that this sequence has be reversed, it needs to
 358            define its own extensionsj.
 359
 360            To do an inplace edit of an object you can go:
 361
 362            $seq = $seq->revcom();
 363
 364            This of course, causes Perl to handle the garbage
 365            collection of the old object, but it is roughly speaking as
 366            efficient as an inplace edit.
 367
 368  Returns : A new (fresh) Bio::PrimarySeqI object
 369  Args    : None
 370
 371
 372 =cut
 373
 374 sub revcom{
 375    my ($self) = @_;
 376
 377
 378    # check the type is good first.
 379    my $t = $self->alphabet;
 380
 381    if( $t eq 'protein' ) {
 382        $self->throw("Sequence is a protein. Cannot revcom");
 383    }
 384
 385    if( $t ne 'dna' && $t ne 'rna' ) {
 386        if( $self->can('warn') ) {
 387            $self->warn("Sequence is not dna or rna, but [$t]. ".
 388                        "Attempting to revcom, but unsure if this is right");
 389        } else {
 390            warn("[$self] Sequence is not dna or rna, but [$t]. ".
 391                 "Attempting to revcom, but unsure if this is right");
 392        }
 393    }
 394
 395    # yank out the sequence string
 396
 397    my $str = $self->seq();
 398
 399    # if is RNA - map to DNA then map back
 400
 401    if( $t eq 'rna' ) {
 402        $str =~ tr/uU/tT/;
 403    }
 404
 405    # revcom etc...
 406
 407    $str =~ tr/acgtrymkswhbvdnxACGTRYMKSWHBVDNX/tgcayrkmswdvbhnxTGCAYRKMSWDVBHNX/;
 408    my $revseq = CORE::reverse $str;
 409
 410    if( $t eq 'rna' ) {
 411        $revseq =~ tr/tT/uU/;
 412    }
 413
 414    my $seqclass;
 415    if($self->can_call_new()) {
 416        $seqclass = ref($self);
 417    } else {
 418        $seqclass = 'Bio::PrimarySeq';
 419        $self->_attempt_to_load_Seq();
 420    }
 421    my $out = $seqclass->new( '-seq' => $revseq,
 422                              '-is_circular'  => $self->is_circular,
 423                              '-display_id'  => $self->display_id,
 424                              '-accession_number' => $self->accession_number,
 425                              '-alphabet' => $self->alphabet,
 426                              '-desc' => $self->desc(),
 427                              '-verbose' => $self->verbose
 428                              );
 429    return $out;
 430
 431 }
 432
 433 =head2 trunc
 434
 435  Title   : trunc
 436  Usage   : $subseq = $myseq->trunc(10,100);
 437  Function: Provides a truncation of a sequence.
 438  Returns : A fresh Bio::PrimarySeqI implementing object.
 439  Args    : Two integers denoting first and last base of the sub-sequence.
 440
 441
 442 =cut
 443
 444 sub trunc{
 445    my ($self,$start,$end) = @_;
 446
 447    my $str;
 448    if( defined $start && ref($start) &&
 449        $start->isa('Bio::LocationI') ) {
 450        $str = $self->subseq($start); # start is a location actually
 451    } elsif( !$end ) {
 452        $self->throw("trunc start,end -- there was no end for $start");
 453    } elsif( $end < $start ) {
 454        my $msg = "start [$start] is greater than end [$end]. \n".
 455            "If you want to truncated and reverse complement, \n".
 456                "you must call trunc followed by revcom. Sorry.";
 457        $self->throw($msg);
 458    } else {
 459        $str = $self->subseq($start,$end);
 460    }
 461
 462    my $seqclass;
 463    if($self->can_call_new()) {
 464        $seqclass = ref($self);
 465    } else {
 466        $seqclass = 'Bio::PrimarySeq';
 467        $self->_attempt_to_load_Seq();
 468    }
 469
 470    my $out = $seqclass->new( '-seq' => $str,
 471                              '-display_id'  => $self->display_id,
 472                              '-accession_number' => $self->accession_number,
 473                              '-alphabet' => $self->alphabet,
 474                              '-desc' => $self->desc(),
 475                              '-verbose' => $self->verbose
 476                              );
 477    return $out;
 478 }
 479
 480
 481 =head2 translate
 482
 483  Title   : translate
 484  Usage   : $protein_seq_obj = $dna_seq_obj->translate
 485
 486            Or if you expect a complete coding sequence (CDS) translation,
 487            with inititator at the beginning and terminator at the end:
 488
 489            $protein_seq_obj = $cds_seq_obj->translate(-complete => 1);
 490
 491            Or if you want translate() to find the first initiation
 492            codon and return the corresponding protein:
 493
 494            $protein_seq_obj = $cds_seq_obj->translate(-orf => 1);
 495
 496  Function: Provides the translation of the DNA sequence using full
 497            IUPAC ambiguities in DNA/RNA and amino acid codes.
 498
 499            The complete CDS translation is identical to EMBL/TREMBL
 500            database translation. Note that the trailing terminator
 501            character is removed before returning the translated protein
 502            object.
 503
 504            Note: if you set $dna_seq_obj->verbose(1) you will get a
 505            warning if the first codon is not a valid initiator.
 506
 507  Returns : A Bio::PrimarySeqI implementing object
 508  Args    : -terminator    - character for terminator        default is *
 509            -unknown       - character for unknown           default is X
 510            -frame         - frame                           default is 0
 511            -codontable_id - codon table id                  default is 1
 512            -complete      - complete CDS expected           default is 0
 513            -throw         - throw exception if not complete default is 0
 514            -orf           - find 1st ORF                    default is 0
 515            -start         - alternative initiation codon
 516            -codontable    - Bio::Tools::CodonTable object
 517                    -offset        - offset for fuzzy locations      default is 0
 518
 519  Notes   : The -start argument only applies when -orf is set to 1. By default
 520            all initiation codons found in the given codon table are used
 521            but when "start" is set to some codon this codon will be used
 522            exclusively as the initiation codon. Note that the default codon
 523            table (NCBI "Standard") has 3 initiation codons!
 524
 525            By default translate() translates termination codons to
 526            the some character (default is *), both internal and trailing
 527            codons. Setting "-complete" to 1 tells translate() to remove
 528            the trailing character.
 529
 530                    -offset is used for seqfeatures which contain the the \codon_start
 531                    tag and can be set to 1, 2, or 3.  This is the offset by which the
 532                    sequence translation starts relative to the first base of the
 533                    feature
 534
 535 For details on codon tables used by translate() see L<Bio::Tools::CodonTable>.
 536
 537            Deprecated argument set (v. 1.5.1 and prior versions)
 538            where each argument is an element in an array:
 539
 540            1: character for terminator (optional), defaults to '*'.
 541            2: character for unknown amino acid (optional), defaults to 'X'.
 542            3: frame (optional), valid values are 0, 1, 2, defaults to 0.
 543            4: codon table id (optional), defaults to 1.
 544            5: complete coding sequence expected, defaults to 0 (false).
 545            6: boolean, throw exception if not complete coding sequence
 546               (true), defaults to warning (false)
 547            7: codontable, a custom Bio::Tools::CodonTable object (optional).
 548
 549 =cut
 550
 551 sub translate {
 552          my ($self,@args) = @_;
 553          my ($terminator, $unknown, $frame, $codonTableId, $complete, $throw,
 554                   $codonTable, $orf, $start_codon, $offset);
 555
 556          ## new API with named parameters, post 1.5.1
 557          if ($args[0] && $args[0] =~ /^-[A-Z]+/i) {
 558                  ($terminator, $unknown, $frame, $codonTableId, $complete, $throw,
 559                   $codonTable, $orf, $start_codon, $offset) =
 560                          $self->_rearrange([qw(TERMINATOR
 561                                                                 UNKNOWN
 562                                                                 FRAME
 563                                                                 CODONTABLE_ID
 564                                                                 COMPLETE
 565                                                                 THROW
 566                                                                 CODONTABLE
 567                                                                 ORF
 568                                                                 START
 569                                                                 OFFSET)], @args);
 570          ## old API, 1.5.1 and preceding versions
 571          } else {
 572                  ($terminator, $unknown, $frame, $codonTableId,
 573                   $complete, $throw, $codonTable, $offset) = @args;
 574          }
 575
 576     ## Initialize termination codon, unknown codon, codon table id, frame
 577     $terminator = '*'    unless (defined($terminator) and $terminator ne '');
 578     $unknown = "X"       unless (defined($unknown) and $unknown ne '');
 579     $frame = 0           unless (defined($frame) and $frame ne '');
 580     $codonTableId = 1    unless (defined($codonTableId) and $codonTableId ne '');
 581
 582     ## Get a CodonTable, error if custom CodonTable is invalid
 583     if ($codonTable) {
 584                  $self->throw("Need a Bio::Tools::CodonTable object, not ". $codonTable)
 585                         unless $codonTable->isa('Bio::Tools::CodonTable');
 586     } else {
 587                  $codonTable = Bio::Tools::CodonTable->new( -id => $codonTableId);
 588          }
 589
 590     ## Error if alphabet is "protein"
 591     $self->throw("Can't translate an amino acid sequence.") if
 592                 ($self->alphabet =~ /protein/i);
 593
 594     ## Error if -start parameter isn't a valid codon
 595          if ($start_codon) {
 596                  $self->throw("Invalid start codon: $start_codon.") if
 597                         ( $start_codon !~ /^[A-Z]{3}$/i );
 598          }
 599
 600          my $seq;
 601
 602          if ($offset) {
 603                 $self->throw("Offset must be 1, 2, or 3.") if
 604                     ( $offset !~ /^[123]$/ );
 605                 my ($start, $end) = ($offset, $self->length);
 606                 ($seq) = $self->subseq($start, $end);
 607          } else {
 608                 ($seq) = $self->seq();
 609          }
 610
 611     ## ignore frame if an ORF is supposed to be found
 612          if ($orf) {
 613                  $seq = $self->_find_orf($seq,$codonTable,$start_codon);
 614          } else {
 615          ## use frame, error if frame is not 0, 1 or 2
 616                  $self->throw("Valid values for frame are 0, 1, or 2, not $frame.")
 617                         unless ($frame == 0 or $frame == 1 or $frame == 2);
 618                  $seq = substr($seq,$frame);
 619     }
 620
 621     ## Translate it
 622     my $output = $codonTable->translate($seq);
 623     # Use user-input terminator/unknown
 624     $output =~ s/\*/$terminator/g;
 625     $output =~ s/X/$unknown/g;
 626
 627     ## Only if we are expecting to translate a complete coding region
 628     if ($complete) {
 629                  my $id = $self->display_id;
 630                  # remove the terminator character
 631                  if( substr($output,-1,1) eq $terminator ) {
 632                          chop $output;
 633                  } else {
 634                          $throw && $self->throw("Seq [$id]: Not using a valid terminator codon!");
 635                          $self->warn("Seq [$id]: Not using a valid terminator codon!");
 636                  }
 637                  # test if there are terminator characters inside the protein sequence!
 638                  if ($output =~ /\*/) {
 639                          $throw && $self->throw("Seq [$id]: Terminator codon inside CDS!");
 640                          $self->warn("Seq [$id]: Terminator codon inside CDS!");
 641                  }
 642                  # if the initiator codon is not ATG, the amino acid needs to be changed to M
 643                  if ( substr($output,0,1) ne 'M' ) {
 644                          if ($codonTable->is_start_codon(substr($seq, 0, 3)) ) {
 645                                  $output = 'M'. substr($output,1);
 646                          }      elsif ($throw) {
 647                                  $self->throw("Seq [$id]: Not using a valid initiator codon!");
 648                          } else {
 649                                  $self->warn("Seq [$id]: Not using a valid initiator codon!");
 650                          }
 651                  }
 652     }
 653
 654     my $seqclass;
 655     if ($self->can_call_new()) {
 656                  $seqclass = ref($self);
 657     } else {
 658                  $seqclass = 'Bio::PrimarySeq';
 659                  $self->_attempt_to_load_Seq();
 660     }
 661     my $out = $seqclass->new( '-seq' => $output,
 662                                                                                 '-display_id'  => $self->display_id,
 663                                                                                 '-accession_number' => $self->accession_number,
 664                                                                                 # is there anything wrong with retaining the
 665                                                                                 # description?
 666                                                                                 '-desc' => $self->desc(),
 667                                                                                 '-alphabet' => 'protein',
 668                               '-verbose' => $self->verbose
 669                               );
 670     return $out;
 671 }
 672
 673 =head2 id
 674
 675  Title   : id
 676  Usage   : $id = $seq->id()
 677  Function: ID of the sequence. This should normally be (and actually is in
 678            the implementation provided here) just a synonym for display_id().
 679  Returns : A string.
 680  Args    :
 681
 682 =cut
 683
 684 sub  id {
 685    my ($self)= @_;
 686
 687    return $self->display_id();
 688 }
 689
 690
 691 =head2 length
 692
 693  Title   : length
 694  Usage   : $len = $seq->length()
 695  Function:
 696  Returns : Integer representing the length of the sequence.
 697  Args    :
 698
 699 =cut
 700
 701 sub  length {
 702    my ($self)= @_;
 703    $self->throw_not_implemented();
 704 }
 705
 706 =head2 desc
 707
 708  Title   : desc
 709  Usage   : $seq->desc($newval);
 710            $description = $seq->desc();
 711  Function: Get/set description text for a seq object
 712  Returns : Value of desc
 713  Args    : newvalue (optional)
 714
 715 =cut
 716
 717 sub desc {
 718    shift->throw_not_implemented();
 719 }
 720
 721
 722 =head2 is_circular
 723
 724  Title   : is_circular
 725  Usage   : if( $obj->is_circular) { /Do Something/ }
 726  Function: Returns true if the molecule is circular
 727  Returns : Boolean value
 728  Args    : none
 729
 730 =cut
 731
 732 sub is_circular{
 733     shift->throw_not_implemented;
 734 }
 735
 736 =head1 Private functions
 737
 738 These are some private functions for the PrimarySeqI interface. You do not
 739 need to implement these functions
 740
 741 =head2 _find_orf
 742
 743  Title   : _find_orf
 744  Usage   :
 745  Function: Finds ORF starting at 1st initiation codon in nucleotide sequence.
 746            The ORF is not required to have a termination codon.
 747  Example :
 748  Returns : A nucleotide sequence or nothing, if no initiation codon is found.
 749  Args    : Nucleotide sequence, CodonTable object, alternative initiation
 750            codon (optional).
 751
 752 =cut
 753
 754 sub _find_orf {
 755         my ($self,$sequence,$codonTable,$start_codon) = @_;
 756
 757         # find initiation codon and remove leading sequence
 758         while ($sequence) {
 759                 my $codon = substr($sequence,0,3);
 760                 if ($start_codon) {
 761                         last if ( $codon =~ /$start_codon/i );
 762                 } else {
 763                         last if ($codonTable->is_start_codon($codon));
 764                 }
 765                 $sequence = substr($sequence,1);
 766         }
 767         return unless $sequence;
 768
 769         # find termination codon and remove trailing sequence
 770         my $len = CORE::length($sequence);
 771         my $offset = 3;
 772         while ($offset < $len) {
 773                 my $codon = substr($sequence,$offset,3);
 774                 if ( $codonTable->is_ter_codon($codon) ){
 775                         $sequence = substr($sequence, 0, $offset + 3);
 776                         return $sequence;
 777                 }
 778                 $offset += 3;
 779         }
 780         $self->warn("No termination codon found, will translate - sequence:\n$sequence");
 781         $sequence;
 782 }
 783
 784 =head2 _attempt_to_load_Seq
 785
 786  Title   : _attempt_to_load_Seq
 787  Usage   :
 788  Function:
 789  Example :
 790  Returns :
 791  Args    :
 792
 793
 794 =cut
 795
 796 sub _attempt_to_load_Seq{
 797    my ($self) = @_;
 798
 799    if( $main::{'Bio::PrimarySeq'} ) {
 800        return 1;
 801    } else {
 802        eval {
 803            require Bio::PrimarySeq;
 804        };
 805        if( $@ ) {
 806            my $text = "Bio::PrimarySeq could not be loaded for [$self]\n".
 807                "This indicates that you are using Bio::PrimarySeqI ".
 808                "without Bio::PrimarySeq loaded or without providing a ".
 809                "complete implementation.\nThe most likely problem is that there ".
 810                "has been a misconfiguration of the bioperl environment\n".
 811                "Actual exception:\n\n";
 812            $self->throw("$text$@\n");
 813            return 0;
 814        }
 815        return 1;
 816    }
 817
 818 }
 819
 820 1;