G::Tools

COGs

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

  use G::Tools::COGs;
  blah blah blah

Stub documentation for G::Tools::COGs 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

    eval "use HTTP::Request::Common qw(POST);";
    if($@){ warn "$@" };
    eval "use LWP::UserAgent;";
    if($@){ warn "$@" };

    my $self = shift;

    opt_default(hit=>3);
    my @args = opt_get(@_);
    my $gb = opt_as_gb(shift @args);
    my $hit = opt_val("hit");

    my $ua = LWP::UserAgent->new();
    my $req = POST 'http://www.ncbi.nih.gov/cgi-bin/COG/xognitor',
    [seq=>$gb->{SEQ}, hit=>$hit];
    my $content = $ua->request($req)->as_string;
    
    if ($content =~ /NO related COG/){
	##return '';
    }elsif($content =~ /<table/){
	$content =~ s/\///g;
	my (undef, $line, $undef) = split(/<table/, $content, 3);
	substr($line, 0, 1) = '<';
	$line =~ s/<.*?>/ /g;
	my (undef, @lines) = split(/\n/, $line);
	
	my $i = 0;
	foreach (@lines){
	    s/^\s*//g;
	    s/\s*$//g;
	    if (/(\d+)\s+proteins/){
		$lines[$i] = $1;
	    }elsif(/BeTs to\s+(\d+)\s+clades/){
		$lines[$i] = $1;
	    }elsif(/pet-score:\s+(\d+)/){
		$lines[$i] = $1;
	    }
	    
	    $i ++;
	}
	
	return ($lines[2], $lines[1], $lines[3], $lines[0], $lines[4], $lines[5]);
	##       COGID      FUNCTION   PRODUCT    HITS       BeTs       pet-score
    }

    my $id = time . '-' . int(rand() * 100000);

    open(DIG, '>/tmp/dignitor-' . $id . '.lst');
    my $gene = shift;
    my $translation = shift;

    open(OUT, '>/tmp/in-' . $id . '.seq');
    print OUT "\>$gene\n$translation\n";
    close(OUT);
    
    my @result = _gblaster('-p blastp -d ' . $cogpath . 'COG/COGall -i /tmp/in-' . $id . '.seq -m8 -a 2');
    
    foreach my $tmp (@result){
	my ($query, $subject, $percent, $length, $qstart, $qend, $sstart, $send, 
	    $eval, $score) = @{$tmp};
	
	printf DIG "%s - %s (%d %s)  %d\.\.%d  %d\.\.%d\n", $query, $subject, $score, $eval,
	$qstart, $qend, $sstart, $send;
    }
    close(DIG);

    my $command = $cogpath . 'zugnitor /tmp/dignitor-' . $id . '.lst ' . $cogpath . 'COG/COGs.txt 2>/dev/null';
    my @result = `$command`;

    unlink('/tmp/dignitor-' . $id . '.lst');
    unlink('/tmp/in-' . $id . '.seq');
    my @coglist = ();
    foreach my $line (@result){
	last unless($line =~ /^\s/);

	if ($line =~ /(COG\d+)/){
	    push(@coglist, $1);
	}
    }

    if (wantarray()){
	return @coglist;
    }else{
	return shift @coglist;
    }

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

    return $this;

    $cogpath = shift;
    
    return $cogpath;

General documentation

Kazuharu "Gaou" Arakawa, gaou@g-language.org

perl(1).