lib/Bio/SeqIO.pm

   1 # BioPerl module for Bio::SeqIO
   2 #
   3 # Please direct questions and support issues to <bioperl-l@bioperl.org>
   4 #
   5 # Cared for by Ewan Birney <birney@ebi.ac.uk>
   6 #       and Lincoln Stein  <lstein@cshl.org>
   7 #
   8 # Copyright Ewan Birney
   9 #
  10 # You may distribute this module under the same terms as perl itself
  11 #
  12 # _history
  13 # October 18, 1999  Largely rewritten by Lincoln Stein
  14
  15 # POD documentation - main docs before the code
  16
  17 =head1 NAME
  18
  19 Bio::SeqIO - Handler for SeqIO Formats
  20
  21 =head1 SYNOPSIS
  22
  23     use Bio::SeqIO;
  24
  25     $in  = Bio::SeqIO->new(-file => "inputfilename" ,
  26                            -format => 'Fasta');
  27     $out = Bio::SeqIO->new(-file => ">outputfilename" ,
  28                            -format => 'EMBL');
  29
  30     while ( my $seq = $in->next_seq() ) {
  31         $out->write_seq($seq);
  32     }
  33
  34   # Now, to actually get at the sequence object, use the standard Bio::Seq
  35   # methods (look at Bio::Seq if you don't know what they are)
  36
  37     use Bio::SeqIO;
  38
  39     $in  = Bio::SeqIO->new(-file => "inputfilename" ,
  40                            -format => 'genbank');
  41
  42     while ( my $seq = $in->next_seq() ) {
  43        print "Sequence ",$seq->id, " first 10 bases ",
  44              $seq->subseq(1,10), "\n";
  45     }
  46
  47
  48   # The SeqIO system does have a filehandle binding. Most people find this
  49   # a little confusing, but it does mean you can write the world's
  50   # smallest reformatter
  51
  52     use Bio::SeqIO;
  53
  54     $in  = Bio::SeqIO->newFh(-file => "inputfilename" ,
  55                              -format => 'Fasta');
  56     $out = Bio::SeqIO->newFh(-format => 'EMBL');
  57
  58     # World's shortest Fasta<->EMBL format converter:
  59     print $out $_ while <$in>;
  60
  61
  62 =head1 DESCRIPTION
  63
  64 Bio::SeqIO is a handler module for the formats in the SeqIO set (eg,
  65 Bio::SeqIO::fasta). It is the officially sanctioned way of getting at
  66 the format objects, which most people should use.
  67
  68 The Bio::SeqIO system can be thought of like biological file handles.
  69 They are attached to filehandles with smart formatting rules (eg,
  70 genbank format, or EMBL format, or binary trace file format) and
  71 can either read or write sequence objects (Bio::Seq objects, or
  72 more correctly, Bio::SeqI implementing objects, of which Bio::Seq is
  73 one such object). If you want to know what to do with a Bio::Seq
  74 object, read L<Bio::Seq>.
  75
  76 The idea is that you request a stream object for a particular format.
  77 All the stream objects have a notion of an internal file that is read
  78 from or written to. A particular SeqIO object instance is configured
  79 for either input or output. A specific example of a stream object is
  80 the Bio::SeqIO::fasta object.
  81
  82 Each stream object has functions
  83
  84    $stream->next_seq();
  85
  86 and
  87
  88    $stream->write_seq($seq);
  89
  90 As an added bonus, you can recover a filehandle that is tied to the
  91 SeqIO object, allowing you to use the standard E<lt>E<gt> and print
  92 operations to read and write sequence objects:
  93
  94     use Bio::SeqIO;
  95
  96     $stream = Bio::SeqIO->newFh(-format => 'Fasta',
  97                                 -fh     => \*ARGV);
  98     # read from standard input or the input filenames
  99
 100     while ( $seq = <$stream> ) {
 101         # do something with $seq
 102     }
 103
 104 and
 105
 106     print $stream $seq; # when stream is in output mode
 107
 108 This makes the simplest ever reformatter
 109
 110     #!/usr/bin/perl
 111     use strict;
 112     my $format1 = shift;
 113     my $format2 = shift || die
 114        "Usage: reformat format1 format2 < input > output";
 115
 116     use Bio::SeqIO;
 117
 118     my $in  = Bio::SeqIO->newFh(-format => $format1, -fh => \*ARGV );
 119     my $out = Bio::SeqIO->newFh(-format => $format2 );
 120     # Note: you might want to quote -format to keep older
 121     # perl's from complaining.
 122
 123     print $out $_ while <$in>;
 124
 125
 126 =head1 CONSTRUCTORS
 127
 128 =head2 Bio::SeqIO-E<gt>new()
 129
 130    $seqIO = Bio::SeqIO->new(-file   => 'seqs.fasta', -format => $format);
 131    $seqIO = Bio::SeqIO->new(-fh     => \*FILEHANDLE, -format => $format);
 132    $seqIO = Bio::SeqIO->new(-string => $string     , -format => $format);
 133    $seqIO = Bio::SeqIO->new(-format => $format);
 134
 135 The new() class method constructs a new Bio::SeqIO object. The returned object
 136 can be used to retrieve or print Seq objects. new() accepts the following
 137 parameters:
 138
 139 =over 5
 140
 141 =item -file
 142
 143 A file path to be opened for reading or writing.  The usual Perl
 144 conventions apply:
 145
 146    'file'       # open file for reading
 147    '>file'      # open file for writing
 148    '>>file'     # open file for appending
 149    '+<file'     # open file read/write
 150
 151 To read from or write to a piped command, open a filehandle and use the -fh
 152 option.
 153
 154 =item -fh
 155
 156 You may use new() with a opened filehandle, provided as a glob reference. For
 157 example, to read from STDIN:
 158
 159    my $seqIO = Bio::SeqIO->new(-fh => \*STDIN);
 160
 161 A string filehandle is handy if you want to modify the output in the
 162 memory, before printing it out. The following program reads in EMBL
 163 formatted entries from a file and prints them out in fasta format with
 164 some HTML tags:
 165
 166   use Bio::SeqIO;
 167   use IO::String;
 168   my $in = Bio::SeqIO->new(-file => "emblfile",
 169                            -format => 'EMBL');
 170   while ( my $seq = $in->next_seq() ) {
 171       # the output handle is reset for every file
 172       my $stringio = IO::String->new($string);
 173       my $out = Bio::SeqIO->new(-fh => $stringio,
 174                                 -format => 'fasta');
 175       # output goes into $string
 176       $out->write_seq($seq);
 177       # modify $string
 178       $string =~ s|(>)(\w+)|$1<font color="Red">$2</font>|g;
 179       # print into STDOUT
 180       print $string;
 181   }
 182
 183 Filehandles can also be used to read from or write to a piped command:
 184
 185   use Bio::SeqIO;
 186   #convert .fastq.gz to .fasta
 187   open my $zcat, 'zcat seq.fastq.gz |' or die $!;
 188   my $in=Bio::SeqIO->new(-fh=>$zcat,
 189                          -format=>'fastq');
 190   my $out=Bio::SeqIO->new(-file=>'>seq.fasta',
 191                           -format=>'fasta');
 192   while (my $seq=$in->next_seq) {
 193       $out->write_seq($seq)
 194   }
 195
 196 =item -string
 197
 198 A string to read the sequences from. For example:
 199
 200    my $string = ">seq1\nACGCTAGCTAGC\n";
 201    my $seqIO = Bio::SeqIO->new(-string => $string);
 202
 203 =item -format
 204
 205 Specify the format of the file.  Supported formats include fasta,
 206 genbank, embl, swiss (SwissProt), Entrez Gene and tracefile formats
 207 such as abi (ABI) and scf. There are many more, for a complete listing
 208 see the SeqIO HOWTO (L<http://bioperl.org/howtos/SeqIO_HOWTO.html>).
 209
 210 If no format is specified and a filename is given then the module will
 211 attempt to deduce the format from the filename suffix. If there is no
 212 suffix that Bioperl understands then it will attempt to guess the
 213 format based on file content. If this is unsuccessful then SeqIO will
 214 throw a fatal error.
 215
 216 The format name is case-insensitive: 'FASTA', 'Fasta' and 'fasta' are
 217 all valid.
 218
 219 =item -alphabet
 220
 221 Sets the alphabet ('dna', 'rna', or 'protein'). When the alphabet is
 222 set then Bioperl will not attempt to guess what the alphabet is. This
 223 may be important because Bioperl does not always guess correctly.
 224
 225 =item -flush
 226
 227 By default, all files (or filehandles) opened for writing sequences
 228 will be flushed after each write_seq() (making the file immediately
 229 usable).  If you do not need this facility and would like to marginally
 230 improve the efficiency of writing multiple sequences to the same file
 231 (or filehandle), pass the -flush option '0' or any other value that
 232 evaluates as defined but false:
 233
 234   my $gb = Bio::SeqIO->new(-file   => "<gball.gbk",
 235                            -format => "gb");
 236   my $fa = Bio::SeqIO->new(-file   => ">gball.fa",
 237                            -format => "fasta",
 238                            -flush  => 0); # go as fast as we can!
 239   while($seq = $gb->next_seq) { $fa->write_seq($seq) }
 240
 241 =item -seqfactory
 242
 243 Provide a Bio::Factory::SequenceFactoryI object. See the sequence_factory() method.
 244
 245 =item -locfactory
 246
 247 Provide a Bio::Factory::LocationFactoryI object. See the location_factory() method.
 248
 249 =item -objbuilder
 250
 251 Provide a Bio::Factory::ObjectBuilderI object. See the object_builder() method.
 252
 253 =back
 254
 255 =head2 Bio::SeqIO-E<gt>newFh()
 256
 257    $fh = Bio::SeqIO->newFh(-fh => \*FILEHANDLE, -format=>$format);
 258    $fh = Bio::SeqIO->newFh(-format => $format);
 259    # etc.
 260
 261 This constructor behaves like new(), but returns a tied filehandle
 262 rather than a Bio::SeqIO object.  You can read sequences from this
 263 object using the familiar E<lt>E<gt> operator, and write to it using
 264 print().  The usual array and $_ semantics work.  For example, you can
 265 read all sequence objects into an array like this:
 266
 267   @sequences = <$fh>;
 268
 269 Other operations, such as read(), sysread(), write(), close(), and
 270 printf() are not supported.
 271
 272 =head1 OBJECT METHODS
 273
 274 See below for more detailed summaries.  The main methods are:
 275
 276 =head2 $sequence = $seqIO-E<gt>next_seq()
 277
 278 Fetch the next sequence from the stream, or nothing if no more.
 279
 280 =head2 $seqIO-E<gt>write_seq($sequence [,$another_sequence,...])
 281
 282 Write the specified sequence(s) to the stream.
 283
 284 =head2 TIEHANDLE(), READLINE(), PRINT()
 285
 286 These provide the tie interface.  See L<perltie> for more details.
 287
 288 =head1 FEEDBACK
 289
 290 =head2 Mailing Lists
 291
 292 User feedback is an integral part of the evolution of this and other
 293 Bioperl modules. Send your comments and suggestions preferably to one
 294 of the Bioperl mailing lists.
 295
 296 Your participation is much appreciated.
 297
 298   bioperl-l@bioperl.org                  - General discussion
 299   http://bioperl.org/wiki/Mailing_lists  - About the mailing lists
 300
 301 =head2 Support
 302
 303 Please direct usage questions or support issues to the mailing list:
 304
 305  bioperl-l@bioperl.org
 306
 307 rather than to the module maintainer directly. Many experienced and
 308 responsive experts will be able look at the problem and quickly
 309 address it. Please include a thorough description of the problem
 310 with code and data examples if at all possible.
 311
 312 =head2 Reporting Bugs
 313
 314 Report bugs to the Bioperl bug tracking system to help us keep track
 315 the bugs and their resolution.  Bug reports can be submitted via the
 316 web:
 317
 318   https://github.com/bioperl/bioperl-live/issues
 319
 320 =head1 AUTHOR - Ewan Birney, Lincoln Stein
 321
 322 Email birney@ebi.ac.uk
 323       lstein@cshl.org
 324
 325 =head1 APPENDIX
 326
 327 The rest of the documentation details each of the object
 328 methods. Internal methods are usually preceded with a _
 329
 330 =cut
 331
 332 #' Let the code begin...
 333
 334 package Bio::SeqIO;
 335
 336 use strict;
 337 use warnings;
 338
 339 use Bio::Factory::FTLocationFactory;
 340 use Bio::Seq::SeqBuilder;
 341 use Bio::Tools::GuessSeqFormat;
 342 use Symbol;
 343
 344 use parent qw(Bio::Root::Root Bio::Root::IO Bio::Factory::SequenceStreamI);
 345
 346 my %valid_alphabet_cache;
 347
 348
 349 =head2 new
 350
 351  Title   : new
 352  Usage   : $stream = Bio::SeqIO->new(-file => 'sequences.fasta',
 353                                      -format => 'fasta');
 354  Function: Returns a new sequence stream
 355  Returns : A Bio::SeqIO stream initialised with the appropriate format
 356  Args    : Named parameters indicating where to read the sequences from or to
 357            write them to:
 358              -file   => filename, OR
 359              -fh     => filehandle to attach to, OR
 360              -string => string
 361
 362            Additional arguments, all with reasonable defaults:
 363              -format     => format of the sequences, usually auto-detected
 364              -alphabet   => 'dna', 'rna', or 'protein'
 365              -flush      => 0 or 1 (default: flush filehandles after each write)
 366              -seqfactory => sequence factory
 367              -locfactory => location factory
 368              -objbuilder => object builder
 369
 370 See L<Bio::SeqIO::Handler>
 371
 372 =cut
 373
 374 my $entry = 0;
 375
 376 sub new {
 377     my ($caller, @args) = @_;
 378     my $class = ref($caller) || $caller;
 379
 380     # or do we want to call SUPER on an object if $caller is an
 381     # object?
 382     if( $class =~ /Bio::SeqIO::(\S+)/ ) {
 383         my ($self) = $class->SUPER::new(@args);
 384         $self->_initialize(@args);
 385         return $self;
 386     } else {
 387         my %params = @args;
 388         @params{ map { lc $_ } keys %params } = values %params; # lowercase keys
 389
 390         unless( defined $params{-file} ||
 391                 defined $params{-fh}   ||
 392                 defined $params{-string} ) {
 393             $class->throw("file argument provided, but with an undefined value")
 394                 if exists $params{'-file'};
 395             $class->throw("fh argument provided, but with an undefined value")
 396                 if exists $params{'-fh'};
 397             $class->throw("string argument provided, but with an undefined value")
 398                 if exists($params{'-string'});
 399             # $class->throw("No file, fh, or string argument provided"); # neither defined
 400         }
 401
 402         # Determine or guess sequence format and variant
 403         my $format = $params{'-format'};
 404         if (! $format ) {
 405             if ($params{-file}) {
 406                 # Guess from filename extension, and then from file content
 407                 $format = $class->_guess_format( $params{-file} ) ||
 408                           Bio::Tools::GuessSeqFormat->new(-file => $params{-file}  )->guess;
 409             } elsif ($params{-fh}) {
 410                 # Guess from filehandle content
 411                 $format = Bio::Tools::GuessSeqFormat->new(-fh   => $params{-fh}    )->guess;
 412             } elsif ($params{-string}) {
 413                 # Guess from string content
 414                 $format = Bio::Tools::GuessSeqFormat->new(-text => $params{-string})->guess;
 415             }
 416         }
 417
 418         # changed 1-3-11; no need to print out an empty string (only way this
 419         # exception is triggered) - cjfields
 420         $class->throw("Could not guess format from file, filehandle or string")
 421             if not $format;
 422         $format = "\L$format";  # normalize capitalization to lower case
 423
 424         if ($format =~ /-/) {
 425             ($format, my $variant) = split('-', $format, 2);
 426             $params{-variant} = $variant;
 427         }
 428
 429         return unless( $class->_load_format_module($format) );
 430         return "Bio::SeqIO::$format"->new(%params);
 431     }
 432 }
 433
 434
 435 =head2 newFh
 436
 437  Title   : newFh
 438  Usage   : $fh = Bio::SeqIO->newFh(-file=>$filename,-format=>'Format')
 439  Function: Does a new() followed by an fh()
 440  Example : $fh = Bio::SeqIO->newFh(-file=>$filename,-format=>'Format')
 441            $sequence = <$fh>;   # read a sequence object
 442            print $fh $sequence; # write a sequence object
 443  Returns : filehandle tied to the Bio::SeqIO::Fh class
 444  Args    :
 445
 446 See L<Bio::SeqIO::Fh>
 447
 448 =cut
 449
 450 sub newFh {
 451     my $class = shift;
 452     return unless my $self = $class->new(@_);
 453     return $self->fh;
 454 }
 455
 456
 457 =head2 fh
 458
 459  Title   : fh
 460  Usage   : $obj->fh
 461  Function: Get or set the IO filehandle
 462  Example : $fh = $obj->fh;      # make a tied filehandle
 463            $sequence = <$fh>;   # read a sequence object
 464            print $fh $sequence; # write a sequence object
 465  Returns : filehandle tied to Bio::SeqIO class
 466  Args    : none
 467
 468 =cut
 469
 470 sub fh {
 471     my $self = shift;
 472     my $class = ref($self) || $self;
 473     my $s = Symbol::gensym;
 474     tie $$s,$class,$self;
 475     return $s;
 476 }
 477
 478
 479 # _initialize is chained for all SeqIO classes
 480
 481 sub _initialize {
 482     my($self, @args) = @_;
 483
 484     # flush is initialized by the Root::IO init
 485
 486     my ($seqfact,$locfact,$objbuilder, $alphabet) =
 487         $self->_rearrange([qw(SEQFACTORY
 488                               LOCFACTORY
 489                               OBJBUILDER
 490                               ALPHABET)
 491                                          ], @args);
 492
 493     $locfact = Bio::Factory::FTLocationFactory->new(-verbose => $self->verbose)
 494         if ! $locfact;
 495     $objbuilder = Bio::Seq::SeqBuilder->new(-verbose => $self->verbose)
 496         unless $objbuilder;
 497     $self->sequence_builder($objbuilder);
 498     $self->location_factory($locfact);
 499
 500     # note that this should come last because it propagates the sequence
 501     # factory to the sequence builder
 502     $seqfact && $self->sequence_factory($seqfact);
 503
 504     #bug 2160
 505     $alphabet && $self->alphabet($alphabet);
 506
 507     # initialize the IO part
 508     $self->_initialize_io(@args);
 509 }
 510
 511
 512 =head2 next_seq
 513
 514  Title   : next_seq
 515  Usage   : $seq = stream->next_seq
 516  Function: Reads the next sequence object from the stream and returns it.
 517
 518            Certain driver modules may encounter entries in the stream
 519            that are either misformatted or that use syntax not yet
 520            understood by the driver. If such an incident is
 521            recoverable, e.g., by dismissing a feature of a feature
 522            table or some other non-mandatory part of an entry, the
 523            driver will issue a warning. In the case of a
 524            non-recoverable situation an exception will be thrown.  Do
 525            not assume that you can resume parsing the same stream
 526            after catching the exception. Note that you can always turn
 527            recoverable errors into exceptions by calling
 528            $stream->verbose(2).
 529
 530  Returns : a Bio::Seq sequence object, or nothing if no more sequences
 531            are available
 532
 533  Args    : none
 534
 535 See L<Bio::Root::RootI>, L<Bio::Factory::SeqStreamI>, L<Bio::Seq>
 536
 537 =cut
 538
 539 sub next_seq {
 540    my ($self, $seq) = @_;
 541    $self->throw("Sorry, you cannot read from a generic Bio::SeqIO object.");
 542 }
 543
 544
 545 =head2 write_seq
 546
 547  Title   : write_seq
 548  Usage   : $stream->write_seq($seq)
 549  Function: writes the $seq object into the stream
 550  Returns : 1 for success and 0 for error
 551  Args    : Bio::Seq object
 552
 553 =cut
 554
 555 sub write_seq {
 556     my ($self, $seq) = @_;
 557     $self->throw("Sorry, you cannot write to a generic Bio::SeqIO object.");
 558 }
 559
 560
 561 =head2 format
 562
 563  Title   : format
 564  Usage   : $format = $stream->format()
 565  Function: Get the sequence format
 566  Returns : sequence format, e.g. fasta, fastq
 567  Args    : none
 568
 569 =cut
 570
 571 # format() method inherited from Bio::Root::IO
 572
 573
 574 =head2 alphabet
 575
 576  Title   : alphabet
 577  Usage   : $self->alphabet($newval)
 578  Function: Set/get the molecule type for the Seq objects to be created.
 579  Example : $seqio->alphabet('protein')
 580  Returns : value of alphabet: 'dna', 'rna', or 'protein'
 581  Args    : newvalue (optional)
 582  Throws  : Exception if the argument is not one of 'dna', 'rna', or 'protein'
 583
 584 =cut
 585
 586 sub alphabet {
 587    my ($self, $value) = @_;
 588
 589    if ( defined $value) {
 590         $value = lc $value;
 591         unless ($valid_alphabet_cache{$value}) {
 592             # instead of hard-coding the allowed values once more, we check by
 593             # creating a dummy sequence object
 594             eval {
 595                 require Bio::PrimarySeq;
 596                 my $seq = Bio::PrimarySeq->new( -verbose  => $self->verbose,
 597                                                 -alphabet => $value          );
 598             };
 599             if ($@) {
 600                 $self->throw("Invalid alphabet: $value\n. See Bio::PrimarySeq for allowed values.");
 601             }
 602             $valid_alphabet_cache{$value} = 1;
 603         }
 604         $self->{'alphabet'} = $value;
 605    }
 606    return $self->{'alphabet'};
 607 }
 608
 609
 610 =head2 _load_format_module
 611
 612  Title   : _load_format_module
 613  Usage   : *INTERNAL SeqIO stuff*
 614  Function: Loads up (like use) a module at run time on demand
 615  Example :
 616  Returns :
 617  Args    :
 618
 619 =cut
 620
 621 sub _load_format_module {
 622     my ($self, $format) = @_;
 623     my $module = "Bio::SeqIO::" . $format;
 624     my $ok;
 625
 626     eval {
 627         $ok = $self->_load_module($module);
 628     };
 629     if ( $@ ) {
 630         print STDERR <<END;
 631 $self: $format cannot be found
 632 Exception $@
 633 For more information about the SeqIO system please see the SeqIO docs.
 634 This includes ways of checking for formats at compile time, not run time
 635 END
 636         ;
 637     }
 638     return $ok;
 639 }
 640
 641
 642 =head2 _concatenate_lines
 643
 644  Title   : _concatenate_lines
 645  Usage   : $s = _concatenate_lines($line, $continuation_line)
 646  Function: Private. Concatenates two strings assuming that the second stems
 647            from a continuation line of the first. Adds a space between both
 648            unless the first ends with a dash.
 649
 650            Takes care of either arg being empty.
 651  Example :
 652  Returns : A string.
 653  Args    :
 654
 655 =cut
 656
 657 sub _concatenate_lines {
 658     my ($self, $s1, $s2) = @_;
 659     $s1 .= " " if($s1 && ($s1 !~ /-$/) && $s2);
 660     return ($s1 ? $s1 : "") . ($s2 ? $s2 : "");
 661 }
 662
 663
 664 =head2 _filehandle
 665
 666  Title   : _filehandle
 667  Usage   : $obj->_filehandle($newval)
 668  Function: This method is deprecated. Call _fh() instead.
 669  Example :
 670  Returns : value of _filehandle
 671  Args    : newvalue (optional)
 672
 673 =cut
 674
 675 sub _filehandle {
 676     my ($self,@args) = @_;
 677     return $self->_fh(@args);
 678 }
 679
 680
 681 =head2 _guess_format
 682
 683  Title   : _guess_format
 684  Usage   : $obj->_guess_format($filename)
 685  Function: guess format based on file suffix
 686  Example :
 687  Returns : guessed format of filename (lower case)
 688  Args    :
 689  Notes   : formats that _filehandle() will guess include fasta,
 690            genbank, scf, pir, embl, raw, gcg, ace, bsml, swissprot,
 691            fastq and phd/phred
 692
 693 =cut
 694
 695 sub _guess_format {
 696    my $class = shift;
 697    return unless $_ = shift;
 698
 699    return 'abi'        if /\.ab[i1]$/i;
 700    return 'ace'        if /\.ace$/i;
 701    return 'alf'        if /\.alf$/i;
 702    return 'bsml'       if /\.(bsm|bsml)$/i;
 703    return 'ctf'        if /\.ctf$/i;
 704    return 'embl'       if /\.(embl|ebl|emb|dat)$/i;
 705    return 'entrezgene' if /\.asn$/i;
 706    return 'exp'        if /\.exp$/i;
 707    return 'fasta'      if /\.(fasta|fast|fas|seq|fa|fsa|nt|aa|fna|faa)$/i;
 708    return 'fastq'      if /\.fastq$/i;
 709    return 'gcg'        if /\.gcg$/i;
 710    return 'genbank'    if /\.(gb|gbank|genbank|gbk|gbs)$/i;
 711    return 'phd'        if /\.(phd|phred)$/i;
 712    return 'pir'        if /\.pir$/i;
 713    return 'pln'        if /\.pln$/i;
 714    return 'qual'       if /\.qual$/i;
 715    return 'raw'        if /\.txt$/i;
 716    return 'scf'        if /\.scf$/i;
 717    # from Strider 1.4 Release Notes: The file name extensions used by
 718    # Strider 1.4 are ".xdna", ".xdgn", ".xrna" and ".xprt" for DNA,
 719    # DNA Degenerate, RNA and Protein Sequence Files, respectively
 720    return 'strider'    if /\.(xdna|xdgn|xrna|xprt)$/i;
 721    return 'swiss'      if /\.(swiss|sp)$/i;
 722    return 'ztr'        if /\.ztr$/i;
 723 }
 724
 725
 726 sub DESTROY {
 727     my $self = shift;
 728     $self->close();
 729 }
 730
 731
 732 sub TIEHANDLE {
 733     my ($class,$val) = @_;
 734     return bless {'seqio' => $val}, $class;
 735 }
 736
 737
 738 sub READLINE {
 739     my $self = shift;
 740     return $self->{'seqio'}->next_seq() || undef unless wantarray;
 741     my (@list, $obj);
 742     push @list, $obj while $obj = $self->{'seqio'}->next_seq();
 743     return @list;
 744 }
 745
 746
 747 sub PRINT {
 748     my $self = shift;
 749     $self->{'seqio'}->write_seq(@_);
 750 }
 751
 752
 753 =head2 sequence_factory
 754
 755  Title   : sequence_factory
 756  Usage   : $seqio->sequence_factory($seqfactory)
 757  Function: Get/Set the Bio::Factory::SequenceFactoryI
 758  Returns : Bio::Factory::SequenceFactoryI
 759  Args    : [optional] Bio::Factory::SequenceFactoryI
 760
 761 =cut
 762
 763 sub sequence_factory {
 764    my ($self, $obj) = @_;
 765    if( defined $obj ) {
 766         if( ! ref($obj) || ! $obj->isa('Bio::Factory::SequenceFactoryI') ) {
 767             $self->throw("Must provide a valid Bio::Factory::SequenceFactoryI object to ".ref($self)."::sequence_factory()");
 768         }
 769         $self->{'_seqio_seqfactory'} = $obj;
 770         my $builder = $self->sequence_builder();
 771         if($builder && $builder->can('sequence_factory') &&
 772             (! $builder->sequence_factory())) {
 773             $builder->sequence_factory($obj);
 774         }
 775    }
 776    $self->{'_seqio_seqfactory'};
 777 }
 778
 779
 780 =head2 object_factory
 781
 782  Title   : object_factory
 783  Usage   : $obj->object_factory($newval)
 784  Function: This is an alias to sequence_factory with a more generic name.
 785  Example :
 786  Returns : value of object_factory (a scalar)
 787  Args    : on set, new value (a scalar or undef, optional)
 788
 789 =cut
 790
 791 sub object_factory{
 792     return shift->sequence_factory(@_);
 793 }
 794
 795
 796 =head2 sequence_builder
 797
 798  Title   : sequence_builder
 799  Usage   : $seqio->sequence_builder($seqfactory)
 800  Function: Get/Set the Bio::Factory::ObjectBuilderI used to build sequence
 801            objects. This applies to rich sequence formats only, e.g. genbank
 802            but not fasta.
 803
 804            If you do not set the sequence object builder yourself, it
 805            will in fact be an instance of L<Bio::Seq::SeqBuilder>, and
 806            you may use all methods documented there to configure it.
 807
 808  Returns : a Bio::Factory::ObjectBuilderI compliant object
 809  Args    : [optional] a Bio::Factory::ObjectBuilderI compliant object
 810
 811 =cut
 812
 813 sub sequence_builder {
 814     my ($self, $obj) = @_;
 815     if( defined $obj ) {
 816         if( ! ref($obj) || ! $obj->isa('Bio::Factory::ObjectBuilderI') ) {
 817             $self->throw("Must provide a valid Bio::Factory::ObjectBuilderI object to ".ref($self)."::sequence_builder()");
 818         }
 819         $self->{'_object_builder'} = $obj;
 820     }
 821     $self->{'_object_builder'};
 822 }
 823
 824
 825 =head2 location_factory
 826
 827  Title   : location_factory
 828  Usage   : $seqio->location_factory($locfactory)
 829  Function: Get/Set the Bio::Factory::LocationFactoryI object to be used for
 830            location string parsing
 831  Returns : a Bio::Factory::LocationFactoryI implementing object
 832  Args    : [optional] on set, a Bio::Factory::LocationFactoryI implementing
 833            object.
 834
 835 =cut
 836
 837 sub location_factory {
 838     my ($self,$obj) = @_;
 839     if( defined $obj ) {
 840         if( ! ref($obj) || ! $obj->isa('Bio::Factory::LocationFactoryI') ) {
 841             $self->throw("Must provide a valid Bio::Factory::LocationFactoryI" .
 842                              " object to ".ref($self)."->location_factory()");
 843         }
 844         $self->{'_seqio_locfactory'} = $obj;
 845     }
 846     $self->{'_seqio_locfactory'};
 847 }
 848
 849 1;
 850