#!/usr/bin/perl -w
#Markus Westphal 14.11.2006
######################################################
# Markus Westphal BlastParser #
######################################################
use strict;
#use CGI::Carp qw(fatalsToBrowser);
my($sort,$letters, $color, @idnetz, @hilf, @aus,$zaus, $first, %ausgabe, $aberg, $q, $sb, $s, $qs, $qe, $ss, $se, $h, $ht, $htm, $html, $j, $id, $de,$dego, $deanh, $acc, $score, $dt, $datei, $ids, $start, $length, $evalue, $gaps, $gapp, $gappp, $i, $idnet, $posit);
#Einlesen aus Browserübergabe
#$ENV{'QUERY_STRING'} =~ s/sl=alle//g;
#$ENV{'QUERY_STRING'} =~ s/ol=alle//g;
#$ENV{'QUERY_STRING'} =~ s/%3A/,/g;
#$ENV{'QUERY_STRING'} =~ s/%3B/;/g;
#$ENV{'QUERY_STRING'} =~ s/+/\ \/g;
#@ARGV = split("&",$ENV{'QUERY_STRING'});
#print HF "Content-type: text/html\n\n";
#globale Variabeln füllen
$zaus = 0;
$evalue = 0;
$s = 0;
$letters = 0;
$sort = 0;
$dt = 0;
$dego = 0;
$start = 0;
$html = 0;
$qs = 0;
$length = 0;
$aberg = 0;
$gaps = 0;
$gapp = 0;
$first = 1;
$sort = 0;
#Einlesen
for($j = -1; $j < $#ARGV; $j++)
{
if($ARGV[$j] =~ /^datei/)
{
($dt, $datei) = split("=", $ARGV[$j]);
}
if($ARGV[$j] =~ /^html/)
{
($ht, $htm) = split("=", $ARGV[$j]);
if($htm eq "on")
{
$html = 1;
}
}
if($ARGV[$j] =~ /^sort/)
{
($ht, $htm) = split("=", $ARGV[$j]);
if($htm eq "ab")
{
$sort = 1;
}
}
}
#HTML-Header
if($html == 1)
{
open(HF, ">ergebnisblast.htm") || die ("Die Ausgabedatei kann nicht erstellt werden!\n");
print HF '';
print HF "Blastparser - Markus Westphal - FH Gießen-Friedberg\n";
print HF "\n";
print HF 'Blastparse
';
}
else
{
open(TF, ">ergebnisblast.txt") || die ("Die Ausgabedatei kann nicht erstellt werden!\n");
print TF "BLASTPARSE\n";
}
#keine Datei
if($dt eq "0")
{
print TF "FEHLER: Keine Eingabedatei!";
if($html == 1)
{
print HF "
KEIN DATEI ANGEGEBEN!!!\n";
}
die ("Lesevorgang abgebrochen!\n");
}
open(F, "<$datei") || die ("$datei kann nicht gelesen werden!\n");
my($vor,$nach);
$vor = 1;
$nach = 0;
while()
{
$i++;
if(index($_,"letters)") > -1)
{
$_ =~ /\((\d*) letters\)/;
$letters = $1;
}
if(index($_,"Length =") > -1)
{
$_ =~ s/Length = //gi;
$_ =~ s/ //g;
chomp($_);
$dego = 0;
$length = $_;
$aberg = (31*($length**-0.124) + 3 * 18.2 * ($length**-0.305));
}
if($dego == 1)
{
$de .= $_;
$de =~ s/ //g;
chomp($de);
}
if($_ =~ /^>/)
{
if($first == 0)
{
&Merken();
}
$_ =~ />+(\w*) +(\w*) +(.*)/;
$id = $1;
$acc = $2;
$de = $3;
chomp($de);
$dego = 1;
$s = 0;
}
if(index($_ ,"Score") > -1)
{
#Alles ausgeben
if($s == 1 && $first == 0)
{
&Merken();
}
$s = 1;
$_ =~ /(\w*), Expect = +(\S*)/;
$evalue = $2;
$first = 0;
}
if(index($_,"Identities =") > -1)
{
@idnetz = split(",",$_);
$idnetz[0] =~ / Identities = (\d*)\/.* \((\d*)%\)/;
$idnet = $2;
$idnetz[1] =~ / Positives = (\d*)\/.* \((\d*)%\)/;
$posit = $2;
$gaps = 0;
$gapp = 0;
if($#idnetz >= 2)
{
$idnetz[2] =~ / Gaps = (\d*)\/.* \((\d*)%\)/;
$gaps = $1;
$gapp = $2;
}
#print "$idnet\n";
$q = 0;
$sb = 0;
}
if(index($_,"Query: ") > -1)
{
if($q == 0)
{
$_ =~ /Query: (\d*) +(.*) (\d*)/;
$qs = $1;
$q = 1;
}
else
{
$_ =~ /Query: (\d*) +(.*) (\d*)/;
$qe = $3;
}
}
if(index($_,"Sbjct: ") > -1)
{
if($sb == 0)
{
$_ =~ /Sbjct: (\d*) +(.*) (\d*)/;
$ss = $1;
$sb = 1;
}
else
{
$_ =~ /Sbjct: (\w*) +(.*) (\w*)/;
$se = $3;
}
}
}
close (F);
#Nochmal für die letzten Werte!
$aberg = (31*($length**-0.124) + 3 * 18.2 * ($length**-0.305));
&Merken();
&Ausgabe();
#Funktionen
sub Merken()
{
my($merker,$farber,$farbere,$color);
if($length > 0)
{
$aberg = $idnet-$aberg;
if($html == 1)
{
$farber = "$aberg";
$farbere = "$evalue";
$color = 'bgcolor="#FFFFFF"';
if($aberg > 0 && $evalue > (1e-3))
{
$farber = "$aberg";
$farbere = "$evalue";
$color = 'bgcolor="#00FF00"';
}
$merker = "
| $id |
$acc |
$letters |
$length |
$farbere |
$farber |
$idnet% |
$posit% |
$gaps |
$gapp% |
$qs |
$qe |
$ss |
$se |
$de |
";
}
else
{
$aberg =~ /(.+\.\d{4}).+/;
$merker = "$id\t\t$acc\t\t$letters\t\t$length\t\t$1\t\t\t$evalue\t\t$idnet\t$posit\t$gaps\t$gapp\t$qs\t$qe\t$ss\t$s\t$de";
}
if($sort == 1)
{
if(defined $ausgabe{$aberg})
{
$aberg = $aberg + 0.0000001;
}
$ausgabe{$aberg} = $merker;
}
else { $aus[$zaus]= $merker; $zaus++;}
}
sub Ausgabe()
{
my($index, $zeile);
if($html == 1)
{
print HF '';
print HF "
| ID |
ACC |
QLEN |
HLEN |
EVALUE |
ABAGYAN |
IDENTITIES |
POSITIVES |
GAPS |
GAPP |
QBEG |
QEND |
HBEG |
HEND |
DE |
";
}
if($sort == 1)
{
@hilf = sort {$a<=>$b} keys %ausgabe;
foreach (@hilf)
{
if($html == 1)
{
print HF "$ausgabe{$_}\n";
}
else
{
print TF "$ausgabe{$_}\n";
}
}
}
else
{
foreach (@aus)
{
if($html == 1)
{
print HF "$_\n";
}
else
{
print TF "$_\n";
}
}
}
if($html == 1)
{
print HF "
";
print HF "\n";
close (HF);
}
}
}