=pod

=head1 LICENSE

Copyright [1999-2015] Wellcome Trust Sanger Institute and the EMBL-European Bioinformatics Institute
Copyright [2016-2022] EMBL-European Bioinformatics Institute

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

=head1 NAME

Bio::EnsEMBL::IO::Parser::Genbank - GenBankParser

=cut

package Bio::EnsEMBL::IO::Parser::Genbank;

use strict;
use warnings;
use Carp;

use parent qw/Bio::EnsEMBL::IO::TokenBasedParser/;

=head2 open

    Description: Open the file given in parameters, the file has to be a valid Genbank file
    Returntype : Filehandle to the GenBank file

=cut

sub open {
    my $caller = shift;
    my $class = ref($caller) || $caller;
    my $filename = shift;
    
    my $self = $class->SUPER::open($filename, '^LOCUS', '^//', @_);
    
    $self->next_block();
    return $self;
}

=head2 is_metadata

    Description: Define what a meta data is for the GenBank file
    Returntype : Boolean, 1 if the line contains metadata

=cut

sub is_metadata {
    my $self = shift;
    return $self->{'current_block'} =~ /^#/;
}

=head2 read_record

    Description: Placeholder for user-defined record lexing function.
                 Function must pre-process the data in $self->current block so that it is
                 readily available to accessor methods.
    Returntype : Void 

=cut

sub read_record {
    my $self = shift;
    
    while (!$self->is_at_beginning_of_record) {
      $self->next_block;
    }
    while (!$self->is_at_end_of_record) {
        my ($field_type, $field) = $self->{'current_block'} =~ /^(\w+)\s+(.*)/;
        unless (defined($field_type)) { croak ("Genbank record parsing going badly.\n".$self->{current_block}."\n".$self->{filename}) };
        chomp $field;
        if ($field_type eq 'LOCUS') {
            $field =~ /(\S+)\s+(\d+)\s[bpa]{2}/;
            $self->{'record'}->{'_locus_id'} = $1;
            $self->{'record'}->{'_length'}   = $2;
            my $molecule = substr($field, 31, 12);
            if ($molecule =~ /(\w+)/) {
                $self->{'record'}->{'_molecule'} = $1;
            }
            $self->{'record'}->{'_tax'}               = substr($field, 52, 3);
            $self->{'record'}->{'_modification_date'} = substr($field, 56, 11);
            if (substr($field, 43, 8) eq 'circular') {
                $self->{'record'}->{'_is_circular'} = 1;
            }
            else {
                $self->{'record'}->{'_is_circular'} = 0;
            }
        }
        elsif ($field_type eq 'ACCESSION') {
            $field .= $self->_get_multiline;
            $self->{'record'}->{'_raw_accession'} = $field;
        }
        elsif ($field_type eq 'VERSION') {
            if ($field =~ /\S+\.(\d+)/) {
                $self->{'record'}->{'_version'} = $1;
            }
            else {
                $self->{'record'}->{'_version'} = $field;
            }
            if ($field =~ /GI:(\d+)/) {
              $self->{'record'}->{'_genebank_id'} = $1;
            }
            else {
              $self->{'record'}->{'_genebank_id'} = undef;
            }
        }
        elsif ($field_type eq 'COMMENT' || $field_type eq 'REFERENCE') {
            # REFERENCE is not used by the genebuild team so it can be "removed"
            push(@{$self->{'record'}->{'_raw_'.lc($field_type)}},  $field.$self->_get_multiline);
        }
        elsif ($field_type eq 'DEFINITION') {
            $field .= $self->_get_multiline;
            $self->{'record'}->{'_raw_definition'} = $field;
        }
        elsif ($field_type eq 'ORIGIN') {
            $field .= $self->_get_multiline;
            $field =~ s/[\d\s]+//g;
            $self->{'record'}->{'_seq'} = $field;
        }
        elsif ($field_type eq 'FEATURES') {
            $self->{record}->{_raw_features} = $self->_get_raw_multiline;
        }
        elsif (defined $field_type) {
            $self->{'record'}->{'_raw_'.lc($field_type)} = $field.$self->_get_multiline;
        }
        else {
            push(@{$self->{'record'}->{'_unknown'}}, $field);
        }
        $self->next_block;
    }
}

=head2 _get_multiline

    Description: Some field can be on multiple lines, this method makes sure that we have all
                 the field information on one line
    Returntype : String

=cut

sub _get_multiline {
    my $self = shift;
    my $field = '';
    while (defined $self->{'waiting_block'} && $self->{'waiting_block'} !~ /^\S/) {
        $self->next_block;
        $field .= $self->{'current_block'};
        chomp $field;
    }
    # We replace multiple spaces/tabulation to be 1 space
    $field =~ s/\s\s+/ /g;
    return $field;
}

=head2 _get_raw_multiline

    Description: Feature blocks can have significant whitespace and newlines. This method returns the
                 whole multiline section as a it appears in the file
    Returntype : String (with linefeeds)

=cut

sub _get_raw_multiline {
    my $self = shift;
    my $field = '';
    while (defined $self->{'waiting_block'} && $self->{'waiting_block'} !~ /^\S/) {
        $self->next_block;
        $field .= $self->{'current_block'};
    }
    return $field;
}

=head2 read_metadata

    Description: Read the metadata field of the line
                 As far as I know, there is no metadata in the GenBank file so we return nothing
    Returntype : Void

=cut

sub read_metadata {
    my $self = shift;

    # We do nothing
    # print STDERR 'DEBUG: Met metadata!! :', $self->{'current_block'}, ":\n";
}

=head2 get_raw_description

    Description: Return the raw definition field from the GenBank file
    Returntype : String

=cut

sub get_raw_description {
    my $self = shift;

    return $self->{'record'}->{'_raw_definition'};
}

=head2 get_description

    Description: Return the definition field from the GenBank file
    Returntype : String

=cut

sub get_description {
    my $self = shift;

    return $self->get_raw_description;
}

=head2 get_sequence

    Description: Return the sequence from the GenBank file
    Returntype : String

=cut

sub get_sequence {
    my $self = shift;

    return $self->{'record'}->{'_seq'};
}

=head2 get_accession

    Description: Return the accession of the sequence
    Returntype : String

=cut

sub get_accession {
    my $self = shift;

    if (!exists $self->{'record'}->{'_accession'}) {
        ($self->{'record'}->{'_accession'}) = $self->{'record'}->{'_raw_accession'} =~ /^(\w+)/;
    }
    return $self->{'record'}->{'_accession'};
}

=head2 get_sequence_name

    Description: Return the accession withe the sequence version of the sequence
    Returntype : String

=cut

sub get_sequence_name {
    my $self = shift;

    return $self->get_accession.'.'.$self->{'record'}->{'_version'};
}

=head2 get_genbank_id

    Description: Return the GenBank Id of the sequence
    Returntype : String

=cut

sub get_genbank_id {
    my $self = shift;

    return $self->{'record'}->{'_genebank_id'};
}

=head2 get_sequence_version

    Description: Return the sequence version of the sequence
    Returntype : String

=cut

sub get_sequence_version {
    my $self = shift;

    return $self->{'record'}->{'_version'};
}

=head2 get_length

    Description: Return the length of the sequence
    Returntype : String

=cut

sub get_length {
    my $self = shift;

    return $self->{'record'}->{'_length'};
}

=head2 get_locus_id

    Description: Return the locus id of the sequence. It can be the gene name if it exists
    Returntype : String

=cut

sub get_locus_id {
    my $self = shift;

    return $self->{'record'}->{'_locus_id'};
}

=head2 get_sequence_type

    Description: Return the type of the sequence: mRNA, DNA, RNA
    Returntype : String

=cut

sub get_sequence_type {
    my $self = shift;

    return $self->{'record'}->{'_molecule'};
}

=head2 get_modification_date

    Description: Return the last modification date in the GenBank format
    Returntype : String

=cut

sub get_modification_date {
    my $self = shift;

    return $self->{'record'}->{'_modification_date'};
}

=head2 is_circular

    Description: Return true if the sequence is circular
    Returntype : Boolean

=cut

sub is_circular {
    my $self = shift;

    return $self->{'record'}->{'_is_circular'};
}

=head2 get_raw_organism

    Description: Return the organism name 
    Returntype : String

=cut

sub get_raw_organism {
    my $self = shift;

    return $self->{'record'}->{'_raw_source'};
}

=head2 get_source

    Description: Return the organism name in the ORGANISM field
    Returntype : String

=cut

sub get_source {
    my $self = shift;

    $self->{'record'}->{'_raw_source'} =~ /^(.+)\s+ORGANISM/;
    # A bit ugly I agree
    return $1;
}

=head2 get_organism

    Description: Return the organism name 
    Returntype : String

=cut

sub get_organism {
    my $self = shift;

    if (!exists $self->{'record'}->{'_organism'}) {
        # Instead of trying an impossible regex, I first get the line until ';', then I remove the last word
        # as it will be the root of the taxonomy
        ($self->{'record'}->{'_organism'}) = $self->{'record'}->{'_raw_source'} =~ /ORGANISM\s*([^;]+)/;
        $self->{'record'}->{'_organism'} =~ s/\s+\w+$//;
    }
    return $self->{'record'}->{'_organism'};
}

=head2 get_taxon_id

    Description: Return the NCBI taxonomy id of the organism
    Returntype : Integer

=cut

sub get_taxon_id {
    my $self = shift;

    if (!exists $self->{'record'}->{'_taxon_id'}) {
        ($self->{'record'}->{'_taxon_id'}) = $self->{'record'}->{'_raw_features'} =~ /db_xref="taxon:(\d+)/;
    }
    return $self->{'record'}->{'_taxon_id'};
}

=head2 get_raw_dblinks

    Description: Return the DBLINK fields from the GenBank file
    Returntype : String

=cut

sub get_raw_dblinks {
    my $self = shift;
    if (!exists $self->{'record'}->{'_raw_dblink'}) {
        return
    }
    return $self->{'record'}->{'_raw_dblink'};
}

=head2 get_raw_comment

    Description: Return the COMMENT fields from the GenBank file
    Returntype : String

=cut

sub get_raw_comment
{
    my $self = shift;
    if (! exists $self->{'record'}->{'_raw_comment'}) {
        return;
    }
    return $self->{'record'}->{'_raw_comment'};
}

=head2 get_features

    Description: Return an array of features as hashes. Feature type is given the 'header' key
                 All keys barring header and the position string are arrayrefs to allow for
                 a multiplicity of keys. Multi-line strings have been concatenated into a single line.
                 The "position" coordinates are with reference to get_sequence()

                 Example keys include: gene, gene_synonym, db_xref, product and many more as per Genbank spec
    Example    : @features = @{ $parser->get_features};
                 foreach my $feat (@features) {
                    if ($feat->{header} eq 'gene') {
                        print $feat->{position}.':'.$feat->{gene}."\n"
                    }
                 }
    Returntype : Array reference

=cut

sub get_features {
    my $self = shift;
    my @features;
    my %feature;
    my $line_buffer;
    if (!exists $self->{record}->{_features}) {
        foreach my $line (split /\n/, $self->{record}->{_raw_features}) {
            if ($line =~ /^\s{5}(\w+)/) {
                push @features,$self->_finish_feature(\%feature, $line_buffer) if %feature;
                undef %feature;
                $line_buffer = '';
                my ($header,$position) = $line =~ /^\s{5}(\S+)\s+(.+)/;
                # Note that position can be complement() and or join(coord1,coord2)
                %feature = ( header => $header, position => $position);
            } else {
                $line =~ s/^\s+//;
                chomp $line;
                $line_buffer .= $line;
            }

        }
        push @features,$self->_finish_feature(\%feature, $line_buffer); # Commit last feature from buffer
        $self->{record}->{_features} = \@features;
    }
    return $self->{record}->{_features};
}

sub _finish_feature {
    my $self = shift;
    my $feature = shift;
    my $line_buffer = shift;

    my @sections = split '/',$line_buffer;
    foreach my $section (@sections) {
        my ($key,$value) = split '=',$section;
        $value =~ s/"//g if $value;
        if ($key && $value) {
            push @{ $feature->{$key} },$value;
        } elsif ($key) {
            push @{ $feature->{$key} },'1';
        }
    }
    my %final_copy = %$feature;
    return \%final_copy;
}

1;
