#!/usr/local/bin/perl -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.
#
#################################################################
###################### SQL_info.pm ##############################
#################################################################
#                                                               #   
#   This perl-module returns information used in 'plateinfo'.   #
#   There are a serious of SQL queries performed only if        #
#   previous queries have been successful or have the correct   #
#   information.                                                #
#                                                               #
#   The order things run is:                                    #
#                                                               #
#   get_team -> check -> gelinfo -> aspinfo -> fn -> report     #
#      |          |        |           |       |       |        #
#      v          |        |           |       |       |        #
#  (Gets user team number.)|           |       |       |        #
#                 |        |           |       |       |        #  
#                 v        |           |       |       |        #
#  (Checks the users entry exists, depending on type.) |        #
#                          |           |       |       |        #
#                          v           |       |       |        #
#  (Gets all of the gelinfo for plate, if exists. Can handle    #
#   rerun plates and uses most recent run.)    |       |        #
#                                      |       |       |        #
#                                      v       |       |        #
#  (Gets all of the asp info for plate, if plate has been       #
#   asped else returns no info.)               |       |        #
#                                              v       |        #
#  (Uses the run name and path from gelinfo to grep the|        #
#   runs history file for the 'fn.'. Only does this if the      #
#   run has been asped, obviously.)                    |        #
#                                                      |        #
#                                                      v        #
#  (This splits all of the info passed to it and organises      #
#   it to look good and fit the window.)                        #
#                                                               #
#################################################################
#################################################################
#
# $Id: SQL_info.pm,v 1.12 2006/11/06 11:45:37 holroyd Exp $
#
# $Log: SQL_info.pm,v $
# Revision 1.12  2006/11/06  11:45:37  holroyd
# Updated the getfn method to use the internal trace database via the new capminder pages.
#
# Revision 1.11  2002/07/26  11:11:49  holroyd
# Fixed stack overflow from reading run history file in sub getfn.
#
# Revision 1.10  2001/08/09  10:29:01  holroyd
# *** empty log message ***
#
# Revision 1.9  2001/08/08  12:23:08  holroyd
# *** empty log message ***
#
# Revision 1.8  2001/08/07  17:20:19  holroyd
# Produced a fall back for runs being looked
# up which aren't finishing.
#
# Revision 1.7  2001/08/07  14:52:38  holroyd
# Added ability to lookup by 'Run'.
#
# Revision 1.5  2001/03/22  16:46:31  holroyd
# *** empty log message ***
#
# Revision 1.4  2001/03/22  16:25:13  holroyd
# Now gets info for J-Plates!
#
# Revision 1.3  2001/03/15  17:07:02  holroyd
# Updated to incorporate remarks for plateinfo
#
# Revision 1.2  2001/03/14  12:59:10  holroyd
# *** empty log message ***
#
# Revision 1.1  2001/03/14  12:43:59  holroyd
# Initial revision
#
#

BEGIN {
    unshift(@INC, "$ENV{'BADGER'}/bin");
    unshift(@INC, "."); 
}

package SQL_info;

use strict;

require LWP::Simple;

no strict('refs');
use WrapDBI;
my $dbh;
my $p;
my $q;

sub new {
  my ( $type,$debug,$remark_file ) = @_;
  my $command;
  my $self = {
	      debug => $debug,
	      remark_file => $remark_file,
	     };
  bless ($self,$type);
  eval{
    $dbh = WrapDBI->connect('reports',{RaiseError => 1}); 
    $dbh->{autocommit} = 0;
  };

  if (@$) {
    print "o can't contact oracle\n";
    die;
  }
      $self->{db} = $dbh;
      ($self->{debug}) ? print "\nStarting PlateInfo (Debug Initialised) .........\n\n"  
      : print "\nStarting PlateInfo .........\n\n";
      return ($self);
    }

  sub get_team {
    my ($self,$user) = @_;
    my @team=();

    $q = $self->{db}->fetch_all (qq[
				    select tp.teamname
				    from team_person tp, person p
				    where p.email = '$user'
				    and p.id_person = tp.id_person
				   ]);

    foreach my $r (@$q) {
      push @team, @$r;
      print STDERR "TEAM: @$r\n",if($self->{debug});
    }
    if (scalar(@team)>1) { 
      print STDERR "TEAM: ERROR more than one team for $user\n",if($self->{debug});
      return("ERROR");
    }
    return($team[0]);
  }

  sub check {
    my ($self,$check,$action) = @_;

    if ($action eq 'p/fin' or $action eq 'j_plate' ) {
      my $count;
      if ( $action eq 'p/fin' ) {
	my $plate;
	foreach my $t (qw( pfin fin )) {
	  $q = $self->{db}->fetch_all (qq[
					  select platename 
					  from loadingplate 
					  where platename = '$t$check'
					 ]);
	  my $count = scalar(@$q);
	  if ( $count ) {
	    $plate = $q->[0][0];
	  }
	}
      return( $plate );
    }elsif( $action eq 'j_plate' ) {
      my ( $plate,$suf ) = $check =~ /^(\S+)(\.\S+)/;
      $q = $self->{db}->fetch_all (qq[
				      select team, platename 
				      from loadingplate 
				      where platename = '$plate'
				      and suffix = '$suf'
				     ]);

      $count = scalar(@$q);
      foreach my $r (@$q) {
	print STDERR "CHECK: @$r COUNT: $count\n",if($self->{debug});
      }
      return( $count,@$q->[0]->[0] );
    }

    }elsif ($action eq 'mapid') {

      $q = $self->{db}->fetch_all (qq[
				      select unique(id_mapplate)
				      from request_map
				      where id_mapplate = '$check'
				     ]);
      my $count = scalar(@$q);
      if ( !$count ) { print STDERR "CHECK: Nothing found for $check\n"; }
      foreach my $r (@$q) {
	print STDERR "CHECK: @$r COUNT: $count\n",if($self->{debug});
      }
      return($count);

    }elsif ($action eq 'sample') {
      my ($platename,$row,$col,$suffix,$iteration,$primer) = $check =~ /^(\S+)([a-h])(\d{1,2})(\.\S\d{1,2}\S)(\S)(.*)$/;

      print STDERR ">>$platename => $row => $col => $suffix => $iteration => $primer<<\n",if($self->{debug});

      my $sql_primer;

      if ($primer) {
	print STDERR ">>>$primer<<<\n";
	$sql_primer = "and pr.primername (+) = '$primer'";
      }else{
	print STDERR ">>NO PRIMER<<\n";
	$sql_primer = "";
      }

      $q = $self->{db}->fetch_all (qq[select fr.platename,fr.rowletter,fr.colnum,
				      sc.suffix,fr.iteration,pr.primername
				      from finish_request fr,seqchem sc,primer pr
				      where fr.platename = '$platename'
				      and fr.rowletter = '$row'
				      and fr.colnum = '$col'
				      and fr.iteration = '$iteration'
				      and fr.id_seqchem = sc.id_seqchem
				      and sc.suffix = '$suffix'
				      and pr.id_primer = fr.id_primer (+)
				      $sql_primer
				     ]);
      foreach my $r (@$q) {
	print STDERR ">>SAMPLE: @$r<<\n";
      }
    }elsif ($action eq 'run' ) {

      $q = $self->{db}->fetch_all (qq[
				      select gelfilename
				      from gelfile
				      where gelfilename = '$check'
				     ]);

      return( 1 ) if ( $q->[0][0] );
      return( 0 );
    }
  }

  sub remark {
    my ( $self,$plate ) =@_;
    my ( $date,$user,$remark );
    my @remarks;

    unless( open( REMARK, "$self->{remark_file}" ) ) {
      warn "Can't open $self->{remark_file} : $!\n";
      $remark = "\n - COULDN'T OPEN : $self->{remark_file}";
      push @remarks, $remark;
      return( @remarks );
    }
    while( defined ( my $line = <REMARK> ) ) {
      chomp $line;
      if ( $line =~ /^$plate/ ) {
	( $date,$user,$remark ) = $line =~ /^\S+\s+(.*)U:\s+(.*)RE:\s+(.*)$/;
	$remark = qq[           
 $date $user
 - $remark
];
	push @remarks, $remark;
      }
    }
    if ( !$remark ) {
      $remark = "\n - NONE";
      push @remarks, $remark;
      return( @remarks );
    } 
    return( @remarks );
    close( REMARK );
  }
  
  sub samples {
    my ($self,$plate) = @_; 
    my @sample=();
    my $suffix;

    $q = $self->{db}->fetch_all (qq[
				    select fr.platename||fr.rowletter||fr.colnum||sc.suffix||
				    fr.iteration||pr.primername
				    from finish_request fr, request_map rm, loadingsample ls,
				    loadingplate lp, seqchem sc, primer pr
				    where lp.id_loadingplate = ls.id_loadingplate
				    and ls.id_loadingsample = rm.id_loadingsample
				    and fr.id_frequest = rm.id_frequest
				    and fr.id_seqchem = sc.id_seqchem
				    and fr.id_primer = pr.id_primer(+)
				    and lp.platename = '$plate'
				   ]);
    my $count=0;
    foreach my $r (@$q) {
      $count++;
      push @sample, @$r;
    }
    print STDERR "SAMPLES: $count found\n",if($self->{debug});
    return(@sample);
  }
  
  
  sub status {
    my ($self,$check,$action) = @_;
    my @status=();

    if ($action eq 'p/fin') {
      $q = $self->{db}->fetch_all (qq[
				      select unique(mp.id_mapplate),lp.platename,mp.status,
				      md.description,mp.statusdate,mp.operator
				      from loadingplate lp, loadingsample ls, request_map rm, 
				      mapplate_status mp,mapplatestatusdict md
				      where lp.id_loadingplate = ls.id_loadingplate
				      and ls.id_loadingsample = rm.id_loadingsample
				      and rm.id_mapplate = mp.id_mapplate
				      and mp.status = md.id_dict
				      and lp.platename = '$check'
				      and mp.iscurrent = 1
				     ]);
      
      
      foreach my $r (@$q) {
	push @status, @$r;
	print STDERR "STATUS: @$r\n",if($self->{debug});
      }
      return(@status);
      
    }elsif ( $action eq 'plate' ) {
      push @status, "NOT A MAP",$check,"NOT A MAP","","NOT A MAP","team$self->{team}";
      return(@status);

    }elsif ( $action eq 'mapid' ) {
      $q = $self->{db}->fetch_all (qq[
				      select unique(mp.id_mapplate),lp.platename,mp.status,
				      md.description,mp.statusdate,mp.operator
				      from loadingplate lp, loadingsample ls, request_map rm, 
				      mapplate_status mp,mapplatestatusdict md
				      where rm.id_mapplate = '$check'
				      and rm.id_mapplate = mp.id_mapplate
				      and rm.id_loadingsample = ls.id_loadingsample
				      and ls.id_loadingplate = lp.id_loadingplate
				      and mp.status = md.id_dict
				      and mp.iscurrent = 1
				     ]);
      if (scalar(@$q)==0) {
	$q = $self->{db}->fetch_all (qq[
					select unique(mp.id_mapplate),mp.status,
					md.description,mp.statusdate,mp.operator
					from mapplate_status mp,mapplatestatusdict md
					where mp.id_mapplate = '$check'
					and mp.status = md.id_dict
					and mp.iscurrent = 1
				       ]);
	
	push @status, @$q->[0]->[0],"NO INFO",@$q->[0]->[1],@$q->[0]->[2],@$q->[0]->[3],@$q->[0]->[4];
	print STDERR "STATUS: @$q->[0]->[0] NO INFO @$q->[0]->[1] @$q->[0]->[2] @$q->[0]->[3] @$q->[0]->[4]\n",if($self->{debug});
	return(@status);
      }else{
	foreach my $r (@$q) {
	  push @status, @$r;
	  print STDERR "STATUS: @$r\n",if($self->{debug});
	}
	return(@status);
      }
      return undef;
    }elsif ( $action eq 'run' ){

      $q = $self->{db}->fetch_all (qq[
				      select unique(mp.id_mapplate),lp.platename,mp.status,
				      md.description,mp.statusdate,mp.operator

				      from  gelfile gf, gel_sample gs, loadingsample ls,
				            loadingplate lp, request_map rm, mapplate_status mp,
				            mapplatestatusdict md

				      where gf.gelfilename      = '$check'
				      and   gf.id_gel           = gs.id_gel
				      and   gs.id_loadingsample = ls.id_loadingsample
				      and   ls.id_loadingplate  = lp.id_loadingplate
				      and   ls.id_loadingsample = rm.id_loadingsample 
				      and   rm.id_mapplate      = mp.id_mapplate
				      and   mp.iscurrent        = 1
				      and   mp.status           = md.id_dict
				     ]);
      
      if ( scalar( @$q->[0] ) == 0 ) { 
	push @status, "NOT A FINISHING RUN";
	$q = $self->{db}->fetch_all (qq[
					select unique ( lp.platename )
					from gelfile gf, gel_sample gs, loadingsample ls,
					loadingplate lp
					where gf.gelfilename    = '$check'
					and gf.id_gel           = gs.id_gel
					and gs.id_loadingsample = ls.id_loadingsample
					and ls.id_loadingplate  = lp.id_loadingplate
				       ]);
	$self->{fail} = 1;
      }
      foreach my $r ( @{$q} ) {
	push @status, @$r;
	print STDERR "STATUS: @$r\n" if ( $self->{debug} );
      }
      if ( $self->{fail} == 1 ) { 
	foreach ( 1..3 ) { 
	  if ( $_ != 2 ) {
	    push @status, "NOT A FINISHING RUN";
	  }else{
	    push @status, "","NOT A FINISHING RUN";
	  }
	}
      }
      return( @status );
    }
  }
  
  sub gelinfo {
    my ($self,$plate) = @_;
    my @gelinfo=();
    
    if ( $self->{lookup} ) {
      ( $plate ) = $plate =~ /^(\S+)(\.\S+)/;
    }
    
    $q = $self->{db}->fetch_all (qq[
				    select unique(gf.gelfilename),gf.abi_run_date,
				    gf.num_good_bases,gf.id_gel,gfs.status,
				    gfs.statusdate,gf.transferdest
				    from loadingplate lp, loadingsample ls, gel_sample gs,
				    gelfile gf, gelfile_status gfs
				    where lp.id_loadingplate = ls.id_loadingplate
				    and ls.id_loadingsample = gs.id_loadingsample
				    and gs.id_gel = gf.id_gel
				    and gf.gelfilename = gfs.gelfilename
				    and lp.platename = '$plate'
				    and gfs.iscurrent = 1
				   ]);

    my ($poo,$c);
    foreach my $r ( @$q ) {
      $poo += scalar( @$r );
    }

    if ( $poo > 7 ) {
      my $times = $poo/7;

      for ( my $i = 1; $i <= $times; $i++ ) {
	foreach (0..6) {
	  $q->[0][$_] .= " $q->[$i][$_]  ";  
	}
      }
      my @plop;
      foreach my $line ( map {@$_} $q->[0] ) {
	my $temp;
	my @stuff = split/\s+/,$line;
	foreach my $bit ( @stuff ) {
	  $temp .= sprintf("%-26s ",$bit);
	}
	push @gelinfo, $temp;
      }
      $self->split_multi_run( @gelinfo );
    }else{

    foreach my $r (@$q) {
      push @gelinfo, @$r;
      print STDERR "GELINFO: @$r\n" if($self->{debug});
    }
  }
    if ( scalar( @gelinfo ) ==0 ) {
      push @gelinfo, "NO GEL INFO","NO GEL INFO","NO GEL INFO","NO GEL INFO","NO GEL INFO",
      "NO GEL INFO";
    }
    return(@gelinfo);
  }

  sub split_multi_run {
    my ( $self,@gelinfo ) = @_;

    #
    # Set's plateinfo to receive runname etc from here instead of splitting in
    # on return, as usual (for single runs i.e not re-run).
    #

    $self->{rerun} = 1; 

    #
    # Split @gelinfo into most recent gelfile and plate name.
    #

    $self->{run_name}   = ( split/\s+/, ( $gelinfo[0] ))[-1];
    $self->{id_gel}     = ( split/\s+/, ( $gelinfo[3] ))[-1];
    $self->{status}     = ( split/\s+/, ( $gelinfo[4] ))[-1];
    $self->{run_dest}   = ( split/\s+/, ( $gelinfo[6] ))[-1];

    print STDERR "MULTI-RUN(Setting in SQL_info.pm):
                  $self->{run_name} $self->{id_gel}
                  $self->{status} $self->{run_dest}\n" if ( $self->{debug} );
    return();
  }


  sub getfn {
    my ($self,$path,$run_name) = @_;
    my (@asping,@fn,@fn_path,@fn_all);
    my $i=0;
    my %paths;

    my $url =
      'http://gcs3.internal.sanger.ac.uk/cgi-bin/capminder/nph-cmHistory.pl'
        . "?cap=$path/$run_name&type=history";

    my @hist = split "\n",LWP::Simple::get($url);

    foreach (@hist) {
	/Statistics for (fn.\d+\S+)/ and do {
	    push @fn, $1
        };
        /Got lock on (\/\S+)/ and do {
            $paths{$1} = 1;
        }
    }

    @fn_path = keys(%paths);

    my $c=0;
    for($c = scalar(@fn); $c>=0;$c--) {
	foreach (@fn_path) {
	    next if (!$fn[$c]);
	    print STDERR "CHECKING : $_/$fn[$c]\n" if $self->{debug};
	    if (-e "$_/$fn[$c]") {
		push @fn_all, "$_/$fn[$c]";
		print STDERR "EXISTS : $_/$fn[$c]\n" if $self->{debug};
	    }
	}
    }
    print STDERR "FOUND FN. : @fn\nFOUND FN_PATH: @fn_path\n" if $self->{debug};
    return @fn_all;
  }


  sub aspinfo {
    my ($self,$plate,$id_gel) = @_;
    my @aspinfo=();

    $q = $self->{db}->fetch_all (qq[
				    select sr.lane,sr.name,ad.description,sr.read_length
				    from seqread sr, aspstatusdict ad
				    where sr.asp_status = ad.id_dict
				    and sr.id_gel = '$id_gel'
				    order by sr.lane
				   ]);
    my $count=0;
    foreach my $r (@$q) {
      $count++;
      push @aspinfo, $r;
    }
    print STDERR "ASPINFO: $count rows found\n",if($self->{debug});
    return(@aspinfo);
  }
  
  sub text_titles {
    my ($self,$plate,$title,@report) = @_;
    my @titled_report=();
    my %stats=();
    print STDERR "Printing $title to listbox\n",if($self->{debug});
    if ($title eq 'status') {
      $title = qq[
		
#### STATUS OF $plate ####
		
];
      my $count=0;;
      push @titled_report, 
      " PLATENAME  : $report[1]\n",
      "MAPID      : $report[0]\n",
      "STATUS     : $report[2] $report[3]\n",
      "STATUS DATE: $report[4]\n",
      "OWNER      : $report[5]\n\n",
      "REMARKS    :\n ";

      foreach ( @report ) {
	if ( $count >= 6 ) {
	  push @titled_report, $_;
	}
	$count++;
      }

      return($title,@titled_report);
    }elsif ($title eq 'gelinfo') {
      $title = qq [
		   
#### GELINFO ####
		
];
      push @titled_report, 
      " RUN NAME      : $report[0]\n",
      "RUN DATE      : $report[1]\n",
      "GOOD BASES    : $report[2]\n",
      "GELID         : $report[3]\n",
      "STATUS        : $report[4]\n",
      "STATUS DATE   : $report[5]\n";
      return($title,@titled_report);
      
    }elsif ($title eq 'samples') {
      my $count = scalar(@report);
      $title = qq[

#### SAMPLES FOR $plate ($count samples found) ####
];
      push @titled_report, qq[
SAMPLE NAME WITH ITERATIONS
---------------------------
];
      if (scalar(@report)==0) {
	push @titled_report, "NO SAMPLES FOUND\n";
	return($title,@titled_report);
      }
      
      foreach (@report) {
	push @titled_report, "$_\n";
      }
      return($title,@titled_report);
      
    }elsif ($title eq 'asp' | $title eq 'fn') { # TAKES CARE OF ASPINFO AND FN. INFO
      
      if ($title eq 'fn') {
	$title = "\n";
	push @titled_report, " ASP FILES: $report[0]\n";
	shift @report;
	foreach (@report) {
	  push @titled_report, "           $_\n";
	}
	return($title,@titled_report);
      }
      
      $title = qq [
		 
#### ASP INFO ####

];
      my $count = scalar(@report);
      my $pass=0;
      my $fail=0;
      
      if (scalar(@report)==0) {
	push @titled_report, "NO ASPED SAMPLES FOR REPORT\n";
	return($title,@titled_report);
      }
      
      foreach (@report) {
	if ($_->[2] eq 'PASS') {
	  $pass++;
	}else{
	  $fail++;
	}
	$stats{$_->[2]}++;
      }
      
      my $perc_pass = sprintf ("%.2f",100/$count * $pass);
      my $perc_fail = sprintf ("%.2f",100/$count * $fail);
      push @titled_report, qq[
ASP REPORT
----------
];
		       
      foreach my $key (keys %stats) {
	push @titled_report, "$key:  $stats{$key}\n";
      }
      push @titled_report, "PERCENT PASS: $perc_pass\%\n";
      push @titled_report, "PERCENT FAIL: $perc_fail\%";
      push @titled_report, qq[
			      
SAMPLE No. |        SAMPLE       | QUALITY | READ LENGTH
--------------------------------------------------------
]; 

      foreach ( @report ) {
	push @titled_report, sprintf ("%-12d%-23s%-9s%-12s\n", $_->[0], $_->[1], $_->[2], $_->[3]);
      }
      return($title,@titled_report);
    }
  }
  
  sub write_remarks {
    my ( $self,$plate,$remark,$user ) = @_;
    my $date = `date`; chomp $date;

    unless( open( REMARK, ">> $self->{remark_file}" ) ) {
      my $sig = 0;
      return( $sig );
    }
    
    print REMARK "$plate $date U: $user RE: $remark","\n";

    close( REMARK );
    


  }
  
  1;
  
