#------------------------------------------------------------------
#
# 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
#------------------------------------------------------------------
=encoding utf-8
=head1 NAME
Bio::Tools::GuessSeqFormat - Module for determining the sequence
format of the contents of a file, a string, or through a
filehandle.
=head1 SYNOPSIS
# 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;
=head1 DESCRIPTION
Bio::Tools::GuessSeqFormat tries to guess the format ("swiss",
"pir", "fasta" etc.) of the sequence or MSA in a file, in a
scalar, or through a filehandle.
The guess() method of a Bio::Tools::GuessSeqFormat object will
examine the data, line by line, until it finds a line to which
only one format can be assigned. If no conclusive guess can be
made, undef is returned.
If the Bio::Tools::GuessSeqFormat object is given a filehandle
which is seekable, it will be restored to its original position
on return from the guess() method.
=head2 Formats
Tests are currently implemented for the following formats:
=over
=item *
ACeDB ("ace")
=item *
Blast ("blast")
=item *
ClustalW ("clustalw")
=item *
Codata ("codata")
=item *
EMBL ("embl")
=item *
FastA sequence ("fasta")
=item *
FastQ sequence ("fastq")
=item *
FastXY/FastA alignment ("fastxy")
=item *
Game XML ("game")
=item *
GCG ("gcg")
=item *
GCG Blast ("gcgblast")
=item *
GCG FastA ("gcgfasta")
=item *
GDE ("gde")
=item *
Genbank ("genbank")
=item *
Genscan ("genscan")
=item *
GFF ("gff")
=item *
HMMER ("hmmer")
=item *
PAUP/NEXUS ("nexus")
=item *
Phrap assembly file ("phrap")
=item *
NBRF/PIR ("pir")
=item *
Mase ("mase")
=item *
Mega ("mega")
=item *
GCG/MSF ("msf")
=item *
Pfam ("pfam")
=item *
Phylip ("phylip")
=item *
Prodom ("prodom")
=item *
Raw ("raw")
=item *
RSF ("rsf")
=item *
Selex ("selex")
=item *
Stockholm ("stockholm")
=item *
Swissprot ("swiss")
=item *
Tab ("tab")
=item *
Variant Call Format ("vcf")
=back
=head1 FEEDBACK
=head2 Mailing Lists
User feedback is an integral part of the evolution of this and
other Bioperl modules. Send your comments and suggestions
preferably to one of the Bioperl mailing lists. Your
participation is much appreciated.
bioperl-l@bioperl.org - General discussion
http://bioperl.org/wiki/Mailing_lists - About the mailing lists
=head2 Support
Please direct usage questions or support issues to the mailing list:
I<bioperl-l@bioperl.org>
rather than to the module maintainer directly. Many experienced and
reponsive experts will be able look at the problem and quickly
address it. Please include a thorough description of the problem
with code and data examples if at all possible.
=head2 Reporting Bugs
Report bugs to the Bioperl bug tracking system to help us
keep track the bugs and their resolution. Bug reports can be
submitted via the web:
https://redmine.open-bio.org/projects/bioperl/
=head1 AUTHOR
Andreas KE<228>hE<228>ri, andreas.kahari@ebi.ac.uk
=head1 CONTRIBUTORS
Heikki LehvE<228>slaiho, heikki-at-bioperl-dot-org
Mark A. Jensen, maj-at-fortinbras-dot-us
=cut
package Bio::Tools::GuessSeqFormat;
use strict;
use warnings;
use base qw(Bio::Root::Root);
=head1 METHODS
Methods available to Bio::Tools::GuessSeqFormat objects
are described below. Methods with names beginning with an
underscore are considered to be internal.
=cut
=head2 new
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.
=cut
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;
}
=head2 file
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.
=cut
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};
}
=head2 fh
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.
=cut
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};
}
=head2 text
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.
=cut
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};
}
=head2 guess
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.
=cut
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);
}
=head1 HELPER SUBROUTINES
All helper subroutines will, given a line of text and the line
number of the same line, return 1 if the line possibly is from a
file of the type that they perform a test of.
A zero return value does not mean that the line is not part
of a certain type of file, just that the test did not find any
characteristics of that type of file in the line.
=head2 _possibly_ace
From bioperl test data, and from
"http://www.isrec.isb-sib.ch/DEA/module8/B_Stevenson/Practicals/transcriptome_recon/transcriptome_recon.html".
=cut
sub _possibly_ace
{
my ($line, $lineno) = (shift, shift);
return ($line =~ /^(?:Sequence|Peptide|DNA|Protein) [":]/);
}
=head2 _possibly_blast
From various blast results.
=cut
sub _possibly_blast
{
my ($line, $lineno) = (shift, shift);
return ($lineno == 1 &&
$line =~ /^[[:upper:]]*BLAST[[:upper:]]*.*\[.*\]$/);
}
=head2 _possibly_bowtie
Contributed by kortsch.
=cut
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);
}
=head2 _possibly_clustalw
From "http://www.ebi.ac.uk/help/formats.html".
=cut
sub _possibly_clustalw
{
my ($line, $lineno) = (shift, shift);
return ($lineno == 1 && $line =~ /CLUSTAL/);
}
=head2 _possibly_codata
From "http://www.ebi.ac.uk/help/formats.html".
=cut
sub _possibly_codata
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /^ENTRY/) ||
($lineno == 2 && $line =~ /^SEQUENCE/) ||
$line =~ m{^(?:ENTRY|SEQUENCE|///)});
}
=head2 _possibly_embl
From
"http://www.ebi.ac.uk/embl/Documentation/User_manual/usrman.html#3.3".
=cut
sub _possibly_embl
{
my ($line, $lineno) = (shift, shift);
return ($lineno == 1 && $line =~ /^ID / && $line =~ /BP\.$/);
}
=head2 _possibly_fasta
From "http://www.ebi.ac.uk/help/formats.html".
=cut
sub _possibly_fasta
{
my ($line, $lineno) = (shift, shift);
return (($lineno != 1 && $line =~ /^[A-IK-NP-Z]+$/i) ||
$line =~ /^>\s*\w/);
}
=head2 _possibly_fastq
From bioperl test data.
=cut
sub _possibly_fastq
{
my ($line, $lineno) = (shift, shift);
return ( ($lineno == 1 && $line =~ /^@/) ||
($lineno == 3 && $line =~ /^\+/) );
}
=head2 _possibly_fastxy
From bioperl test data.
=cut
sub _possibly_fastxy
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /^ FAST(?:XY|A)/) ||
($lineno == 2 && $line =~ /^ version \d/));
}
=head2 _possibly_game
From bioperl testdata.
=cut
sub _possibly_game
{
my ($line, $lineno) = (shift, shift);
return ($line =~ /^<!DOCTYPE game/);
}
=head2 _possibly_gcg
From bioperl, Bio::SeqIO::gcg.
=cut
sub _possibly_gcg
{
my ($line, $lineno) = (shift, shift);
return ($line =~ /Length: .*Type: .*Check: .*\.\.$/);
}
=head2 _possibly_gcgblast
From bioperl testdata.
=cut
sub _possibly_gcgblast
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /^!!SEQUENCE_LIST/) ||
($lineno == 2 &&
$line =~ /^[[:upper:]]*BLAST[[:upper:]]*.*\[.*\]$/));
}
=head2 _possibly_gcgfasta
From bioperl testdata.
=cut
sub _possibly_gcgfasta
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /^!!SEQUENCE_LIST/) ||
($lineno == 2 && $line =~ /FASTA/));
}
=head2 _possibly_gde
From "http://www.ebi.ac.uk/help/formats.html".
=cut
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);
}
=head2 _possibly_genbank
From "http://www.ebi.ac.uk/help/formats.html".
Format of [apparantly optional] file header from
"http://www.umdnj.edu/rcompweb/PA/Notes/GenbankFF.htm". (TODO: dead link)
=cut
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 /));
}
=head2 _possibly_genscan
From bioperl test data.
=cut
sub _possibly_genscan
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /^GENSCAN.*Date.*Time/) ||
($line =~ /^(?:Sequence\s+\w+|Parameter matrix|Predicted genes)/));
}
=head2 _possibly_gff
From bioperl test data.
=cut
sub _possibly_gff
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /^##gff-version/) ||
($lineno == 2 && $line =~ /^##date/));
}
=head2 _possibly_hmmer
From bioperl test data.
=cut
sub _possibly_hmmer
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 2 && $line =~ /^HMMER/) ||
($lineno == 3 &&
$line =~ /Washington University School of Medicine/));
}
=head2 _possibly_nexus
From "http://paup.csit.fsu.edu/nfiles.html".
=cut
sub _possibly_nexus
{
my ($line, $lineno) = (shift, shift);
return ($lineno == 1 && $line =~ /^#NEXUS/);
}
=head2 _possibly_mase
From bioperl test data.
More detail from "http://www.umdnj.edu/rcompweb/PA/Notes/GenbankFF.htm" (TODO: dead link)
=cut
sub _possibly_mase
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /^;;/) ||
($lineno > 1 && $line =~ /^;[^;]?/));
}
=head2 _possibly_mega
From the ensembl broswer (AlignView data export).
=cut
sub _possibly_mega
{
my ($line, $lineno) = (shift, shift);
return ($lineno == 1 && $line =~ /^#mega$/);
}
=head2 _possibly_msf
From "http://www.ebi.ac.uk/help/formats.html".
=cut
sub _possibly_msf
{
my ($line, $lineno) = (shift, shift);
return ($line =~ m{^//} ||
$line =~ /MSF:.*Type:.*Check:|Name:.*Len:/);
}
=head2 _possibly_phrap
From "http://biodata.ccgb.umn.edu/docs/contigimage.html". (TODO: dead link)
From "http://genetics.gene.cwru.edu/gene508/Lec6.htm". (TODO: dead link)
From bioperl test data ("*.ace.1" files).
=cut
sub _possibly_phrap
{
my ($line, $lineno) = (shift, shift);
return ($line =~ /^(?:AS\ |CO\ Contig|BQ|AF\ |BS\ |RD\ |
QA\ |DS\ |RT\{)/x);
}
=head2 _possibly_pir
From "http://www.ebi.ac.uk/help/formats.html".
The ".,()" spotted in bioperl test data.
=cut
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);/);
}
=head2 _possibly_pfam
From bioperl test data.
=cut
sub _possibly_pfam
{
my ($line, $lineno) = (shift, shift);
return ($line =~ m{^\w+/\d+-\d+\s+[A-IK-NP-Z.]+}i);
}
=head2 _possibly_phylip
From "http://www.ebi.ac.uk/help/formats.html". Initial space
allowed on first line (spotted in ensembl AlignView exported
data).
=cut
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]+)/)
);
}
=head2 _possibly_prodom
From "http://prodom.prabi.fr/prodom/current/documentation/data.php".
=cut
sub _possibly_prodom
{
my ($line, $lineno) = (shift, shift);
return ($lineno == 1 && $line =~ /^ID / && $line =~ /\d+ seq\.$/);
}
=head2 _possibly_raw
From "http://www.ebi.ac.uk/help/formats.html".
=cut
sub _possibly_raw
{
my ($line, $lineno) = (shift, shift);
return ($line =~ /^[A-Za-z\s]+$/);
}
=head2 _possibly_rsf
From "http://www.ebi.ac.uk/help/formats.html".
=cut
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);
}
=head2 _possibly_selex
From "http://www.ebc.ee/WWW/hmmer2-html/node27.html".
Assuming presence of Selex file header. Data exported by
Bioperl on Pfam and Selex formats are identical, but Pfam file
only holds one alignment.
=cut
sub _possibly_selex
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /^#=ID /) ||
($lineno == 2 && $line =~ /^#=AC /) ||
($line =~ /^#=SQ /));
}
=head2 _possibly_stockholm
From bioperl test data.
=cut
sub _possibly_stockholm
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /^# STOCKHOLM/) ||
$line =~ /^#=(?:GF|GS) /);
}
=head2 _possibly_swiss
From "http://ca.expasy.org/sprot/userman.html#entrystruc".
=cut
sub _possibly_swiss
{
my ($line, $lineno) = (shift, shift);
return ($lineno == 1 && $line =~ /^ID / && $line =~ /AA\.$/);
}
=head2 _possibly_tab
Contributed by Heikki.
=cut
sub _possibly_tab
{
my ($line, $lineno) = (shift, shift);
return ($lineno == 1 && $line =~ /^[^\t]+\t[^\t]+/) ;
}
=head2 _possibly_vcf
From "http://www.1000genomes.org/wiki/analysis/vcf4.0".
Assumptions made about sanity - format and date lines are line 1 and 2
respectively. This is not specified in the format document.
=cut
sub _possibly_vcf
{
my ($line, $lineno) = (shift, shift);
return (($lineno == 1 && $line =~ /##fileformat=VCFv/) ||
($lineno == 2 && $line =~ /##fileDate=/));
}
1;