#!/usr/bin/perl -w

#
# tasuke_track_gff.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_track";
my $TRACK   = '';
my $CREATE  = 1;
my $REMOVE  = 0;
my $LIST    = 0;
my $FILE    = '';
my $DB      = '';
my $HOST    = 'localhost';
my $USER    = '';
my $PASS    = '';

################################################################
# Checking parameters and database connection
################################################################
GetOptions( 't|track=s'     => \$TRACK,
            'r|remove'      => \$REMOVE,
            'l|list'        => \$LIST,
            'f|file=s'      => \$FILE,
            'db|database=s' => \$DB,
            'h|host=s'      => \$HOST,
            'u|user=s'      => \$USER,
            'p|password=s'  => \$PASS
);

if ( !$DB || !$USER ) {
    _error_method();
    exit;
}
if (!$LIST&&($TRACK eq '' ||(!$REMOVE&&!-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("sys_track") ) {
    print "Track table does not exists.\n";
    print "Did you excute 'tasuke_init.pl' at the first?\n";
    _exit();
}

###########################################################
# Listing track
###########################################################
if ($LIST) {
    print "[List of tracks] :\n";
    foreach my $l (_lists()) {
        print "$l\n";
    }
    _exit();
}

###########################################################
# Removing track
###########################################################
if ($REMOVE) {
    _dbexe("DELETE FROM $TABLE WHERE track='$TRACK';");
    print "$TRACK track is deleted.\n";
    _exit();
}

###########################################################
# Prepareing table
###########################################################
if(! _check_exists_note()){
    _add_column_note();
}

###########################################################
# Checking idx note
###########################################################
if( _check_exists_idx()){
    _drop_idx_note();
}

###########################################################
# Checking p_idx 
###########################################################
if( _check_exists_idx_pidx()){
    _drop_idx_pidx();
}

###########################################################
# Creating track
###########################################################
if ($CREATE) {
    _print_time("Begining");
    if ( my @dup = grep { /$TRACK/i } _lists() ) {
        print "$TRACK is exists\n";
        exit;
    }

    open IN, '<', $FILE or die "file open error: $!";
    while (<IN>) {
        if ($_ !~ /^#/i){
            chomp($_);
            my @line=split(/\t/, $_);
            my $CHR=$line[0];
            my $TYPE=$line[2];
            my $START=int($line[3]);
            my $END=int($line[4]);
            my $STRAND="null";
            my $NOTE="";
            my $OTHERS="null";
            $STRAND="1" if $line[6] eq "+";
            $STRAND="0" if $line[6] eq "-";
            my $PARENT="1";
            my $ID="";
            my $NAME="";
            if ($line[8]) {
                my @attr=split(/;/, $line[8]);
                if (my @p = grep { /parent=/i } @attr) {
                    if ( length(@attr) == 1 ) {
                        $PARENT="0";
                        my @tmp=split(/=/, $p[0]);
                        $ID=$tmp[1];
                        $NAME="null";
                    }
                } else {
                    my @i = grep { /id=/i } @attr;
                    my @tmp=split(/=/,$i[0]);
                    $ID=$tmp[1];
                    if (my @n = grep { /name=/i } @attr) {
                        my @tmp=split(/=/,$n[0]);
                        $NAME=$tmp[1];
                    } else {
                        $NAME=$ID;
                    }
                    if (my @nt = grep { /note=/i } @attr) {
                        my @tmp=split(/=/,$nt[0]);
                        $NOTE=$tmp[1];
                        $NOTE=~s/'//g;
                    }
                    if (my @nt = grep { !/name=/i } @attr && grep { !/id=/i } @attr && grep { !/parent=/i } @attr && grep { !/note=/i } @attr) {
                        $OTHERS="";
                        foreach my $str (@nt){
                            $str=~s/'//g;
                            $OTHERS.=$str.";";
                        }
                    }
                }
            }
            _dbexe("INSERT INTO $TABLE(track,chr,id,name,parent,type,pos,end,strand,note,others) VALUES('$TRACK','$CHR','$ID','$NAME','$PARENT','$TYPE',$START,$END,$STRAND,'$NOTE','$OTHERS')");
        }
    }
    close (IN);
    _add_idx_note();
    _add_idx_pidx();
    _print_time("complete");
}
_exit();

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

sub _error_method {
    print "\nCreating annotation track\n";
    print "tasuke_track_gff.pl -t [track(name)] -f [GFF] -db [database] -u [user] -p [password]\n\n";
    print "Removing track\n";
    print "tasuke_track_gff.pl -r -t [track(name)] -db [database] -u [user] -p [password]\n\n";
    print "Listing track\n";
    print "tasuke_track_gff.pl -l -db [database] -u [user] -p [password]\n\n";
}

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";
}

### Listing tracks ####################################
sub _lists {
    my $val;
    my @tracks;
    my $query = "SELECT distinct track FROM $TABLE order by seq";
    my $query_handle = $connect->prepare($query);
    $query_handle->execute();
    $query_handle->bind_columns(undef, \$val);
    while($query_handle->fetch()) {
        push @tracks, $val;
    }
    return @tracks;
}

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

### Checking column "note" ###############################
sub _check_exists_note {
    my $val = $connect->selectrow_array("show columns from sys_track where Field = 'note'");
    return $val;
}

### Add column "note"###################################
sub _add_column_note{
    _dbexe("alter table sys_track add column note text");
    _dbexe("alter table sys_track add column others text");
}

### Checking index "note" ###############################
sub _check_exists_idx {
    my $val = $connect->selectrow_array("show index from sys_track where Column_name='note' and Index_type='FULLTEXT'");
    return $val;
}

### Add index "note"###################################
sub _add_idx_note{
    _dbexe("alter table sys_track add fulltext(note)");
    _dbexe("alter table sys_track add fulltext(others)");
}

### Drop index "note"###################################
sub _drop_idx_note{
    _dbexe("alter table sys_track drop index note");
    _dbexe("alter table sys_track drop index others");
}

### Checking index for loading ###############################
sub _check_exists_idx_pidx{
    my $val = $connect->selectrow_array("show index from sys_track where Key_name='p_idx'");
    return $val;
}

### Add index for loading ###################################
sub _add_idx_pidx{
    _dbexe("alter table sys_track add index p_idx(chr,pos)");
}

### Drop index for loading ###################################
sub _drop_idx_pidx{
    _dbexe("alter table sys_track drop index p_idx");
}

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