Bio::SeqIO::Handler GenericRichSeqHandler
SummaryIncluded librariesPackage variablesSynopsisDescriptionGeneral documentationMethods
Toolbar
WebCvs
Summary
Bio::SeqIO::Handler::GenericRichSeqHandler - Bio::HandlerI-based
data handler for GenBank/EMBL/UniProt (and other) sequence data
Package variables
Privates (from "my" definitions)
%HANDLERS = ( 'genbank' => { 'LOCUS' =>\& _genbank_locus, 'DEFINITION' =>\& _generic_description, 'ACCESSION' =>\& _generic_accession, 'VERSION' =>\& _generic_version, 'KEYWORDS' =>\& _generic_keywords, 'DBSOURCE' =>\& _genbank_dbsource, 'DBLINK' =>\& _genbank_dbsource, 'SOURCE' =>\& _generic_species, 'REFERENCE' =>\& _generic_reference, 'COMMENT' =>\& _generic_comment, 'FEATURES' =>\& _generic_seqfeatures, 'BASE' =>\& noop, 'ORIGIN' =>\& _generic_seq, '_DEFAULT_' =>\& _generic_simplevalue, }, 'embl' => { 'ID' =>\& _embl_id, 'DT' =>\& _embl_date, 'DR' =>\& _generic_dbsource, 'SV' =>\& _generic_version, 'RN' =>\& _generic_reference, 'KW' =>\& _generic_keywords, 'DE' =>\& _generic_description, 'AC' =>\& _generic_accession, 'SQ' =>\& _generic_seq, 'OS' =>\& _generic_species, 'CC' =>\& _generic_comment, 'FT' =>\& _generic_seqfeatures, '_DEFAULT_' =>\& _generic_simplevalue, }, 'swiss' => { 'ID' =>\& _swiss_id, 'DT' =>\& _swiss_date, 'GN' =>\& _swiss_genename, 'DR' =>\& _generic_dbsource, 'RN' =>\& _generic_reference, 'KW' =>\& _generic_keywords, 'DE' =>\& _generic_description, 'AC' =>\& _generic_accession, 'SQ' =>\& _generic_seq, 'OS' =>\& _generic_species, 'CC' =>\& _generic_comment, 'FT' =>\& _generic_seqfeatures, '_DEFAULT_' =>\& _generic_simplevalue, }, )
%DBSOURCE = map {$_ => 1} qw( EchoBASE IntAct SWISS-2DPAGE ECO2DBASE ECOGENE TIGRFAMs TIGR GO InterPro Pfam PROSITE SGD GermOnline HSSP PhosSite Ensembl RGD AGD ArrayExpress KEGG H-InvDB HGNC LinkHub PANTHER PRINTS SMART SMR MGI MIM RZPD-ProtExp ProDom MEROPS TRANSFAC Reactome UniGene GlycoSuiteDB PIRSF HSC-2DPAGE PHCI-2DPAGE PMMA-2DPAGE Siena-2DPAGE Rat-heart-2DPAGE Aarhus/Ghent-2DPAGE Biocyc MetaCyc Biocyc:Metacyc GenomeReviews FlyBase TMHOBP COMPLUYEAST-2DPAGE OGP DictyBase HAMAP PhotoList Gramene WormBase WormPep Genew ZFIN PeroxiBase MaizeDB TAIR DrugBank REBASE HPA swissprot GenBank GenPept REFSEQ embl PDB UniProtKB)
%NOPROCESS = map {$_ => 1} qw(DBSOURCE ORGANISM FEATURES)
Included modules
Bio::Annotation::Collection(1)
Bio::Annotation::Collection(2)
Bio::Annotation::Comment
Bio::Annotation::DBLink
Bio::Annotation::Reference
Bio::Annotation::SimpleValue
Bio::Annotation::TagTree
Bio::DB::Taxonomy
Bio::Factory::FTLocationFactory
Bio::SeqFeature::Generic
Bio::SeqIO::FTHelper
Bio::Species
Bio::Taxon
Data::Dumper
Inherit
Bio::HandlerBaseI Bio::Root::Root
Synopsis
  # MyHandler is a GenericRichSeqHandler object.
  # inside a parser (driver) constructor....

  $self->seq_handler($handler || MyHandler->new(-format => 'genbank'));

  # in next_seq() in driver...

  $hobj = $self->seqhandler();

  # roll data up into hashref chunks, pass off into Handler for processing...

  $hobj->data_handler($data);

  # or retrieve Handler methods and pass data directly to Handler methods...

  my $hmeth = $hobj->handler_methods;

  if ($hmeth->{ $data->{NAME} }) {
      my $mth = $hmeth->{ $data->{NAME} };
      $hobj->$mth($data);
  }
Description
This is an experimental implementation of a sequence-based HandlerBaseI parser
and may change over time. It is possible (nay, likely) that the way handler
methods are set up will change over development to allow more flexibility.
Release pumpkins, please do not add this to a release until the API has settled.
It is also likely that write_seq() will not work properly for some data.
Standard Developer caveats:
Do not use for production purposes.
Not responsible for destroying (your data|computer|world).
Do not stare directly at GenericRichSeqHandler.
If GenericRichSeqHandler glows, back slowly away and call for help.
Consider yourself warned!
This class acts as a demonstration on how to handle similar data chunks derived
from Bio::SeqIO::gbdriver, Bio::SeqIO::embldriver, and Bio::SeqIO::swissdriver
using similar (or the same) handler methods.
The modules currently pass all previous tests in t/genbank.t, t/embl.t, and
t/swiss.t yet all use the same handler methods (the collected tests for handlers
can be found in t/Handler.t). Some tweaking of the methods themselves is
probably in order over the long run to ensure that data is consistently handled
for each parser. Round-trip tests are probably in order here...
Though a Bio::Seq::SeqBuilder is employed for building sequence objects no
bypassing of data based on builder slots has been implemented (yet); this is
planned in the near future.
As a reminder: this is the current Annotation data chunk (via Data::Dumper):
  $VAR1 = {
            'NAME' => 'REFERENCE',
            'DATA' => '1  (bases 1 to 10001)'
            'AUTHORS' => 'International Human Genome Sequencing Consortium.'
            'TITLE' => 'The DNA sequence of Homo sapiens'
            'JOURNAL' => 'Unpublished (2003)'
          };
  ...
This is the current SeqFeature data chunk (again via Data::Dumper):
  $VAR1 = {
            'mol_type' => 'genomic DNA',
            'LOCATION' => '<1..>10001',
            'NAME' => 'FEATURES',
            'FEATURE_KEY' => 'source',
            'note' => 'Accession AL451081 sequenced by The Sanger Centre',
            'db_xref' => 'taxon:9606',
            'clone' => 'RP11-302I18',
            'organism' => 'Homo sapiens'
          };
Methods
newDescriptionCode
handler_methodsDescriptionCode
data_handlerDescriptionCode
reset_parametersDescriptionCode
formatDescriptionCode
get_paramsDescriptionCode
set_paramsDescriptionCode
seqbuilderDescriptionCode
build_sequenceDescriptionCode
location_factoryDescriptionCode
annotation_collectionDescriptionCode
_generic_seq
No description
Code
_genbank_locus
No description
Code
_embl_id
No description
Code
_swiss_id
No description
Code
_swiss_genename
No description
Code
_generic_version
No description
Code
_embl_date
No description
Code
_swiss_date
No description
Code
_generic_keywords
No description
Code
_generic_description
No description
Code
_generic_accession
No description
Code
_generic_species
No description
Code
_genbank_dbsource
No description
Code
_generic_dbsource
No description
Code
_generic_reference
No description
Code
_generic_comment
No description
Code
_generic_seqfeatures
No description
Code
_generic_simplevalue
No description
Code
_debug
No description
Code
Methods description
newcode    nextTop
 Title   :  new
 Usage   :  
 Function:  
 Returns :  
 Args    :  -format    Sequence format to be mapped for handler methods
            -builder   Bio::Seq::SeqBuilder object (normally defined in
                       SequenceStreamI object implementation constructor)
 Throws  :  On undefined '-format' sequence format parameter
 Note    :  Still under heavy development
handler_methodscodeprevnextTop
 Title   :  handler_methods
 Usage   :  $handler->handler_methods('GenBank')
            %handlers = $handler->handler_methods();
 Function:  Retrieve the handler methods used for the current format() in
            the handler.  This assumes the handler methods are already
            described in the HandlerI-implementing class.
 Returns :  a hash reference with the data type handled and the code ref
            associated with it.
 Args    :  [optional] String representing the sequence format.  If set here
            this will also set sequence_format()
 Throws  :  On unimplemented sequence format in %HANDLERS
data_handlercodeprevnextTop
 Title   :  data_handler
 Usage   :  $handler->data_handler($data)
 Function:  Centralized method which accepts all data chunks, then distributes
            to the appropriate methods for processing based on the chunk name
            from within the HandlerBaseI object.

            One can also use 
 Returns :  None
 Args    :  an hash ref containing a data chunk.
reset_parameterscodeprevnextTop
 Title   :  reset_parameters
 Usage   :  $handler->reset_parameters()
 Function:  Resets the internal cache of data (normally object parameters for
            a builder or factory)
 Returns :  None
 Args    :  None
formatcodeprevnextTop
 Title   :  format
 Usage   :  $handler->format('GenBank')
 Function:  Get/Set the format for the report/record being parsed. This can be
            used to set handlers in classes which are capable of processing
            similar data chunks from multiple driver modules.
 Returns :  String with the sequence format
 Args    :  [optional] String with the sequence format
 Note    :  The format may be used to set the handlers (as in the
            current GenericRichSeqHandler implementation)
get_paramscodeprevnextTop
 Title   :  get_params
 Usage   :  $handler->get_params('-species')
 Function:  Convenience method used to retrieve the specified
            parameters from the internal parameter cache
 Returns :  Hash ref containing parameters requested and data as
            key-value pairs.  Note that some parameter values may be 
            objects, arrays, etc.
 Args    :  List (array) representing the parameters requested
set_paramscodeprevnextTop
 Title   :  set_params
 Usage   :  $handler->set_param({'-species')
 Function:  Convenience method used to set specific parameters
 Returns :  None
 Args    :  Hash ref containing the data to be passed as key-value pairs
seqbuildercodeprevnextTop
 Title   :  seqbuilder
 Usage   :  
 Function:  
 Returns :  
 Args    :
 Throws  :
 Note    :
build_sequencecodeprevnextTop
 Title   :  build_sequence
 Usage   :  
 Function:  
 Returns :  
 Args    :
 Throws  :
 Note    :
location_factorycodeprevnextTop
 Title   :  location_factory
 Usage   :  
 Function:  
 Returns :  
 Args    :
 Throws  :
 Note    :
annotation_collectioncodeprevnextTop
 Title   :  annotation_collection
 Usage   :  
 Function:  
 Returns :  
 Args    :
 Throws  :
 Note    :
Methods code
newdescriptionprevnextTop
sub new {
    my ($class, @args) = @_;
    my $self = $class->SUPER::new(@args);
    $self = {@args};
    bless $self,$class;
    my ($format, $builder) = $self->_rearrange([qw(FORMAT BUILDER)], @args);
    $self->throw("Must define sequence record format") if !$format;
    $self->format($format);
    $self->handler_methods();
    $builder  &&  $self->seqbuilder($builder);
    $self->location_factory();
    return $self;
}
handler_methodsdescriptionprevnextTop
sub handler_methods {
    my $self = shift;
    if (!($self->{'handlers'})) {
        $self->throw("No handlers defined for seqformat ",$self->format)
            unless exists $HANDLERS{$self->format};
        $self->{'handlers'} = $HANDLERS{$self->format};
    }
    return ($self->{'handlers'});
}
data_handlerdescriptionprevnextTop
sub data_handler {
    my ($self, $data) = @_;
    my $nm = $data->{NAME} || $self->throw("No name tag defined!");
    
    # this should handle data on the fly w/o caching; any caching should be 
    # done in the driver!
    my $method = (exists $self->{'handlers'}->{$nm}) ? ($self->{'handlers'}->{$nm}) :
                (exists $self->{'handlers'}->{'_DEFAULT_'}) ? ($self->{'handlers'}->{'_DEFAULT_'}) :
                undef;
    if (!$method) {
        $self->debug("No handler defined for $nm\n");
        return;
    };
    $self->$method($data);
}
reset_parametersdescriptionprevnextTop
sub reset_parameters {
    my $self = shift;
    $self->{'_params'} = undef;
}
formatdescriptionprevnextTop
sub format {
    my $self = shift;
    return $self->{'_seqformat'} = lc shift if @_;
    return $self->{'_seqformat'};
}
get_paramsdescriptionprevnextTop
sub get_params {
    my ($self, @ids) = @_;
    my %data;
    for my $id (@ids) {
        if (!index($id, '-')==0) {
            $id = '-'.$id ;
        }
        $data{$id} = $self->{'_params'}->{$id} if (exists $self->{'_params'}->{$id});
    }
    return\% data;
}
set_paramsdescriptionprevnextTop
sub set_params {
    shift->throw('Not implemented yet!');
}
seqbuilderdescriptionprevnextTop
sub seqbuilder {
    my $self = shift;
    return $self->{'_seqbuilder'} = shift if @_;
    return $self->{'_seqbuilder'};
}
build_sequencedescriptionprevnextTop
sub build_sequence {
    my $self = shift;
    my $builder = $self->seqbuilder();
    my $seq;
    if (defined($self->{'_params'})) {
        $builder->add_slot_value(%{ $self->{'_params'} });
        $seq = $builder->make_object();
        $self->reset_parameters;
    }
    return $seq if $seq;
    return 0;
}
location_factorydescriptionprevnextTop
sub location_factory {
    my ($self, $factory) = @_;
    if ($factory) {
        $self->throw("Must have a Bio::Factory::LocationFactoryI when ".
                     "explicitly setting factory()") unless
             (ref($factory) && $factory->isa('Bio::Factory::LocationFactoryI'));
        $self->{'_locfactory'} = $factory;
    } elsif (!defined($self->{'_locfactory'})) {
        $self->{'_locfactory'} = Bio::Factory::FTLocationFactory->new()
    }
    return $self->{'_locfactory'};
}
annotation_collectiondescriptionprevnextTop
sub annotation_collection {
    my ($self, $coll) = @_;
    if ($coll) {
        $self->throw("Must have Bio::AnnotationCollectionI ".
                     "when explicitly setting collection()")
            unless (ref($coll) && $coll->isa('Bio::AnnotationCollectionI'));
        $self->{'_params'}->{'-annotation'} = $coll;
    } elsif (!exists($self->{'_params'}->{'-annotation'})) {
        $self->{'_params'}->{'-annotation'} = Bio::Annotation::Collection->new()
    }
    return $self->{'_params'}->{'-annotation'};
}

####################### SEQUENCE HANDLERS #######################

# any sequence data
}
_generic_seqdescriptionprevnextTop
sub _generic_seq {
    my ($self, $data) = @_;
    $self->{'_params'}->{'-seq'} = $data->{DATA};
}

####################### RAW DATA HANDLERS #######################

# GenBank LOCUS line
}
_genbank_locusdescriptionprevnextTop
sub _genbank_locus {
    my ($self, $data) = @_;
    my (@tokens) = split m{\s+}, $data->{DATA};
    my $display_id = shift @tokens;
    $self->{'_params'}->{'-display_id'} = $display_id;
    my $seqlength = shift @tokens;
    if (exists $VALID_ALPHABET{$seqlength}) {
        # moved one token too far.  No locus name?
        $self->warn("Bad LOCUS name?  Changing [".$self->{'_params'}->{'-display_id'}.
                    "] to 'unknown' and length to ".$self->{'_params'}->{'-display_id'});
        $self->{'_params'}->{'-length'} = $self->{'_params'}->{'-display_id'};
        $self->{'_params'}->{'-display_id'} = 'unknown';
        # add token back...
        unshift @tokens, $seqlength;
    } else {
    	$self->{'_params'}->{'-length'} = $seqlength;
    }
    my $alphabet = lc(shift @tokens);        
    $self->{'_params'}->{'-alphabet'} =
        (exists $VALID_ALPHABET{$alphabet}) ? $VALID_ALPHABET{$alphabet} :
                           $self->warn("Unknown alphabet: $alphabet");
    if (($self->{'_params'}->{'-alphabet'} eq 'dna') || (@tokens > 2)) {
	    $self->{'_params'}->{'-molecule'} = shift(@tokens);
	    my $circ = shift(@tokens);
	    if ($circ eq 'circular') {
		$self->{'_params'}->{'-is_circular'} = 1;
		$self->{'_params'}->{'-division'} = shift(@tokens);
	    } else {
				# 'linear' or 'circular' may actually be omitted altogether
		$self->{'_params'}->{'-division'} =
		    (CORE::length($circ) == 3 ) ? $circ : shift(@tokens);
	    }
	} else {
	    $self->{'_params'}->{'-molecule'} = 'PRT' if($self->{'_params'}->{'-alphabet'} eq 'aa');
	    $self->{'_params'}->{'-division'} = shift(@tokens);
	}
    my $date = join(' ', @tokens);
    # maybe use Date::Time for dates?
    if($date && $date =~ s{\s*((\d{1,2})-(\w{3})-(\d{2,4})).*}{$1}) {
        
	    if( length($date) < 11 ) {
            # improperly formatted date
            # But we'll be nice and fix it for them
            my ($d,$m,$y) = ($2,$3,$4);
            if( length($d) == 1 ) {
                $d = "0$d";
            }
            # guess the century here
            if( length($y) == 2 ) {
                if( $y > 60 ) { # arbitrarily guess that '60' means 1960
                $y = "19$y";
                } else {
                $y = "20$y";
                }
                $self->warn("Date was malformed, guessing the century for $date to be $y\n");
            }
            $self->{'_params'}->{'-dates'} = [join('-',$d,$m,$y)];
	    } else {
            $self->{'_params'}->{'-dates'} = [$date];
	    }
	}
}

# EMBL ID line
}
_embl_iddescriptionprevnextTop
sub _embl_id {
    my ($self, $data) = @_;
    my $alphabet;
    my ($name, $sv, $topology, $mol, $div);
    my $line = $data->{DATA};
    #$self->debug("$line\n");
    my ($idtype) = $line =~ tr/;/;/;    
    if ( $idtype == 6) {   # New style headers contain exactly six semicolons.
    	# New style header (EMBL Release >= 87, after June 2006)
    	my $topology;
    	my $sv;
        
    	# ID   DQ299383; SV 1; linear; mRNA; STD; MAM; 431 BP.
		# This regexp comes from the new2old.pl conversion script, from EBI
    	if ($line =~ m/^(\w+);\s+SV (\d+); (\w+); ([^;]+); (\w{3}); (\w{3}); (\d+) \w{2}\./) {    
            ($name, $sv, $topology, $mol, $div) = ($1, $2, $3, $4, $6);
        } else {
            $self->throw("Unrecognized EMBL ID line:[$line]");
        }
    	if (defined($sv)) {
            $self->{'_params'}->{'-seq_version'} = $sv;
            $self->{'_params'}->{'-version'} = $sv;
    	}

    	if ($topology eq "circular") {
            $self->{'_params'}->{'-is_circular'} = 1;
    	}
	
        if (defined $mol ) {
            if ($mol =~ /DNA/) {
                $alphabet='dna';
            }
            elsif ($mol =~ /RNA/) {
                $alphabet='rna';
            }
            elsif ($mol =~ /AA/) {
                $alphabet='protein';
            }
        }
    } elsif ($idtype) { # has internal ';'
    	# Old style header (EMBL Release < 87, before June 2006)
        if ($line =~ m{^(\S+)[^;]*;\s+(\S+)[^;]*;\s+(\S+)[^;]*;}) {
            ($name, $mol, $div) = ($1, $2, $3);
            #$self->debug("[$name][$mol][$div]");
        } 

        if($mol) {
            if ( $mol =~ m{circular} ) {
                $self->{'_params'}->{'-is_circular'} = 1;
                $mol =~  s{circular }{};
            }
    	    if (defined $mol ) {
        		if ($mol =~ /DNA/) {
        		    $alphabet='dna';
        		}
        		elsif ($mol =~ /RNA/) {
        		    $alphabet='rna';
        		}
        		elsif ($mol =~ /AA/) {
        		    $alphabet='protein';
        		}
    	    }
    	}
    } else {
        $name = $data->{DATA};
    }
    unless( defined $name && length($name) ) {
        $name = "unknown_id";
    }
    $self->{'_params'}->{'-display_id'} = $name;
    $self->{'_params'}->{'-alphabet'} = $alphabet;
    $self->{'_params'}->{'-division'} = $div if $div;
    $self->{'_params'}->{'-molecule'} = $mol if $mol;
}

# UniProt/SwissProt ID line
}
_swiss_iddescriptionprevnextTop
sub _swiss_id {
    my ($self, $data) = @_;
    my ($name, $seq_div);
    if($data->{DATA} =~ m{^
                (\S+)           \s+     #  $1  entryname
                ([^\s;]+);      \s+     #  $2  DataClass
                (?:PRT;)?       \s+     #  Molecule Type (optional)
                [0-9]+[ ]AA     \.      #  Sequencelength (capture?)
                $
                }ox ) {
        ($name, $seq_div) = ($1, $2);
        $self->{'_params'}->{'-namespace'} =
          ($seq_div eq 'Reviewed'   || $seq_div eq 'STANDARD')     ? 'Swiss-Prot' :
          ($seq_div eq 'Unreviewed' || $seq_div eq 'PRELIMINARY')  ? 'TrEMBL'     :
           $seq_div;
        # we shouldn't be setting the division, but for now...
        my ($junk, $division) = split q(_), $name;
        $self->{'_params'}->{'-division'} = $division;
        $self->{'_params'}->{'-alphabet'} = 'protein';
        # this is important to have the id for display in e.g. FTHelper, otherwise
        # you won't know which entry caused an error
        $self->{'_params'}->{'-display_id'} = $name;
    } else {
        $self->throw("Unrecognized UniProt/SwissProt ID line:[".$data->{DATA}."]");
    }
}

# UniProt/SwissProt GN line
}
_swiss_genenamedescriptionprevnextTop
sub _swiss_genename {
    my ($self, $data) = @_;
    #$self->debug(Dumper($data));
    my $genename = $data->{DATA};
    my $gn;
    if ($genename) {
        my @stags;
        if ($genename =~ /\w=\w/) {
            # new format (e.g., Name=RCHY1; Synonyms=ZNF363, CHIMP)
            for my $n (split(m{\s+and\s+},$genename)) {
                my @genenames;
                for my $section (split(m{\s*;\s*},$n)) {
                    my ($tag, $rest) = split("=",$section);
                    $rest ||= '';
                    for my $val (split(m{\s*,\s*},$rest)) {
                        push @genenames, [$tag => $val];
                    }
                }
                push @stags, ['gene_name' =>\@ genenames];
            }
        } else {
            # old format
            for my $section (split(/ AND /, $genename)) {
                my @genenames;
                $section =~ s/[\(\)\.]//g;
                my @names = split(m{\s+OR\s+}, $section);
                push @genenames, ['Name' => shift @names];
                push @genenames, map {['Synonyms' => $_]} @names;
                push @stags, ['gene_name' =>\@ genenames]            
            }
        } #use Data::Dumper; print Dumper $gn, $genename;# exit;
        my $gn = Bio::Annotation::TagTree->new(-tagname => 'gene_name',
                                               -value => ['gene_names' =>\@ stags]);
        $self->annotation_collection->add_Annotation('gene_name', $gn);
    }
}

# GenBank VERSION line
# old EMBL SV line (now obsolete)
# UniProt/SwissProt?
}
_generic_versiondescriptionprevnextTop
sub _generic_version {
    my ($self, $data) = @_;
    my ($acc,$gi) = split(' ',$data->{DATA});
    if($acc =~ m{^\w+\.(\d+)}xmso) {
        $self->{'_params'}->{'-version'} = $1;
        $self->{'_params'}->{'-seq_version'} = $1;
    }
    if($gi && (index($gi,"GI:") == 0)) {
        $self->{'_params'}->{'-primary_id'} = substr($gi,3);
    }
}

# EMBL DT lines
}
_embl_datedescriptionprevnextTop
sub _embl_date {
    my ($self, $data) = @_;
    while ($data->{DATA} =~ m{(\S+)\s\((.*?)\)}g) {
        my ($date, $version) = ($1, $2);
        $date =~ tr{,}{}d; # remove comma if new version
        if ($version =~ m{\(Rel\.\s(\d+),\sCreated\)}xmso ) {
            my $release = Bio::Annotation::SimpleValue->new(
                            -tagname    => 'creation_release',
                            -value      => $1
                            );
            $self->annotation_collection->add_Annotation($release);
        } elsif ($version =~ m{\(Rel\.\s(\d+),\sLast\supdated,\sVersion\s(\d+)\)}xmso ) {
            my $release = Bio::Annotation::SimpleValue->new(
                            -tagname    => 'update_release',
                            -value      => $1
                            );
            $self->annotation_collection->add_Annotation($release);
            my $update = Bio::Annotation::SimpleValue->new(
                           -tagname    => 'update_version',
                           -value      => $2
                           );
            $self->annotation_collection->add_Annotation($update);
        }
        push @{ $self->{'_params'}->{'-dates'} }, $date;
    }
}

# UniProt/SwissProt DT lines
}
_swiss_datedescriptionprevnextTop
sub _swiss_date {
    my ($self, $data) = @_;
    # swissprot
    my @dls = split m{\n}, $data->{DATA};
    for my $dl (@dls) {
        my ($date, $version) = split(' ', $dl, 2);
        $date =~ tr{,}{}d; # remove comma if new version    
        if ($version =~ m{\(Rel\. (\d+), Last sequence update\)} || # old
            $version =~ m{sequence version (\d+)\.}) { #new
        my $update = Bio::Annotation::SimpleValue->new(
                                    -tagname    => 'seq_update',
                                    -value      => $1
                                    );
        $self->annotation_collection->add_Annotation($update);
        } elsif ($version =~ m{\(Rel\. (\d+), Last annotation update\)} || #old
                 $version =~ m{entry version (\d+)\.}) { #new
            $self->{'_params'}->{'-version'} = $1;
            $self->{'_params'}->{'-seq_version'} = $1;
        }
        push @{ $self->{'_params'}->{'-dates'} }, $date;
    }
}

# GenBank KEYWORDS line
# EMBL KW line
# UniProt/SwissProt KW line
}
_generic_keywordsdescriptionprevnextTop
sub _generic_keywords {
    my ($self, $data) = @_;
    $data->{DATA} =~ s{\.$}{};
    my @kw = split m{\s*\;\s*}xo ,$data->{DATA};
    $self->{'_params'}->{'-keywords'} =\@ kw;
}

# GenBank DEFINITION line
# EMBL DE line
# UniProt/SwissProt DE line
}
_generic_descriptiondescriptionprevnextTop
sub _generic_description {
    my ($self, $data) = @_;
    $self->{'_params'}->{'-desc'} = $data->{DATA};
}

# GenBank ACCESSION line
# EMBL AC line
# UniProt/SwissProt AC line
}
_generic_accessiondescriptionprevnextTop
sub _generic_accession {
    my ($self, $data) = @_;
    my @accs = split m{[\s;]+}, $data->{DATA};
    $self->{'_params'}->{'-accession_number'} = shift @accs;
    $self->{'_params'}->{'-secondary_accessions'} =\@ accs if @accs;
}

####################### SPECIES HANDLERS #######################

# uses Bio::Species
# GenBank SOURCE, ORGANISM lines
# EMBL O* lines
# UniProt/SwissProt O* lines
}
_generic_speciesdescriptionprevnextTop
sub _generic_species {
    my ($self, $data) = @_;
    
    my $seqformat = $self->format;
    # if data is coming in from GenBank parser...
    if ($seqformat eq 'genbank' &&
        $data->{ORGANISM} =~ m{(.+?)\s(\S+;[^\n\.]+)}ox) {
        ($data->{ORGANISM}, $data->{CLASSIFICATION}) = ($1, $2);
    }
    
    # SwissProt stuff...
    # hybrid names in swissprot files are no longer valid per intergration into
    # UniProt. Files containing these have been split into separate entries, so
    # it is probably a good idea to update if one has these lingering around...

    my $taxid;
    if ($seqformat eq 'swiss') {
        if ($data->{DATA} =~ m{^([^,]+)}ox) {
            $data->{DATA} = $1;
        }
        if ($data->{CROSSREF} && $data->{CROSSREF} =~ m{NCBI_TaxID=(\d+)}) {
            $taxid = $1;
        }
    }
    
    my ($sl, $class, $sci_name) = ($data->{DATA},
                                   $data->{CLASSIFICATION},
                                   $data->{ORGANISM} || '');
    my ($organelle,$abbr_name, $common);    
    my @class = reverse split m{\s*;\s*}, $class;
    # have to treat swiss different from everything else...
    if ($sl =~ m{^(mitochondrion|chloroplast|plastid)?   # GenBank format
                \s*(.*?)
                \s*(?: \( (.*?) \) )?\.?$ 
         }xmso ){ 
        ($organelle, $abbr_name, $common) = ($1, $2, $3); # optional
    } else {
        $abbr_name = $sl;	# nothing caught; this is a backup!
    }
    # there is no 'abbreviated name' for EMBL
    $sci_name = $abbr_name if $seqformat ne 'genbank';
    $organelle ||= '';
    $common ||= '';
    $sci_name || return;
    unshift @class, $sci_name;
    # no genus/species parsing here; moving to Bio::Taxon-based taxonomy
    my $make = Bio::Species->new();
    $make->scientific_name($sci_name);
    $make->classification(@class) if @class > 0;
    $common    && $make->common_name( $common );
    $abbr_name && $make->name('abbreviated', $abbr_name);
    $organelle && $make->organelle($organelle);
    $taxid     && $make->ncbi_taxid($taxid);
    $self->{'_params'}->{'-species'} = $make;
}

####################### ANNOTATION HANDLERS #######################

# GenBank DBSOURCE line
}
_genbank_dbsourcedescriptionprevnextTop
sub _genbank_dbsource {
    my ($self, $data) = @_;
    my $dbsource = $data->{DATA};
    my $annotation = $self->annotation_collection;
    # deal with swissprot dbsources
    # we could possibly parcel these out to subhandlers...
    if( $dbsource =~ s/(UniProt(?:KB)|swissprot):\s+locus\s+(\S+)\,.+\n// ) {
        $annotation->add_Annotation
            ('dblink',
             Bio::Annotation::DBLink->new
             (-primary_id => $2,
              -database => $1,
              -tagname => 'dblink'));
        if( $dbsource =~ s/\s*created:\s+([^\.]+)\.\n// ) {
            $annotation->add_Annotation
            ('swissprot_dates',
             Bio::Annotation::SimpleValue->new
             (-tagname => 'date_created',
              -value => $1));
        }
        while( $dbsource =~ s/\s*(sequence|annotation)\s+updated:\s+([^\.]+)\.\n//g ) {
            $annotation->add_Annotation
            ('swissprot_dates',
             Bio::Annotation::SimpleValue->new
             (-tagname => 'date_updated',
              -value => $1));
        }
        $dbsource =~ s/\n/ /g;
        if( $dbsource =~ s/\s*xrefs:\s+((?:\S+,\s+)+\S+)\s+xrefs/xrefs/ ) {
            # will use $i to determine even or odd
            # for swissprot the accessions are paired
            my $i = 0;
            for my $dbsrc ( split(/,\s+/,$1) ) {
                if( $dbsrc =~ /(\S+)\.(\d+)/ || $dbsrc =~ /(\S+)/ ) {
                    my ($id,$version) = ($1,$2);
                    $version ='' unless defined $version;
                    my $db;
                    if( $id =~ /^\d\S{3}/) {
                        $db = 'PDB';
                    } else {
                        $db = ($i++ % 2 ) ? 'GenPept' : 'GenBank';
                    }
                    $annotation->add_Annotation
                    ('dblink',
                     Bio::Annotation::DBLink->new
                     (-primary_id => $id,
                      -version => $version,
                      -database => $db,
                      -tagname => 'dblink'));
                }
            }
        } elsif( $dbsource =~ s/\s*xrefs:\s+(.+)\s+xrefs/xrefs/i ) {
            # download screwed up and ncbi didn't put acc in for gi numbers
            my $i = 0;
            for my $id ( split(/\,\s+/,$1) ) {
            my ($acc,$db);
            if( $id =~ /gi:\s+(\d+)/ ) {
                $acc= $1;
                $db = ($i++ % 2 ) ? 'GenPept' : 'GenBank';
            } elsif( $id =~ /pdb\s+accession\s+(\S+)/ ) {
                $acc= $1;
                $db = 'PDB';
            } else {
                $acc= $id;
                $db = '';
            }
            $annotation->add_Annotation
                ('dblink',
                 Bio::Annotation::DBLink->new
                 (-primary_id => $acc,
                  -database => $db,
                  -tagname => 'dblink'));
            }
        } else {
            $self->warn("Cannot match $dbsource\n");
        }
        if( $dbsource =~ s/xrefs\s+\(non\-sequence\s+databases\):\s+
            ((?:\S+,\s+)+\S+)//x ) {
            for my $id ( split(/\,\s+/,$1) ) {
                my $db;
                # this is because GenBank dropped the spaces!!!
                # I'm sure we're not going to get this right
                ##if( $id =~ s/^://i ) {
                ##    $db = $1;
                ##}
                $db = substr($id,0,index($id,':'));
                if (! exists $DBSOURCE{ $db }) {
                    $db = '';   # do we want 'GenBank' here?
                }
                $id = substr($id,index($id,':')+1);
                $annotation->add_Annotation
                    ('dblink',Bio::Annotation::DBLink->new
                     (-primary_id => $id,
                      -database => $db,
                      -tagname => 'dblink'));
            }
        }
    } else {
        if( $dbsource =~ /^(\S*?):?\s*accession\s+(\S+)\.(\d+)/ ) {
            my ($db,$id,$version) = ($1,$2,$3);
            $annotation->add_Annotation
            ('dblink',
             Bio::Annotation::DBLink->new
             (-primary_id => $id,
              -version => $version,
              -database => $db || 'GenBank',
              -tagname => 'dblink'));
        } elsif ( $dbsource =~ /(\S+)([\.:])(\d+)/ ) {
            my ($id, $db, $version);
            if ($2 eq ':') {
                ($db, $id) = ($1, $3);
            } else {
                ($db, $id, $version) = ('GenBank', $1, $3);
            }
            $annotation->add_Annotation('dblink',
                Bio::Annotation::DBLink->new(
                    -primary_id => $id,
                    -version => $version,
                    -database => $db,
                    -tagname => 'dblink')
                );
        } else {
            $self->warn("Unrecognized DBSOURCE data: $dbsource\n");
        }
    }
}

# EMBL DR lines
# UniProt/SwissProt DR lines
}
_generic_dbsourcedescriptionprevnextTop
sub _generic_dbsource {
    my ($self, $data) = @_;
    #$self->debug(Dumper($data));
    while ($data->{DATA} =~ m{([^\n]+)}og) { 
        my $dblink = $1;
        $dblink =~ s{\.$}{};
        my $link;
        my @linkdata = split '; ',$dblink;
        if ( $dblink =~ m{([^\s;]+);\s*([^\s;]+);?\s*([^\s;]+)?}) {
        #if ( $dblink =~ m{([^\s;]+);\s*([^\s;]+);?\s*([^\s;]+)?}) {
            my ($databse, $prim_id, $sec_id) = ($1,$2,$3);
            $link = Bio::Annotation::DBLink->new(-database    => $databse,
                                -primary_id  => $prim_id,
                                -optional_id => $sec_id);
        } else {
            $self->warn("No match for $dblink");
        }
        $self->annotation_collection->add_Annotation('dblink', $link);        
    }
}


# GenBank REFERENCE and related lines
# EMBL R* lines
# UniProt/SwissProt R* lines
}
_generic_referencedescriptionprevnextTop
sub _generic_reference {
    my ($self, $data) = @_;
    my $seqformat = $self->format;
    my ($start, $end);
    # get these in EMBL/Swiss
    if ($data->{CROSSREF}) {
        while ($data->{CROSSREF} =~ m{(pubmed|doi|medline)(?:=|;\s+)(\S+)}oig) {
            my ($db, $ref) = (uc $1, $2);
            $ref =~ s{[;.]+$}{};
            $data->{$db} = $ref;
        }
    }
    # run some cleanup for swissprot
    if ($seqformat eq 'swiss') {
        for my $val (values %{ $data }) {
            $val =~ s{;$}{};
            $val =~ s{(\w-)\s}{$1};
        }
    }
    if ( $data->{POSITION} ) {
        if ($seqformat eq 'embl') {
            ($start, $end) = split '-', $data->{POSITION},2;
        } elsif ($data->{POSITION} =~ m{.+? OF (\d+)-(\d+).*}) { #swiss
            ($start, $end) = ($1, $2);
        }
    }
    if ($data->{DATA} =~ m{^\d+\s+\([a-z]+\s+(\d+)\s+to\s+(\d+)\)}xmso) {
        ($start, $end) = ($1, $2);
    } 
    my $ref = Bio::Annotation::Reference->new(
                    -comment    => $data->{REMARK},
                    -location   => $data->{JOURNAL},
                    -pubmed     => $data->{PUBMED},
                    -consortium => $data->{CONSRTM},
                    -title      => $data->{TITLE},
                    -authors    => $data->{AUTHORS},
                    -medline    => $data->{MEDLINE},
                    -doi        => $data->{DOI},
                    -rp         => $data->{POSITION}, # JIC...
                    -start      => $start,
                    -end        => $end,
                    );
    if ($data->{DATA} =~  m{^\d+\s+\((.*)\)}xmso) {
	      $ref->gb_reference($1);
	}
    $self->annotation_collection->add_Annotation('reference', $ref);
}

# GenBank COMMENT lines
# EMBL CC lines
# UniProt/SwissProt CC lines
}
_generic_commentdescriptionprevnextTop
sub _generic_comment {
    my ($self, $data) = @_;
    $self->annotation_collection->add_Annotation('comment',
        Bio::Annotation::Comment->new( -text => $data->{DATA} ));
}

####################### SEQFEATURE HANDLER #######################

# GenBank Feature Table
}
_generic_seqfeaturesdescriptionprevnextTop
sub _generic_seqfeatures {
    my ($self, $data) = @_;
    return if $data->{FEATURE_KEY} eq 'FEATURES';
    my $primary_tag = $data->{FEATURE_KEY};
    
    # grab the NCBI taxon ID from the source SF
    if ($primary_tag eq 'source' && exists $data->{'db_xref'}) {
        if ( $self->{'_params'}->{'-species'} &&
            $data->{'db_xref'} =~ m{taxon:(\d+)}xmso ) {
            $self->{'_params'}->{'-species'}->ncbi_taxid($1);
        }
    }
    my $source = $self->format;
    
    my $seqid = ${ $self->get_params('accession_number')  }{'accession_number'};
    
    my $loc;
    eval {
        $loc = $self->{'_locfactory'}->from_string($data->{'LOCATION'});
    };
    if(! $loc) {
        $self->warn("exception while parsing location line [" .
                    $data->{'LOCATION'} .
                    "] in reading $source, ignoring feature " .
                    $data->{'primary_tag'}.
                    " (seqid=" . $seqid . "): " . $@);
        return;
    }
    if($seqid && (! $loc->is_remote())) {
        $loc->seq_id($seqid); # propagates if it is a split location
    }
    my $sf = Bio::SeqFeature::Generic->direct_new();
    $sf->location($loc);
    $sf->primary_tag($primary_tag);
    $sf->seq_id($seqid);
    $sf->source_tag($source);
    delete $data->{'FEATURE_KEY'};
    delete $data->{'LOCATION'};
    delete $data->{'NAME'};
    delete $data->{'DATA'};
    $sf->set_attributes(-tag => $data);
    push @{ $self->{'_params'}->{'-features'} }, $sf;
}

####################### ODDS AND ENDS #######################

# Those things that don't fit anywhere else.  If a specific name 
# maps to the below table, that class and method are used, otherwise
# it goes into a SimpleValue (I think this is a good argument for why
# we need a generic mechanism for storing annotation)
}
_generic_simplevaluedescriptionprevnextTop
sub _generic_simplevalue {
    my ($self, $data) = @_;
    $self->annotation_collection->add_Annotation(
        Bio::Annotation::SimpleValue->new(-tagname => lc($data->{NAME}),
       -value => $data->{DATA})
        );
}
_debugdescriptionprevnextTop
sub _debug {
    my ($self, $data) = @_;
    $self->debug(Dumper($data));
}


1;
}
General documentation
FEEDBACKTop
Mailing ListsTop
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
Support Top
Please direct usage questions or support issues to the mailing list:
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.
Reporting BugsTop
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/
AUTHOR - Chris FieldsTop
Email cjfields at bioperl dot org
APPENDIXTop
The rest of the documentation details each of the object methods. Internal
methods are usually preceded with a _
Bio::HandlerBaseI implementing methodsTop
Methods unique to this implementationTop