G::Tools

EPCR

G::Tools::EPCR - Perl extension for blah blah blah

  use G::Tools::EPCR;
  blah blah blah

Stub documentation for G::Tools::EPCR 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(type=>"plane",work_dir=>'./');
    my @args=opt_get(@_);

    my $tmp=shift @args;
    my $file=substr($tmp,rindex($tmp,'/')+1);
    my $type=opt_val('type');
    my $work=opt_val('work_dir');
    my $sts;
    my $filename;
    my %chr;
    my @tmp;
    my @files;
    my $HANDLE;

    $work.='/' if($work ne '');
    $sts=_STS_modifer_for_STeP($tmp,-type=>"$type");

    {
	no strict;
	foreach(@{$sts}){
	    @tmp=split(/\t/,$_);
	    $HANDLE = "CHR" . "$tmp[4]";

	    unless(exists($chr{$tmp[4]})){
		$chr{$tmp[4]}=1;
		$filename = $work."chr".$tmp[4]."\.".$file;
		open($HANDLE,">$filename");
		push(@files, $filename);
	    }
	    
	    print $HANDLE $_."\n";
	}
    }

    return\@ files;

    opt_default(type=>'plane');
    my @args=opt_get(@_);
    
    my $file=shift @args;
    my $type=opt_val('type');
    my @line;

    open(FILE, $file); 
    if($type eq 'genethon'){
	while(<FILE>){
	    if(/(^\S*\s*\S*\s*\S*\s*\S*)\s*\((\S*)\)\s*Chr\.(\S*)\,\s*(.*)/){
		push(@line , $1."\t".$3."\t".$2."\t".$4);
	    }
	    else{
		msg_send("error: $_");
	    }
	}
    }
    elsif($type eq 'txmap'){
	while(<FILE>){
	    if(/(^\S*\s*\S*\s*\S*\s*\S*)\s*Chr\.(\S*)\,\s*(.*)/){
		push(@line , $1."\t".$2."\t".'-'."\t".$3);
	    }
	    else{
		msg_send("error: $_");
	    }
	}
    }	    
    elsif($type eq 'dbsts'){
	while(<FILE>){
	    if(/^\S*\s*(\S+\s*\S+\s*\S*)\s*(\S*)\s*(\S*\;\S*)\s*(.*)/){
		push(@line , $2."\t".$1."\t".'-'."\t".$4);
	    }
	    elsif(/^\S+\s*(\S+\s*\S+\s*\S*)\s*(\S*)\s*(\S*)\s*(.*)/){
		push(@line , $2."\t".$1."\t".$3."\t".$4);
	    }
	    else{
		msg_send("error: $_");
	    }
	}
    }
    else{
	while(<FILE>){
	    push(@line , $_);
	}
    }
    close(FILE);

    return\@ line;

    my @args=opt_get(@_);

    my $files=shift @args;
    my $database=shift @args;
    my @database;
    my $tmp;
    my @tmp;
    my $data;
    my @data;
    my @filenames;
    
    if($database=~/\*/){
	$tmp=substr($database,0,rindex($database,'/'));
	$data=substr($database,rindex($database,'/')+1);
	$data=~tr/*//d;
	opendir(DIR, $tmp);
	@database=grep{/$data/}readdir(DIR);
	@database=map($tmp.'/'.$_,@database);
    }
    else{
	@database=($database);
    }

    foreach $tmp (@{$files}){
	@data=();
	@tmp=split(/\./,$tmp);
	$tmp[0]=substr($tmp[0],rindex($tmp[0],'/')+1);
	@data=grep{/$tmp[0]\./}@database;
	if($data[0] ne ''){
	    system('qr',"e-PCR $tmp $data[0] > $tmp"."\.epcr");
	    push(@filenames, $tmp."\.epcr");
	}
	else{
	    foreach $data (@database){
		system('qr',"e-PCR $tmp $data >> $tmp"."\.epcr");
		push(@filenames, $tmp."\.epcr");
	    }
	}
    }
    return\@ filenames;

    my $jstat;
    my $who=qx!whoami!;
    my $switch=1;
    my @line;

    $who=~tr/\n//d;
    while($switch==1){
        $switch=0;
        $jstat=qx!jstat!;
	@line=split(/\n/,$jstat);
        foreach(@line){
            $switch=1 if(/^${who}.*\se-PCR\s.*/);
            $switch=1 if(/^${who}.*def_${who}.*/);
            $switch=1 if(/jobs in queue def_${who}, queue is active,/);
        }
        sleep 60;
    }

    my @args=opt_get(@_);
    
    my $sts=shift @args;
    my $conn;
    my $sql;
    my $result;

    $conn = Pg::connectdb("dbname=chronicle");

    foreach(@{$sts}){
	open(STS,$_);
	while(<STS>){
	    if(/^(\S*)\s*(\S*)\.\.(\S*)\s*(\S*)\s*\S*\s*(\S*)\s*(.*)/){
		$sql = qq(insert into AD values\(\'$4\',\'$1\',\'$2\',\'$3\',\'$5\',\'$6\',\'\',\'\'\););
		$result = $conn->exec($sql);
	    }
	}
	close(STS);
    }
    return $result;

    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).