None available.
sub CHI_engine
{ &opt_default(src=>"");
my @args=opt_get(@_);
my $gcffile=shift @args;
my $generate=&opt_val("src");
my $cf;
my $gcfname=substr((split(/\//,$gcffile))[-1],0,index(((split(/\//,$gcffile))[-1],'.')));
my $time;
my $script;
my $method;
my $param;
my $user;
my $switch;
my $pkg;
my $EXCT;
my $tmp;
my @koya;
my @instance;
$cf=CHI_parser("$gcffile");
return "HOGE" if($cf eq "HOGE");
if($generate){
open(GNRT,">$generate");
print GNRT '#!/usr/bin/env perl',"\n\n",'##################################################',"\n";
print GNRT "\# $gcfname source script\n";
print GNRT '##################################################',"\n",'#Generated by G-language Genome Analysis Environment.',"\n";
print GNRT '#',"\n",'#usage: perl This_file_name',"\n\n",'use G;', "\n",
'use G::Messenger;', "\n\n";
print GNRT 'mkdir("',"$gcfname",'",0777);',"\n",'chdir("',"$gcfname",'");',"\n\n";
}
else{
$time=time;
open(EXCT,">/tmp/CHI_$time\.pl");
$tmp='#!/usr/bin/env perl'."\n\n".'##################################################';
$tmp.="\n\# $gcfname temporary script\n";
$tmp.='##################################################'."\n".'#Generated by G-language Genome Analysis Environment.';
$tmp.="\n".'#This program is a temporary script of G-language Manager.'."\n\n";
$tmp.='package CHI_'.$time."\;\n\n".'use G;'."\n".'use SubOpt;'."\n\n";
$tmp.="use G::Messenger;\n\n";
$tmp.=$cf->{subroutines} . "\n\n";
$tmp.='sub CHI_SRC{'."\n\n";
$tmp.='mkdir("'."$gcfname".'",0777);'."\n".'chdir("'."$gcfname".'");'."\n";
eval{print EXCT $tmp;};
}
print GNRT $cf->{subroutines} if ($generate);
foreach(keys(%{$cf})){
next if($_ !~ /^G\d+$/);
@instance=split(/,/,$cf->{$_}->{data});
unless(lstat $instance[0]){
msg_error("FATAL ERROR: genome file not found.\n");
return;
}
$script.=$cf->{$_}->{instance}.'=new G(';
foreach(@instance){
$script.='"'.$_.'",';
}
chop $script;
$script.=');'."\n\n";
$tmp=substr($instance[0],rindex($instance[0],'/')+1);
$tmp=substr($tmp,0,index($tmp,'.'));
$script.='mkdir("'.$tmp.'",0777);'."\n";
$script.='chdir("'.$tmp.'");'."\n";
my $step = 0;
foreach $method (@{$cf->{Order}}){
$tmp='';
$switch=0;
next if($method eq '');
if($switch==0){
next if($cf->{$method}->{param1}->{value} ne $cf->{$_}->{instance});
$script.="msg_error\(\"\\\#\n\\\#".$cf->{"$method"}->{comment}."\n\\\#\n\"\)\;\n";
$tmp='&'.$method.'(';
@koya=keys(%{$cf->{"$method"}});
for(my $i=1;$i<=$#koya;$i++){
$param="param".$i;
next if($param!~/^param/);
if($cf->{"$method"}->{"$param"}->{key}!~/^\-/ && $cf->{"$method"}->{"$param"}->{value} ne ''){
$tmp.="$cf->{$method}->{$param}->{value}".",";
}
elsif($cf->{"$method"}->{"$param"}->{key} eq "-Return" && $cf->{"$method"}->{"$param"}->{value} ne ''){
$tmp="$cf->{$method}->{$param}->{value}".'='.$tmp;
last;
}
elsif($cf->{"$method"}->{"$param"}->{key}=~/^\-/ && $cf->{"$method"}->{"$param"}->{value} ne ''){
$tmp.="$cf->{$method}->{$param}->{key}"."\=\>".'"'."$cf->{$method}->{$param}->{value}".'",';
}
}
chop $tmp;
$tmp.=');';
}
$script.=$tmp."\n";
unless ($generate){
$script .= '&G::Messenger::msg_percent(';
$script .= sprintf("%.2f", $step / scalar(@{$cf->{Order}}));
$script .= ");\n\n";
}
$step ++;
}
$script.=$cf->{$_}->{instance}.'="";'."\n";
$script.='chdir("..");'."\n";
$script.="\n";
}
print GNRT $script,"\n" if($generate);
$script.="\n".'}'."\n\n" . '1;'."\n";
eval{print EXCT $script if($generate eq '');};
close(GNRT);
close(EXCT);
if($generate eq ''){
$pkg='CHI_'.$time;
require('/tmp/'.$pkg.'.pl');
&{$pkg.'::CHI_SRC'}();
unlink('/tmp/'.$pkg.'.pl');
}
return $time;} | sub CHI_parser
{ my @args=opt_get(@_);
my $gcfname=shift @args;
my $cf;
my @order;
my @turn;
my @code;
my @tmp;
my @comment;
my ($g, $i, $u, $t);
my $switch = 0;
my $method;
unless(lstat "$gcfname"){
&msg_error("CHI: $gcfname: No such file or directory\n");
return "HOGE";
}
$cf->{GCF}=$gcfname;
open(GCF,$gcfname);
while(<GCF>){
next if($_ eq "\n" || $_ =~ /^\#/);
my $line = $_;
if($line =~ /^CONFIGURE/){
$switch ++;
while(<GCF>){
$cf->{subroutines} .= $_;
}
last;
}elsif($switch == 1){
$line =~ tr/\n//d;
$line =~ tr/\r//d;
if($line =~ /^(\$\w+)\s*\<\s*(.*)/){
$g++;
$cf->{"G$g"}->{instance}=$1;
$cf->{"G$g"}->{data}=$2;
}elsif($line =~ /^\>(\w+)/){
$method=$1;
$i=1;
}elsif($line =~ /^\!comment\s*(.*)/){
$cf->{"$method"}->{comment}=$1;
}elsif($line =~ /^\!switch\s*(\w*)/){
$cf->{"$method"}->{switch}='Y' if($1 eq 'Y');
$cf->{"$method"}->{switch}='N' if($1 ne 'Y');
}elsif($line =~ /^\!order\s*(\d*)/){
$cf->{"$method"}->{order}=$1;
if($cf->{"$method"}->{switch} eq "Y"){
if($order[$1] ne ''){
&msg_error("$method: $order[$1]: Invalid orders!\n");
return "HOGE";
}
$order[$1]=$method if($1 ne '');
push(@tmp,$method) if($1 eq '');
}
}elsif($line =~ /^(\S+)\s*([^\#]*)\s*\#*(.*)/){
if(substr($_,0,1) ne '-' && $2 eq '' && $cf->{"$method"}->{switch} eq "Y"){
&msg_error("$method: $1: Lacking parameter input!\n");
return "HOGE";
}
$cf->{"$method"}->{"param$i"}->{key}=$1;
$cf->{"$method"}->{"param$i"}->{value}=$2;
$cf->{"$method"}->{"param$i"}->{comment}=$3;
$i++;
}
}
$switch++ if($line =~ /<< CONFIGURE >>/);
}
close(GCF);
shift @order;
foreach(@order){
$turn[$t]=$_ if($_ ne '');
$turn[$t]=shift(@tmp) if($_ eq '');
$t++;
}
push(@turn,@tmp);
@{$cf->{Order}}=@turn;
return $cf;} | sub CHI_scripter
{ my @args=&opt_get(@_);
my $cf=shift @args;
my $new;
my $switch;
my $s_usr;
my $s_G;
my $s_p;
my $method;
open(GCF,$cf->{GCF});
while(<GCF>){
if($switch==0){
$new.=$_;
$switch++ if(/\<\< CONFIGURE/);
next;
}
if(/^CONFIGURE/){
$switch++;
$new.=$_;
next;
}
if($switch == 2){
$new.="\n".$cf->{subroutines}."\n";
last;
}
if($_ eq "\n" || $_ =~ /^\#/){
$new.=$_;
next;
}
if($switch == 1){
tr/\n//d;
if(/(\$\w+)\s*<\s*(.*)/){
if($s_G == 0){
$s_G=1;
foreach(sort keys(%{$cf})){
next if($_ !~ /^G\d+/);
$new.="$cf->{$_}->{instance}\< $cf->{$_}->{data}\n";
}
}
}
elsif(/^\>(\w+)/){
$new.=$_."\n";
$method=$1;
$s_p=0;
}
elsif(/^(\!comment)\s*.*/){
$new.=$1."\t".$cf->{"$method"}->{comment}."\n";
}
elsif(/^(\!switch)\s*\w*/){
$new.=$1."\t\t".$cf->{"$method"}->{switch}."\n";
}
elsif(/^(\!order)\s*\d*/){
$new.=$1."\t\t".$cf->{"$method"}->{order}."\n";
}
elsif(/^\S+(\s*)[^\#\s]*(\s*)\#*.*/){
if($s_p == 0){
$s_p=1;
foreach(sort keys(%{$cf->{"$method"}})){
next if(substr($_,0,5) ne "param");
$new.=$cf->{"$method"}->{"$_"}->{key}.$1;
$new.=$cf->{"$method"}->{"$_"}->{value}.$2;
$new.="\#".$cf->{"$method"}->{"$_"}->{comment} if($cf->{"$method"}->{"$_"}->{comment});
$new.="\n";
}
}
}
}
}
close(GCF);
return $new;} |