#!/usr/bin/perl

# util.pm
# Copyright 2002 Nat Echols and Werner Krebs.
# Last modified with functions added 2007 by Samuel Flores
#
# Library of utility functions for the morph
# server and motions database.  Any subroutines
# used in more than one script should probably
# go here (PDB handling and graphics functions
# are in different modules, however).
#

require '/usr/local/server/etc/config.pm';
require "$PREFIX/lib/pdb.pm";
use DBI;
use XML::DOM;
use File::Copy;

#######################################
#---------- MYSQL FUNCTIONS ----------#
#######################################

sub db_connect {
	my ($USER, $PASSWD, $DB) = @_;
	if (! $DB) {
		$DB = $DATABASE; # revert to default
	}
	
	my $mysql = DBI->connect("DBI:mysql:$DB:localhost:3306", $USER, $PASSWD);
	if ($mysql) {
		return $mysql;
	}
	else {
		print STDERR "[ $0 ] : Could not connect to the database as $USER\n";
		return 0;
	}
}

sub sqlDo {
#
# added by Samuel Flores
# 9 February 05
#
        my ($stmt,$db,$print) = @_;
        if (!($db)){$db ="molmovdb";}
	if ($print) {print "$stmt\n";}
        my @table = ();
	#print ">inside sqlDo:  >$ROOT_USER,$ROOT_PASSWD, $db<\n";
        my $mysql = &db_connect($ROOT_USER,'26gS1a1B', $db) ;
        $mysql->do("$stmt") ;

        $mysql->disconnect() ;

        return @table;
}


sub sqlRow {
	my ($stmt, $db,$print) = @_;
	if (! $db) {
		$db = $DATABASE;
	}
	print "$stmt\n" if ($print);
	my $mysql = &db_connect($CGI_USER, $CGI_PASSWD, $db);
	

	my $query = $mysql->prepare($stmt);
	$query->execute();
	my @row = $query->fetchrow_array();
	$query->finish();
	$mysql->disconnect();
	print "@row\n" if ($print);
	
	return @row;
}

sub sqlRow_single {
        # hacked by Samuel Flores 9 March 05
        # sqlRow wasn't working for some reason
        my ($stmt, $db,$print) = @_;

        if (! $db) {
                $db = $DATABASE;
        }
        my $mysql = &db_connect($CGI_USER, $CGI_PASSWD, $db);

        my $query = $mysql->prepare($stmt);
        $query->execute();
        my @row = $query->fetchrow_array();
        $query->finish();
        $mysql->disconnect();
	if ($print) {print "$stmt\n"; print "@row[0]\n";}
        return @row[0];
}


sub sqlHash {
	my ($stmt, $db) = @_;
	if (! $db) {
		$db = $DATABASE;
	}
	my $mysql = &db_connect($CGI_USER, $CGI_PASSWD, $db);
	
	my $query = $mysql->prepare($stmt);
	$query->execute();
	my %row = %{ $query->fetchrow_hashref() };
	$query->finish();
	$mysql->disconnect();

	return %row;
}

sub sqlTable {
	my ($stmt, $db,$print) = @_;
	if ($print) {print $stmt;}
	my @table = ();
	my $mysql = &db_connect($CGI_USER, $CGI_PASSWD, $db);

	my $query = $mysql->prepare($stmt);
	$query->execute();
	while (my @row = $query->fetchrow_array()) {
		push(@table, [ @row ]);
	}
	$query->finish();
	$mysql->disconnect();

	return @table;
}

sub sqlArray {
    my @array = ();
    my $mysql = &db_connect($CGI_USER, $CGI_PASSWD);
    my $stmt = $_[0];
    print "$stmt\n" if ($_[1]);	   
    my $query = $mysql->prepare($stmt);
    $query->execute();
    while (my @row = $query->fetchrow_array()) {
        push(@array, $row[0]);
    }
    $query->finish();
    $mysql->disconnect();
    
    return @array;
}

sub sqlScalar {
	
	my $mysql = db_connect($CGI_USER, $CGI_PASSWD);
	my $stmt = $_[0];
	
	my $query = $mysql->prepare($stmt);
	$query->execute();
	my $val = ($query->fetchrow_array())[0];
	$query->finish();
	$mysql->disconnect();

	return $val;
}

sub untaint_sql {
    my $string = $_[0];
    $string =~ s/\n//g;
    $string =~ s/\ \ /\ /g;
    $string =~ s/;//g;
    $string =~ s/\*//g;
    $string =~ s/\'/\\\'/g;
    $string =~ s/\"/\\\"/g;
    $string =~ s/\&//g;
    return $string;
}

# Deprecated
sub getMorphList {
    my @morphs = &sqlArray("SELECT mid_ FROM stats");

    return @morphs;
}

##########################################
#---------- MISC CGI FUNCTIONS ----------#
##########################################

sub logmsg {
	my $msg = $_[0];
	print STDERR "[ $$ ]: $msg\n";
}

sub printarray {
	my @array = @_;
	
	my $text;
	for $i (0 ... ($#array - 1)) {
		 $text .= "$array[$i]\t";
	}
	$text .= "$array[$#array]\n";
}

sub print2Darray {
	my @table = @_;
	for $i (0 ... $#table) {
		printarray(@{ $table[$i] });
	}
}

sub get_date {
	open (DATE, "/bin/date |");
	while (<DATE>) {
		$date = $_;
	}
	return $date;
}

sub gen_ID {
    my $temp = substr time, 4;
    my $temp_id = $temp . "-" . $$;
    return $temp_id;
}

sub untaint {
	local ($var) = shift @_;

	if ($var =~ /^([-\@\w.]+)$/) {
		$var = $1;
	}
	else {
		&errorExit("[ $0 ] : Bad data in $var");
	}
	return($var);
}

sub untaint2 {
	local ($var) = shift @_;

	if ($var =~ /^([-\/\@\w.]+)$/) {
		$var = $1;
	}
	else {
		&errorExit("[ $0 ] : Bad data in $var");
	}
	return($var);
}

sub untaint3 {
	local ($var) = shift @_;

	if ($var =~ /^([-\/\@\w.]+)$/) {
		$var = $1;
	}
	else {
		$var = $1; #always untaint.
	}
	return($var);
}

sub untaint4 {
	local ($var) = shift @_;
	local ($default) = shift @_;

	if ($var =~ /^([-\@\w.]+)$/) {
		return $var;
	}
	else {
		return $default;
	}
}

# Basic sort add-on.
sub numerically { $a <=> $b; }


##########################################
#--- CONFORMATION EXPLORER UTILITIES ----#
##########################################

sub alt_conformers_table_to_pdb
{
# this program gets pitch, yaw, roll coordinates from sql table alt_conformers and puts into a pdb-formatted file which can then be displayed by cgi-bin/motion-viewer.cgi.
#usage sub alt_conformers_table_to_pdb ($query, $outfilename)
$outfile = @_[1];
$myquery = @_[0];
$mymid_ = @_[2];
$cells = @_[3]; #this makes pretty boxes around existing conformers.  It's slow, so only use it when generating figures for the paper.
# $myquery has to look something like the following.  Don't alter any of the column names, but can add columns after roll and change conditions at will.
#$myquery = "select distinct struct_id,generated_from,energy, pitch, yaw,roll from alt_conformers where struct_id >= \"$loweststructure\" and timesteps >= $timesteps and (energy <> 0) ; ";
print $myquery;
@mytable = sqlTable($myquery);
print "\nwill write table to $outfile\n";
open (MYFILE, ">$outfile");
# don't print MODEL 0; this will be done when movie.pdb.gz is generated.
$i=0;
while ($mytable[$i][0])
{
$energy = $mytable[$i][2];
$pitch = $mytable[$i][3];
$yaw = $mytable[$i][4];
$roll = $mytable[$i][5];
$atno = $i;
format MYFILE =
ATOM  @####  C       @####   @#####.#@#####.#@#####.#       @#####   @<<<<<<<<<
      $atno,          $atno,  $pitch, $yaw,   $roll,        $energy, $struct_id
.
#print  MYFILE $energy;
write MYFILE;
$i++;
}
#scf uncomment later
print MYFILE "END\n";

close(MYFILE);

if ($cells)
	{
	open (MYFILE1, ">>$outfile");
	print MYFILE1 "MODEL 1\n";
	my $myi = 6000;	
	my $mydelta = 10;
	$maxroll=80;
	$minroll=-$maxroll;
	for (my $myiroll  =$minroll ; $myiroll  <= $maxroll; $myiroll  = $myiroll  + $mydelta)
		{
		for (my $myipitch = -20 ; $myipitch <= 80; $myipitch = $myipitch + $mydelta)
			{
			for (my $myiyaw   = -80 ; $myiyaw   <= 80; $myiyaw   = $myiyaw   +  $mydelta)
				{
				$mystructexist = sqlRow_single("select struct_id from alt_conformers where abs(yaw-$myiyaw) <= ($mydelta/2) and abs(pitch-$myipitch) <= ($mydelta/2) and abs(roll-$myiroll) <= ($mydelta/2) and motion_id = \"$mymid_\" ;",'',1);
				if ($mystructexist)
					{
print "Got one!\n";
format MYFILE1 =
HETATM@####  C       B@###    @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
	$myi  ,         $myi ,   $myipitch-$mydelta/2,$myiyaw-$mydelta/2,$myiroll-$mydelta/2,            0,			
HETATM@####  C       B@###    @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
	$myi+1  ,         $myi ,   $myipitch+$mydelta/2,$myiyaw-$mydelta/2,$myiroll-$mydelta/2,            0,			
HETATM@####  C       B@###    @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
	$myi+2  ,         $myi ,   $myipitch+$mydelta/2,$myiyaw+$mydelta/2,$myiroll-$mydelta/2,            0,			
HETATM@####  C       B@###    @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
	$myi+3  ,         $myi ,   $myipitch-$mydelta/2,$myiyaw+$mydelta/2,$myiroll-$mydelta/2,            0,			
HETATM@####  C       B@###    @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
	$myi+4,         $myi ,   $myipitch-$mydelta/2,$myiyaw-$mydelta/2,$myiroll+$mydelta/2,            0,			
HETATM@####  C       B@###    @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
	$myi+5  ,         $myi ,   $myipitch+$mydelta/2,$myiyaw-$mydelta/2,$myiroll+$mydelta/2,            0,			
HETATM@####  C       B@###    @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
	$myi+6,         $myi ,   $myipitch+$mydelta/2,$myiyaw+$mydelta/2,$myiroll+$mydelta/2,            0,			
HETATM@####  C       B@###    @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
	$myi+7  ,         $myi ,   $myipitch-$mydelta/2,$myiyaw+$mydelta/2,$myiroll+$mydelta/2,            0,			
CONECT@####@####
      $myi  ,$myi+1 
CONECT@####@####
      $myi+1,$myi+2 
CONECT@####@####
      $myi+2,$myi+3 
CONECT@####@####
      $myi+3,$myi   
CONECT@####@####
      $myi+4,$myi+5 
CONECT@####@####
      $myi+5,$myi+6 
CONECT@####@####
      $myi+6,$myi+7 
CONECT@####@####
      $myi+7,$myi+4 
CONECT@####@####
      $myi  ,$myi+4 
CONECT@####@####
      $myi+1,$myi+5 
CONECT@####@####
      $myi+2,$myi+6 
CONECT@####@####
      $myi+3,$myi+7 
.
				write MYFILE1;
				$myi += 8;
					} # of if mystructexist	
				}
			}
		}
	print MYFILE1 "END\n";
	close(MYFILE1);
	
	}

$decades =18;

if (1)
{
open (MYFILE2, ">>$outfile");
print MYFILE2 "MODEL 1\n";
for ($j = -$decades ; $j <($decades+1); $j+=3)
{
for ($k = -1; $k <2; $k+=2)
{
$atno = 30000 +$j*12+($k - 1)/2;
$pitch = $j*10;
$roll =0;
$yaw = $decades*10*$k;#(($j % 2)*2 -1);

format MYFILE2 =
HETATM@####  C        @####   @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
      $atno,          $atno,  $pitch, $yaw,   $roll,        $energy, $struct_id
HETATM@####  C        @####   @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
      $atno+2,        $atno+2, $yaw,  $pitch,  $roll,        $energy, $struct_id
HETATM@####  C        @####   @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
      $atno+4,        $atno+4, $roll,  $yaw,  $pitch,        $energy, $struct_id
HETATM@####  C        @####   @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
      $atno+6,        $atno+6, $roll, $pitch,$yaw ,        $energy, $struct_id
HETATM@####  C        @####   @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
      $atno+8,        $atno+8,  $pitch , $roll, $yaw,       $energy, $struct_id
HETATM@####  C        @####   @#####.#@#####.#@#####.#      @#####   @<<<<<<<<< 
      $atno+10,       $atno+10, $yaw, $roll, $pitch,        $energy, $struct_id
.
#print  MYFILE2 $energy;
write MYFILE2;
close(MYFILE2);

} # of for $k
open (MYFILE3, ">>$outfile");
format MYFILE3 =
CONECT@####@####
      $atno, $atno-1
CONECT@####@####
      $atno+2, $atno+1
CONECT@####@####
      $atno+4, $atno+3
CONECT@####@####
      $atno+6, $atno+5
CONECT@####@####
      $atno+8, $atno+7
CONECT@####@####
      $atno+10, $atno+9
.
#print  MYFILE3 $energy;
write MYFILE3;
} # of for $j
print MYFILE3 "END\n";
close(MYFILE3);
} #of if(0)
}

sub renumberResidues {
        my $i = 1;
        my $ID = $_[0];
	if ($_[1] eq 'SVD') {$orderby = 'svd';$renumfield='resnum_svd_renumbered';} else {$orderby = 'resnum';$renumfield='resnum_renumbered';}
        my @resnumarray = sqlArray("select resnum from sequence where  mid_ = \"$ID\" and not isnull(resnum) order by $orderby asc;");
        foreach $resnum (@resnumarray)
                {
                sqlDo("update sequence set $renumfield = $i where mid_ = \"$ID\" and resnum = $resnum;");
                $i++;
                }
}


##########################################
#---------- GRAPHICS UTILITIES ----------#
##########################################

# Most of these are equally applicable to HTML (e.g. tables).

our %COLORS = (
	'gray1' =>			'#E8E8E8',
	'gray2' =>			'#D4D4D4',
	'gray3' =>			'#C0C0C0',
	'gray4' =>          '#A0A0A0',
	'lightIndigo' =>	'#B1B1D8',
	'paleGreen' =>		'#B3FFE7',
	'paleBlue' =>		'#D3FAFF',
	'pastelGreen' => 	'#A4FFA4',
	'pastelBlue' =>		'#A4C0FF',
	'pastelRed' =>		'#FFA4A4',
);


# Generates a scaled rainbow
sub makeGradient {
	my ($size, $sat) = @_; 

	my @colors;
	
	for (my $i = 0; $i < $size; $i++) {
		push(@colors, [ &hsv2rgb(($i / ($size - 1)) * 270, $sat, 1.00) ]);
	}

	return @colors;
}

sub redBlueGradient {
	my ($size, $sat) = @_;
	my @colors;

	for (my $i = 0; $i < $size; $i++) {
		push(@colors, [ &hsv2rgb(239 + (($i / ($size - 1)) * 120), $sat, 1.00) ]);
	}
	return @colors;
}

# (hue, saturation, value) has range of
# (0:255, 0.0:1.0, 0.0:1.0)
sub hsv2rgb {
	use POSIX;

	my ($h, $s, $v) = @_;
	my $f, $p, $q, $t, $i;
		
	if ($s == 0) { 
		return ($v, $v, $v);
	}   
		
	$h /= 60;
	$v *= 255;

	$i = POSIX::floor($h);
	$f = $h - $i;
	$p = $v * (1 - $s);
	$q = $v * (1 - ($s * $f));
	$t = $v * (1 - ($s * (1 - $f)));

	if ($i == 0) {
		return ($v, $t, $p);
	} elsif ($i == 1) {
		return ($q, $v, $p);
	} elsif ($i == 2) {
		return ($p, $v, $t);
	} elsif ($i == 3) {
		return ($p, $q, $v);
	} elsif ($i == 4) {
		return ($t, $p, $v);
	} else {
		return ($v, $p, $q);
	}
}

sub rgb2hex {
	my ($r, $g, $b) = @_;

	my $code = sprintf("%x%x%x", $r, $g, $b);
	return $code;
}

#####################################
#---------- CATH AND SCOP ----------#
#####################################

sub getIdLink {
	my ($schema, $id) = @_;
	if ($schema eq 'cath') {
		return CathIDLink($id);
	} elsif ($schema eq 'scop') {
		return ScopIDLink($id);
	} elsif ($schema eq 'go') {
		return GoIDLink($id);
	}
}

sub CathIDLink {
	my $id = $_[0];

	my @cath = split(/\./, $id);
	my $url = "http://www.biochem.ucl.ac.uk/bsm/cath_new/class$cath[$0]";
	for (my $i = 1; $i <= $#cath; $i++) {
		$url .= "/$cath[$i]";
	}
	$url .= "/index.html";

	return qq(<A HREF="$url" CLASS="no_underline" TARGET="_blank">$id</A>);
}

# Figure out the sequence-identical ID for a given morph.  @ids is the
# list of possible keys to search for in the pdb_id field.
# Some morphs won't ever be found, but this should catch anything
# actually in CATH to begin with.

sub getCathID {
	my ($mid) = @_;

    my ($pdb0, $chain0, $pdb1, $chain1) = &sqlRow("SELECT inputframe0, inputchain0, inputframe1, inputchain1 FROM stats WHERE mid_ = '$mid'");
    
    $pdb0 =~ s/\.pdb//;
    $pdb1 =~ s/\.pdb//;
    
    my @ids = ($pdb0 . $chain0,
               $pdb1 . $chain1,
               $pdb0 . "0",
               $pdb1 . "0");
    
    my @entries, $i = 0;
    
    # Oooh, this will be slow.  What the hell.
    open(DOMAINS, "$PREFIX/lib/cath/CathDomainList.v2.4");
    while (<DOMAINS>) {
        chomp;
        if (! /^#/) {
            s/\s\s*/\t/g;
            my @line = split(/\t/, $_);
            my $id = "$line[1].$line[2].$line[3].$line[4].$line[5].$line[6].$line[7]";
            my $domain = substr($line[0], 0, 5);
            for (my $i = 0; $i < scalar(@ids); $i++) {
                if ($ids[$i] eq $domain) {
                    return $id;
                }
            }
        }
    }
    close(DOMAINS);
    
    return 0;
}

sub getCATHEntries {
	my $id = $_[0];

	my @entries;

	my $mysql = DBI->connect("DBI:mysql:cath:localhost:3306", $CGI_USER, $CGI_PASSWD);
	my $stmt = $mysql->prepare("SELECT cath_id, type, name FROM cath WHERE pdb_id RLIKE '$id'");
	$stmt->execute();
	while (my @row = $stmt->fetchrow_array()) {
		push (@entries, [ @row ]);
	}
	$stmt->finish();
	$mysql->disconnect();

	return @entries;
}

sub findRelatedCath {
	my ($mid) = @_;

	my $parser = new XML::DOM::Parser;
	my $doc = $parser->parsefile("$HTDOCS/db/cath_va.xml");
	my $cath = $doc->getDocumentElement();

	my $id = &getCathID($mid);
	print STDERR "$mid has CATH ID $id\n";
    my @levels = split(/\./, $id);
    my $top_id = "$levels[0].$levels[1].$levels[2]";
	my $s95_id = "$levels[0].$levels[1].$levels[2].$levels[3].$levels[4].$levels[5]";

    my @topologies = $cath->getElementsByTagName("topology");
    my $top_parent;
    for (my $i = 0; $i < scalar(@topologies); $i++) {
        if ($topologies[$i]->getAttribute("id") eq $top_id) {
            $top_parent = $topologies[$i];
			print STDERR "Found $top_id...\n";
            last;
        }
    }

    if ($top_parent) {
        my @near = $top_parent->getElementsByTagName("s95");
        for (my $i = 0; $i < scalar(@near); $i++) {
            if ($near[$i]->getAttribute("id") eq $s95_id) {
				print STDERR "Found $s95_id...\n";
                my @morphs = $near[$i]->getElementsByTagName("morph");

				my @others;
				for (my $j = 0; $j < scalar(@morphs); $j++) {
					push(@others, $morphs[$j]->getAttribute("mid"));
				}
				return @others;

            }
        }
    }

    return undef;
}

##############################################
#---------- XML HANDLING FUNCTIONS ----------#
##############################################

sub canonicalMorphs {
	my @morphs = ();
	opendir(XML, "$HTDOCS/db/xml") or &html_error("Could not read XML directory!");
	my @motions = grep(/\.xml$/, readdir(XML));

	my $parser = new XML::DOM::Parser;
	for (my $i = 0; $i <= $#motions; $i++) {
		my $report = $parser->parsefile("$HTDOCS/db/xml/$motions[$i]") or
			&html_error("Could not parse XML file for $motions[$i]");
		my $morphlink = ($report->getElementsByTagName("morph"))[0];
		if ($morphlink) {
			my $mid = $morphlink->getAttribute("id");
			push(@morphs, $mid);
		}
	}
	return @morphs;
}

sub midToMotion {
	my $ID = $_[0];

	my $name = "Other";
	if (-e "$HTDOCS/db/xml/$ID.xml") {
		my $parser = new XML::DOM::Parser;
		my $motion = $parser->parsefile("$HTDOCS/db/xml/$ID.xml");
		$name = ($motion->getElementsByTagName("motion"))[0]->getAttribute("name");
	}
	return $name;
}

##################################
#---------- MISCELLANY ----------#
##################################


#this will populate the resnum_renumbered column in sequence for a given mid_.  These are basically the residue numbers renumbered to be sequential and start with 1.
sub renumbersql {
        my $mymid_= "$_[0]";
        my @myresnumarray = sqlArray("select resnum from sequence where mid_=\"$
mymid_\" order by resnum asc;");
        for (my $i=1;$i<=scalar(@myresnumarray);$i++)
                {
                sqlDo("update sequence set resnum_renumbered = $i where mid_=\"$mymid_\" and resnum=$myresnumarray[$i-1];");
                }
}

# this runs a system call with preferred ways of handling output
# expects args:
# command to run, as quoted string.
# file to write non-error output.  output will be appended to this file.
sub mysyscall {
        print "about to issue: $_[0]\n";
	if (@_[1])
		{
       		system("@_[0] >> @_[1]") && die("Exiting now.  Failed to execute command: @_[0]\n");
        	print "system call completed.  Output written : $_[1] \n";
		
		}
	else
		{
       		system("@_[0]") && die("Exiting now.  Failed to execute command: @_[0]\n");
        	print "system call completed. Output written to STDOUT\n";
		}
}

#the following three subroutines are useful for selecting domains for subsequent highlighting or manipulation using VMD.


sub gendomainstrings {
        my $ID = $_[0]; # subroutine expects morph ID as an argument  #$ARGV[3];
        my $renumber = $_[1]; # if this is set to 1, user resnum_renumbered rather than resnum for domain numbering.  The former option is intended for conformation explorer, which renumbers the residues.
        if ($renumber) {$resnumfield = "resnum_renumbered";} else {$resnumfield = "resnum";}
        #print "select $resnumfield from sequence where mid_=\"$ID\" and domains=2;\n";
        @arrayDomain = (0,sqlArray("select $resnumfield from sequence where mid_=\"$ID\" and domains=1 and not isnull($resnumfield) and $resnumfield>0;"));
        if ($arrayDomain[1]) {$domain1 = &gendomainstring();
                                }

        @arrayDomain = (0,sqlArray("select $resnumfield from sequence where mid_=\"$ID\" and domains=2 and not isnull($resnumfield) and $resnumfield>0;"));
        #print @arrayDomain,"<domain 2\n";
        if ($arrayDomain[1]) {$domain2 = &gendomainstring();}
        @arrayDomain = (0,sqlArray("select $resnumfield from sequence where mid_=\"$ID\" and domains=3 and not isnull($resnumfield) and $resnumfield>0;"));
        if ($arrayDomain[1]) {        $domain3 = &gendomainstring();}
        #print " ****** $domain1 , $domain2, $domain3 \n";
        return($domain1 , $domain2, $domain3);
}


sub gendomainstring {
        my @test = (0,0,1);
        my $domain = 'resid';
        do {
                @test = &getindexes($test[2]);
                $domain = sprintf "%s_$test[0]",$domain;
                if($test[0] != $test[1]) {$domain = sprintf "%s_to_$test[1]",$domain;}
                if($test[2] != -1) {$domain = sprintf "%s_or_resid",$domain;}
        } while($test[2] != -1);
        return $domain;
}

### Input is the index at which to start searching for consecutive residues.
### Returns a list of 3 numbers. The first two numbers are a range of consecutive residues.
###                              The third number is the next index to start looking or
###                              -1 if there are no more.
sub getindexes {
        my $index = $_[0];
        my $currentVal = $arrayDomain[$index];
        my $endIndex = $index;

        for(;$endIndex < $#arrayDomain; $endIndex++) {
                if(($currentVal+1) != $arrayDomain[$endIndex+1]) {last;}
                $currentVal = $arrayDomain[$endIndex+1];
        }

        if($endIndex == $#arrayDomain) {return ($arrayDomain[$index],$arrayDomain[$endIndex],-1);}
        else {return ($arrayDomain[$index],$arrayDomain[$endIndex],$endIndex+1);}
}



# Perl trim function to remove whitespace from the start and end of the string
# source: http://www.somacon.com/p114.php
# -scf

sub trim($)
{
        my $string = shift;
        $string =~ s/^\s+//;
        $string =~ s/\s+$//;
        return $string;
}
# Left trim function to remove leading whitespace
sub ltrim($)
{
        my $string = shift;
        $string =~ s/^\s+//;
        return $string;
}
# Right trim function to remove trailing whitespace
sub rtrim($)
{
        my $string = shift;
        $string =~ s/\s+$//;
        return $string;
}



# I am _not_ going to link to a placeholder if I can avoid it.
sub havePartsListEntry {
	my $PDB = $_[0];
    $PDB =~ tr/a-z/A-Z/;

	open(PARTS, "$PREFIX/lib/partslist.txt") || return 0;
	while (<PARTS>) {
		chomp;
		if ($PDB eq $_) {
			return 1;
		}   
	}       
	return 0;
}

# Figure out number of frames based on either MySQL or stats file
sub get_frame_count {
	my $ID = $_[0];
    my $frames = 10;

    # Find out number of frames from MySQL
    if (my $mysql = &db_connect($CGI_USER, $CGI_PASSWD)) {
   		my $query = $mysql->prepare("SELECT outframes FROM stats WHERE mid_ = '$ID'");
		if ($query) {
    		$query->execute();
    		my @row = $query->fetchrow_array();
    		if ($row[0]) {
        		return $row[0];
    		}
		
			$query->finish();
		}
		$mysql->disconnect();
	}

    # Fall back to stats file
    if (-e "$UPLOADS/$ID/stats") {
        open(STATS, "$UPLOADS/$ID/stats");
        while (<STATS>) {
            if (/^outframes/) {
                chomp;
                s/.*\ //;
                return $_;
            }
        }
    }
	else {
		die "Aieeee!\n";
		#return 10;
	}
}

sub errorExit {
	my $errorCode = shift(@_);
	print "Content-type: text/plain", "\n\n";
	print "$errorCode";
	open(ERROROUT,">>/tmp/server.log");
	print ERROROUT "Server Error: $errorCode\n";
	close(ERROROUT);
	exit;
}

sub getpdb {

	use Cwd;

	local($pwd) = untaint3(cwd());
	local($id) = lc shift @_;
	local($id) = untaint($id);

	#PDB files are grouped by middle two characters.
	local(@lid) = split (//, $id);
	if( ($count = scalar @lid) != 4 ) {
		&errorExit("[ $0 ] : PDB identifer must be four characters. PDB id given, $id, is $count characters.");
	}

	local($flag) = "$id.pdb";
	local($fid) = join ('', $lid[1], $lid[2]);

	chdir $PDBCACHE or &errorExit("getpdb: Couldn't cd to pdbcache $PDBCACHE!");
	if (! -e $fid) {
		mkdir ($fid,0777) or &errorExit("getpdb: Couldn't mkdir $fid in $PDBCACHE!");
		chmod (0777, $fid);
	}

	chdir $fid or &errorExit("getpdb: Couldn't cd into $fid in $PDBCACHE!");

	if (-e "$id.pdb") {
		#   print "Retrieving $id from local cache.\n";
	}
	else {

		local($url) = "ftp://ftp.rcsb.org/pub/pdb/data/structures/divided/pdb/$fid/pdb$id.ent.Z";

		if(system("lynx -dump $url | zcat > $id.pdb.tmp")) {
			warn("Retrieval of $id.pdb from PDB failed.\n");
			$flag = 0;
		}
		else {
			#Don't place file into cache unless it has been downloaded in its entirety.
			link("$id.pdb.tmp","$id.pdb");
			unlink("$id.pdb.tmp");
		}
	}

	unlink("$pwd/$id.pdb");

	if(! symlink("$PDBCACHE/$fid/$id.pdb","$pwd/$id.pdb")) {
		warn "getpdb: Couldn't create symlink from $id.pdb to $pwd/$id.pdb.\n";
		$flag = 0;
	}
	chdir($pwd) or die "getpdb: Couldn't cd $pwd.\n";

	return $flag;
}

# Duncan corrected PDB division join below
sub getpdb2 {
	use Cwd;

	local($pwd) = untaint3(cwd());
	local($id) = lc shift @_;
	local($id) = untaint($id);
	$id =~ tr/A-Z/a-z/;

	#PDB files are grouped by middle two characters.
	local(@lid) = split (//, $id);
	if( ($count = scalar @lid) != 4 ) {
		&errorExit("[ $0 ] : PDB identifer must be four characters. PDB id given, $id, is $count characters.");
	}

	local($fid) = join ('', $lid[1], $lid[2]);
	local($flag) = "$id.pdb";

	chdir $PDBCACHE or &errorExit("getpdb: Couldn't cd to pdbcache $PDBCACHE!");
	if (! -e $fid) {
		mkdir ($fid,0777) or &errorExit("getpdb: Couldn't mkdir $fid in $PDBCACHE!");
		chmod (0777, $fid);
	}

	chdir $fid or &errorExit("getpdb: Couldn't cd into $fid in $PDBCACHE!");

	if (-e "pdb$id.ent.Z") {
		print "Retrieving $id from local cache.\n";
		system("zcat pdb$id.ent.Z > $pwd/$id.pdb");
    } else {
		chdir($pwd);
		system("$PREFIX/bin/pdbget.sh $id");
		system("/bin/cp $id.pdb $id_$fid.pdb");
	}
	chdir($pwd) or die "getpdb: couldn't cd $pwd.\n";

	return $flag;
}

# store gzipped data files in $PDBCACHE for fast future access
sub getpdb3 {
	use Cwd;

	local($pwd) = untaint3(cwd());
	local($id) = lc shift @_;
	local($id) = untaint($id);
	$id =~ tr/A-Z/a-z/;

	#PDB files are grouped by middle two characters.
	local(@lid) = split (//, $id);
	if( ($count = scalar @lid) != 4 ) {
		&errorExit("[ $0 ] : PDB identifer must be four characters. PDB id given, $id, is $count characters.");
	}

	local($fid) = join ('', $lid[1], $lid[2]);
	local($flag) = "$id.pdb";

    # check to see if we've been here before...
	chdir $PDBCACHE or &errorExit("getpdb: Couldn't cd to pdbcache $PDBCACHE!");
	if (! -e $fid) {
		mkdir ($fid,0777) or &errorExit("getpdb: Couldn't mkdir $fid in $PDBCACHE!");
		chmod (0777, $fid);
	}

	chdir $fid or &errorExit("getpdb: Couldn't cd into $fid in $PDBCACHE!");

	# if not, download the file from PDB
	if (! -e "$id.pdb") {
		system("$PREFIX/bin/pdbget.sh $id");
		if (! -e "$id.pdb") {
			&errorExit("getpdb: failed in caching attempt.");
        	}
	}

	# linking to cache is default behavior
	print "Retrieving $id from local cache.\n";
	if (! symlink("$PDBCACHE$fid/$id.pdb","$pwd/$id.pdb")) {
                print "getpdb: Failed to link to cache!\nAttempting to use copy.\n";                
		copy("$PDBCACHE$fid/$id.pdb","$pwd/$id.pdb") || &errorExit("getpdb: Failed to copy from cache!");
                #&errorExit("getpdb: Failed to link to cache!");
	}

	chdir($pwd) or die "getpdb: couldn't cd $pwd.\n";

	return $flag;
}

# Pick out single arguments from arg list.  Option
# should be supplied without leading '-'.
sub isOption {
	my @args = @_;
	my $option = shift(@args);
	$option = '-' . $option;
	
	for (my $i = 0; $i <= $#args; $i++) {
		if ($args[$i] eq $option) {
			return 1;
		}
	}
	return 0;
}

# Parse argument list as "-option value", return
# 'value' corresponding to '-option'.  This is
# actually called as ($option, $default, @RGV), so
# that @args below includes the option name and
# default as well as the list of arguments.
sub parse_option {
	my @args = @_;
	my $option = shift(@args);
	my $default = shift(@args);
	
	my $value = $default;
	for $i (0 ... $#args) {
		if ($args[$i] eq $option) {
			if ($args[$i + 1] and ($args[$i + 1] !~ /^-/)) {
				$value = $args[$i + 1];
			}
			last;
		}
	}
	
	return $value;
}


######################################
#---------- ERROR HANDLING ----------#
######################################

sub mail {
	$message = $_[2];
	$subject = $_[1];
	my $myemail = $_[0];
	open (SENDMAIL, "| /usr/lib/sendmail -t ");
	print SENDMAIL << "EOF";
From: $ADMIN
To: $ADMIN,$myemail
Subject: $subject

$message

thanks,
The Web Server
EOF
	close(SENDMAIL);
}
sub mail_nat {
	$message = $_[0];
	open (SENDMAIL, "| /usr/lib/sendmail -t ");
	print SENDMAIL << "EOF";
From: $ADMIN
To: $ADMIN
Subject: error in morph server

Message body: $message

thanks,
The Web Server
EOF
	close(SENDMAIL);
}

#prints error, cleans up, and exits
#sub errorExit {
#	my $errorCode = shift(@_);
#	print "Content-type: text/plain", "\n\n";
#	print "$errorCode";
#	open(ERROROUT,">>/tmp/server.log");
#	print ERROROUT "Server Error: $errorCode\n";
#	close(ERROROUT);
#	exit;
#}

sub html_error {
	my $error = $_[0];
	print "Content-Type: text/html\n\n";
	print &gc_header();
	print <<EOF;
<BLOCKQUOTE>

<H2>Your request could not be processed.  The following error was detected:</H2>

<FONT FACE='arial, Helvetica, sans-serif' SIZE=3>
<I><FONT COLOR="red">
$error</FONT>
</I>
<P>
Please email $ADMIN if you think this message was caused by a server error.
</P>
</FONT>

</BLOCKQUOTE>
EOF
	print &footer();
	exit;
}

sub mailError {
	my ($email, $msg, $ID) = @_;
	open(SENDMAIL, "| /usr/lib/sendmail -t");
	print SENDMAIL <<EOF;
From: The Morph Server <$ADMIN>
To: $email, $ADMIN
Subject: [Morph Server] Error in $ID

There was a server error creating your animation.  The server reported the
following message:

$msg

You may contact the developers at $ADMIN for assistance.
A FAQ list is available at http://www.molmovdb.org/help/faq.html.

EOF
	close(SENDMAIL);
	exit;
}

######################################
#---------- HTML UTILITIES ----------#
######################################

sub haveCache {
	my ($file, $maxdays) = @_;
	
	if (-e "$HTDOCS/tmp/$file" and -M "$HTDOCS/tmp/$file" < $maxdays) {
		return 1;
	} else {
		return 0;
	}
}

sub retrieveCache {
	my $file = $_[0];

	# This actually will probably include the "Content-Type" header, but
	# we're still a CGI script so this is okay.
	open(TMP, "$HTDOCS/tmp/$file") or html_error("Could not read cached HTML.");
	while (<TMP>) {
		print $_;
	}
	close(TMP);
}

sub makeMenu {
	my @table = @_;

	my $menu;
	for (my $i = 0; $i <= $#table; $i++) {
		$menu .= qq(
<OPTION VALUE="$table[$i][0]">$table[$i][1]</OPTION>
);
	}
	return $menu;
}

sub html_msg {
	my $message = $_[0];
	$footer = &footer();
	print "Content-Type: text/html\n\n";
	print <<EOF;
<HTML>

$HEADER

<BLOCKQUOTE><H2>Server message:</H2>
$message
</BLOCKQUOTE>

$footer

</HTML>
EOF
# $footer was $FOOTER -scf 21 Sept 05
	exit(0);
}

sub htmlSendRedirect {
	my $URL = $_[0];
	print "Content-Type: text/html\n\n";
	print <<EOF;
<HTML>
<HEAD>
	<META HTTP-EQUIV="refresh" CONTENT="0; URL=$URL">
</HEAD>
</HTML>
EOF
	exit;
}

sub die_gently {
	$message = $_[0];
	open (SENDMAIL, "| /usr/lib/sendmail -t ");
	print SENDMAIL <<EOF;
From: root\@molmovdb.org
To: protmot\@bioinfo.mbb.yale.edu
Subject: error in morph server

Message body: $message

thanks,
The Web Server
EOF
    close(SENDMAIL);
	die "$message\n";
}

# Return string containing Jimmy's GeneCensus header.
sub gc_header {

	my $header = qq(
<BODY CLASS="arial" BGCOLOR="#FFFFFF" MARGINHEIGHT="0" MARGINWIDTH="0" TOPMARGIN="0" LEFTMARGIN="0">

<!-- GERSTEIN LAB HEADER BAR -->
<TABLE WIDTH="100%" BORDER="0" CELLSPACING="0" CELLPADDING="0">

<TR>
<TD NOWRAP ALIGN=LEFT BGCOLOR="#CCCCCC">
<A HREF="http://www.molmovdb.org/">
<IMG SRC="$WEBROOT/images/header2.jpg" BORDER="0"></A>
    </TD>
</TR>

</TABLE>

);
	return $header;
}

#---------- Standard MolMovDB footer ----------#
sub footer {

	my $footer = qq(
<!-- STANDARD FOOTER FOR MOLMOVDB -->
<BLOCKQUOTE>
<HR>
<font class="tiny">
<A HREF=$WEBROOT/help>
	<IMG ALT="[help]" HEIGHT=40 WIDTH=40 SRC="$WEBROOT/images/help-icon.gif">
</A>
<A HREF=$WEBROOT>
	<IMG ALT="[home]" HEIGHT=40 WIDTH=56 SRC="$WEBROOT/images/home-icon.gif">
</A>
<A HREF=$WEBCGI/movie.cgi>
	<IMG ALT="[movies]" SRC="$WEBROOT/images/icon.movie.gif" HEIGHT=40 WIDTH=45>
</A>
<BR>
<A HREF="$WEBROOT/help/#copyright">Copyright</A>
	1995-2005 M. Gerstein, W. Krebs,  <a href="$WEBROOT/sam">S. Flores</a>, N. Echols, and
	<A HREF="$WEBROOT/help/#authors">others</a>
<BR>
Email: wang.bo_AT_yale.edu
</font>

</BLOCKQUOTE>
);

	return $footer;
}

#---------- MolMovDB footer for New Projects ----------#

sub footer2 {

        my $footer = qq(
<!-- STANDARD FOOTER FOR MOLMOVDB -->
<BLOCKQUOTE>
<HR>
<font class="tiny">
<A HREF=$WEBROOT/help>
        <IMG ALT="[help]" HEIGHT=40 WIDTH=40 SRC="$WEBROOT/images/help-icon.gif">
</A>
<A HREF=$WEBROOT>
        <IMG ALT="[home]" HEIGHT=40 WIDTH=56 SRC="$WEBROOT/images/FlexOracle_logo_small.gif">
</A>
<BR>
<A HREF="$WEBROOT/help/#copyright">Copyright</A>
        2005-2006 M. Gerstein, <a href="$WEBROOT/sam">S. Flores</a>, N. Echols, and
        <A HREF="$WEBROOT/help/#authors">others</a>
<BR>
Email: Mark.Gerstein _at_ yale.edu
</font>

</BLOCKQUOTE>
);

        return $footer;
}

# This search box is for morphs only 
sub searchbox {
#<option value="text">Full-text</option>
#3<option value="linkhub">LinkHub/PFAM</option>
#<option value="go">GO term</option>
#<option value="pdb">PDB ID</option>
#<option value="morphid">Morph ID</option>
#<option value="pdbhom">PDB hom. 99%</option>

    my $searchbox = "

<FORM METHOD=\"post\" ACTION=\"$WEBCGI/search.cgi\" NAME=\"searchbox\">
    <B>Search morphs:</B>
    <SELECT NAME=\"type\">
    	<OPTION VALUE=\"text\">Full-text</OPTION>
	    <OPTION VALUE=\"pdb\">PDB ID</OPTION>

 		<option value=\"linkhub\">LinkHub/PFAM</option>
		<option value=\"go\">GO term</option>
		<option value=\"morphid\">Morph ID</option>
		<option value=\"pdbhom\">PDB hom. 99%</option>




    </SELECT>
    &nbsp
    <INPUT TYPE=\"text\" SIZE=20 NAME=\"key\"></INPUT>
    <INPUT TYPE=\"submit\" VALUE=\"Submit\">
</FORM>

";

    return $searchbox;
}

sub cgiDefaultPage {
	print "Content-Type: text/html\n\n";
	print "<HTML><HEAD><TITLE>CGI Error</TITLE></HEAD>\n\n";
	print &gc_header();
	print <<EOF;
<BLOCKQUOTE>

<H2>Sorry, this page cannot be called without parameters.</H2>

<FONT FACE='arial, Helvetica, sans-serif' SIZE=3>
Please check your link or form submission and try again.  If you
think this page was in error, you can email the site administrator at $ADMIN.
</FONT>

EOF
	print &footer();

	exit(0);
}


#############################################
#---------- SEQUENCE MANIPULATION ----------#
#############################################

sub compress {
	my $aa = $_[0];
	$aa =~ s/ALA/A/g;
	$aa =~ s/CYS/C/g;
	$aa =~ s/ASP/D/g;
	$aa =~ s/GLU/E/g;
	$aa =~ s/PHE/F/g;
	$aa =~ s/GLY/G/g;
	$aa =~ s/HIS/H/g;
	$aa =~ s/ILE/I/g;
	$aa =~ s/LYS/K/g;
	$aa =~ s/LEU/L/g;
	$aa =~ s/MET/M/g;
	$aa =~ s/ASN/N/g;
	$aa =~ s/PRO/P/g;
	$aa =~ s/GLN/Q/g;
	$aa =~ s/ARG/R/g;
	$aa =~ s/SER/S/g;
	$aa =~ s/THR/T/g;
	$aa =~ s/VAL/V/g;
	$aa =~ s/TRP/W/g;
	$aa =~ s/TYR/Y/g;
	$aa =~ s/\s*//g;

	return $aa;
}

sub translate {
	
	my %codons = (
		'UUU'=>'F',
		'UUC'=>'F',
		'UUA'=>'L',
		'UUG'=>'L',
		'CUU'=>'L',
		'CUC'=>'L',
		'CUA'=>'L',
		'CUG'=>'L',
		'AUU'=>'I',
		'AUC'=>'I',
		'AUA'=>'I',
		'AUG'=>'M',
		'GUU'=>'V',
		'GUC'=>'V',
		'GUA'=>'V',
		'GUG'=>'V',
		'UCU'=>'S',
		'UCC'=>'S',
		'UCA'=>'S',
		'UCG'=>'S',
		'CCU'=>'P',
		'CCC'=>'P',
		'CCA'=>'P',
		'CCG'=>'P',
		'ACU'=>'T',
		'ACC'=>'T',
		'ACA'=>'T',
		'ACG'=>'T',
		'GCU'=>'A',
		'GCC'=>'A',
		'GCA'=>'A',
		'GCG'=>'A',
		'UAU'=>'Y',
		'UAC'=>'Y',
		'UAA'=>'*',
		'UAG'=>'*',
		'CAU'=>'H',
		'CAC'=>'H',
		'CAA'=>'Q',
		'CAG'=>'Q',
		'AAU'=>'N',
		'AAC'=>'N',
		'AAA'=>'K',
		'AAG'=>'K',
		'GAU'=>'D',
		'GAC'=>'D',
		'GAA'=>'E',
		'GAG'=>'E',
		'UGU'=>'C',
		'UGC'=>'C',
		'UGA'=>'*',
		'UGG'=>'W',
		'CGU'=>'R',
		'CGC'=>'R',
		'CGA'=>'R',
		'CGG'=>'R',
		'AGU'=>'S',
		'AGC'=>'S',
		'AGA'=>'R',
		'AGG'=>'R',
		'GGU'=>'G',
		'GGC'=>'G',
		'GGA'=>'G',
		'GGG'=>'G',
	);

	my $protein = "";

	my $dna = $_[0];		# Well, could be RNA as well.
	#$dna =~ s/^ATG//;      # Hack off start codon, where present
	$dna =~ s/T/U/g;		# Convert DNA to RNA
	$dna =~ s/UAA$//;       # Also get rid of terminal stop codons
	$dna =~ s/UAG$//;
	$dna =~ s/UGA$//;
        
	my @nt = split(//, $dna);       #Convert the DNA into a character array
	for (my $i = 0; $i <= ($#nt / 3); $i++) {
		my $next = "";
		for (my $j = 0; $j < 3; $j++) {       #Read the next three nucleotides from the array
			my $pos = ($i * 3) + $j;
			$next .= $nt[$pos];
		}
		unless(length($next) != 3){     #Debugging only
			$protein .= $codons{$next};
		}
	}

	return $protein;

}

# really simpleminded linear interpolation.  this assumes that your input
# files are probably named the same as the argument $base, with numbering
# starting at 0 - thus if you supply "ff0.pdb" and "ff9.pdb" as the inputs
# and request 10 frames total, it will produce ff1.pdb through ff8.pdb.

sub interpolate {
	my ($initial, $final, $frames, $base) = @_;

	my (@first, @last);

	open(INITIAL, "$initial");
	open(FINAL, "$final");
	while (<INITIAL>) {
		chomp;
		if (/^ATOM/) {
			push(@first, $_);
		}
	}
	while (<FINAL>) {
		chomp;
		if (/^ATOM/) {
			push(@last, $_);
		}
	}
	close(INITIAL);
	close(FINAL);

	if (scalar(@first) != scalar(@last)) {
		print STDERR "Atom counts do not match!\n";
		return 0;
	}

	for (my $i = 1; $i < ($frames - 1); $i++) {
		my $adv = $frames - $i;
		open(OUT, "> $base$i.pdb");
		for (my $j = 0; $j < scalar(@first); $j++) {
			my ($iser,$atnam,$resnam,$chnnam,$resn,$x,$y,$z,$occ,$b,$segid) = &pdb::ParsePDBAtom($first[$j]);
			my ($iser1,$atnam1,$resnam1,$chnnam1,$resn1,$x1,$y1,$z1,$occ1,$b1,$segid1) = &pdb::ParsePDBAtom($last[$j]);
			$x += ($x1 - $x) / $adv;
			$y += ($y1 - $y) / $adv;
			$z += ($z1 - $z) / $adv;
			&pdb::WritePDBAtom(\*OUT,"ATOM",$iser,$atnam,$resnam,$chnnam,$resn,$x,$y,$z,1,$b,$segid);
		}
		close(OUT);
	}
}

1; # sigh...