#!/usr/local/bin/perl5.004 -w
#######################################################################
# this software has been created by genome research limited (grl).    # 
# grl hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# grl neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################
# 	$Id: proj_web.pl,v 1.6 2005/03/15 16:02:07 ja1 Exp $	
use strict;
use Data::Dumper;

my $debugging = shift || 0;

warn "$debugging\n" if $debugging;

my ($wwwdir, $prog);

if ($ENV{USER} eq 'ja1') {
#    $wwwdir = "/nfs/intweb/INTWEB_docs/htdocs/LocalUsers/ja1/depth";
    $wwwdir = "/nfs/gelsweb/GELS_docs/htdocs/Software/HGP/humseq/depth/test";
    $prog = '/nfs/disk53/ja1/badger-bin/proj_depth.pl';
} else {
#    $wwwdir = "/nfs/intweb/INTWEB_docs/htdocs/HGP/humseq/depth";
    $wwwdir = "/nfs/gelsweb/GELS_docs/htdocs/Software/HGP/humseq/depth";
    $prog = '/usr/local/badger/bin/proj_depth.pl';
}
$prog .= " debugging" if $debugging;

print "$prog\n$wwwdir\n";
open F,"$prog |" or die "can't open pipe from $prog\n";
my (@info) = (<F>);
close F;
my (@header) = @info[0,1,2];
my $footer = $info[$#info];
my (%teaminfo, %bigproj, %chrominfo);
foreach my $line (@info) {
    next unless $line =~ /^\| \d\d/;
    my ($junk, $team, $depth, $stat, $proj, $chrom, $size, $reads, $contigs, $reason, $digest) = 
	split /\s*\|\s*/, $line;
#    print "<$team> <$depth> <$proj> <$digest>\n";
    $line =~ s#\b$proj\b#<a href="/cgi-bin/oracle_reports/report.pl?Projectname=$proj">$proj</a>#;
    $teaminfo{$team}{$depth}{$proj} = $line;
    $chrominfo{$chrom}{$depth}{$proj} = $line;
    if(defined $size and $size > 200) {
	$bigproj{$team}{$size}{$proj} = $line;
    }
}

if(@info < 100 and not $debugging) {
	print "no data, exiting\n";
	exit;
}
foreach my $team (40, 41, 42, 43) {
    my $outfile = "$wwwdir/depth$team.html";
    my $oldfile = "$wwwdir/depth$team.old";
    system("mv $outfile $oldfile") if -e $outfile;
    open F, ">$outfile" or die "can not open $outfile\n";
    print F "<html><head><title>Project Depth for team $team</title></head><body bgcolor=\"white\">\n";
    print F "<h1>Project Depth for team $team</h1><pre>\n";
    print F scalar localtime(), "\n";
    print F @header;
    foreach my $depth (sort numerically keys %{$teaminfo{$team}}){
	foreach my $proj (sort keys %{$teaminfo{$team}{$depth}}){
	    print F $teaminfo{$team}{$depth}{$proj};
	}
    }
    print F $footer;
    print F "</pre></body></html>\n";
    close F;
}
foreach my $chrom (keys %chrominfo) {
    my $outfile = "$wwwdir/depth_chr$chrom.html"; $outfile =~ s/\s+/_/g;
    my $oldfile = "$wwwdir/depth_chr$chrom.old"; $oldfile =~ s/\s+/_/g;
    system("mv $outfile $oldfile") if -e $outfile;
    open F, ">$outfile" or die "can not open $outfile\n";
    print F "<html><head><title>Project Depth for chromosome $chrom</title></head><body bgcolor=\"white\">\n";
    print F "<h1>Project Depth for chromosome $chrom</h1><pre>\n";
    print F scalar localtime(), "\n";
    print F @header;
    foreach my $depth (sort numerically keys %{$chrominfo{$chrom}}){
	foreach my $proj (sort keys %{$chrominfo{$chrom}{$depth}}){
	    print F $chrominfo{$chrom}{$depth}{$proj};
	}
    }
    print F $footer;
    print F "</pre></body></html>\n";
    close F;
}
my $outfile = "$wwwdir/bigproj.html";
my $oldfile = "$wwwdir/bigproj.old";
system("mv $outfile $oldfile") if -e $outfile;
open F, ">$outfile" or die "can not open $outfile\n";
print F "<html><head><title>Big Project Depths</title></head><body bgcolor=\"white\">\n";
print F "<h1>Project Depths for Big Projects</h1><pre>\n";
print F scalar localtime(), "\n";
foreach my $team (sort keys %bigproj){
    foreach (@header) {
	printf F "%s",$_;
    }
    foreach my $size (reverse sort keys %{$bigproj{$team}}){
	foreach my $proj (keys %{$bigproj{$team}{$size}}){
	    printf F "%s",$bigproj{$team}{$size}{$proj};
	}
    }
    printf F "%s", $footer;
}
print F "</pre></body></html>\n";
close F;

$outfile = "$wwwdir/index.html";
$oldfile = "$wwwdir/index.old";system("mv $outfile $oldfile");
open F, ">$outfile" or die "can not open $outfile\n";
print F <<EOM;
<html><head><title>Project Depth Info</title></head><body bgcolor="white">
<h1>Project Depth Info</h1>

<i>The values for number of reads and contigs are for contigs >2k
unless otherwise stated</i>
<h3>Big Projects</h3>
<a href="bigproj.html">Big projects</a>
<h3>By Team</h3>
<ul>
  <li><a href="depth40.html">team 40</a>
  <li><a href="depth41.html">team 41</a>
  <li><a href="depth42.html">team 42</a>
  <li><a href="depth43.html">team 43</a>
</ul>
<h3>By Chromosome</h3>
<ul>
EOM
opendir DIR,$wwwdir or die "Can't open $wwwdir: $!\n";
my @chroms = grep /^depth_chr.*\.html$/, readdir DIR;
closedir DIR;
foreach my $file (sort {sensibly(lc($a), lc($b)) } @chroms) {
    if ( -e "$wwwdir/$file" and -M _ < 0.5) {
	my $chrom = $file;
	$chrom =~ s/^depth_chr//; $chrom =~ s/\.html$//;
	$chrom = 'unknown' unless length($chrom);
	print F "<li><a href=\"$file\">$chrom</a>\n";
    }
}
my $now = scalar localtime();
print F <<EOM2;
</ul><hr>
<address><a HREF="mailto:bug\@sanger.ac.uk">bug\@sanger.ac.uk</a></address>
Last modified: $now
</body></html>
EOM2
close F;

sub numerically { $a <=> $b; }

# This subroutine splits off the left-hand component of both symbols and
# compares them (numerically if they are both composed of digits, lexically
# otherwise). If they are different, it returns with a value indicating which
# comes first, otherwise it reinvokes itself recursively with the remainder
# of the two symbols until either a difference is found, or else one or both
# of the symbols has been exhausted. Note that this will only work if all
# symbols to be sorted are guaranteed to start with the same thing (digit 
# or letter).

sub sensibly {
        my ($aa, $bb) = @_;
        my ($a_lhs, $b_lhs);

        return $aa cmp $bb if $aa eq "" or $bb eq "";
        $aa =~ s/^(\D+|\d+)//;
        $a_lhs = $1;
        $bb =~ s/^(\D+|\d+)//;
        $b_lhs = $1;
        if ($a_lhs =~ /^[0-9]/ and $b_lhs =~ /^[0-9]/) {
                if ($a_lhs == $b_lhs) {
                        return sensibly($aa, $bb);
                } else {
                        return $a_lhs <=> $b_lhs;
               }
        } else {
                if ($a_lhs eq $b_lhs) {
                        return sensibly($aa, $bb);
                } else {
                        return $a_lhs cmp $b_lhs;
                }
        }
}
