package Maasha::KISS::IO;

# Copyright (C) 2009 Martin A. Hansen.

# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.

# http://www.gnu.org/copyleft/gpl.html


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


# Routines for parsing and emitting KISS records.

# http://code.google.com/p/biopieces/wiki/KissFormat


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


use warnings;
use strict;
use Data::Dumper;
use Maasha::Common;
use Maasha::Filesys;
use Maasha::Align;
use Maasha::SQL;
use vars qw( @ISA @EXPORT );

@ISA = qw( Exporter );

use constant {
    S_ID        => 0,
    S_BEG       => 1,
    S_END       => 2,
    Q_ID        => 3,
    SCORE       => 4,
    STRAND      => 5,
    HITS        => 6,
    ALIGN       => 7,
    BLOCK_COUNT => 8,
    BLOCK_BEGS  => 9,
    BLOCK_LENS  => 10,
    BLOCK_TYPE  => 11,
};


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<


sub kiss_entry_get
{
    my ( $fh,    # file handle
       ) = @_;

    # Returns a hashref.

    my ( $line, @fields, %entry );

    while ( $line = <$fh> )
    {
        chomp $line;

        next if $line =~ /^$|^#/;

        @fields = split /\t/, $line;

        Maasha::Common::error( qq( BAD kiss entry: $line) ) if not @fields == 12;
        
        $entry{ 'S_ID' }        = $fields[ S_ID ];
        $entry{ 'S_BEG' }       = $fields[ S_BEG ];
        $entry{ 'S_END' }       = $fields[ S_END ];
        $entry{ 'Q_ID' }        = $fields[ Q_ID ];
        $entry{ 'SCORE' }       = $fields[ SCORE ];
        $entry{ 'STRAND' }      = $fields[ STRAND ];
        $entry{ 'HITS' }        = $fields[ HITS ];
        $entry{ 'ALIGN' }       = $fields[ ALIGN ];
        $entry{ 'BLOCK_COUNT' } = $fields[ BLOCK_COUNT ];
        $entry{ 'BLOCK_BEGS' }  = $fields[ BLOCK_BEGS ];
        $entry{ 'BLOCK_LENS' }  = $fields[ BLOCK_LENS ];
        $entry{ 'BLOCK_TYPE' }  = $fields[ BLOCK_TYPE ];

        return wantarray ? %entry : \%entry;
    }
}


sub kiss_entry_put
{
    my ( $entry,   # KISS entry to output
         $fh,      # file handle  -  OPTIONAL
       ) = @_;

    # Returns nothing.
    
    my ( @fields );

    if ( defined $entry->{ 'S_ID' } and 
         defined $entry->{ 'S_BEG' } and
         defined $entry->{ 'S_END' }
       )
    {
        $fh ||= \*STDOUT;
    
        $fields[ S_ID ]        = $entry->{ 'S_ID' };
        $fields[ S_BEG ]       = $entry->{ 'S_BEG' };
        $fields[ S_END ]       = $entry->{ 'S_END' };
        $fields[ Q_ID ]        = $entry->{ 'Q_ID' };
        $fields[ SCORE ]       = $entry->{ 'SCORE' };
        $fields[ STRAND ]      = $entry->{ 'STRAND' };
        $fields[ HITS ]        = $entry->{ 'HITS' };
        $fields[ ALIGN ]       = $entry->{ 'ALIGN' };
        $fields[ BLOCK_COUNT ] = $entry->{ 'BLOCK_COUNT' };
        $fields[ BLOCK_BEGS ]  = $entry->{ 'BLOCK_BEGS' };
        $fields[ BLOCK_LENS ]  = $entry->{ 'BLOCK_LENS' };
        $fields[ BLOCK_TYPE ]  = $entry->{ 'BLOCK_TYPE' };

        print $fh join( "\t", @fields ), "\n";
    }
}


sub kiss_sql_get
{
    my ( $dbh,     # Database handle
         $table,   # Table name
         $s_beg,   # Subject begin
         $s_end,   # Subject end
       ) = @_;

    my ( $sql, $entries );

    # $sql = "SELECT * FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end ORDER BY S_BEG,S_END";
    $sql = "SELECT S_BEG,S_END,Q_ID,ALIGN FROM $table WHERE S_BEG >= $s_beg AND S_END <= $s_end";

    $entries = Maasha::SQL::query_hashref_list( $dbh, $sql );

    return wantarray ? @{ $entries } : $entries;
}


sub kiss_index
{
    # Martin A, Hansen, October 2009.

    # Creates an index of a sorted KISS file that
    # allowing the location of the byte position
    # from where records can be read given a
    # specific S_BEG position. The index consists of
    # triples: [ beg, end, bytepos ], where beg and
    # end denotes the interval where the next KISS
    # record begins at bytepos.

    my ( $fh,   # filehandle to KISS file
       ) = @_;

    # Returns a list.

    my ( $line, @fields, $beg, $end, $pos, @index );

    $beg = 0;
    $pos = 0;

    while ( $line = <$fh> )
    {
        chomp $line;

        @fields = split /\t/, $line, 3;
        
        $end = $fields[ S_BEG ];

        if ( $end == 0 )
        {
            push @index, [ $beg, $end, $pos ];
            $beg = 1;
        }
        elsif ( $end > $beg )
        {
            push @index, [ $beg, $end - 1, $pos ];
            $beg = $end;
        }
        elsif( $end < $beg )
        {
            Maasha::Common::error( qq(KISS file not sorted: $end < $beg) );
        }

        $pos += 1 + length $line;
    }

    return wantarray ? @index : \@index;
}


sub kiss_index_store
{
    my ( $path,
         $index,
       ) = @_;

    Maasha::Filesys::file_store( $path, $index );
}


sub kiss_index_retrieve
{
    my ( $path,
       ) = @_;

    my $index;

    $index = Maasha::Filesys::file_retrieve( $path );

    return wantarray ? @{ $index } : $index;
}


sub kiss_index_search
{
    my ( $index,
         $num,
       ) = @_;

    # Returns a number.

    my ( $high, $low, $try );

    $low  = 0;
    $high = scalar @{ $index };

    while ( $low <= $high )
    {
        $try = int( ( $high + $low ) / 2 );
    
        if ( $num < $index->[ $try ]->[ 0 ] ) {
            $high = $try;
        } elsif ( $num > $index->[ $try ]->[ 1 ] ) {
            $low = $try + 1;
        } else {
            return $index->[ $try ]->[ 2 ];
        }
    }

    Maasha::Common::error( "Could not find number->$num in index" );
}


sub kiss_index_get
{
    my ( $file,
         $beg,
         $end,
       ) = @_;

    my ( $index, $offset, $fh, $entry, @entries );

    $index = Maasha::KISS::IO::kiss_index_retrieve( "$file.index" );

    $offset = Maasha::KISS::IO::kiss_index_search( $index, $beg );

    $fh = Maasha::Filesys::file_read_open( $file );

    sysseek( $fh, $offset, 0 );

    while ( $entry = kiss_entry_get( $fh ) )
    {
        push @entries, $entry;

        last if $entry->{ 'S_END' } > $end;
    }

    close $fh;

    return wantarray ? @entries : \@entries;
}


sub kiss_align
{
    # S.aur_COL       41      75      5_vnlh2ywXsN1/1 1       -       .       17:A>T,31:A>N   .       .       .       .

    my ( $s_seqref,   # subject sequence reference
         $entry,      # KISS entry
       ) = @_;

    # Returns a string.

    my ( $align, $pos, $s_symbol, $q_symbol, $s_seq, $q_seq, $insertions );

    $s_seq = substr ${ $s_seqref }, $entry->{ 'S_BEG' }, $entry->{ 'S_END' } - $entry->{ 'S_BEG' } + 1;
    $q_seq = $s_seq;

    $insertions = 0;

    foreach $align ( split /,/, $entry->{ 'ALIGN' } )
    {
        if ( $align =~ /(\d+):(.)>(.)/ )
        {
            $pos      = $1;
            $s_symbol = $2;
            $q_symbol = $3;

            if ( $s_symbol eq '-' ) # insertion
            {
                substr $s_seq, $pos + $insertions, 0, $s_symbol;
                substr $q_seq, $pos + $insertions, 0, $q_symbol;

                $insertions++;
            }
            elsif ( $q_symbol eq '-' ) # deletion
            {
                substr $q_seq, $pos + $insertions, 1, $q_symbol;
            }
            else # mismatch
            {
                substr $q_seq, $pos + $insertions, 1, $q_symbol;
            }
        }
        else
        {
            Maasha::Common::error( qq(Bad alignment descriptor: "$align") );
        }
    }

    Maasha::Align::align_print_pairwise( [ $entry->{ 'S_ID' }, $s_seq ], [ $entry->{ 'Q_ID' }, $q_seq ] );
}


sub kiss2biopiece
{
    my ( $entry,   # KISS entry
       ) = @_;

    return wantarray ? %{ $entry } : $entry;
}


sub biopiece2kiss
{
    my ( $record,   # Biopiece record
       ) = @_;

    $record->{ 'SCORE' }       ||= $record->{ 'E_VAL' } || ".";
    $record->{ 'HITS' }        ||= ".";
    $record->{ 'BLOCK_COUNT' } ||= ".";
    $record->{ 'BLOCK_BEGS' }  ||= ".";
    $record->{ 'BLOCK_LENS' }  ||= ".";
    $record->{ 'BLOCK_TYPE' }  ||= ".";
    $record->{ 'ALIGN' }       ||= $record->{ 'DESCRIPTOR' } || ".";

    return wantarray ? %{ $record } : $record;
}


# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

1;


