~ubuntu-branches/ubuntu/edgy/bioperl/edgy

« back to all changes in this revision

Viewing changes to Bio/PrimarySeqI.pm

  • Committer: Bazaar Package Importer
  • Author(s): Matt Hope
  • Date: 2002-03-20 01:16:30 UTC
  • Revision ID: james.westby@ubuntu.com-20020320011630-wyvmxwc7o5bi4665
Tags: upstream-1.0
ImportĀ upstreamĀ versionĀ 1.0

Show diffs side-by-side

added added

removed removed

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