G::System

CHI

G::System::CHI - Perl extension for blah blah blah

  use G::System::CHI;
  blah blah blah

Stub documentation for G::System::CHI was created by h2xs. It looks like the
author of the extension was negligent enough to leave the stub
unedited.

Blah blah blah.

Methods description

Methods code

    &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";

    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;

    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;

    my $self = shift;

    my $pkg = shift;
    my $filename = shift;
    my $option = shift;
    my $this;

    return $this;

General documentation

A. U. Thor, a.u.thor@a.galaxy.far.far.away

perl(1).