#!/usr/bin/env perl

#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# This file is part of G-language Genome Analysis Environment package
#
#     Copyright (C) 2001-2007 Keio University
#:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
# 
#   $Id: G.pm,v 1.4 2002/07/30 17:40:56 gaou Exp $
#
# G-language GAE is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
# 
# G-language GAE is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
# See the GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public
# License along with G-language GAE -- see the file COPYING.
# If not, write to the Free Software Foundation, Inc.,
# 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
# 
#END_HEADER
#
# written by Kazuharu Arakawa <gaou@sfc.keio.ac.jp> at
# G-language Project, Institute for Advanced Biosciences, Keio University.
#

use Term::ReadLine;
use POSIX qw(:sys_wait_h);
use Getopt::Long;

use G;
use G::Messenger;
use G::Shell::Help;
use G::Shell::EUtils;
use G::Shell::Log;

use vars qw($G_INTERNAL_HASH_OLD $G_INTERNAL_OPT $G_INTERNAL_LOG $G_INTERNAL_CACHE1 $G_INTERNAL_HEADER $G_INTERNAL_TERM);

$| = 1;

#::::::::::::::::::::::::::::::
#     Let the code begin...
#::::::::::::::::::::::::::::::

my ($opt_l, $opt_h);

GetOptions(
	   'help'=>\$opt_h,
	   'log'=>\$opt_l,
	   );


$G_INTERNAL_OPT = $opt_l;

if($opt_h){

    print qq(

	     G-language Shell -- interactive command-line shell for G-language System

   	      Usage:

	       G [-l]                       : Starts G-language Shell
	       G [.gcf file]                : Runs G-language System script
	       G [.pl  file]                : same as 'perl -MG [.pl file]'
	       G [-h]                       : Print this message
	     
	      Options:
	     
	       -l or --log                  : activate logging of the session.
	                                    : you can also activate logging 
	                                    : within the shell by "makelog" 
	                                    : and deactivate by "rmlog"
	     
	       -h or --help                 : Print this message.

);

    exit;

};



if($ARGV[0]){

    if($ARGV[0] =~ /.pl$/){
	system("perl -MG $ARGV[0]");
    }elsif($ARGV[0] =~ /.gcf$/){
	funcD($ARGV[0]);
    }

}else{
    msg_interface('Shell');

    $G_INTERNAL_TERM = Term::ReadLine->new('G_tmp');
    my $G_INTERNAL_ATTRIBS = $G_INTERNAL_TERM->Attribs;
    
    $G_INTERNAL_ATTRIBS->{catch_signals} = 0;
    $G_INTERNAL_ATTRIBS->{attempted_completion_function} = \&G_INTERNAL_COMPLETION;
    $G_INTERNAL_ATTRIBS->{completion_word} = [(map {"$_()"} @G::EXPORT), "makelog", "rmlog", "help", "pubmed", "entrez"];
    
    sub G_INTERNAL_COMPLETION {
	my ($text, $line, $start, $end) = @_;
	
	if(substr($line, 0, $start) =~ /^\s*$/){
	    return ($G_INTERNAL_TERM->completion_matches($text,$G_INTERNAL_ATTRIBS->{'filename_completion_function'}),
		    $G_INTERNAL_TERM->completion_matches($text,$G_INTERNAL_ATTRIBS->{'list_completion_function'})
		    );
	}else{
	    return ();
	}
    }
    
    my $G_INTERNAL_STDIN = $G_INTERNAL_TERM->IN() || *STDIN;
    my $G_INTERNAL_DIRECT = $G_INTERNAL_TERM->OUT() || *STDOUT;
    
    $SIG{INT} = sub{
	if($G_INTERNAL_TERM->ReadLine eq 'Term::ReadLine::Gnu'){
	    $G_INTERNAL_ATTRIBS->{done} = 1;
	    $G_INTERNAL_TERM->free_line_state(); 
	    $G_INTERNAL_TERM->cleanup_after_signal();
	    print $G_INTERNAL_DIRECT "SIGINT: use \"quit\" to exit.\n\n";
	}
    };
    
    my $G_INTERNAL_INSTANCE = new G("blessed");
    $G_INTERNAL_INSTANCE->loaded_msg();
    
    G_INTERNAL_HASH_OLD->{dummy} = 1;
    my $G_INTERNAL_CACHE1 = '';
    my $G_INTERNAL_HEADER = '> ';
    
    unless (-e _sdb_path() . 'G_INTERNAL_OLD'){
	sdb_save(\$G_INTERNAL_HASH_OLD, "G_INTERNAL_OLD");
    }
    my $G_INTERNAL_HASH = sdb_load('G_INTERNAL_OLD');
    
    
    foreach  my $G_INTERNAL_TMP1 (keys(%{$$G_INTERNAL_HASH})){
	my $G_INTERNAL_TMP2 = $$G_INTERNAL_HASH->{$G_INTERNAL_TMP1};
	if($G_INTERNAL_TMP1 =~ /^\$/){
	    $G_INTERNAL_TMP1 =~ s/\$//g;
	    ${"$G_INTERNAL_TMP1"} = $G_INTERNAL_TMP2;
        }
        if($G_INTERNAL_TMP1 =~ /^\@/){
	    $G_INTERNAL_TMP1 =~ s/\@//g;
            @{"$G_INTERNAL_TMP1"} = @$G_INTERNAL_TMP2;
        }
        if($G_INTERNAL_TMP1 =~ /^\%/){
            $G_INTERNAL_TMP1 =~ s/\%//g;
            %{"$G_INTERNAL_TMP1"} = %$G_INTERNAL_TMP2;
        }
    }

    do{
      my $G_INTERNAL_TMP;
      $G_INTERNAL_INPUT = $G_INTERNAL_TERM->readline('G > ');
      
      my $G_INTERNAL_SHFLAG = 0;
      
      foreach my $G_INTERNAL_COMMAND (qw(ls pwd cat more less head tail uniq
					 wc diff compress uncompress gzip gunzip
					 zcat tar ln find cp mv rm touch nkf tee
					 which jobs date cal whoami w finger chfn
					 alias unalias type echo env source 
					 printenv su df du uptime uname
					 dmesg mount ps rpm man info kill ping ifconfig
					 setenv export lv display convert free
					 gimp firefox dig traceroute emacs scp
					 rsh ftp sudo mysql psql make
					 ruby sh python vi R wget curl perl irb
					 perldoc sqlite sqlite3 dbish
					 )){
	  
	  if($G_INTERNAL_INPUT =~ /^\s*$G_INTERNAL_COMMAND(\s+|$)/){
	      $G_INTERNAL_SHFLAG = 1;
	      my $G_INTERNAL_SIGINT = 0;
	      eval{
		  eval{
		      system($G_INTERNAL_INPUT);
		  };
		  die($@) if($@);
	      };
	      
	      warn $@ if($@);
	      
	      last;
	  }
      }
      
      if($G_INTERNAL_SHFLAG == 1){
	  #do nothing, already done.
      }
      elsif($G_INTERNAL_INPUT =~ /^\s*exit/){
	  quit();
      }
      elsif($G_INTERNAL_INPUT =~ /^\s*help\s*help\s*help/ || $G_INTERNAL_INPUT =~ /^\s*help me(\!|\s+|$)/){
	  print "   Relax, strech yourself, and take a deep breath :-)\n";
	  $G_INTERNAL_INPUT = 1;
      }
      elsif($G_INTERNAL_INPUT =~ /^\s*help!/){
	  print "   I need somebody~ not just anybody~\n";
	  $G_INTERNAL_INPUT = 1;
      }
      elsif($G_INTERNAL_INPUT =~ /^\s*cd\s*(\S+)/){
	  $G_INTERNAL_INPUT = $1;
	  
	  chdir ($G_INTERNAL_INPUT) || print $G_INTERNAL_INPUT, ": ", $!, "\n";
      }
      elsif($G_INTERNAL_INPUT =~ /^\s*makelog/){
          print "   This session will be logged.\n";
	  $G_INTERNAL_OPT = 1;
	  $G_INTERNAL_INPUT = 1;
      }
      elsif($G_INTERNAL_INPUT =~ /^\s*rmlog/){
          print "   This session will NOT be logged.\n";
	  $G_INTERNAL_OPT = 0;
	  $G_INTERNAL_INPUT = 1;
      }
      elsif($G_INTERNAL_INPUT =~ /^\s*mokkori/){
	  while(1){
	      $G_INTERNAL_INPUT = $G_INTERNAL_TERM->readline('MOKKORI? ');
	      last if($G_INTERNAL_INPUT =~ /^\s*mokkori/);
	  }
      }
      else{
          # if the command is someting Perl...

	  my $G_INTERNAL_INPUT_BACKUP = '';
	  
	  if($G_INTERNAL_INPUT =~ /^\s*help\s+(\S.*)$/){
	      $G_INTERNAL_INPUT_BACKUP = $G_INTERNAL_INPUT;
	      my $string = $1;
	      
	      if($string =~ /^(\-\S+)\s+(.*)$/){
		  $G_INTERNAL_INPUT = "help(\'$1\',\'$2\')";
	      }else{
		  $G_INTERNAL_INPUT = "help(\'$string\')";
	      }
	  }
	  elsif($G_INTERNAL_INPUT =~ /^\s*pubmed\s+(.*)/){
	      $G_INTERNAL_INPUT_BACKUP = $G_INTERNAL_INPUT;
	      $G_INTERNAL_INPUT = "pubmed(\'$1\')";
	  }
	  elsif($G_INTERNAL_INPUT =~ /^\s*entrez\s+(.*)/){
	      $G_INTERNAL_INPUT_BACKUP = $G_INTERNAL_INPUT;
	      my @tmp = split(/\s+/, $1, 2);
	      $G_INTERNAL_INPUT = "entrez(\'$tmp[0]\', \'$tmp[1]\')";
	  }
	  
	  $G_INTERNAL_CUT = substr($G_INTERNAL_INPUT, -1,1);
	  if($G_INTERNAL_CUT eq '\\'){
	      my $G_INTERNAL_I = 1;
	      do{
		  $G_INTERNAL_CUT = substr($G_INTERNAL_INPUT, -1,1);
		  if($G_INTERNAL_CUT eq '\\'){
		      chomp($G_INTERNAL_INPUT);
		      chop($G_INTERNAL_INPUT);
		      $G_INTERNAL_INPUT1 = "$G_INTERNAL_INPUT\n";
		      $G_INTERNAL_CACHE1 .= $G_INTERNAL_INPUT1;
		      $G_INTERNAL_INPUT = $G_INTERNAL_TERM->readline('next >>');
		  }
		  else{
		      $G_INTERNAL_INPUT1 = "$G_INTERNAL_INPUT\n";
		      $G_INTERNAL_I = 0;
		  }
	      }while($G_INTERNAL_I == 1);
	  }
	  $G_INTERNAL_CACHE1 .= $G_INTERNAL_INPUT;

	  eval{
	      local $SIG{'INT'} = sub{warn("SIGINT: Interrupted by user.");die();};
	      $G_INTERNAL_TMP = eval($G_INTERNAL_CACHE1);

	      die($@) if ($@);
	      print "\n" if ($G_INTERNAL_TMP);
	      return $G_INTERNAL_TMP;
	  };
	  
	  $G_INTERNAL_CACHE1 = $G_INTERNAL_INPUT_BACKUP if (length $G_INTERNAL_INPUT_BACKUP);

	  $G_INTERNAL_TERM->addhistory($G_INTERNAL_CACHE1);
	  $G_INTERNAL_CACHE1 .= ';' unless(substr($G_INTERNAL_CACHE1, -1, 1) eq ';' || length($G_INTERNAL_CACHE1) == 0);
	  $G_INTERNAL_LOG .= "$G_INTERNAL_CACHE1\n";

	  if($G_INTERNAL_CACHE1 =~ /^\s*\$/){		    
	      @G_INTERNAL_ARRAY = split(/=/,$G_INTERNAL_CACHE1);
	      $G_INTERNAL_ARRAY[0] =~ s/ //g;
	      $G_INTERNAL_KEY = $G_INTERNAL_ARRAY[0];
	      $G_INTERNAL_ARRAY[0] =~ s/\$//g;
	      $G_INTERNAL_HASH_OLD->{"$G_INTERNAL_KEY"} = ${"$G_INTERNAL_ARRAY[0]"};
          }
	  elsif($G_INTERNAL_CACHE1 =~ /^\s*\@/){		    
	      @G_INTERNAL_ARRAY = split(/=/,$G_INTERNAL_CACHE1);
	      $G_INTERNAL_ARRAY[0] =~ s/ //g;
	      $G_INTERNAL_KEY = $G_INTERNAL_ARRAY[0];
	      $G_INTERNAL_ARRAY[0] =~ s/\@//g;
	      $G_INTERNAL_HASH_OLD->{"$G_INTERNAL_KEY"} = \@{"$G_INTERNAL_ARRAY[0]"};
	  }
	  elsif($G_INTERNAL_CACHE1 =~ /^\s*\%/){		    
  	      @G_INTERNAL_ARRAY = split(/=/,$G_INTERNAL_CACHE1);
	      $G_INTERNAL_ARRAY[0] =~ s/ //g;
	      $G_INTERNAL_KEY = $G_INTERNAL_ARRAY[0];
	      $G_INTERNAL_ARRAY[0] =~ s/\%//g;
	      $G_INTERNAL_HASH_OLD->{"$G_INTERNAL_KEY"} = \%{"$G_INTERNAL_ARRAY[0]"};
	  }
	  
	  $G_INTERNAL_CACHE1 = "";
      
	  if ($@){
	      my $G_INTERNAL_ERROR_MSG = $@;
	      $G_INTERNAL_ERROR_MSG =~ s/(.*)\(eval \d+\) (.*)/$1$2/g;
	    
	      warn $G_INTERNAL_ERROR_MSG;
	  }

	  $G_INTERNAL_CACHE1 = '';
	  $G_INTERNAL_HEADER = '> ';
	}
    }while(1);    
}    

sub quit{
    print "  save value ?  y/n (or cancel) ?\n";

    my $n = 1;
    do{
      my $G_INTERNAL_INPUT2 = $G_INTERNAL_TERM->readline('quit >>');

      if($G_INTERNAL_INPUT2 eq 'y'){
	sdb_save(\$G_INTERNAL_HASH_OLD,'G_INTERNAL_OLD');
	$n = 0;
      }
      elsif($G_INTERNAL_INPUT2 eq 'cancel'){
	  return;
      }
      elsif($G_INTERNAL_INPUT2 eq 'n'){
	  $n = 0;
      }
      else{
	print "select 'y', 'n', or 'cancel'\n";
      }
    }while($n);

    if($G_INTERNAL_OPT == 1){
	my $filename = make_log($G_INTERNAL_LOG);
	print "Session Log is saved as: $filename\n";
    }

    opendir(DIR, $ENV{HOME} . '/.glang/');
    foreach my $file (readdir(DIR)){
	next unless($file =~ /^cache-/);

	$file = $ENV{HOME} . '/.glang/' . $file;
	my $mtime = (stat($file))[9];

	if(time() - $mtime > 3600 * 24 * 31){
	    unlink($file);
	}
    }
    closedir(DIR);

    exit;
}


sub clear_cache{
    print "  Really clear all of your cache ?  y/n?\n";

    my $n = 1;
    do{
      my $G_INTERNAL_INPUT2 = $G_INTERNAL_TERM->readline('clear_cache >>');

      if($G_INTERNAL_INPUT2 eq 'y'){
	  opendir(DIR, $ENV{HOME} . '/.glang/');
	  foreach my $file (readdir(DIR)){
	      next unless($file =~ /^cache-/);
	      
	      $file = $ENV{HOME} . '/.glang/' . $file;
	      unlink($file);
	  }
	  closedir(DIR);

	  return;
      }
      elsif($G_INTERNAL_INPUT2 eq 'n'){
	  return;
      }
      else{
	print "select 'y' or 'n'\n";
      }
    }while($n);

}


1;














