G::System

STeP

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

  use G::System::STeP;
  blah blah blah

Stub documentation for G::System::STeP 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

    my $self = shift;

    &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 $script;
    my $method;
    my $result;
    my @instance;
    my @files;

    $cf=STeP_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 System.',"\n";
        print GNRT '#This program analyses bacterial Genomes.',"\n",'#usage:perl This_file_name',"\n\n",'use G;',"\n\n";
	print GNRT 'mkdir("',"$cf->{STeP}->{param2}->{value}",'",0777);',"\n\n";
    
	foreach(keys(%{$cf})){
	    next if($_ !~ /^G\d+$/);
	    $cf->{$_}->{data}=~tr/ //d;
	    @instance=split(/,/,$cf->{$_}->{data});
	    $script.=$cf->{$_}->{instance}.'=_STS_divider_for_STeP(';
	    $script.='"'.$instance[0].'"';
	    $script.=',-type=>"'.$instance[1].'"' if($instance[1] ne '');
	    $script.=',-work_dir=>"'.$cf->{STeP}->{param2}->{value}.'"' if($cf->{STeP}->{param2}->{value} ne '');
	    $script.=');'."\n";
	    $script.='$result=_ePCR_for_STeP('.$cf->{$_}->{instance}.',"'.$cf->{STeP}->{param1}->{value}.'");'."\n";
	    $script.='push(@files,@$result);'."\n" if($cf->{STeP}->{param3}->{value} eq "y");
	    $script.="\n";
	}
	$script.='_jstat_for_STeP();'."\n" if($cf->{STeP}->{param3}->{value} eq "y");
	$script.='_sts2pg_for_STeP(\@files);'."\n" if($cf->{STeP}->{param3}->{value} eq "y");

	print GNRT $script,"\n",$cf->{subroutines} if($generate);
	close(GNRT);
    }
    else{
	{
	    no strict;
	    foreach(keys(%{$cf})){
		next if($_ !~ /^G\d+$/);
		$cf->{$_}->{data}=~tr/ //d;
		@instance=split(/,/,$cf->{$_}->{data});
		mkdir("$cf->{STeP}->{param2}->{value}",0777);
		${$cf->{$_}->{instance}}=_STS_divider_for_STeP("$instance[0]",
	        -type=>"$instance[1]",-work_dir=>"$cf->{STeP}->{param2}->{value}");
	        $result=_ePCR_for_STeP(${$cf->{$_}->{instance}},
                "$cf->{STeP}->{param1}->{value}");
	        push(@files,@$result); 
            }
            _jstat_for_STeP() if($cf->{STeP}->{param3}->{value} eq "y");
            _sts2pg_for_STeP(\@files) if($cf->{STeP}->{param3}->{value} eq "y");

        }
    }

    my @args=opt_get(@_);
    my $gcfname=shift @args;

    my $cf;
    my @order;
    my @turn;
    my @code;
    my @tmp;
    my @comment;
    my $g;
    my $i;
    my $u;
    my $t;
    my $switch;
    my $method;

    unless(lstat "$gcfname"){
        &msg_error("STeP: $gcfname: No such file or directory\n");
        return "HOGE";
    }

    $cf->{GCF}=$gcfname;
    open(GCF,$gcfname);
    while(<GCF>){
	next if($_ eq "\n" || $_ =~ /^\#/);
	$switch++ if(/^1;/);
	$cf->{subroutines}.=$_ if($switch == 4);
	$switch++ if(/^\>User_defined_subroutines/);
	$switch++ if(/^CONFIGURE/);
	$_ =~ tr/\n//d;
	if($switch == 2){
		$u++;
		@comment=split(/#/,$_);
		@code=split(/\s+!order\s+/,$comment[0]);
		$code[1]=~tr/ \n//d;
		$cf->{"User$u"}->{code}=$code[0];
		$cf->{"User$u"}->{order}=$code[1];
		$cf->{"User$u"}->{comment}=$comment[1];
		if($order[$code[1]] ne ''){
		    &msg_error("$code[0]: $order[$code[1]]: Invalid orders!\n");
		    return "HOGE";
		}
		$order[$code[1]]=$code[0] if($code[1] ne '');
		push(@tmp,$code[0]) if($code[1] eq '');	    
	}
	$switch++ if(/>User_defined_functions/);
	if($switch == 1){
	    if(/^(\$\w+)\s*\<\s*(.*)/){
		$g++;
		$cf->{"G$g"}->{instance}=$1;
		$cf->{"G$g"}->{data}=$2;
	    }
	    elsif(/^\>(\w+)/){
		$method=$1;
		$i=1;
	    }
	    elsif(/^\!comment\s*(.*)/){
		$cf->{"$method"}->{comment}=$1;
	    }
	    elsif(/^\!switch\s*(\w*)/){
		$cf->{"$method"}->{switch}='Y' if($1 eq 'Y');
		$cf->{"$method"}->{switch}='N' if($1 ne 'Y');
	    }
	    elsif(/^\!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(/^(\S+)\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(/\<\< 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 || $switch==3){
	    $new.=$_;
	    $switch++ if(/\<\< CONFIGURE/);
	    $switch++ if(/\>User_defined_subroutines/);
	    next;
	}
	if(/\>User_defined_functions/){
	    $switch++;
	    $new.=$_;
	    next;
	}
	if(/^CONFIGURE/){
	    $switch++;
	    $new.=$_;
	    next;
	}
	if($switch == 4){
	    $new.="\n".$cf->{subroutines}."\n";
	    last;
	}
	if($_ eq "\n" || $_ =~ /^\#/){
	    $new.=$_;
	    next;
	} 
	if($switch == 2){
	    if($s_usr == 0){
		$s_usr=1;
		foreach(sort keys(%{$cf})){
		    next if($_ !~ /^User/);
		    $new.="$cf->{$_}->{code}\t\!order $cf->{$_}->{order}";
		    $new.="\t\#$cf->{$_}->{comment}\n" if($cf->{$_}->{comment});
		}
	    }
	}
	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 $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).