#!/usr/bin/perl
#
# To configure your client, define the location of
# the rasmol executable in the line below, if required
#

$rasmol = "rasmol.2.6.4.exe_Linux.i386"; # Rasmol executable name

### end configuration section

$rasmol_location = $0;
$rasmol_location =~ s/rasmol\.pl$//g; # remove 'rasmol.pl' tail 

$rasmol = $rasmol_location . $rasmol;

###$cgi_script = "http://osiris:8081/reli-cgi/open_netscape_window.pl?";
###$cgi_script_water = "http://osiris:8081/reli-cgi/water_open_netscape_window.pl?";

$cgi_script = "/reli-cgi/open_netscape_window.pl?";
$cgi_script_water = "/reli-cgi/water_open_netscape_window.pl?";

#
###############################################################
#
# rasmol.pl, AB 9/99
#
# Script performs Rasmol actions on client site.
# The script is launched via the MIME type 'chemical/x-relibase',
# which must be known to the browser. (Edit preferences/applications)
#
# ARGV[0] is the name of the Rasmol-script (contains data + commands)
# The first line (Comment) contains additional information about 
# the actions to perform:
#     # socket #  --> send only 'script $rasmol_script' to rasmol-socket
#     # reload #  --> send  'script $rasmol_script' to rasmol-socket, and sends rlbcoord file
#                     name to socket (This is to initialize the hyperlinking mechansism)
#     # reload_pdb --> similar as reload; for PDB-view initialization (hyperlink!)
#     # init   #  --> Start new Rasmol with script
#
#       init: causes the script the call itself (within 'xterm') with 
#             2 arguments. 'xterm' is required as parent tty for RasMol
#             and to look for output (distances)
#
# Important: action must be defined between 2 '#' in the first line
#

###open(DEV,">/dev/ttyq1");

if ($#ARGV == -1 )
{
  # emergency exit
  print "Rasmol.pl requires one parameter (rasmol-script)\n";
  exit;
}


use Socket;
use Sys::Hostname;

$rasmolport  = 21069;
$rasmol_script = $ARGV[0];
$remote = 'localhost';


sub SendCommandToRasmol
{
   ### see pg. 349 programming PERL / Wall et al. /  O'Reilly
   ### returns 0 or 1  (rasmol running or not; for test)

   $com = $_[0];

   my ($iaddr,$paddr,$proto,$line);

   if($rasmolport =~ /\D/) { $rasmolport = getservbyname($rasmolport,'tcp') } 
      die "no port " unless $rasmolport;

   $iaddr  = inet_aton($remote) or die "no host: $remote";
   $paddr  = sockaddr_in($rasmolport, $iaddr);
   $proto  = getprotobyname('tcp');

   $proto = getprotobyname('tcp');
   socket(SOCK,PF_INET,SOCK_STREAM,$proto) or die "socket: $!";
   connect(SOCK,$paddr); #  or die "SOCKET_CONNECT_ERROR: $!";

   if($! eq "Connection refused")
   {
     return (1);
   }
   else
   {
     syswrite(SOCK,$com,length($com)); #|| return (1); 
     return (0);
   }
}

   
sub RunRasmol
{
   # Starts RasMol (called by this script via 'xterm -e'
   # and handles output to contact back to the ReLiBase server

   $relibase_server_url = $_[0];   
   $cgi_script       = $relibase_server_url . $cgi_script;
   $cgi_script_water = $relibase_server_url . $cgi_script_water;

   open(RASMOL,"$rasmol -script $rasmol_script 2>&1 |");

      while(<RASMOL>)
      {
         chop;

         if (/@@@/ && /_INIT/)
         {
	   if(/_INIT_/)    {$flag_protein = 0;} # complexes (incl. superposition)
	   if(/_INITPDB_/) {$flag_protein = 1;} # full protein display
	   
	   print "  Init $_ .... \n";
	   ###print "URL: $cgi_script\n";

	   # init array containing ligand (and PDB) names (referenced by complex numbers)
	   # The numbers are determined by the atom numbers (1 = 0-499, 2 = 500-999 etc.)
	   @ligand_names = ();
	   @pdb_names = ();

	   # init hash containing ligand_name depending on chain ID
	   %ligand_chainID = ();

	   # Init array containing ligand names (required if chainID = '-', slow)
	   $i_ligand = 0; # ligand counter
	   $ligand_names_field = ();
	   
	   # extract @@@ info from rlbcoord file on client site
	   if($flag_protein == 0)
	     {@tmp = split(/_INIT_/,$_);}
	   else
	     {@tmp = split(/_INITPDB_/,$_);}

	   $rlbcoord_file = $tmp[1];
	   
	   open(RLBCOORD,"<$rlbcoord_file");
	   while(<RLBCOORD>)
	   {
	     chomp;
	     $line = $_;

	     if($flag_protein == 0) # complexes, superpositions, i.e. use complex number
	     {
	       if(/^(ATOM|HETATM)/) # Storing atomnumber of protein atom preeceding #@@@ entry
	       {
		 $this_line = $line;
		 $this_line =~ s/HETATM/HETATM /g;
		 @tmp2 = split(" ",$this_line);
		 $atom_number = $tmp2[1];
	       }
	       if((/\#@@@/) && ($line!~ /solv/))
	       {
		 # Determination of complex number from atom number
		 $complex_number = int($atom_number/500) + 1;

		 @rasmol_line = split(/ /,$line);
		 # Storing ligand obj. name in array 
		 $ligand_names[$complex_number] = $rasmol_line[1];

		 # Extracting PDB entry from ligand obj. name, storing
		 $pdbName = $rasmol_line[1];
		 $pdbName =~ s/.*_(\w{3,7})_\d*:DBN.*/$1/g; 
		 $pdb_names[$complex_number] = $pdbName;

		 # create long pdb_name
		 @split = split(/pdb/,$_);
		 $long_pdb_name = $split[1];

	       }
	       elsif ($line =~ /solv_/) # get solvent_model_name
	       { 
		   @solv_split = split(" ",$line);
		   $solv_name =$solv_split[1];
	       }
	     }
	     else # $flag_protein == 1; Protein total view
	     {
	       if(($line =~ /\#@@@/) && ($line !~ /solv/))
	       {
		 # extract chain ID from full ligand name
		 @rasmol_line = split(" ",$line);
                 $ligand_name = $rasmol_line[1];
                 $chainID = $rasmol_line[1];
		 $chainID =~ s/^\#@@@//g;
		 $chainID =~ s/ //g;
		 $chainID =~ s/^[^_]+_[^_]+-(\w)_.*/\1/g; # matches digit before 3rd '_'
		 
		 if(length($chainID) > 1) # No chain ID extracted 
		 {
		   # Reference via array of ligand names (slower)
		   $chainID = '-';
		   $ligand_names_field[$i_ligand] = $ligand_name;
		 }
		 else
		 {
		   # reference via chainID
		   $ligand_chainID{$chainID} = $ligand_name;
		 }
		 $i_ligand++;
	       }
	       elsif ($line =~ /solv_/) # get solvent_model_name
	       { 
		   @solv_split = split(" ",$line);
		   $solv_name =$solv_split[1];
	       }
	   }
	 }
	   close(RLBCOORD);
       }
         else
	 {
	   print "$_\n";

	   if (/Group|Hetero/) #  Valid atom clicked for Hyperlinking: building URL using data in stored array
	   {
	     if ($flag_protein == 0)
	     {
	       # Getting information from of clicked atom, determination of complex number
	       @rasout = split(" ",$_);
	       $complex_number = int($rasout[2]/500) + 1;
    
	       # Building query URL for different atom classes (protein, ligand, water)
	     
	       if(/Group/) {last;} # protein; not implemtented yet

	       if(/Hetero/ && !(/HOH/)) # ligand
		 {$http_adress = $cgi_script . $ligand_names[$complex_number];}

	       if(/HOH/) # water
	       {
		 $water_un = $rasout[5]; # residue number of water molecule
		 $arg=$solv_name.":RES:HOH_".$water_un."_";
		 $http_adress = $cgi_script_water . $arg;
	       }
	     }
	     else # flag_protein == 1
	     {
	       @rasout = split(/Chain:/,$_);
               $chainID = $rasout[1];
	       $chainID =~ s/ //g;
	       
	       if(/HOH/) # water
	       {
		 @water_rasout = split(" ",$_);    
		 $water_un = $water_rasout[5]; # residue number of water molecule
		 $arg=$solv_name.":RES:HOH_".$water_un."_";
		 $http_adress = $cgi_script_water . $arg;
	       }

	       if(/Hetero/ && !(/HOH/)) # ligand
	       {
		 if($chainID ne "-") # reference to ligand name via hash chainID
		 {
		   $http_adress = $cgi_script . $ligand_chainID{$chainID};
		 }
		 else # reference to chain ID via searching all ligand names
		 {
		   @tmp = split(/Hetero:/,$rasout[0]);
		   $resi_name_plus_number = $tmp[1]; # Sth. like 'MCN 920'
		   @resi_info = split(" ",$resi_name_plus_number);

		   for($ii = 0; $ii <= $#ligand_names_field; $ii++)
		   {
		     ###if( ($ligand_names_field[$ii] =~ /$resi_info[0]/) &&
		     ### ($ligand_names_field[$ii] =~ /$resi_info[1]/))
		     # If residue names occur more than once (e.g. 1ALO;
		     # resid = 907 (FES and ALA), previous selection doesnt work

		     if($ligand_names_field[$ii] =~ /_${resi_info[1]}_/)
		       {$http_adress = $cgi_script . $ligand_names_field[$ii];last;}
		   }
		 }
	       }
	     }

	     # Catching Rasmol error (MAXRES not big enough; launch JavaScript ERROR)
	     ###if (/Database Error: Too many new residues/)
	     ###  {$http_adress = $cgi_script . "MAXRES_ERROR";}

	     # Finalize URL for query and launch it
	     $netscape_com = "netscape -remote openURL\\(\"";
	     $netscape_com =  $netscape_com . $http_adress;
	     # The ' ' before the back-slashes is *VERY IMPORATNT* !!!
	     $netscape_com =  $netscape_com . " \\)\"";

	     ###print "$netscape_com\n";
	     print "$netscape_com\n";
	     print "Submitting new query to ReLiBase: $http_adress\n";
	     system($netscape_com);
	   }
         }
       }

   close(RASMOL);
   exit;
}

sub InitRasmol
{
  if(&SendCommandToRasmol("echo") == 1)
  {
    # Launch warning if required
    if($_[0] eq "no_hyperlinking")
    {
      $| = 1;
      print "This version of $0 does not comply with your\n";
      print "Relibase server version. Hyperlinking will not work\n";     
    }

    # Calls RasMol via this script in a xterm
    $relibase_server_url = $_[0];
    system("xterm  -icon -geom 60x5 -e $0 $rasmol_script $relibase_server_url&");
    ###system("xterm  -icon -geom 60x5 -e $0 $rasmol_script start_rasmol&");
    sleep 30;
  }
  else
  {
    print "RasMol is already running on your machine\n";
    print "Only 1 RasMol process allowed\n";
    exit; 
  }
} 

sub GetAction
{
   if ($#ARGV == 0)
   {
      # reads first line of $rasmol_script and gets actions to perform
      # ('init' or 'socket' or 'reload'; see header)

      open(RASMOLSCRIPT,"<$rasmol_script");
      read RASMOLSCRIPT, $first_line, 80;
      close(RASMOLSCRIPT);

      @tmp=split(/\#/,$first_line);
      $action = $tmp[1];
      $action =~ s/ //g;

      # Get Hyperlink-URL
      if($action eq "init")
      {
	if(!defined $tmp[3]) # old version of Init.rlbcoord (no URL in line 1)
	{
	  ###print "This version of $0 does not comply with your\n";
	  ###print "Relibase server version. Hyperlinking will not work\n";
	  $relibase_server_url = "no_hyperlinking";
	}
	else
	{
	  $relibase_server_url = $tmp[2];
	  $relibase_server_url =~ s/ //g;
	}
      }
   }
   else
   {
      # More than one argument: Causes the script to start RasMol;
      # this happens only upon init, when the script calls itself
      $action = "start";
      $relibase_server_url = $ARGV[1]; # this is parsed to the script from &InitRasmol
   }
} 

GetAction;

if ($action eq "init")  { &InitRasmol($relibase_server_url); exit; }
if ($action eq "start") { &RunRasmol($relibase_server_url); exit; }

# One of the following conditions should be match, just for security
if ($action eq "socket" || $action eq "reload" || $action eq "reload_pdb") 
{
   &SendCommandToRasmol("script $rasmol_script");

   if ($action eq "reload") # Start reinitialization of @@@ info in rlbcoord-file
   {
      $init_string = "echo \@\@\@_INIT_" . $rasmol_script ; 
      &SendCommandToRasmol("$init_string");
      sleep 20; # loading PDB can take longer
   }
   elsif ($action eq "reload_pdb")
   {
     $init_string = "echo \@\@\@_INITPDB_" . $rasmol_script ; 
     &SendCommandToRasmol("$init_string");
     sleep 20; # loading PDB can take longer
   }
   else # only socket call (display commands etc.)
   {
     sleep 4; # ensures RasMol can load data before script finished
   }
}

# eof


