#!/usr/local/bin/perl -wT

######################################
#                                    #
#   The script allows the user to    #
#   devise their own query from      # 
#   the parameters provided.         #
#                                    #
#   Author : Karen Ambrose           #
######################################

   
#BEGIN {
#  use CGI::Carp qw(carpout);
#
#  my ($root) = $ENV{'DOCUMENT_ROOT'} =~ m|([a-z0-9_/\.]+)|i;
#  
#  open(LOG, ">>$root/../cgi-bin/oracle_reports/logs/submit-log") or die "Unable to append to submit-log:$!\n";
#  carpout(*LOG);
#}

$|=1;
#set up the components needed.

use SangerPaths qw(core badger);
use WrapDBI;
use strict;
use CGI qw(:all :nph :html3);
#use Date::Manip qw(ParseDate);
#use Data::Dumper;

my $cgititle= 'KIT FILTERS';
my $cgiauthor='kva';
my %preferences;
#my @restrictions;
my $db;
my $dbh;
my $reportaddress = '/cgi-bin/oracle_reports/report.pl';
my $eps           = 'http://intweb.sanger.ac.uk/cgi-bin/prodsoft/EPS/nph-EPS.pl?';
my $table_colour  = '#E2E2FF'; #table colour
my $script        = $ENV{'SCRIPT_NAME'};
my $ref_info;
#y $extepsinf='&view=Full&problem_view=all&attempt_view=all';
# Modified to arround for changes to EPS.... (bt1 16/12/01)
my $extepsinf = "&sort=Chromosome".
                "&view=Full".
                "&projectfilter=finished".
                "&projectfilter=11+or+less+weeks+in+finishing".
                "&projectfilter=12+to+15+weeks+in+finishing".
                "&projectfilter=16+to+24+weeks+in+finishing".
		"&projectfilter=24+plus+weeks+in+finishing".
                "&info=Project".
                "&problem_view=NONE".
                "&attempt_view=all";

my (@d,@m,@y);
push @d, ("N/A","01","02","03","04","05","06","07","08","09","10","11","12","13","14","15","16","17","18","19","20","21","22","23","24","25","26","27","28","29","30","31");
push @m, ("N/A","JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC");

#Some of the lists used
#@restrictions=('No Restriction','first 10','first 20','first 50','first 100','first 500');


my %HASHDATE = (
                "JAN" => '1',
                "FEB" => '2',
                "MAR" => '3',
                "APR" => '4',
                "MAY" => '5',
                "JUN" => '6',
                "JUL" => '7',
                "AUG" => '8',
                "SEP" => '9',
                "OCT" => '10',
                "NOV" => '11',
                "DEC" => '12'
                );


#Names and connects to the database 'reports'.
$db = 'reports';

$dbh = WrapDBI->connect("$db", {RaiseError => 1}) || die print "Connection with database failed: $DBI::errstr";

my $query = new CGI;
print $query->header;
print $query->start_html('-title'   => $cgititle,
                         -bgcolor   => 'FFFFFF'
                         ); 

my ($years, $teams, $organisms, $chromosomes, $libraryname, $projstat, $clonestat,$organisations,$priority);

#get the previous year, current year and the next year
$years = &get_years;
push @y, "N/A";
foreach my $ye (@{$years}){
    push @y, @{$ye};
}

my @t;
$teams = &sql_get_teams;
push @t,"Choose a Team"; 
foreach my $t (@{$teams}){
    push @t,@{$t};
}

my @o;
$organisms = &sql_get_organisms;
push @o, "Choose an Organism";
foreach my $o (@{$organisms}){
    push @o,@{$o};
}

my @c;
$chromosomes = &sql_get_chromosomes;
push @c, "Choose a Chromosome";
push @c, "No Chromosome";
my @sorted;
@sorted = sort {@$a <=> @$b } @{$chromosomes};
foreach my $c (@sorted){
    push @c,@{$c};
}

my @l;
$libraryname = &sql_get_library;
push @l, "Choose a Library";
push @l, "No Library";
foreach my $l (@{$libraryname}){
    push @l,@{$l};
}

my %PROJECT_ORDER;
my $ordercount=0;
my @ps;
$projstat = &sql_get_projstat;
foreach my $ps (@{$projstat}){
    $ordercount++;
    push @ps,@{$ps};
    
    my $piece = @{$ps}[0];
    my $p_stat;
    if ($piece=~ /\d+\-(.+)/){
        $p_stat = $1;
    }
    $PROJECT_ORDER{$p_stat}=$ordercount;

}

my @cs;
$clonestat = &sql_get_clonestat;
foreach my $cs (@{$clonestat}){
    push @cs,@{$cs};
}

my @ogs;
$organisations = &sql_get_organisations;
foreach my $ogs (@{$organisations}){
    push @ogs,@{$ogs};
}

my @prios;
my %HASH_PRIOS;
my %REV_PRIOS;
$priority = &get_priority;
foreach my $prios (@{$priority}){
    push @prios,@{$prios}[1];
    $HASH_PRIOS{@{$prios}[1]} = @{$prios}[0]; 
}
%REV_PRIOS = reverse %HASH_PRIOS;
 
if (param('ALLDATA')){
    
    my $adata =  param('ALLDATA');
    my $header = param('HEADERS');
    my $getinfo = param('INFO');
    
    my @newset;
    my @recordset = split (/RECORDSET/,$getinfo);
    my $record_count=0;
    foreach (@recordset){
        $record_count++;
        push @newset , $_;
    }
    
    my $in = 0;
    my $index;
    my @record_data;
    foreach (@newset){
        $_ = CGI::unescape($_);
        @$index[$in]= [ split (/\-SPACE\-/, $_) ];
        $in++;
    }
    
    
    my $a=0;
    my @data_head = split(/\+/,$header);
    print "<TABLE BORDER=\"1\" WIDTH=\"80%\" ALIGN=\"center\">";
    print Tr([th({-align=>'center', -bgcolor=>$table_colour},[@data_head, "Other Links"])]), "\n";
    foreach my $i (@{$index}){
        my $proj = @{$i}[0];
        @{$i}[0]=a({href=>"$reportaddress?Projectname=@{$i}[0]"},"@{$i}[0]");
        @{$i}[1]=a({href=>"$reportaddress?Clonename=@{$i}[1]"},"@{$i}[1]");
        
        my $count=0;
        $count=@{$i};  
        my $j;
        for ($j=0; $j<$count; $j++){
            @{$i}[$j] = '&nbsp;' unless @{$i}[$j];  
        }
        
        if (@{$i}[9] eq '1'){
            @{$i}[9]="Yes";
        }else{
            @{$i}[9]="No";
        }
        
        my $link="p="."$proj";
        print Tr([td({-align=>'center'},[@$i, a({href=>"$eps$link$extepsinf"},"EPS")])]);
        $a++;
        
    }
    print "</TABLE>";
    print "<BR>";
    print h3({-align=>'left'},(font{-color=>'red'},"Total rows of data shown : $a"));
    print "<BR>";
    print "<BR>";
    print "EPS - Electronic Project Sheet";
    print "<BR>";
    print "<HR>";
    print "<BR>";
    
} else {
    
    print "<BR>";
    print "<BR>";
    print "<H1><CENTER>$cgititle</CENTER></H1>";
    print "<BR>";
    print "<HR>";
    print "<BR>";
    print "<BLOCKQUOTE><H4>This page will allow the submission of a query made up of various paramters in this page. Please try to use as many paramters as possible where possible as to limit the volume of data that is returned from the database. You can choose multiple project or clone status's, and multiple organisation names for the sequenced by and funded by paramters, this will help cut down the the data returned from the database. The data is ordered by projectname/clonename, but if a date range is supplied, then the data returned is ordered by project status date in the order of most recent first. The data has been altered to format the information in tables based on teams, project status and chromosome where appropriate. You have the option of viewing all the information, and also viewing subsets of information based on the tables of information. 
</BLOCKQUOTE>
<BLOCKQUOTE>You can also view the ELECTRONIC PROJECT SHEET page (bt1) which details specific project information relevant to finishers for 1 or more projects at a time. The link to this page is found via the highlighted link at the end of each table row entitled 'Electronic Project Sheet' or 'EPS'.</H4></BLOCKQUOTE>
<BLOCKQUOTE><H4><FONT COLOR=\"RED\">NOTE</FONT>: For the moment the link to the electronic project sheet page is disabled for any number of records above 100. </H4></BLOCKQUOTE>";
    print "<BR>";
    
    print hr,
    start_form(-method => 'post'),
    
    table(      
                TR(
                   td(''),
                   td("Teams:"),
                   td(popup_menu(-name=>'team',
                                 -value=>\@t,
                                 -default=>$preferences{'team'})
                      ),

                   td(''),
                   td("Chromosomes:"),
                   td(popup_menu(-name=>'chromosome',
                                 -value=>\@c,
                                 -default=>$preferences{'chromosome'})
                      ),
                   ),
                br,
                TR(
                   td(''),
                   td("Organisms:"),
                   td(popup_menu(-name=>'organism',
                                 -value=>\@o,
                                 -default=>$preferences{'organism'})
                      ),

                td(''),
                   td("Library:"),
                   td(popup_menu(-name=>'libraryname',
                                 -value=>\@l,
                                 -default=>$preferences{'libraryname'})
                      ),
                   ),
                ),
                       
    br,
                       
    table (
           TR(
              td(b('START')),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              td(b('FINISH')),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              td(''),
              ),
           
           TR(
#start date of projstatus
              td("Day:"),
              td(popup_menu(-name=>'sday',
                            -value=>\@d,
                            -default=>$preferences{'sday'})
                 ),
              td(''),
              td("Month:"),
              td(popup_menu(-name=>'smonth',
                            -value=>\@m,
                            -default=>$preferences{'smonth'})
                 ),
              td(''),
              td("Year:"),
              td(popup_menu(-name=>'syear',
                            -value=>\@y,
                            -default=>$preferences{'syear'})
                 ),
              
#finish date of projstatus              
              td(''),
              td(''),
              td("Day:"),
              td(popup_menu(-name=>'fday',
                            -value=>\@d,
                            -default=>$preferences{'fday'})
                 ),
              td(''),
              td("Month:"),
              td(popup_menu(-name=>'fmonth',
                            -value=>\@m,
                            -default=>$preferences{'fmonth'})
                 ),
              td(''),
              td("Year:"),
              td(popup_menu(-name=>'fyear',
                            -value=>\@y,
                            -default=>$preferences{'fyear'})
                 ),
              ),
           ),
    
    br,   
    table (
           TR(
              td(''),
              td("Project Status:"),
              td(popup_menu(-name=>'projstat',
                            -size=>5,
                            -multiple=>3,
                            -value=>\@ps,
                            -default=>$preferences{'projstat'})
                 ),
              td(''),
              td("Clone Status:"),
              td(popup_menu(-name=>'clonestat',
                            -size=>5,
                            -multiple=>3,
                            -value=>\@cs,
                            -default=>$preferences{'clonestat'})
                 ), 
              ),
           ),
    
    
    table(
          TR(
             td(''),
             td("Sequenced by:"),
             td(popup_menu(-name=>'sequenced',
                           -width=>10,
                           -size=>5,
                           -multiple=>3,
                           -value=>\@ogs,
                           -default=>$preferences{'sequenced'})
                ),
             ),
          
          TR(
             td(''),
             td("Funded by:"),
             td(popup_menu(-name=>'funded',
                           -width=>10,
                           -size=>5,
                           -multiple=>3,
                           -value=>\@ogs,
                           -default=>$preferences{'funded'})
                ),
             ),      
          
          TR(
             td(''),
             td("Priority:"),
             td(popup_menu(-name=>'priority',
                           -width=>10,
                           -size=>3,
                           -multiple=>3,
                           -value=>\@prios,
                           -default=>$preferences{'priority'})
                ),
             ),

#          TR(
#             td(''),
#             td("Restrict data:"),
#             td(popup_menu(-name=>'restrict',
#                           -value=>\@restrictions,
#                           -default=>$preferences{'restrict'})
#                )
#             )
          ),
    
    radio_group(-name=>'tile_path',
                -value=>['Tile path','non Tile path','Both'],
                -cols=>3),br,
    
    submit(-label=>'Submit Query'),
    defaults('Clear'),
    end_form,
    hr;

print_response(param('team')) if param('team');

}

print $query->end_html;

#footer with my own addition above it.
print "<br><br><center><address>Any feedback should be directed to <a href=\"mailto:kva\@sanger.ac.uk\">Karen Ambrose</a></address></center>";


#Disconnecting from the database.
$dbh->disconnect or warn "Disconnection failed: $DBI::errstr\n";


#exiting via mod perl environment or normally.
if ($ENV{'MOD_PERL'}){   
    Apache->exit();
}else{
    exit;
}


#SUBROUTINES---------------------------------------------


sub print_response {
    
    print h2({-align=>'center'},(font{-color=>'red'},"Result"));
    print br;
    
    my $team = param('team');
    my $org = param('organism');
    my $chr = param('chromosome'); 
    my $lib = param('libraryname');
    my @proj_stat = param('projstat');
    my @clone_stat = param('clonestat');
    my @seq_by = param('sequenced');
    my @fund_by = param('funded');
    my @clone_prios = param('priority');
#    my $restr = param('restrict');
    my $tile_path = param('tile_path');
    
    my $sdy  = param('sday'); 
    my $smon = param('smonth');
    my $syr  = param('syear');
    my $fdy  = param('fday');
    my $fmon = param('fmonth');
    my $fyr  = param('fyear');
    
#    print "$sdy $smon $syr TO $fdy $fmon $fyr";
#    print "<BR>";
    
    my (@p_s,@c_s,@c_p);
    push @p_s, @proj_stat;
    push @c_s, @clone_stat;
    push @c_p, @clone_prios;

    foreach (@p_s){
        $_=~ s/\d+\-//;
    } 
    
    foreach (@c_s){
        $_=~ s/\d+\-//;
    }

    foreach (@c_p){
        $_=~ s/\s+//;
    }

    my ($start_date,$finish_date);    
    $start_date = "$sdy"."-"."$smon"."-"."$syr";
    $finish_date = "$fdy"."-"."$fmon"."-"."$fyr";
    
    my @ent;
    my @dentit = split (/\-/,$start_date);
    push @dentit, split (/\-/,$finish_date);
    foreach (@dentit){
        if ($_ eq 'N/A'){
            push @ent, $_;
        }
    }
    my $dent_count = scalar (@ent);
    
    if ($dent_count !~ /0|6/) {
        
        if ($dent_count !~ /0|6/) {
            print "<CENTER><H4>The date range section was not filled in properly, please go back and add the missing data.</H4></CENTER>";
            print "<BR>";
            print "<HR>";
            print "<BR>";
        }
        
        
    } else {
        
        my ($startpdate,$finishpdate); 
        if ($dent_count == '0'){
            $startpdate = "$syr"."$HASHDATE{$smon}"."$sdy";
            $finishpdate = "$fyr"."$HASHDATE{$fmon}"."$fdy";
            #my $startpdate = ParseDate($start_date); 
            #my $finishpdate = ParseDate($finish_date);
#            print ">>$finishpdate<<";
#            print "<BR>";
            
#    $startpdate=~ s/:.*//g;
#    $finishpdate=~ s/:.*//g;
            
#            print "ALTERED PARSEDATES: >>$startpdate<<>>$finishpdate<<";
#            print "<BR>";
            
        }
        
        if ($startpdate && $finishpdate) {
            if ($startpdate > $finishpdate) {
                print "<CENTER><H4>The start date $start_date is greater than the finish date $finish_date in the date range please rectify and try again.</H4></CENTER>";
                print "<BR>";
                print "<HR>";
                print "<BR>";
                exit;
            } 
            
        }
        
        if ($dent_count == '6'){
            $start_date = "";
            $finish_date = "";
        }
        
        my $cln_count = scalar(@clone_stat);
        my $prt_count = scalar(@proj_stat);
        my $seq_count = scalar(@seq_by);
        my $fun_count = scalar(@fund_by);
        my $prio_count = scalar(@clone_prios);
	
        if ($tile_path=~ /^Tile.+/){
            $tile_path = '1';
        } elsif ($tile_path=~ /^Both/){
            $tile_path = '2';
        }else{
            $tile_path = '0';
        }
        
        my $proj_stat;
        if ($prt_count > 0) {
            foreach (@proj_stat){
                $_=~ s/-.*//;
                $_=~ s/\s+//;
            }
            $proj_stat=join",", @proj_stat;
        }
        
        my $clone_stat;
        if ($cln_count > 0) {
            foreach (@clone_stat){
                $_=~ s/-.*//;
                $_=~ s/\s+//;
            }
        }
        $clone_stat=join",", @clone_stat;
        
        my $s_by;
        my @seq;
        if ($seq_count > 0) {
            foreach (@seq_by){
                $_=~ /-(.*)/;
                push @seq, $1;
                $_=~ s/-.*//;
                $_=~ s/\s+//;
            }
            $s_by=join",", @seq_by;
        }
        
        my $f_by;
        my @fund;
        if ($fun_count > 0) {
            foreach (@fund_by){
                $_=~ /-(.*)/;
                push @fund, $1;
                $_=~ s/-.*//;
                $_=~ s/\s+//;
            }
            $f_by=join",", @fund_by;
        }
        
        my @prios_list;
        my $p_id;
        if ($prio_count > 0) {
            foreach my $cprios (@clone_prios){
                my $id = $HASH_PRIOS{$cprios};
                push @prios_list, $id;
            }
            $p_id=join",", @prios_list;
        }
 
        my $select_sql = "select /*+ INDEX(a) INDEX(cd) INDEX(g) */ e.projectname, a.clonename, g.description, f.statusdate, e.remark, f.remark, c.description, b.statusdate, a.remark, a.is_hsm ";
        
        if ((!$s_by) || ($seq_count > 1)){
            $select_sql .=",i.orgtitle";
        }
        
        if ((!$f_by) || ($fun_count >1)){
            $select_sql .=",j.orgtitle";
        }
        
        if ($org=~ /Choose an Organism/){
            $org="";
            $select_sql .=", a.speciesname";
        }
        
        if ($chr=~ /Choose a Chromosome/){
            $chr="";
            $select_sql .=", cd.chromosome";
        }
        
        if ($chr=~ /No Chromosome/){
            $chr="NULL";
        }
        
        if ($team=~ /Choose a Team/){
            $team="";
            $select_sql .=", h.teamname";
        }

        if ($lib=~ /Choose a Library/){
            $lib="";
            $select_sql .=", a.libraryname";
        }
        
        if ($lib=~ /No Library/){
            $lib="NULL";
        }

        if (($p_id eq '') || ($prio_count > 1)){
            $select_sql .=", l.description";
        }

#        if ($restr=~ /No Restriction/){
#            $restr="";
#        }
        
#        if ($restr=~ /first\s+(\d+)/){
#            $restr=$1;
#        }
        
        
#        if ((!$team) && (!$org) && (!$chr) && ($cln_count == 0) && ($prt_count == 0) && ($seq_count == 0) && ($fun_count == 0) && (!$restr)) {
        if ((!$team) && (!$org) && (!$chr) && ($cln_count == 0) && ($prt_count == 0) && ($seq_count == 0) && ($fun_count == 0)) {
            print "<CENTER><H4>This query will extract too much information from the database, please redefine your query using more parameters.</H4></CENTER>";
            print "<BR>";
            print "<HR>";
            print "<BR>";
            
        } else {
            
            print "<HR>";
            print "<H3>Parameters set</H3>";
            if ($team) { print "Team is <FONT COLOR = \"blue\">$team</FONT>"; print "<BR>";}
            if ($org) { print "Organism is <FONT COLOR = \"blue\">$org</FONT>"; print "<BR>";}
            if ($chr) { print "Chromosome is <FONT COLOR = \"blue\">$chr</FONT>"; print "<BR>";} 
            if ($lib) { print "Library is <FONT COLOR = \"blue\">$lib</FONT>"; print "<BR>";}
            if ($start_date && $finish_date) {print "Date range is between <FONT COLOR = \"blue\">$start_date</FONT> to <FONT COLOR = \"blue\">$finish_date</FONT>"; print "<BR>";}
            
            if ($prt_count > 0) {print "Project status(s) chosen are/is <FONT COLOR = \"blue\">".&commify_series(@p_s)."</FONT>"; print "<BR>";}
            if ($cln_count > 0) {print "Clone status(s) chosen are/is <FONT COLOR = \"blue\">".&commify_series(@c_s)."</FONT>"; print "<BR>";}
            
            if ($s_by) { print "Sequencing centre(s) are/is the <FONT COLOR = \"blue\">".&commify_series(@seq)."</FONT>"; print "<BR>";}
            if ($f_by) { print "Funding centre(s) are/is the <FONT COLOR = \"blue\">".&commify_series(@fund)."</FONT>"; print "<BR>";}
            if ($p_id ne '') {print "Priorities selected are <FONT COLOR = \"blue\">".&commify_series(@clone_prios)."</FONT>"; print "<BR>";}
#            if ($restr) { print "Restriction of data is set to first <FONT COLOR = \"blue\">$restr</FONT> records"; print "<BR>";}
            
            if ($tile_path == '1') { 
                print "Are records shown part of the tiling path? - YES"; 
                print "<BR>";
            }
            elsif ($tile_path == '0') {
                print "Are records shown part of the tiling path? - NO"; 
                print "<BR>";
            } 
            else {
                print "Tilepath restriction has been turned off\n";
                print "<BR>";
            }
            print "<BR>";
            print "<HR>";
            print "<BR>";
            
            
            my $large_statement;
            
            my $stat = " from clone a, clone_status b, clonestatusdict c, clone_project d, chromosomedict cd,  project e, project_status f, projectstatusdict g, project_owner h, organisation i, organisation j, clone_priority k, cloneprioritydict l
where a.clonename = b.clonename
and a.chromosome = cd.id_dict (+)
and b.status = c.id_dict
and a.clonename = d.clonename
and d.projectname = e.projectname
and e.projectname = f.projectname
and f.status = g.id_dict
and f.projectname = h.projectname (+)
and a.sequenced_by = i.id_org (+)
and a.funded_by  = j.id_org (+)
and a.clonename  = k.clonename (+)
and k.priority = l.id_dict (+)
and b.iscurrent = 1
and f.iscurrent = 1
and h.iscurrent (+)= 1
and k.is_current (+)=1
";
            
            $large_statement =$select_sql.$stat;
            my $count_statement = $select_sql.$stat;
           
            my @all;
#            my($bit1,$bit2,$bit3,$bit4,$bit5,$bit6,$bit7, $bit8, $bit9, $bit10);
            my($bit1,$bit2,$bit3,$bit4,$bit5,$bit6,$bit8,$bit9,$bit10,$bit11,$bit12);

            if ($clone_stat){
                $bit1 = " and b.status in ($clone_stat)";
                $large_statement .= $bit1;
                $count_statement .= $bit1;
            }
            
            if ($proj_stat){
                $bit2 = " and f.status in ($proj_stat)";
                $large_statement .= $bit2;
                $count_statement .= $bit2;
            }
            
            if ($team){
                $bit3 = " and h.teamname = $team";
                $large_statement .= $bit3;
                $count_statement .= $bit3;
            }
            
            if ($org){
                $bit4 = " and a.speciesname = '$org'";
                $large_statement .= $bit4;
                $count_statement .= $bit4;
            }
            
            if ($chr){
                if ($chr=~ /NULL/){
                    $bit5 = " and cd.chromosome is null";
                } else {
                    $bit5 = " and cd.chromosome = '$chr'";
                }
                $large_statement .= $bit5;
                $count_statement .= $bit5;
            }
            
            if (($tile_path == '0') || ($tile_path == '1')){
                $bit6 = " and a.is_hsm = $tile_path";
                $large_statement .= $bit6;
                $count_statement .= $bit6;
            }
            
#            if ($restr){
#                $bit7 = " and ROWNUM <= $restr";
#                $large_statement .= $bit7;
#            }
            
            if ($s_by){
                $bit8 = " and a.sequenced_by in ($s_by)";
                $large_statement .= $bit8;
                $count_statement .= $bit8;
            }
            
            if ($f_by){
                $bit9 = " and a.funded_by in ($f_by)";
                $large_statement .= $bit9;
                $count_statement .= $bit9;
            }   
            
            if ($start_date && $finish_date){
                $bit10 = " and f.statusdate between to_date('$start_date','DD-MON-YY') and to_date('$finish_date','DD-MON-YY')";
                $large_statement .= $bit10;
                $count_statement .= $bit10;
            } 

            if ($p_id ne ''){
                $bit11 = " and k.priority in ($p_id)";
                $large_statement .= $bit11;
                $count_statement .= $bit11;
            }

            if ($lib){
                if ($lib=~ /NULL/){
                    $bit12 = " and a.libraryname is null";
                } else {
                    $bit12 = " and a.libraryname = '$lib'";
                }
                $large_statement .= $bit12;
                $count_statement .= $bit12;
            }

            my $order_sql;
            if ($start_date && $finish_date) {
                $order_sql = " order by f.statusdate DESC, e.projectname, a.clonename, f.status, b.status";
            } else {
                $order_sql = " order by e.projectname, a.clonename, f.status, b.status,f.statusdate";
            }

            $large_statement.= $order_sql;

            my $info;
            ($info) = $dbh->selectall_arrayref($large_statement);
            
#            my $full;
#            my $total_count;
#            if ($restr) {
#                ($full) = $dbh->selectall_arrayref($count_statement);
#                $total_count=@{$full}; 
#            }
            
#    my @sorts = ("Sort by Project","Sort by Clone","Sort by PS Date","Sort by CS Date");
#    print start_form;
#    foreach (@sorts) {
#        print submit(-name=>'action',-value=>"$_");
#        print button(-name=>'action', -value=>"$_", -onclick=>"parent.location='$script'");
#    }
#    print hidden(-name=>'team', -value=>"$team");
#    print hidden(-name=>'data', -value=>"$info");
#    print end_form;
    
            print "<br>";
            
            my $a=0;
            my $r_count=0; 
            
            my @headers;
            push @headers , ('Projectname','Clonename','Project_Status','Projectstatus_Date','Project_Remark','Project_Status_Remark','Clone_Status','Clonestatus_Date','Clone_Remark','Tile_Path?');
            
            if ((!$s_by) || ($seq_count > 1)){
                push @headers, "Seq_by";
            }
            
            if ((!$f_by) || ($fun_count > 1)){
                push @headers, "Fund_by";
            }
            
            if ($org eq ""){
                push @headers ,"Species";
            }
            
            if ($chr eq ""){
                push @headers ,"Chr";
            }
            
            if ($team eq ""){
                push @headers ,"Team";
            } 

            if ($lib eq ""){
                push @headers ,"Library";
            }

            if (($p_id eq '') || ($prio_count > 1)){
                push @headers ,"Priority";
            }
            
            my %HEADER;
            my $count_header = 0;
            foreach my $head (@headers){
                $HEADER{$head} =$count_header;
                $count_header++;
            }
            my $ref_headers = join ("+",@headers); 
            
            my %TSTATS;
            my %PSTATS;
            my %CHRSTATS;
            my %TILESTATS;
            my %SPECSTATS;
            my %PRIOSTATS;
            
            my @allinfo;
            my $allinfo;

            my %t_proj;
            my %ps_proj;
            my %c_proj;
            my %tl_proj;
            my %sp_proj;
            my %prs_proj;

            my @all_proj;
            my $all_var;           
            
            foreach my $i (@{$info}){
                
                my $count=0;
                $count=@{$i};  
                my $j;
                for ($j=0; $j<$count; $j++){
                    @{$i}[$j] = "&nbsp;" unless @{$i}[$j];  
                }
                
                if ($HEADER{'Team'}){
                    my $pos = $HEADER{'Team'};
                    my $htm = @{$i}[$pos];
                    if ($htm !~ /\d+/){
                        $htm = "NO TEAM";
                    }
                    push (@{$TSTATS{$htm}},$i);
                    my $var = "p=".@{$i}[0];
                    push (@{$t_proj{$htm}},$var);
                }
                
                if ($HEADER{'Project_Status'}){
                    my $pos = $HEADER{'Project_Status'};
                    my $htm = @{$i}[$pos];
                    # print ">>$htm<<";
                    # print "<br>";
                    push (@{$PSTATS{$htm}},$i);
                    my $var = "p=".@{$i}[0];
                    push (@{$ps_proj{$htm}},$var);
                }
                
                if ($HEADER{'Chr'}){
                    my $pos = $HEADER{'Chr'};
                    my $htm = @{$i}[$pos];
                    if ($htm eq ""){
                        $htm = "NO CHR";
                    }
                    push (@{$CHRSTATS{$htm}},$i);
                    my $var = "p=".@{$i}[0];
                    push (@{$c_proj{$htm}},$var);
                }

                if ($HEADER{'Tile_Path?'}){
                    my $pos = $HEADER{'Tile_Path?'};
                    my $htm = @{$i}[$pos];
                    if ($htm eq "1"){
                        $htm = 'YES';
                    } else {
                        $htm = 'NO';
                    }
                    push (@{$TILESTATS{$htm}},$i);
                    my $var = "p=".@{$i}[0];
                    push (@{$tl_proj{$htm}},$var);
                }   
                
                if ($HEADER{'Species'}){
                    my $pos = $HEADER{'Species'};
                    my $htm = @{$i}[$pos];
                    push (@{$SPECSTATS{$htm}},$i);
                    my $var = "p=".@{$i}[0];
                    push (@{$sp_proj{$htm}},$var);
                }   

                if ($HEADER{'Priority'}){
                    my $pos = $HEADER{'Priority'};
                    my $htm = @{$i}[$pos];
                    if ($htm !~ /\s+/){
                        $htm = "NO PRIORITY RECORD";
                    }
                    push (@{$PRIOSTATS{$htm}},$i);
                    my $var = "p=".@{$i}[0];
                    push (@{$prs_proj{$htm}},$var);
                }

                push @all_proj ,"p=".@{$i}[0];                
                my $row_data = join "-SPACE-", @$i;
                $row_data=CGI::escape($row_data);
                push @allinfo,$row_data;
            }
            
            $ref_info = join "RECORDSET", @allinfo;
            $r_count = @{$info}; 
            
            print "<BR>";
            $all_var = join "&", @all_proj;
            
#            if ($restr) {
#                $total_count=a({href=>"$script?ALLDATA=yes", -target=>"remote_window"},"$total_count");
#                print h3({-align=>'center'},(font{-color=>'red'},"Total number of records found in the database : $total_count"));
#            } else {
#                $r_count = @{$info};
#                $r_count=a({href=>"$script?ALLDATA=yes&HEADERS=$ref_headers&INFO=$ref_info", -target=>"remote_window"},"$r_count");
#                print h3({-align=>'center'},(font{-color=>'red'},"Total number of records found in the database : $r_count"));
#            }
 
           
            print "<BR>"; 
            print "<TABLE BORDER=\"0\" WIDTH=\"60%\" ALIGN=\"CENTER\">";
            print "<TR>";
            print "<TD ALIGN=\"CENTER\" WIDTH=\"80%\"><H3><B><FONT COLOR='RED'>Total number of records found in the database</FONT> : $r_count</B></H3></TD>";
            
            if ($r_count != 0){
                print "<TD ALIGN=\"CENTER\" WIDTH=\"40%\"><FORM method=\"POST\" target=\"resource window\"><INPUT TYPE=HIDDEN NAME=HEADERS VALUE=$ref_headers><INPUT TYPE=HIDDEN NAME=INFO VALUE=$ref_info><INPUT TYPE=submit NAME=ALLDATA VALUE=\"Get all data\" class=blue1></FORM></TD>";
                if ($r_count < 101) {
       print "<TD ALIGN=\"CENTER\" WIDTH=\"40%\"><A HREF=\"$eps$all_var$extepsinf\", target=\"remote_window\">EPS</A></TD>";             
            }
            }
            print "</TR>";
            print "</TABLE>";


            my (%TP, %PS, %CP, %TLP, %SPP, %PSP);
            foreach my $tkeys (%t_proj){
                my @t_proj;
                foreach my $tp (@{$t_proj{$tkeys}}){
                    push @t_proj, $tp;
                }
                my $t_proj = join '&', @t_proj;
                $TP{$tkeys} = $t_proj;
            }
            
            
            foreach my $pkeys (%ps_proj){
                my @ps_proj;
                foreach my $ps (@{$ps_proj{$pkeys}}){
                    push @ps_proj, $ps;
                }
                my $ps_proj = join '&', @ps_proj;
                $PS{$pkeys} = $ps_proj;
            }
            
            
            foreach my $ckeys (%c_proj){
                my @c_proj;
                foreach my $c (@{$c_proj{$ckeys}}){
                    push @c_proj, $c;
                }
                my $c_proj = join '&', @c_proj;
                $CP{$ckeys} = $c_proj;
            }
            
            foreach my $tlkeys (%tl_proj){
                my @tl_proj;
                foreach my $tl (@{$tl_proj{$tlkeys}}){
                    push @tl_proj, $tl;
                }
                my $tl_proj = join '&', @tl_proj;
                $TLP{$tlkeys} = $tl_proj;
            }
       
            foreach my $spkeys (%sp_proj){
                my @sp_proj;
                foreach my $sp (@{$sp_proj{$spkeys}}){
                    push @sp_proj, $sp;
                }
                my $sp_proj = join '&', @sp_proj;
                $SPP{$spkeys} = $sp_proj;
            }
       
            foreach my $prskeys (%prs_proj){
                my @prs_proj;
                foreach my $prs (@{$prs_proj{$prskeys}}){
                    push @prs_proj, $prs;
                }
                my $prs_proj = join '&', @prs_proj;
                $PSP{$prskeys} = $prs_proj;
            }
            
            if (%TSTATS) {
                my $title = "Number of projects per team";
                my @sub_headers = ("Team","No of Projects","Show Projects");
                my $hash_tproj = \%TP;
                my $hash_ref = \%TSTATS;                
                &display_tables($title,\@sub_headers,$hash_ref,$ref_headers,$hash_tproj);
            }
            
            if (%PSTATS) {
                print "<BR>";
                print "<BR>";
                print "<BR>";
                my $title = "Number of projects per project status";
                my @sub_headers = ("Project Status","No of Projects","Show Projects");
                my $hash_psproj = \%PS;
                my $hash_ref = \%PSTATS;                
                &display_tables($title,\@sub_headers,$hash_ref,$ref_headers,$hash_psproj,'project_sort');
            }
            
            if (%CHRSTATS) {            
                print "<BR>";
                print "<BR>";
                print "<BR>";
                my $title = "Number of projects per chromosome";
                my @sub_headers = ("Chromosome","No of Projects","Show Projects");
                my $hash_cproj = \%CP;
                my $hash_ref = \%CHRSTATS;                
                &display_tables($title,\@sub_headers,$hash_ref,$ref_headers,$hash_cproj);
            }

            if ($tile_path == '2') {
                if (%TILESTATS) {
                    print "<BR>";
                    print "<BR>";
                    print "<BR>";
                    my $title = "Number of projects on tile and non-tile paths";
                    my @sub_headers = ("Tile Path?","No of Projects","Show Projects");
                    my $hash_tlproj = \%TLP;
                    my $hash_ref = \%TILESTATS;                
                    &display_tables($title,\@sub_headers,$hash_ref,$ref_headers,$hash_tlproj);
                }
            }
            
            if (%SPECSTATS) {            
                print "<BR>";
                print "<BR>";
                print "<BR>";
                my $title = "Number of projects per organism";
                my @sub_headers = ("Organism","No of Projects","Show Projects");
                my $hash_spproj = \%SPP;
                my $hash_ref = \%SPECSTATS;                
                &display_tables($title,\@sub_headers,$hash_ref,$ref_headers,$hash_spproj);
            }
            
            if (%PRIOSTATS) {            
                print "<BR>";
                print "<BR>";
                print "<BR>";
                my $title = "Number of projects per priority";
                my @sub_headers = ("Priority","No of Projects","Show Projects");
                my $hash_prsproj = \%PSP;
                my $hash_ref = \%PRIOSTATS;                
                &display_tables($title,\@sub_headers,$hash_ref,$ref_headers,$hash_prsproj);
            }
            
        }   
        
    }    
    
}


sub sql_get_teams{
    ($teams) = $dbh->selectall_arrayref(qq[select teamname 
                                           from team
                                           order by teamname
                                           ]);
    return ($teams);
}


sub sql_get_organisms{
    ($organisms) = $dbh->selectall_arrayref(qq[select speciesname 
                                               from species
                                               order by speciesname
                                               ]);
    return ($organisms);
}

sub sql_get_chromosomes{
    ($chromosomes) = $dbh->selectall_arrayref(qq[select distinct chromosome 
                                                 from chromosomedict
                                                 order by chromosome
                                                 ]);
    return ($chromosomes);
}

sub sql_get_library{
    ($libraryname) = $dbh->selectall_arrayref(qq[select distinct libraryname
                                             from library
                                             order by libraryname
                                                 ]);
    return ($libraryname);
}

sub sql_get_projstat{
    ($projstat) = $dbh->selectall_arrayref(qq[select id_dict||'-'||description
                                              from projectstatusdict
                                                 order by assign_order
                                              ]);
    return ($projstat);
}

sub sql_get_clonestat{
    ($clonestat) = $dbh->selectall_arrayref(qq[select id_dict||'-'||description
                                               from clonestatusdict
                                               order by assign_order
                                               ]);
    return ($clonestat);   
}

sub sql_get_organisations {
    ($organisations) = $dbh->selectall_arrayref(qq[select id_org||'-'||orgtitle 
                                                   from organisation
                                                   order by id_org
                                                   ]);
    return ($organisations);
}

sub get_years {
    ($years) = $dbh->selectall_arrayref(qq[select to_char(add_months(sysdate,-12),'YY'),
                                           to_char(sysdate,'YY'), 
                                           to_char(add_months(sysdate,+12),'YY') 
                                           from dual
                                           ]);
    return($years);
}

sub get_priority {
    ($priority) = $dbh->selectall_arrayref(qq[select id_dict,description 
                                              from cloneprioritydict 
                                              order by id_dict
                                              ]);
    return($priority);
}


sub commify_series {

    my $sepchar = grep(/,/ => @_) ? ";" : ",";
    (@_ == 0) ? ''                      :
        (@_ == 1) ? $_[0]                   :
            (@_ == 2) ? join(" and ", @_)       :
                join("$sepchar ", @_[0 .. ($#_-1)], "and $_[-1]");
    
}


sub display_tables {
    
    my ($title, $sub_tab_headers, $stats, $ref_headers, $proj_link, $extra_field) = @_;
    
    my %STATS = %$stats;
    my %EXT_LNK = %$proj_link;
    
    print "<H3><CENTER>$title</CENTER></H3>";
    print "<BR>";
    print "<TABLE BORDER=\"1\" WIDTH=\"50%\" ALIGN=\"center\" CELLPADDING=\"2\" BGCOLOR=$table_colour>";
    print Tr([th({-align=>'center'},[@$sub_tab_headers, "Other Links"])]), "\n";
    
    if ($extra_field){
        foreach my $keys (sort {$PROJECT_ORDER{$a} <=> $PROJECT_ORDER{$b}} keys %PROJECT_ORDER){
            my @pallinfo;
            my $pref_info; 
            if (exists $STATS{$keys}){
                foreach my $multi (@{$STATS{$keys}}) {
                    my $row_data = join "-SPACE-", @$multi;
                    $row_data=CGI::escape($row_data);
                    push @pallinfo,$row_data;   
                }
                
                $pref_info = join "RECORDSET", @pallinfo;
                if (scalar(@{$STATS{$keys}}) > 100) {
                    print Tr([td({-align=>'center'},[$keys, scalar(@{$STATS{$keys}}), "<FORM method=POST target=resource window><INPUT TYPE=HIDDEN NAME=HEADERS VALUE=$ref_headers><INPUT TYPE=HIDDEN NAME=INFO VALUE=$pref_info><INPUT TYPE=submit NAME=ALLDATA VALUE=\"Get data\" class=blue1></form>", '&nbsp;'])]);
                } else {   
                    print Tr([td({-align=>'center'},[$keys, scalar(@{$STATS{$keys}}), "<FORM method=POST target=resource window><INPUT TYPE=HIDDEN NAME=HEADERS VALUE=$ref_headers><INPUT TYPE=HIDDEN NAME=INFO VALUE=$pref_info><INPUT TYPE=submit NAME=ALLDATA VALUE=\"Get data\" class=blue1></form>", a({href=>"$eps$EXT_LNK{$keys}$extepsinf", target=>"remote_window"},"Electronic Project Sheet")])]);
                }
            }    
        }
        
    } else {   
        
        foreach my $keys (sort keys %STATS){
            my @pallinfo;
            my $pref_info;  
            foreach my $multi (sort @{$STATS{$keys}}) {
                my $row_data = join "-SPACE-", @$multi;
                $row_data=CGI::escape($row_data);
                push @pallinfo,$row_data;   
            }
            
            $pref_info = join "RECORDSET", @pallinfo;
            if (scalar(@{$STATS{$keys}}) > 100) {
                print Tr([td({-align=>'center'},[$keys, scalar(@{$STATS{$keys}}), "<FORM method=POST target=resource window><INPUT TYPE=HIDDEN NAME=HEADERS VALUE=$ref_headers><INPUT TYPE=HIDDEN NAME=INFO VALUE=$pref_info><INPUT TYPE=submit NAME=ALLDATA VALUE=\"Get data\" class=blue1></form>", '&nbsp;'])]);
                
            } else {   
                
                print Tr([td({-align=>'center'},[$keys, scalar(@{$STATS{$keys}}), "<FORM method=POST target=resource window><INPUT TYPE=HIDDEN NAME=HEADERS VALUE=$ref_headers><INPUT TYPE=HIDDEN NAME=INFO VALUE=$pref_info><INPUT TYPE=submit NAME=ALLDATA VALUE=\"Get data\" class=blue1></form>", a({href=>"$eps$EXT_LNK{$keys}$extepsinf", target=>"remote_window"},"Electronic Project Sheet")])]);
            }
            
        }
    }
    print "</TABLE>";
    
    
}




__END__

