#!/usr/bin/env perl

use strict;
use Carp;
use DBI;

### GENERAL VARIABLES ###
# PURY parameter file
my $PURY_HOME = $ENV{"PURY"};
my $PURY_DATABASE_FILE = $PURY_HOME."server/PURY.db";
my $PURY_DATABASE_FILE_MEM = "/dev/shm/PURY.par";


my $FILE = "undef.list" ;
open (IN, $FILE) or die "NO LIST ($FILE) FILE: $!\n";
my @lines = <IN>;
close IN;

my $line ;
my @bonds = () ;
my @angles = () ;
my @diheds = () ;
my @impros = () ;
my $II  = 0 ;
my $IA  = 0 ;
my $ID  = 0 ;
my $IM  = 0 ;
foreach $line ( @lines ) 
{
#    print substr($line, 0,9), " ++>", $line ;
    chomp $line ;
    if ( substr($line, 0,10) eq " DEF_BOND>" ) 
    { 
	my @words = split ( '\|', $line ) ;
	my %bs ; 
	$bs{a1} = $words[1] ;
	$bs{a2} = $words[3] ;
	$bs{"target"} = $words[5] ;
	push(@bonds, \%bs ) ;
#	print $II, $bs{a1}, $bs{a2}, "\n" ;
	$II++ ;
    }
    if ( substr($line, 0,10) eq " DEF_ANGL>" ) 
    { 
	my @words = split ( '\|', $line ) ;
	my @bs = ($words[1], $words[3], $words[5], $words[7]) ;
	push (@angles, \@bs ) ;
	print $IA, " angles> ", join(" - ", @bs), "\n" ;
	$IA++ ;
    }
    if ( substr($line, 0,9) eq " TP_DIHE>" ) 
    { 
	my @words = split ( '\|', $line ) ;
	my @bs = ($words[1], $words[3], $words[5], $words[7]) ;
	push (@diheds, \@bs ) ;
	print $ID, " diheds> ", join(" - ", @bs), "\n" ;
	$ID++ ;
    }
    if ( substr($line, 0,12) eq " TP_RS_IMPR>" ) 
    { 
	my @words = split ( '\|', $line ) ;
	my @bs = ($words[1], $words[3], $words[5], $words[7]) ;
	push (@impros, \@bs ) ;
	print $IM, " imprs> ", join(" - ", @bs), "\n" ;
	$IM++ ;
    }

}

#${$bonds[0]}[0] = "C__Y" ;
#${$bonds[0]}[1] = "O__Y" ;
#push ( @{$bonds[0]}, "C__Y" ) ;

sql_get_param ( \@bonds, \@angles, \@diheds, \@impros ) ;

exit ;

sub sql_get_param { 
    
    my ( $ref_bond_list, $ref_angl_list, $ref_dihe_list, $ref_impr_list) = @_ ;
    my @bond_list = @{$ref_bond_list } ;
    my @angle_list = @{$ref_angl_list } ;
    my @dihed_list = @{$ref_dihe_list } ;
    my @impros_list = @{$ref_impr_list } ;
    
    my %par_bond;
    my %par_angl;
    my %par_dihe;
    my %par_impr;


    my $dbh = DBI->connect ("dbi:SQLite:".$PURY_DATABASE_FILE) || die "Cannot connect: $DBI::errstr";
 
    
    print "! > BONDS ", $#bond_list, " !!!! <<<\n";    
    my $sname;
    my $count = 0 ;
    my $bond ;
    foreach $bond (@bond_list) 
    {
	$count++ ;
	my %bs = %{ $bond } ;
	my $b1 = $bs{"a1"} ;
	my $b2 = $bs{"a2"} ;
	my @sorted = sort ($b1, $b2);
	$sname = "$sorted[0]--$sorted[1]";
#	print $count, " bond:> ", $b1, " - ", $b2, "\n" ;
	# SQL search
	if ( !exists( $par_bond{$sname} ) )
	{
	    $par_bond{$sname} = "done" ;
	    my $find = $sname;
	    my $single = $dbh -> selectrow_arrayref ('SELECT * FROM bond WHERE bond = ?', undef, $find);
	    
	    if ($single) 
	    {
		printf "BOND %4s %4s  %8.3f %8.3f ! sigma %8.4f repeat %6d\n", $b1, $b2, $single->[2], $single->[1], $single->[3], $single->[4];   
# 	    $bond_par->{force} = $single->[2];
# 	    $bond_par->{avg} = $single->[1];
# 	    $bond_par->{sigma} = $single->[3];
# 	    $bond_par->{repeat} = $single->[4];
	    } else 
	    {
		# EXPAND this routine !!!
		printf "BOND %4s %4s  %8.3f %8.3f ! MISSING \n", $b1, $b2, 100, $bs{"target"};   
	    } 
	}	
    }   
    
    print "\n ! ANGLES $#angle_list \n" ;

    my $angle ;
    foreach $angle (@angle_list) 
    {
	$count++ ;
	my @bs = @{ $angle } ;
	my $b1 = $bs[0] ;
	my $b2 = $bs[1] ;
	my $b3 = $bs[2] ;
	my @sorted = sort ($b1, $b3);
	$sname = "$sorted[0]--$b2--$sorted[1]";
	if ( !exists( $par_angl{$sname} ) )
	{
	    $par_angl{$sname} = "done" ;
	    # SQL search
	    my $find = $sname;
	    my $single = $dbh -> selectrow_arrayref ('SELECT * FROM angle WHERE angle = ?', undef, $find);
	    
	    if ($single) {
		printf "ANGLE %4s %4s %4s %8.3f %8.3f ! sigma %8.4f repeat %6d\n", $b1, $b2, $b3, $single->[2], $single->[1], $single->[3], $single->[4];   
# 	    $bond_par->{force} = $single->[2];
# 	    $bond_par->{avg} = $single->[1];
# 	    $bond_par->{sigma} = $single->[3];
# 	    $bond_par->{repeat} = $single->[4];
	    } else {
		# EXPAND this routine !!!
		printf "ANGLE %4s %4s %4s %8.3f %8.3f ! ----  MISSING  ----\n", $b1, $b2, $b3, 100, $bs[3];   
	    } 
	    
	}   
    }
	
    print "\n ! DIHEDRALS ", $#dihed_list, "\n" ;

    my $dihe ;
    foreach $dihe (@dihed_list) 
    {
	$count++ ;
	my @bs = @{ $dihe } ;
	my $b1 = $bs[0] ;
	my $b2 = $bs[1] ;
	my $b3 = $bs[2] ;
	my $b4 = $bs[3] ;

	my $s1 = $b2."---".$b1;
	my $s2 = $b3."---".$b4;
	
	my @in_sort = sort ($s1, $s2);
	
	($b2, $b1) = split /---/, $in_sort[0];
	($b3, $b4) = split /---/, $in_sort[1];
	
	my $sname = "$b1--$b2--$b3--$b4";
	$s1 = "--$b2--$b3--";

	my $find = $sname;
	if ( !exists( $par_dihe{$sname} ) )
	{
	    $par_dihe{$sname} = "done" ;
	    my $single = $dbh -> selectrow_arrayref ('SELECT * FROM dihedral WHERE dihedral = ?', undef, $find);
	    
	    if ($single) {
		printf "DIHED %4s %4s %4s %4s %8.3f %2d %8.3f ! sigma %8.4f repeat %6d\n", 
		$b1, $b2, $b3, $b4, $single->[2], $single->[3],  $single->[1], $single->[4], $single->[5];   
	    } else {
		printf "DIHED %4s %4s %4s %4s %8.3f %2d %8.3f ! ----  MISSING  ----\n", $b1, $b2, $b3, $b4, 10., 3, 180.;   
	    } 
	}   
    }

    print "\n ! IMPROPERS $#impros_list \n" ;

    my $impr ;
    foreach $impr (@impros_list) 
    {
	$count++ ;
	my @bs = @{ $impr } ;
	my $b1 = $bs[0] ;
	my $b2 = $bs[1] ;
	my $b3 = $bs[2] ;
	my $b4 = $bs[3] ;

	my $s1 = $b2."---".$b1;
	my $s2 = $b3."---".$b4;
	
	my @in_sort = sort ($s1, $s2);
	
	($b2, $b1) = split /---/, $in_sort[0];
	($b3, $b4) = split /---/, $in_sort[1];
	
	my $sname = "$b1--$b2--$b3--$b4";
	$s1 = "--$b2--$b3--";

	if ( !exists( $par_impr{$sname} ) )
	{
	    $par_impr{$sname} = "done" ;
	    my $find = $sname;
	    my $single = $dbh -> selectrow_arrayref ('SELECT * FROM improper WHERE improper = ?', undef, $find);
	    
	    if ($single) {
		printf "IMPRO %4s %4s %4s %4s %8.3f %2d %8.3f ! sigma %8.4f repeat %6d\n", $b1, $b2, $b3, $b4, $single->[2], $single->[3], $single->[1], $single->[4], $single->[5];   
	    } else {
		printf "IMPRO %4s %4s %4s %4s %8.3f %2d %8.3f ! ----  MISSING  ----\n", $b1, $b2, $b3, $b4, 10., 0, 180.;   
	    } 
	    
	    
	}   
    }	
	
    $dbh -> disconnect();
	
}
