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

###########################################################################
#                                                                         #
#   The script displays the results of the selected report, invoked from  #
#   the script reportindex.pl. Values can be added if required by the     #
#   script. The results are then displayed after the correct information  #
#   is received.                                                          #
#                                                                         #             
#   Author : Karen Ambrose                                                #
#                                                                         #
###########################################################################


$|=1;
use strict;
use SangerPaths qw(core badger);
use SangerWeb;
use WrapDBI;
use DBI;
use CGI qw(:all :html3);
use Benchmark;

my $logfile = "/cgi-bin/oracle_reports/logs/kit_log";
my $dbh;                               # Database handle
my $dbi_user = 'reports';              # DBI alias
my $sth;
my $result_arrayref;                   # Data structure holding report results
my $VAR1;                              # Data structure holding report definition
my $table_colour = '#B0E0E6';          # Colour of table cells in report#E2E2FF
my $reportaddress='/cgi-bin/oracle_reports/report.pl'; #displays the clone or project report information.
my $cgititle='Oracle Reports';
my $cgiauthor = 'kva';
my $eps = 'http://intweb.sanger.ac.uk/cgi-bin/prodsoft/EPS/nph-EPS.pl?';
my $extepsinf='&sort=Chromosome&view=Full&projectfilter=finished&projectfilter=15+or+less+weeks+in+finishing&projectfilter=16+to+24+weeks+in+finishing&projectfilter=24%2B+weeks+in+finishing&info=Project&problem_view=NONE&attempt_view=all';
my $capminder_lnk = 'http://intweb.sanger.ac.uk/cgi-bin/capminder/nph-cm.pl?';

# Root directory for report definition files
my $reportfile;
my $title;
my @equery;
my $listquery=0;
my $query;
my $filepath;
my @commands;
my $entry_values;
my $script;
my $cols;
my $h;
my %hash;
my $database='cas';

my $script_name=$ENV{'SCRIPT_NAME'};
$query=CGI::new();
$script=$query->url();

# Main ------------------------------------------------------------------------

$dbh = WrapDBI->connect($dbi_user, {RaiseError => 1});

my $timer1 = new Benchmark();

if (param("Filepath")){
    
    &outputheader($cgititle);
    
    $filepath = $query->param("Filepath");
    my $tfile;
    $tfile = $query->param("TF");
    
    print "<TABLE BORDER=\"4\" CELLPADDING=\"5\" BGCOLOR=$table_colour>";
    print Tr([td(strong["Filepath :", $filepath])]);
    print "</TABLE>";
    print "<BR><BR>";

    if ($logfile=~ m/^\w+$/){
    system ("`/bin/echo` `/bin/date` $tfile >> $logfile");
    }

    my @report_contents;
    $reportfile=$filepath;
    if ($reportfile=~ /.sql/){
        if (open (REPORT, "< $reportfile")) {
            while(<REPORT>){
                push @report_contents, $_;
            }
        }
        close (REPORT);
    } else {
        print "Can't open $reportfile";
        die;
    }
    
    my %CHECK;
    my $remcount=1;
    foreach (@report_contents){
	if ($_ =~ /^rem\s+\w*/i){
            $title=$_;
            $title=~ s/rem\s+/\n/gi;
            $title=~ s/rem/ /gi;
            $title=~ s/\:entry.+?title.+|\:list.+?title.+//gi;
            $title=~ s/~|-|\#//gi;
            &DISPLAY_HEADER($title);
	} 
	
	if ($_=~ /rem:database=(.+)/i){
	    print "<TABLE BORDER=\"0\" CELLPADDING=\"0\" WIDTH=\"90%\" ALIGN=\"center\">";   
	    $database = $1;
            print Tr([td(strong["Database connection specified is $database"])]);
            print Tr([td("<br>")]);
	    print "</TABLE>";
	}
	
	elsif ($_=~ /rem:/i){
	    $entry_values=$_;
	    $entry_values=~ s/\n+/+/g;
	    $entry_values=~ s/\s+//g;
	    $entry_values=~ s/(.*?)rem://;
	    $CHECK{$entry_values}=$remcount;
	    $remcount++;
	} 
	
    }
    
    if (scalar(keys %CHECK) > 0){
	&DISPLAY_BUTTONS(\%CHECK,$reportfile);
    }
    
    my $keyvals = scalar(keys %CHECK);
    if ($keyvals == 0){ 
        &GET_STATEMENTS(\@report_contents,"",""); 
    }
    
#=pod
##this is going to be cut out untill something can be done.
#    elsif ($reportfile=~ /.pl$/){
#        my $comp_test=`perl -c $reportfile 2>&1`;
#        if ($comp_test=~ /compilation errors/){
#            print "Warn, Errors in compilation: $comp_test";
#        print "These will be dealt with";
#        }else{
#            open(FH,"<$reportfile");
#            while (<FH>){
#                if ($_ =~ /^\#rem/i){
#                    $title=$_;
#                    $title=~ s/\#rem//gi;
#                    &DISPLAY_HEADER($title);
#                } 
#            &RUN_PERL($reportfile);
#            }   
#        }
#    }
#=cut


}


if (param("enterquery")){
    
    &outputheader($cgititle);
    
    $filepath= $query ->param("file");
    my $equery;
    
    @equery = $query ->param("values");
    if (scalar(@equery)>0){
	foreach $equery (@equery){
	    $equery=~ s/\s+//g; 
	    $equery="'".$equery."'"
	    }
    } else {
	@equery="";
    }
    
    $listquery = $query ->param("listvals");
    my @list;
    if ($listquery){
	@list = split/\s+/,$listquery;
	if (scalar(@list)>0){
	    foreach (@list){
		$_="'".$_."'";
	    }
	    $listquery=join ' ',@list;
	    $listquery=~ s/^\s+//g;
	    $listquery=~ s/\s+$//g;
	    $listquery=~ s/\s+/\+/g;
	} else {
	    $listquery="";
	}  
    }

    my @report;
    $reportfile = $filepath;
    if ($reportfile =~ /.sql/){
	my $tmp     = SangerWeb->server_root() . "/$reportfile";
	$reportfile = $tmp if(!-e $reportfile && -e $tmp);

        if (open (REPORT, "< $reportfile")) {
            while(<REPORT>){
                @report=<REPORT>;
            }    
        } 
        close REPORT;
    }

    &GET_STATEMENTS(\@report,\@equery,$listquery);

}

my $timer2 = new Benchmark();
my $diff   = timediff($timer2, $timer1);
print "it took ", timestr($diff), "\n";

print "<br><br><center><address>Any feedback should be directed to <a href=\"mailto:kva\@sanger.ac.uk\">Karen Ambrose</a></address></center>";
&outputfooter($cgiauthor);

#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 outputheader {
    
    my ($cgititle)=@_;
    
    print &SangerWeb::header({
        'title'=> $cgititle
        });
}

sub outputfooter {
    
    my ($cgiauthor)=@_;
    
    print &SangerWeb::footer({
        'author' => $cgiauthor
        });
}


sub DISPLAY_HEADER {
    
    my ($title)=@_;

    print "<TABLE BORDER=\"0\" CELLPADDING=\"0\" WIDTH=\"90%\" ALIGN=\"center\">";   
    print Tr([td(strong[$title])]);
    print "</TABLE>";
#    print "<BR>";
    
}

sub DISPLAY_BUTTONS {
    
    my ($kys,$reportfile)=@_;
  
    my %EV = %$kys;
    foreach my $entry_values (sort { $EV{$a} cmp $EV{$b} } keys %EV){
	push @commands,split(/\+/,"$entry_values");
    }
    
    print "<TABLE BORDER=\"0\" CELLPADDING=\"0\" WIDTH=\"90%\" ALIGN=\"center\">";    
    print Tr("<BR>");
    print Tr([td(["NOTE: If dates need to be entered, please take note of any suggested format in the information given with the report."])]); 
    print "</TABLE>";
    print "<BR>";

    print<<EOS;
    <TABLE BORDER="0" CELLPADDING="0" WIDTH="30%" ALIGN="center" >  
        <Tr><td align="left">
            <form method="post" action ="$script" enctype="application /x-www-form-urlencoded">
                <input type="hidden" name="enterquery" value="EQ">
                    <input type="hidden" name="file" value="$reportfile">
EOS
    
    foreach my $name (@commands){
        if ($name=~ /entrytitle=(.*)/gi){
            $name=~ s/(.*)=//g;
            print "<tr><td>\n\t$name</td><td><input type=\"text\" size=\"10\" name=\"values\"></td></tr>";
        }
        
        if ($name=~ /listtitle=(.+)?/gi){
            $name=~ s/(.*)=//g;
                print "<tr><TD>$name</TD></tr>";
                print "<tr><TD><TEXTAREA rows=\"10\" cols=\"10\" name=\"listvals\" wrap=\"1\"></TEXTAREA></td></tr>";
        }
    }

                                                                          
    print<<EOS;
        </td>
            </tr>
                
                <tr><td align="center">
                    <BR>
                        <INPUT TYPE="submit" VALUE="Run Report" class="red1">
                            <INPUT TYPE="reset" VALUE="Reset"></td></tr>
                                </form>&nbsp;
    
    </TABLE>
        <BR>
EOS


}
 

sub GET_STATEMENTS {
   
    my($REP,$equery,$listquery)=@_;

    my $tables;
    my $count=0; 
    my $column;
    my $recording_val=0;
    my $rcnt=0;
    my $pcnt=0; 
    my $tcnt=0;
    my %STATE;
    my %PROMPT;
    my %TABTITLE;
    my $stat;
    my @string;
    my $table_title;
 
    foreach my $rc (@$REP){
	if ($rc){
            if ($rc=~ /rem:database=(.+)/i){
                $database = $1;
            }
 
	    if ($rc=~ /^select/i){
		$pcnt++;
		$tcnt++;
		if (scalar(@string)>0){
		    my $string=join ' ',@string;
		    $PROMPT{$pcnt}=$string;
		    @string="";
		}
		
		if ($table_title){
		    $TABTITLE{$tcnt}=$table_title;
		    $table_title="";
		}
		
		$stat="";
		$recording_val=1;
	    }
	    $count++;	
	    if ($recording_val==1){
		$stat=$stat.$rc;
	    }
	    if ($rc=~ /;/){
		if ($stat){
		    $rcnt++;
		    $STATE{$rcnt}=$stat;
		    $recording_val=0;
		}
		$stat="";
	    }
	    
	    elsif ($rc=~ /^prompt\s+(\w*.+)/i){
		my $prompt = $1;
		if ($prompt){
                    $prompt=~ s/\#//g;
		    $prompt=$prompt." <BR>";
		    push @string, $prompt;
		}
	    }
	    
	    elsif ($rc=~ /ttitle.+\'(.+)\'/gi){
		$table_title=$1;
	    }
	}
    } 

    my @raw_vals;
    if ($equery){
        @equery=@$equery;
	push @raw_vals,@equery;
    }


    my $listvals=$listquery;
    if (defined $listvals){
	$listvals=~ s/\+/\,/g;
	push @raw_vals, $listvals;
    }
    
    my @values_inserted;    
    foreach (@raw_vals){
	unless ($_ eq ''){
	    push @values_inserted,$_;
	}
    }

    foreach my $rep (@$REP){
	if (defined $rep){
	    if ($rep=~ /^column/gi){
		$column=$rep;
		my($col,$form,$head);
		if ($column=~ /column\s+(\w+)\s+/i){
		    $col = $1;
		}
		if ($column=~ /heading\s+\"(.+)\"\s+/i){
		    $head = $1;
		    $head=~ s/\'//g;
		}
		if ($column=~ /format\s+(\w+)\s+/i){
		    $form = $1;
		}
		
		if ($col){
		    unless ($hash{$col}){
			if ($head){
			    $hash{$col}=$head;
			}
		    }
		}
	    }
	}
	
    }
    

    my $a=1;
    my $vidcount;
    my $vidvar;

#NEED TO HAVE THE : INCASE THEIR IS A 
#TIME DESCRIPTION INCORPORATED IN THE 
#VARIABLES TO BE EXCHANGED.
    if (scalar(@values_inserted)>0){
	foreach my $vid (@values_inserted){
	    $vid=~ s/\s+//g;
	    $vidcount->[$a]=$vid;
	    foreach my $k (keys %STATE){
		if ($STATE{$k}=~ /\'*(\&$a)(\:*)\'*/g){ 
		    my $t = $1;
		    my $ext = $2;
		    $vidvar='&'.$a;
		    if ($vidvar eq $t){
			if ($ext){
			    $vid=~ s/\'//g;
			    $vid="'".$vid;
			}
			if ($STATE{$k}=~ /\'*\%.+/){
			    $vid=~ s/\'//g;
			    $STATE{$k}=~ s/\'*\&*$t\'*/$vid/g; 
			} else {
			    $STATE{$k}=~ s/\'*\&*$t\'*/$vid/g; 
			}
			if ($PROMPT{$k}){
			    $PROMPT{$k}=~ s/\'*\&*$t\'*/$vid/g;
			}
		    }
		}
		$STATE{$k}=~ s/\;|quit//gi;
	    }
	    last if $vid eq ''; 
	    $a++;
	}
    }
    
    unless ($database eq 'cas'){
        $dbh->disconnect;
        eval {
            my $name = "dbi:Oracle:".$database;
            $dbh = DBI->connect($name, "read_only","read_only", {RaiseError => 1});
        };
        if ($@){
            print "<B><FONT COLOR='RED'>Error detected on connection to $database: $@</FONT></B>";
            print "<BR>";
        } else {
            print "<B><FONT COLOR='BLUE'>Connected to $database</FONT></B>";
            print "<BR>";
        }
    }
    
    foreach my $k (keys %STATE){
	my $result_arrayref;
	my $sth;
	if ($STATE{$k}=~ /\;|quit/gi){
	    $STATE{$k}=~ s/\;|quit//gi;
	}
	if (exists $PROMPT{$k}){
	    print "<H4><B>$PROMPT{$k}</B></H4>";
	}
	if (exists $TABTITLE{$k}){
	    print "<H5><B>$TABTITLE{$k}</B></H5>";
	}
	my $whole_statement=$STATE{$k};
	eval{
	    $sth = $dbh->prepare($whole_statement);
	    $result_arrayref = $dbh->selectall_arrayref($sth);
	};
	if ($@){
	    print "Error detected in execution :- $@\n";
	}
	
	#setting up sections of information to be hyperlinked or
	#boolean values to be exchanged for user friendly information.
	my @proj_lst;
	my $i=0;
	$cols=$sth->{NAME};  
	foreach my $c (@{$cols}){
	    my $val1 =uc($c);
	    my $val2 =lc($c);
	    my $clonename;	    
	    foreach my $h (@{$result_arrayref}){
		if ($c=~ /^PROJECTNAME|^PROJECT/i){
		    if (scalar(keys %hash)>0){
			unless (($hash{$val1}=~ /^project status/i) || ($hash{$val2}=~ /^project status/i) || ($hash{$c}=~ /^project status/i)){
			    push @proj_lst,@{$h}[$i];
			    @{$h}[$i]=a({href=>"$reportaddress?Projectname=@{$h}[$i]"},"@{$h}[$i]");
			}
		    } else {
			push @proj_lst,@{$h}[$i];
			@{$h}[$i]=a({href=>"$reportaddress?Projectname=@{$h}[$i]"},"@{$h}[$i]");
		    }    
		}
		
		if ($c=~ /^CLONENAME$|^CLONE$/i){
		    $clonename=@{$h}[$i];
		    if ($clonename=~ /\-\d+/g){
			$clonename=~ s/\-\d+//g;
		    }
		    @{$h}[$i]=a({href=>"$reportaddress?Clonename=$clonename"},"@{$h}[$i]");
		}
		
		if ($c=~ /^IS_HSM/i){ 
		    if (@{$h}[$i]=='1'){
			@{$h}[$i]='yes';
		    }
		}
		
		if ($c=~ /^GELFILENAME/i){ 
		    my $c_lnk = $capminder_lnk."cap=@{$h}[$i]&Action=Lookup";
		    @{$h}[$i]=a({href=>"$c_lnk"},"@{$h}[$i]");
		}
		
	    }        
	    $i++;  
	}
	
	foreach (@{$cols}) {
	    my $val1 = uc($_);
	    my $val2 = lc($_);
	    if ($hash{$val1}){
		$_=$hash{$val1};
	    }
	    if ($hash{$val2}){
		$_=$hash{$val2};
	    }
	    if ($hash{$_}){
		$_=$hash{$_};
	    }
	    
	    if ($_=~ /COUNT.+/i){
		$_="COUNT";
	    }
	    if (($_!~ /||/) && ($_=~ /.*STATUSDATE.*/i) || ($_=~ /.+STATUSDATE.+/i) ){
		$_="DATE";
	    }
	    if ($_=~ /.*BATCHDATE.*/i){
		$_="DATE";
	    }
	}
	
	
	$VAR1 = { 'sql' => { 'fields' =>[@{$cols}]}};
	
	#only make the eps link with a project list
	#of less than 500.
	unless (scalar(@proj_lst)>500){
	    my %seen;
	    foreach (@proj_lst){
		$_=~ s/\s+//g;
		if ($_ ne ''){
		    unless($seen{$_}){
			$_='p='.$_;
			$seen{$_}=1;   
		    }
		}
	    }
	    
	    #create EPS link.
	    my @keys = keys %seen;

	    my $Last="";
	    my @sorted_proj = grep(($Last eq $_ ? 0 : ($Last = $_, 1)), sort @keys);
	    
	    if (scalar(@sorted_proj)>0){
		print "<BR>";
		print "Number of project(s) - ".scalar(@sorted_proj);
		print "<BR>";
	    }
	    my $ul_total = @sorted_proj;
	    my $val = $ul_total/100;
	    $val = sprintf("%.2f",$val);
	    
	    my @n;
	    my $point;
	    my $pcount=0;
	    for (;;){
		if (!$point){
		    $point=100;
		} else {
		    $point = $point+100;
		}
		push @n,$point;
		last if $val=~ /$pcount\.\d+/;
		$pcount++;
	    }
	    
	    my @AR;
	    foreach (@n){
		push @AR, [ splice(@sorted_proj,0,100)];
	    }
	    
	    my $row;
	    my $range = 100;
	    for $row (@AR){
		my $link=join "&",@$row;
		if ($link){
		    my $b_range = $range-99;
		    print "<a href=\"$eps$link$extepsinf\"><B>EPS LINK(range $b_range - $range projects)</B></A>";
		    print "<BR>";
		}
		$range = $range+100;
	    }
	}
	
	unless ($@){	
	    &DISPLAY_REPORT($VAR1,$result_arrayref,$h);     
	    print "<CENTER>###########################</CENTER>";
	}
	
    }    
    
}


sub DISPLAY_REPORT {
    
    my ($VAR1,$result_arrayref,$h) = @_;
    
    if (defined @{$result_arrayref}){
        
        print "<br>";
        print "<table border=\"2\" cellpadding=\"10\" align=\"center\">";
        
        print Tr([th([@{$VAR1->{'sql'}{'fields'}}])]);
        
        foreach my $arrayref(@{$result_arrayref}) {
            
            if (defined @{$arrayref}){ 
                my $total=@{$arrayref};
                my $i=0;
                for ($i=0; $i<$total; $i++){
                    @{$arrayref}[$i]='&nbsp;' unless @{$arrayref}[$i];
                } 
                if (defined $h){
                    print $h;
                }
                print Tr([td([@{$arrayref}])]), "\n";
            }
        }
        print "</table>\n";
        print "<br>";
        
    }else{
        print "<br>";
        print "<TABLE align=\"center\">";
        print Tr([td({align=>'center'},["No Information Found"])]), "\n";
        print "</TABLE>";
        print "<br>";
    }
    
    
}



#=pod
#    sub RUN_PERL {
#
#        my ($reportfile)=@_;
#
#        my @results;
#
#        open(FH,"$reportfile 2>&1|");
#        while (<FH>){
#            chomp $_;
#            push @results,$_; 
#            print "RESULTS: ";
#            print @results;          
#        }
#
#   
#    }
#=cut



###exta bit to go between $VAR1 and \@cols.
#=pod
#        my %all_tables;
#        my $single_table;
#        my %tablehash; 
#        my $file;
#        
#        chomp $tables;  
#        $tables=~ s/\+/ /g;
#        $tables=uc $tables;
#        
#        foreach (split(/,/,$tables)){
#            my $table_raw=$_;
#            $table_raw=~ s/^ //;
#            $table_raw=~ s/ $//;
#            my ($table_name,$table_alias)=split(/ /,$table_raw);
#            if ($table_name){
#                $all_tables{$table_alias}=$table_name;
#            }else{
#                $all_tables{$table_raw}=$table_raw;       
#                $single_table=$table_raw;
#            }
#        }
#        
#        chomp $select_string;   
#        $select_string=~ s/\+/ /g;
#        $select_string=~ s/( distinct | unique )//i;   
#        
#        my @table_field;
#        my @field_alias;
#        my $tab_col;
#        
#        foreach (split(/,/,$select_string)){
#            my $select_raw=$_;
#            $select_raw=~ s/^ //;
#            $select_raw=~ s/ $//;
#            my ($fld_raw,$fld_alias)=split(/ /,$select_raw,2);
#            #$fld_alias=~ s/.+?\s+//g;        
#            unless ($fld_raw){
#                $fld_raw=$_;
#            }else{
#                $fld_alias=~ s/\"//g;
#            }
#            $fld_raw = uc $fld_raw;
#            
#            my ($tab_alias,$tab_fld)=split(/\./,$fld_raw);
#            my $table_prefix;
#            if ($tab_alias){
#                $table_prefix = $all_tables{$tab_alias};
#            }else{
#                $tab_fld=$fld_raw;
#                $table_prefix=$single_table;
#            }
#            
#            #push @table_field,$tab_fld;
#            #push @field_alias,$fld_alias;
#            if ($fld_alias){
#                print "Column:$fld_alias\trefers to field: $table_prefix.$tab_fld\n";
#            }else{ 
#                print "Column:$tab_fld\trefers to field:$table_prefix.$tab_fld\n";
#            }
#        }
#        
#        
#        #print @field_alias; 
#        #print @table_field;
#        
#        my %tablehash;
#        #my $file;
#        my $foff;
#        #my $single_table;
#        $file='/nfs/intweb/INTWEB_docs/cgi-bin/oracle_reports/sql_field_file';
#        if (open (SFF,"< $file")){
#            while(<SFF>){ 
#                chomp;
#                $foff.=$_;
#            }
#        }else{
#            print "This file: $file cannot be accessed: $!";
#        }
#        
#        my($foreign_tab,$id_tab);
#        
#        foreach (split(/\#/,$foff)){
#            my $each=$_;
#            $each=~ s/^ //;
#            $each=~ s/ $//;
#            ($foreign_tab,$id_tab)=split(/ /,$each);
#            $foreign_tab=~ s/^ //;
#            $foreign_tab=~ s/ $//;
#            $id_tab=~ s/^ //;
#            $id_tab=~ s/ $//;
#            $tablehash{$foreign_tab}=$id_tab;
#        }     
#        #print ">$tablehash{$foreign_tab}<";
#        #print "##@{[%tablehash]}##";
#        
#        ###############################################################
#        
#=cut




































