#!/usr/bin/perl -w
#
# tasuke_track_gff.pl
# http://tasuke.dna.affrc.go.jp/
#
# Author: Jungsok Kim, Ryutaro Itoh
#
# Copyright (c) 2013 National Institute of Agrobiological Sciences
#

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    = '';
my $RDBMS = '';
my $TABLESPACE = '';

################################################################
# 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,
            'b|backend=s'   => \$RDBMS,
            's|space=s'   => \$TABLESPACE,
            'p|password=s'  => \$PASS
);

if ( !$DB || !$USER ) {
    _error_method();
    exit;
}
if (!$LIST&&($TRACK eq '' ||(!$REMOVE&&!-e$FILE))) {
    _error_method();
    exit;
}

my $connect;
if($RDBMS eq "oracle"){
    if(!$TABLESPACE){
        _error_method();
        exit;
    }
    $connect = DBI->connect('DBI:Oracle:host='.$HOST.';SERVICE_NAME='.$DB.';',$USER,$PASS)
    or die "Can't connect to database: $DBI::errstr\n";
    if(!_check_exists_tablespace($TABLESPACE)){
        print "Tablespace: '$TABLESPACE' is not found.";
        _exit(1);
    }
}else{
    $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(1);
}

###########################################################
# 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'");
    _rm_gfftrack($TRACK);
    print "$TRACK track is deleted.\n";
    _exit();
}

if($RDBMS ne "oracle"){
    ###########################################################
    # 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();
    }
}else{
    _disable_indexes();
}

#open(my $IN,"<Glycine_max.Glycine_max_v2.0.41.chr.gff3"); ##for Ensemble plants:OK
#open(my $IN,"<TAIR10_GFF3_genes.gff"); ## for TAIR10:OK
#open(my $IN,"<Homo_sapiens.GRCh37.68.chr.protein-coding-gene.utr.gff"); ##for human100:OK
#open(my $IN,"<Homo_sapiens.GRCh37.68.chr.ncRNA.gff"); ##for human100
#open(my $IN,"<GRCh38_latest_genomic.gff");##for NCBI:OK
#open(my $IN,"<test.gff"); ##for Ensemble human:OK
#open(my $IN,"<BeetSet-2.unfiltered_genes.1408.Bvchr2_un_sca004_bolting.gff3"); ##for augustus output?:OK
#open(my $IN,"<transcripts.gff"); ##for RAP-DB:OK

my $id;
my $parent;
my $topr;
my %id_prnt;
my %isExistsID;
my %idhash;

###########################################################
# Creating track
###########################################################
if ($CREATE) {
    _print_time("Begining");
    if ( my @dup = grep { /$TRACK/i } _lists() ) {
        print "'$TRACK' already exist\n";
        exit(1);
    }
    my $stmt_count = 0;
    my @gffs = _readGff();
    for (@gffs) {
	if ($_ !~ /^#/) { ##except header
		my $line = $_;
		my $existid = 0;
		my $existpr = 0;
		$line =~ s/[\r\n]//g;
		my @lines = split(/\t/,$line);
                my $CHR=$lines[0];
                my $TYPE=$lines[2];
                my $START=int($lines[3]);
                my $END=int($lines[4]);
                my $STRAND="null";
                my $NOTE="";
                my $OTHERS="null";
                $STRAND="1" if $lines[6] eq "+";
                $STRAND="0" if $lines[6] eq "-";
                my $PARENT="1";
		next if($lines[1] =~ m/^refseq$/i && $TYPE eq 'region');	# full length Chromosome region
		if ($TYPE =~ /chromosome/ || $TYPE =~ /protein/) {
			$PARENT = "0";
		}
                my $ID="";
                my $NAME="";
		my @features = split(/;/,$lines[8]);
		for my $feature (@features) {
			if ($feature =~ /^id=/i) { 
				my @tmp = split(/=/,$feature);
				$existid = 1;
				#$id  = $tmp[1];
				$ID  = $tmp[1];
			} elsif ($feature =~ /^parent=/i) {
				my @tmp = split(/=/,$feature);
				if($tmp[1] =~ /,/) { ## for TAIR10
					my @tmp2 = split(/,/,$tmp[1]);
					$parent = $tmp2[0];
				} else {
					$parent = $tmp[1];
				}
				$existpr = 1;
			} elsif ($feature =~ /^name=/i) {
				my @tmp = split(/=/,$feature);
				$NAME = $tmp[1];
			}
=head
			} else {
				if ($feature =~ /^name=/i) {
					my @tmp = split(/=/,$feature);
					$NAME = $tmp[1];
				} else {
					$NAME=$ID;
				}
			}
=cut
			$OTHERS = $lines[8];
		}
		$NAME = $ID if(!$NAME);
		if ($existid == 1 and $existpr == 0) { ##parent
		 	$isExistsID{$ID} = 1; ##parent dictionary
		} elsif ($existpr == 1) { ##child (RNA or exon?)
			if($isExistsID{$parent}) { ##if parent exists
				if ($ID ne "") { ## PCG or PConly for other gff
					$idhash{$ID} = $parent; ## parent-child relationship
					$id_prnt{$parent}{$ID} = 0; ## RNA section
				} else { ##PConly for RAP-DB and so on
					$PARENT = "0";
					$ID = $parent;
					$id_prnt{$parent}++;
				}
			}  else { ## other feature section
				$parent =~ s/ //g;
				my $prntid = $idhash{$parent};
				if(exists($id_prnt{$prntid}) && exists($id_prnt{$prntid}{$parent})) {
					_dbexe("update $TABLE set parent = '0' where id = '$prntid'");
					$PARENT = "0";
					$ID = $parent;
					$id_prnt{$prntid}{$parent}++;
				}
			}
		}
		$TRACK =~ s/'/''/g;
		$CHR =~ s/'/''/g;
		$ID =~ s/'/''/g;
		$NAME =~ s/'/''/g;
		$TYPE =~ s/'/''/g;
		$NOTE =~ s/'/''/g;
		$OTHERS =~ s/'/''/g;
		_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')");
	}
    }
    $parent = "";
    close (IN);
    if($RDBMS eq "oracle"){
        _rebuild_indexes();
        _sync_oracle_text();
    }else{
        _add_idx_note();
        _add_idx_pidx();
    }
    _print_time("complete");
}
_exit();

### Read GFF #################################################
sub _readGff {
    my @reffile = split(/\./,$FILE);
    my $ext = $reffile[$#reffile];
    my @lines;
    local(*IN);
    if ($ext eq "gz") {
        open IN, "gzip -dc $FILE |" or die "file open error: $!";
    } elsif ($ext eq "bz2") {
        open IN, "bzip2 -dc $FILE |" or die "file open error: $!";
    } else {
        open IN, '<', $FILE or die "file open error: $!";
    }
    @lines = <IN>;
    close(IN);

    return(@lines);
}
### Removing from a table ####################################
sub _rm_gfftrack{
    my ($dest) = @_;
    my $stmt_count = 0;

    if($RDBMS eq "oracle"){
        my $query = "DELETE FROM $TABLE WHERE track='$dest'";
        my $sth = $connect->prepare($query);
        my $error="";
        if($stmt_count == 0){
            $connect->begin_work;
        }
        $stmt_count++;
        eval{
            $sth->execute() or die "Cannot execute: " . $sth->errstr();
        };
        if($@){
            $connect->rollback();
            _exit(1);
        }else{
            if($stmt_count>=1000 or eof IN){
                $connect->commit();
                $stmt_count = 0;
            }
        }
        _sync_oracle_text();
    }else{
        _dbexe("LOCK TABLES $TABLE WRITE;");
        _dbexe("DELETE FROM $TABLE WHERE track='$dest'");
        _dbexe("UNLOCK TABLES;");
    }
}
### Execute DB ################################################
sub _dbexe {
    my ($query) = @_;
    my $query_handle = $connect->prepare($query);
    $query_handle->execute() or warn "Excute error: $DBI::errstr\n";
}

sub _dbexeIgnNamePh{
    my ($query) = @_;
    my $query_handle = $connect;
    $query_handle->{odbc_ignore_named_placeholders} = 1;
    $query_handle->do($query) or warn "Excute error: $DBI::errstr\n";#odbc_ignore_named_placeholders
}

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( For oracle database: -b oracle -s [tablespace])\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 $val2;
    my @tracks;
    my $query = "";
    if($RDBMS eq "oracle"){
        $query = "SELECT distinct track FROM (SELECT track, seq from $TABLE order by seq) tmp";
    }else{
#        $query = "SELECT distinct track,seq FROM $TABLE order by seq";
        $query = "SELECT track,min(seq) as minseq FROM $TABLE group by track order by minseq";
    }
    my $query_handle = $connect->prepare($query);
    $query_handle->execute();
    $query_handle->bind_columns(undef, \$val,\$val2);
    while($query_handle->fetch()) {
        push @tracks, $val;
    }
    return @tracks;
}
### Checking table ####################################
sub _check_exists_table {
    my ($t) = @_;
    my $val;
    if($RDBMS eq "oracle"){
        $t = uc($t);
        $val = $connect->selectrow_array("select table_name from user_tables where tablespace_name = '$TABLESPACE' and table_name = '$t'");
    }else{
        $val = $connect->selectrow_array("show tables like '$t'");
    }
    return $val;
}

### Checking tablespace ####################################
sub _check_exists_tablespace {
    my ($t) = @_;
    $t = uc($t);
    my $val = $connect->selectrow_array("select tablespace_name from user_tablespaces where tablespace_name = '$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" for old schema ###################################
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" for mysql ###############################
sub _check_exists_idx {
    my $val = $connect->selectrow_array("show index from sys_track where Column_name='note' and Index_type='FULLTEXT'");
    return $val;
}

### updating oracle text index #########################
sub _sync_oracle_text{
    _dbexeIgnNamePh("BEGIN
                    ctx_ddl.sync_index('SYS_TRACK_ID_IDX');
                    ctx_ddl.optimize_index('SYS_TRACK_ID_IDX','full');
                    ctx_ddl.sync_index('SYS_TRACK_NOTE_IDX');
                    ctx_ddl.optimize_index('SYS_TRACK_NOTE_IDX','full');
                    ctx_ddl.sync_index('SYS_TRACK_OTHERS_IDX');
                    ctx_ddl.optimize_index('SYS_TRACK_OTHERS_IDX','full');
                    END;");
}

### disable indexes ###################################
sub _disable_indexes{
    _dbexe("alter index SYS_TRACK_IDX unusable");
    _dbexe("alter index SYS_TRACK_PIDX unusable");
    _dbexe("alter index sys_track_id_idx unusable");
    _dbexe("alter index sys_track_note_idx unusable");
    _dbexe("alter index sys_track_others_idx unusable");
}

### rebuild indexes ###################################
sub _rebuild_indexes{
    _dbexe("alter index SYS_TRACK_IDX rebuild");
    _dbexe("alter index SYS_TRACK_PIDX rebuild");
    _dbexe("alter index sys_track_id_idx rebuild");
    _dbexe("alter index sys_track_note_idx rebuild");
    _dbexe("alter index sys_track_others_idx rebuild");
}

### 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 {
    my ($arg) = @_;
    my $code = 0;
    if(defined $arg){$code = $arg;}
    $connect->disconnect or warn "Disconnection error: $DBI::errstr\n";
    exit($code);
}
=pod
##key1:parent, key2:child, $id_prnt:the number of child or grandchild##
for my $key1 (keys(%id_prnt)) {
	if($id_prnt{$key1} !~ /^[0-9]+$/) { 
		for my $key2 (keys($id_prnt{$key1})) {
			print "$key1\t$key2\t$id_prnt{$key1}{$key2}\n";
		}
	} else {
		if (!(defined($id_prnt{$key1}))) {
			$id_prnt{$key1} = 0;
		}
		print "$key1\t$id_prnt{$key1}\n";
	}
}
=cut
