#!/usr/bin/perl -w

#
# tasuke_ref.pl
# http://tasuke.dna.affrc.go.jp/
#
# Copyright (c) 2013 National Institute of Agrobiological Sciences   
#
# This software is released under the MIT License.
#
# http://opensource.org/licenses/mit-license.php
#

use strict;
use DBI;
use Getopt::Long;

my $TABLE   = "sys_fasta";
my $CREATE  = 0;
my $DELETE  = 0;
my $FILE    = '';
my $DB      = '';
my $HOST    = 'localhost';
my $USER    = '';
my $PASS    = '';

################################################################
# Checking parameters and database connection
################################################################
GetOptions( 
            'r|restore'     => \$DELETE,
            'f|file=s'      => \$FILE,
            'db|database=s' => \$DB,
            'h|host=s'      => \$HOST,
            'u|user=s'      => \$USER,
            'p|password=s'  => \$PASS
);

if ( !$DB || !$USER || (!$DELETE && !-e$FILE)) {
    _error_method();
    exit;
}

my $connect = DBI->connect('DBI:mysql:database='.$DB.';host='.$HOST,$USER,$PASS)
  or die "Can't connect to database: $DBI::errstr\n";

###########################################################
# Checking base table
###########################################################
if ( ! defined _check_exists_table($TABLE) ) {
    print "Reference table does not exists.\n";
    print "Did you excute 'tasuke_init.pl' at the first?\n";
    exit;
}

###########################################################
# Drop table
###########################################################
if ($DELETE) {
    _dbexe("TRUNCATE TABLE $TABLE;");
    print "Reference sequence was deleted.\n";
    _exit();
}

###########################################################
# Checking ref-seq already installed or not
###########################################################
if(defined _check_seq_table()){
    print "Reference sequence is already installed.\n";
    print "If you want to install again. \nPlease run this tool again with \"-r\" option for restore reference sequence table.\n";
    _exit();
}

###########################################################
# Insert fasta
###########################################################
_print_time("*[fasta]  begin");
my (@chrs) = _chrs();
_createQry(@chrs);
_dbexe("LOCK TABLES $TABLE WRITE;");
_updateRef(@chrs);
_dbexe("UNLOCK TABLES;");
_print_time(" [fasta]  complete");
_exit();

###########################################################
# Functions
###########################################################
sub _updateRef {
    my (@c)= @_;
    open IN, '<', $FILE or die "file open error: $!";
    my $POS=0;
    my $CHR="";
    my $GO=0;

    while (<IN>) {
        chomp($_);
        if ($_ =~ /^>/i){
            my @chrline;
            $CHR=$_;
            $CHR=~s/>//g;
            $CHR =~ s/^\s*(.*?)\s*$/$1/;
            @chrline = split(/ /, $CHR);
            $CHR=$chrline[0];
            $POS=0;
            $GO=0;
            for(my $i=0; $i<=$#c; $i++) {
                if ($c[$i] eq $CHR ) {
                    $GO=1;
                    print $CHR."\n";
                }
            }
        } elsif ($GO) {
            my $line=$_;
            $line =~ s/^\s*(.*?)\s*$/$1/;
            my @p;
            my $query="UPDATE $TABLE SET ".$CHR."_f=case pos ";
            for (my $j=0; $j < length($line); $j++){
                $POS++;
                push @p, "$POS";
                my $FASTA = substr($line, $j, 1);
                $query .= "when $POS then '$FASTA' ";
            }
            $query .= "end WHERE pos in(";
            for (my $j=0; $j < length($line); $j++){
                $query .= $p[$j];
                $query .= "," if $j < length($line)-1;
            }
            $query.=")";
            _dbexe($query);
        }
    }
    close (IN);
}

sub _createQry {
    my $m = _max();
    my $str="";
    for (my $i=1;$i<=$m;$i++) {
        if ( $i == $m || !($i%2000) ) {
            $str.="($i)";
            _dbexe("INSERT into $TABLE(pos) values $str;");
            $str="";
        } else {
            $str.="($i),";
        }
    }
} 

### Set chromosome ################################################
sub _chrs {
    my $val="";
    my @c;
    my $query = "SELECT id FROM sys_chromosome";
    my $query_handle = $connect->prepare($query);
    $query_handle->execute();
    $query_handle->bind_columns(undef, \$val);
    while($query_handle->fetch()) {
        push @c, $val;
    }
    return @c;
}

### Set max of chromosome ################################################
sub _max {
    my $val;
    my $query = "SELECT max(size) FROM sys_chromosome";
    my $query_handle = $connect->prepare($query);
    $query_handle->execute();
    $val = $query_handle->fetchrow_hashref;
    return $val->{'max(size)'};
}

### Execute DB ################################################
sub _dbexe {
    my ($query) = @_;
    my $query_handle = $connect->prepare($query);
    $query_handle->execute() or warn "Excute error: $DBI::errstr\n";
}

#### Usage #######################################
sub _error_method {
    print "\nCreating reference sequence track\n";
    print "./tasuke_ref.pl -f [.fasta] -db [database] -u [user] -p [password]\n\n";
    print "Restoring track\n";
    print "./tasuke_ref.pl -r -db [database] -u [user] -p [password]\n\n";
}

#### Time #######################################
sub _print_time {
    my ($str) = @_;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime;
    $year += 1900;
    $mon += 1;
    my $datetime = sprintf "%04d-%02d-%02d %02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec;
    print "$str : $datetime\n";
}

### Checking table ####################################
sub _check_exists_table {
    my ($t) = @_;
    my $val = $connect->selectrow_array("show tables like '$t'");
    return $val;
}

### Installed or not ####################################
sub _check_seq_table {
    my $val = $connect->selectrow_array("show tables like 'sys_fasta'");
    my $res = $connect->selectrow_array("select * from sys_fasta where pos = 1") if defined $val;
    return $res;
}

#### Disconnection and exit #######################################
sub _exit {
    $connect->disconnect or warn "Disconnection error: $DBI::errstr\n";
    exit;
}

