#!/bin/perl
#
# blast2html - HTMLizes blast output and draws aligned segments
# between the Query and hits sequences.
# Original idea of blast2html is from:
# Keith Robison November 1993
# krobison@nucleus.harvard.edu
# blast2html displays eventually a Gif image made with a modified version
# of Alessandro Guffanti (guffanti@tigem.it) PaintBlast package
# drawdrawimaimage function.
#The original package PaintBlast is available at the following URL:
#"http://hercules.tigem.it/Biomodules/PaintBlast.pm".
#A Similar tool is available from:
# ftp.pasteur.fr/pub/GenSoft/unix/alignment/Blast_tools/Html4blast/html4blast-1.3a.tar.gz
#use strict;
use Getopt::Std;
use File::Basename;
use GD;
## Check command line
my %options = ();
if (! getopts("o:gn",\%options)) { usage(); exit(1); }
if (@ARGV != 1) { usage(); exit(1); }
my $outfile = "$infile.html";
if ($options{'o'}) { $outfile = $options{'o'}; }
my $infile = shift(@ARGV);
### Init default values
if ( -e "$infile.html" || -e "$infile.gif")
{system("rm $infile.html $infile.gif");}
open (OUT,">>$outfile");
#----------------------
print OUT "";
print OUT "";
print OUT "Blast Results";
print OUT "";
$FOUND=0;
open (IN,"$infile") || die ("can't open $infile\n");
while()
{
@tab=split(/\s+/, $_);
if ( $FOUND == 0 ) { print OUT $_ ; }
if ( m/>/ ) { $FOUND = 2; }
if ( $FOUND == 2 )
{
$iflag = 0;
if ( m/>/ )
{
$seqname=substr($tab[0],1,length($tab[0]));
print OUT '>'; print OUT "$seqname"; print OUT ''; print OUT " "; print OUT ''; print OUT 'top';
foreach $word (1 .. $#tab) { print OUT " $tab[$word]";}
print OUT "\n";
$iflag=1;
}#if m
if ( $iflag == 0 ) { print OUT $_;}
}
#transform E-values to point to the corresponding alignment and vice versa
if ( $FOUND == 1 )
{
s/$tab[$#tab]/\ \<\/a\> \$tab[$#tab]\<\/a\>/ ;
print OUT $_;
}
#Parts where E-values are indicated
if ( m/Sequences producing significant alignments/ ) { $FOUND = 1; }
#------------
## Display alignment graphical summary
if ($options{'g'} && /^$/ && $FOUND == 1 ) {
print OUT "\n";
select OUT;
my $image = drawimage($infile);
print OUT "\n";
print OUT ' '; print OUT "\n";
}
}#while
## Close Blast & HTML file
print OUT "";
close(IN);
close(OUT);
## Normal end
exit(0);
##--- Usage display ---------------------
sub usage {
my $prog = basename($0);
print STDERR < Output file name [$outfile].
-g Graphical alignment summary.
USAGE
};
## This is a modified version of Alessandro Guffanti (guffanti@tigem.it)
## original PaintBlast package.
# "http://hercules.tigem.it/Biomodules/PaintBlast.pm".
sub drawimage {
my $file = shift;
## Init values
my $qname = "Query"; my $qlen = 0;
my $seqid = "";
my %seqs = ();
my @seqlist = ();
## Parse blast file
open(INB,"< $file") || die("Can't open file $file");
while() {
## Get query name & length
if (/^Query= (\S*)/) { $qname = $1; next; }
if (/\(([\d,]+) letters\)/) {
$qlen = $1; $qlen =~ s/,//g; next; }
## Get match sequence id
if (/^>(\S*)/) {
$seqid = $1;
next if ($seqid eq "");
next if (grep(/$seqid/,@seqlist) != ());
push(@seqlist,$seqid);
next; }
## Get align score
if (/Score =\s+(\d+(\.\d+)?)/) {
push(@{$seqs{$seqid}},$1);
push(@{$seqs{$seqid}},0);
push(@{$seqs{$seqid}},0);
next; }
## Get query align start & end
if (/^Query:\s+(\d+)\s+\S+\s+(\d+)$/) {
my $stop = pop(@{$seqs{$seqid}});
my $start = pop(@{$seqs{$seqid}});
my $beg; my $end;
## Check for reversed query
if ($1 < $2) { $beg = $1; $end = $2; }
else { $beg = $2; $end = $1; }
if ($start == 0 || $beg < $start) {
push(@{$seqs{$seqid}},$beg); }
else { push(@{$seqs{$seqid}},$start); }
if ($stop == 0 || $end > $stop) {
push(@{$seqs{$seqid}},$end); }
else { push(@{$seqs{$seqid}},$stop); }
next; }
}
close(INB);
## Init alignments summary image
my $imgname = "$infile.gif";
my $font = gdMediumBoldFont; my $fonth = $font->height;
# my $font = gdTinyFont; my $fonth = $font->height;
my $seqnb = scalar @seqlist; my $spos = 25 * $font->width;
my $imgw = 632; my $imgh = (4 + $seqnb + 7) * $fonth;
my $img = new GD::Image($imgw,$imgh);
$img->interlaced('true');
## Allocate colors
my $white = $img->colorAllocate(255,255,255);
my $black = $img->colorAllocate(0,0,0);
my $red = $img->colorAllocate(255,0,0);
my $green = $img->colorAllocate(0,205,25);
my $yellow = $img->colorAllocate(247,174,0);
my $grey = $img->colorAllocate(130,130,130);
my $blue = $img->colorAllocate(0,0,255);
## Scoring colors intervals (min value key).
my %colors = ( 0 => $blue, 50 => $grey, 100 => $yellow, 150 => $green,
200 => $red );
## Black frame round image
$img->rectangle(0,0,$imgw-1,$imgh-1,$black);
## Draw top query
my $start = $spos; my $stop = $imgw - $fonth;
my $line = $fonth;
$img->string($font,$fonth,$line,$qname,$red);
$img->filledRectangle($start,$line,$stop,$line+$fonth/2-1,$red);
# $img->filledRectangle($start,$line,$stop,$line+$fonth/10-1,$red);
$line += $fonth/2;
## Rule scaling calc
my $unit = ($stop - $start) / $qlen;
my $delta = 1;
for (my $i=1; 1; $i*=10) {
my $tmp = $qlen/$i;
if (($tmp/5) > 10) { $delta = $i * 5; next }
if ($tmp > 10) { $delta = $i; next; }
last; }
## Draw top rule
for (my $i=0; $i<=$qlen/$delta; $i++) {
my $pos = $i*$delta*$unit;
$img->line($spos+$pos,$line,$spos+$pos,$line+$fonth/2-1,$red);
# $img->line($spos+$pos,$line,$spos+$pos,$line+$fonth/10-1,$red);
next if ($i%5 != 0);
$img->string($font,$spos+$pos,$line+$fonth/2,$i*$delta,$black); }
$line += $fonth * 2.5;
## Draw all matched sequences & image hrefs
print "\n";
print "";
print "
";
print "\n";
## Draw bottom query & rule
$line += $fonth;
for (my $i=0; $i*$delta<=$qlen; $i++) {
my $pos = $i*$delta*$unit;
$img->line($spos+$pos,$line+$fonth,$spos+$pos,$line+$fonth*1.5-1,$red);
next if ($i%5 != 0);
$img->string($font,$spos+$pos,$line,$i*$delta,$black); }
$line += $fonth;
$img->string($font,$fonth,$line,$qname,$red);
$img->filledRectangle($start,$line+$fonth/2,$stop,$line+$fonth-1,$red);
$line += $fonth;
## Draw color legend
$line += $fonth;
$img->string($font,$fonth,$line,"Scoring",$red);
$img->string($font,$fonth,$line+$fonth,"colors",$red);
my $nbcol = scalar keys %colors;
my $lencol = ($stop - $start) / $nbcol;
my $pos = $start; my $prec = 0;
foreach (sort bynumber keys %colors) {
my $color = $colors{$_};
$img->filledRectangle($pos,$line,$pos+$lencol,$line+$fonth,$color);
$img->string($font,$pos,$line+$fonth,"S>$_",$black);
$pos += $lencol; }
## Convert image to GIF and save
my $image = $img->gif;
open(IMG,"> $imgname");
print IMG $image;
close(IMG);
return $imgname; }
## Sort by numbers
sub bynumber { $a <=> $b; }