Bio::Tools::GuessSeqFormat - Module for determining the sequence

    # To guess the format of a flat file, given a filename:
    my $guesser = Bio::Tools::GuessSeqFormat->new( -file => $filename );
    my $format  = $guesser->guess;

    # To guess the format from an already open filehandle:
    my $guesser = Bio::Tools::GuessSeqFormat->new( -fh => $filehandle );
    my $format  = $guesser->guess;
    # If the filehandle is seekable (STDIN isn't), it will be
    # returned to its original position.

    # To guess the format of one or several lines of text (with
    # embedded newlines):
    my $guesser = Bio::Tools::GuessSeqFormat->new( -text => $linesoftext );
    my $format = $guesser->guess;

    # To create a Bio::Tools::GuessSeqFormat object and set the
    # filename, filehandle, or line to parse afterwards:
    my $guesser = Bio::Tools::GuessSeqFormat->new();
    $guesser->file($filename);
    $guesser->fh($filehandle);
    $guesser->text($linesoftext);

    # To guess in one go, given e.g. a filename:
    my $format = Bio::Tools::GuessSeqFormat->new( -file => $filename )->guess;

  bioperl-l@bioperl.org                  - General discussion
  http://bioperl.org/wiki/Mailing_lists  - About the mailing lists

  https://redmine.open-bio.org/projects/bioperl/

 Title      : new
 Usage      : $guesser = Bio::Tools::GuessSeqFormat->new( ... );
 Function   : Creates a new object.
 Example    : See SYNOPSIS.
 Returns    : A new object.
 Arguments  : -file The filename of the file whose format is to
                    be guessed, or
              -fh   An already opened filehandle from which a text
                    stream may be read, or
              -text A scalar containing one or several lines of
                    text with embedded newlines.

    If more than one of the above arguments are given, they
    are tested in the order -text, -file, -fh, and the first
    available argument will be used.

 Title      : file
 Usage      : $guesser->file($filename);
              $filename = $guesser->file;
 Function   : Gets or sets the current filename associated with
              an object.
 Returns    : The new filename.
 Arguments  : The filename of the file whose format is to be
              guessed.

    A call to this method will clear the current filehandle and
    the current lines of text associated with the object.

 Title      : fh
 Usage      : $guesser->fh($filehandle);
              $filehandle = $guesser->fh;
 Function   : Gets or sets the current filehandle associated with
              an object.
 Returns    : The new filehandle.
 Arguments  : An already opened filehandle from which a text
              stream may be read.

    A call to this method will clear the current filename and
    the current lines of text associated with the object.

 Title      : text
 Usage      : $guesser->text($linesoftext);
              $linesofext = $guesser->text;
 Function   : Gets or sets the current text associated with an
              object.
 Returns    : The new lines of texts.
 Arguments  : A scalar containing one or several lines of text,
              including embedded newlines.

    A call to this method will clear the current filename and
    the current filehandle associated with the object.

 Title      : guess
 Usage      : $format = $guesser->guess;
              @format = $guesser->guess; # if given a line of text
 Function   : Guesses the format of the data accociated with the
              object.
 Returns    : A format string such as "swiss" or "pir".  If a
              format can not be found, undef is returned.
 Arguments  : None.

    If the object is associated with a filehandle and if that
    filehandle is searchable, the position of the filehandle
    will be returned to its original position before the method
    returns.

 From various blast results.

#------------------------------------------------------------------
#
# BioPerl module Bio::Tools::GuessSeqFormat
#
# Please direct questions and support issues to <bioperl-l@bioperl.org> 
#
# Cared for by Andreas Kähäri, andreas.kahari@ebi.ac.uk
#
# You may distribute this module under the same terms as perl itself
#------------------------------------------------------------------

package Bio::Tools::GuessSeqFormat;

use strict;
use warnings;


use base qw(Bio::Root::Root);

sub new
{
    my $class = shift;
    my @args  = @_;

    my $self = $class->SUPER::new(@args);

    my $attr;
    my $value;

    while (@args) {
        $attr = shift @args;
        $attr = lc $attr;
        $value = shift @args;
        $self->{$attr} = $value;
    }

    return $self;
}

sub file
{
    # Sets and/or returns the filename to use.
    my $self = shift;
    my $file = shift;

    if (defined $file) {
        # Set the active filename, and clear the filehandle and
        # text line, if present.
        $self->{-file} = $file;
        $self->{-fh} = $self->{-text} = undef;
    }

    return $self->{-file};
}

sub fh
{
    # Sets and/or returns the filehandle to use.
    my $self = shift;
    my $fh = shift;

    if (defined $fh) {
        # Set the active filehandle, and clear the filename and
        # text line, if present.
        $self->{-fh} = $fh;
        $self->{-file} = $self->{-text} = undef;
    }

    return $self->{-fh};
}

sub text
{
    # Sets and/or returns the text lines to use.
    my $self = shift;
    my $text = shift;

    if (defined $text) {
        # Set the active text lines, and clear the filehandle
        # and filename, if present.
        $self->{-text} = $text;
        $self->{-fh} = $self->{-file} = undef;
    }

    return $self->{-text};
}

our %formats = (
    ace         => { test => \&_possibly_ace        },
    blast       => { test => \&_possibly_blast      },
    bowtie      => { test => \&_possibly_bowtie     },
    clustalw    => { test => \&_possibly_clustalw   },
    codata      => { test => \&_possibly_codata     },
    embl        => { test => \&_possibly_embl       },
    fasta       => { test => \&_possibly_fasta      },
    fastq       => { test => \&_possibly_fastq      },
    fastxy      => { test => \&_possibly_fastxy     },
    game        => { test => \&_possibly_game       },
    gcg         => { test => \&_possibly_gcg        },
    gcgblast    => { test => \&_possibly_gcgblast   },
    gcgfasta    => { test => \&_possibly_gcgfasta   },
    gde         => { test => \&_possibly_gde        },
    genbank     => { test => \&_possibly_genbank    },
    genscan     => { test => \&_possibly_genscan    },
    gff         => { test => \&_possibly_gff        },
    hmmer       => { test => \&_possibly_hmmer      },
    nexus       => { test => \&_possibly_nexus      },
    mase        => { test => \&_possibly_mase       },
    mega        => { test => \&_possibly_mega       },
    msf         => { test => \&_possibly_msf        },
    phrap       => { test => \&_possibly_phrap      },
    pir         => { test => \&_possibly_pir        },
    pfam        => { test => \&_possibly_pfam       },
    phylip      => { test => \&_possibly_phylip     },
    prodom      => { test => \&_possibly_prodom     },
    raw         => { test => \&_possibly_raw        },
    rsf         => { test => \&_possibly_rsf        },
    selex       => { test => \&_possibly_selex      },
    stockholm   => { test => \&_possibly_stockholm  },
    swiss       => { test => \&_possibly_swiss      },
    tab         => { test => \&_possibly_tab        },
    vcf         => { test => \&_possibly_vcf        }
);

sub guess
{
    my $self = shift;

    foreach my $fmt_key (keys %formats) {
        $formats{$fmt_key}{fmt_string} = $fmt_key;
    }

    my $fh;
    my $start_pos;
    my @lines;
    if (defined $self->{-text}) {
	# Break the text into separate lines.
	@lines = split /\n/, $self->{-text};
    } elsif (defined $self->{-file}) {
        # If given a filename, open the file.
        open($fh, $self->{-file}) or
            $self->throw("Can not open '$self->{-file}' for reading: $!");
    } elsif (defined $self->{-fh}) {
        # If given a filehandle, figure out if it's a plain GLOB
        # or a IO::Handle which is seekable.  In the case of a
        # GLOB, we'll assume it's seekable.  Get the current
        # position in the stream.
        $fh = $self->{-fh};
        if (ref $fh eq 'GLOB') {
            $start_pos = tell($fh);
        } elsif (UNIVERSAL::isa($fh, 'IO::Seekable')) {
            $start_pos = $fh->getpos();
        }
    }

    my $done  = 0;
    my $lineno = 0;
    my $fmt_string;
    while (!$done) {
        my $line;       # The next line of the file.
        my $match = 0;  # Number of possible formats of this line.

	if (defined $self->{-text}) {
	    last if (scalar @lines == 0);
	    $line = shift @lines;
	} else {
	    last if (!defined($line = <$fh>));
	}
        next if ($line =~ /^\s*$/); # Skip white and empty lines.

        chomp($line);
        $line =~ s/\r$//;   # Fix for DOS files on Unix.
        ++$lineno;

        while (my ($fmt_key, $fmt) = each (%formats)) {
            if ($fmt->{test}($line, $lineno)) {
                ++$match;
                $fmt_string = $fmt->{fmt_string};
            }
        }

        # We're done if there was only one match.
        $done = ($match == 1);
    }

    if (defined $self->{-file}) {
        # Close the file we opened.
        close($fh);
    } elsif (ref $fh eq 'GLOB') {
        # Try seeking to the start position.
        seek($fh, $start_pos, 0) || $self->throw("Failed resetting the ".
                                        "filehandle; IO error occurred");;
    } elsif (defined $fh && $fh->can('setpos')) {
        # Seek to the start position.
        $fh->setpos($start_pos);
    }
    return ($done ? $fmt_string : undef);
}

sub _possibly_ace
{
    my ($line, $lineno) = (shift, shift);
    return ($line =~ /^(?:Sequence|Peptide|DNA|Protein) [":]/);
}

sub _possibly_blast
{
    my ($line, $lineno) = (shift, shift);
    return ($lineno == 1 &&
        $line =~ /^[[:upper:]]*BLAST[[:upper:]]*.*\[.*\]$/);
}

sub _possibly_bowtie
{
    my ($line, $lineno) = (shift, shift);
    return ($line =~ /^[[:graph:]]+\t[-+]\t[[:graph:]]+\t\d+\t([[:alpha:]]+)\t([[:graph:]]+)\t\d+\t[[:graph:]]?/)
            && length($1)==length($2);
}

sub _possibly_clustalw
{
    my ($line, $lineno) = (shift, shift);
    return ($lineno == 1 && $line =~ /CLUSTAL/);
}

sub _possibly_codata
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^ENTRY/) ||
            ($lineno == 2 && $line =~ /^SEQUENCE/) ||
            $line =~ m{^(?:ENTRY|SEQUENCE|///)});
}

sub _possibly_embl
{
    my ($line, $lineno) = (shift, shift);
    return ($lineno == 1 && $line =~ /^ID   / && $line =~ /BP\.$/);
}

sub _possibly_fasta
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno != 1 && $line =~ /^[A-IK-NP-Z]+$/i) ||
            $line =~ /^>\s*\w/);
}

sub _possibly_fastq
{
    my ($line, $lineno) = (shift, shift);
    return ( ($lineno == 1 && $line =~ /^@/) ||
	     ($lineno == 3 && $line =~ /^\+/) );
}

sub _possibly_fastxy
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^ FAST(?:XY|A)/) ||
            ($lineno == 2 && $line =~ /^ version \d/));
}

sub _possibly_game
{
    my ($line, $lineno) = (shift, shift);
    return ($line =~ /^<!DOCTYPE game/);
}

sub _possibly_gcg
{
    my ($line, $lineno) = (shift, shift);
    return ($line =~ /Length: .*Type: .*Check: .*\.\.$/);
}

sub _possibly_gcgblast
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^!!SEQUENCE_LIST/) ||
            ($lineno == 2 &&
             $line =~ /^[[:upper:]]*BLAST[[:upper:]]*.*\[.*\]$/));
}

sub _possibly_gcgfasta
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^!!SEQUENCE_LIST/) ||
            ($lineno == 2 && $line =~ /FASTA/));
}

sub _possibly_gde
{
    my ($line, $lineno) = (shift, shift);
    return ($line =~ /^[{}]$/ ||
            $line =~ /^(?:name|longname|sequence-ID|
                                                    creation-date|direction|strandedness|
                                                    type|offset|group-ID|creator|descrip|
                                                    comment|sequence)/x);
}

sub _possibly_genbank
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /GENETIC SEQUENCE DATA BANK/) ||
            ($lineno == 1 && $line =~ /^LOCUS /) ||
            ($lineno == 2 && $line =~ /^DEFINITION /) ||
            ($lineno == 3 && $line =~ /^ACCESSION /));
}

sub _possibly_genscan
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^GENSCAN.*Date.*Time/) ||
            ($line =~ /^(?:Sequence\s+\w+|Parameter matrix|Predicted genes)/));
}

sub _possibly_gff
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^##gff-version/) ||
            ($lineno == 2 && $line =~ /^##date/));
}

sub _possibly_hmmer
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 2 && $line =~ /^HMMER/) ||
            ($lineno == 3 &&
             $line =~ /Washington University School of Medicine/));
}

sub _possibly_nexus
{
    my ($line, $lineno) = (shift, shift);
    return ($lineno == 1 && $line =~ /^#NEXUS/);
}

sub _possibly_mase
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^;;/) ||
            ($lineno > 1 && $line =~ /^;[^;]?/));
}

sub _possibly_mega
{
    my ($line, $lineno) = (shift, shift);
    return ($lineno == 1 && $line =~ /^#mega$/);
}

sub _possibly_msf
{
    my ($line, $lineno) = (shift, shift);
    return ($line =~ m{^//} ||
            $line =~ /MSF:.*Type:.*Check:|Name:.*Len:/);
}

sub _possibly_phrap
{
    my ($line, $lineno) = (shift, shift);
    return ($line =~ /^(?:AS\ |CO\ Contig|BQ|AF\ |BS\ |RD\ |
                                                    QA\ |DS\ |RT\{)/x);
}

sub _possibly_pir # "NBRF/PIR" (?)
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno != 1 && $line =~ /^[\sA-IK-NP-Z.,()]+\*?$/i) ||
            $line =~ /^>(?:P1|F1|DL|DC|RL|RC|N3|N1);/);
}

sub _possibly_pfam
{
    my ($line, $lineno) = (shift, shift);
    return ($line =~ m{^\w+/\d+-\d+\s+[A-IK-NP-Z.]+}i);
}

sub _possibly_phylip
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^\s*\d+\s\d+/) ||
            ($lineno == 2 && $line =~ /^\w\s+[A-IK-NP-Z\s]+/) ||
            ($lineno == 3 && $line =~ /(?:^\w\s+[A-IK-NP-Z\s]+|\s+[A-IK-NP-Z\s]+)/)
           );
}

sub _possibly_prodom
{
    my ($line, $lineno) = (shift, shift);
    return ($lineno == 1 && $line =~ /^ID   / && $line =~ /\d+ seq\.$/);
}

sub _possibly_raw
{
    my ($line, $lineno) = (shift, shift);
    return ($line =~ /^[A-Za-z\s]+$/);
}

sub _possibly_rsf
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^!!RICH_SEQUENCE/) ||
            $line =~ /^[{}]$/ ||
            $line =~ /^(?:name|type|longname|
                                                    checksum|creation-date|strand|sequence)/x);
}

sub _possibly_selex
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^#=ID /) ||
            ($lineno == 2 && $line =~ /^#=AC /) ||
            ($line =~ /^#=SQ /));
}

sub _possibly_stockholm
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /^# STOCKHOLM/) ||
            $line =~ /^#=(?:GF|GS) /);
}

sub _possibly_swiss
{
    my ($line, $lineno) = (shift, shift);
    return ($lineno == 1 && $line =~ /^ID   / && $line =~ /AA\.$/);
}

sub _possibly_tab
{
    my ($line, $lineno) = (shift, shift);
    return ($lineno == 1 && $line =~ /^[^\t]+\t[^\t]+/) ;
}

sub _possibly_vcf
{
    my ($line, $lineno) = (shift, shift);
    return (($lineno == 1 && $line =~ /##fileformat=VCFv/) ||
            ($lineno == 2 && $line =~ /##fileDate=/));
}



1;