#######################################################################
# 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.                      #
#######################################################################
#
# author: pjm
#
# Pass in a hash containing a Tk window ref and a clone name and this
# package will display a list of all subclone requests made for that
# clone
#
# $Id: LemurShowExistingRequests.pm,v 1.2 2001/01/09 10:12:00 pjm Exp $
#

package LemurShowExistingRequests;

require Exporter;

use strict;
use WrapDBI;

use Data::Dumper;


sub new {
    my ($type, $options) = @_;

    my $self = {
        mw => $options->{parent_window},
        clone_name  => $options->{clone_name},
    };

    bless($self, $type);

    my @to_show = $self->get_requests_for($options->{clone_name});

    $self->create_window($options->{parent_window},
                         $options->{clone_name},
                         \@to_show);
}

sub get_requests_for {
    my ($self, $clone_name) = @_;
    my @to_show;
    my $dbh;

    eval {
        if( $clone_name ){

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

            if( !defined $dbh ) {
                die "Could not connect to database";
            }

            $dbh->{AutoCommit} = 0;

            my $sth =
                $dbh->prepare(q[SELECT l.id_ligation, trq.id_request,
                                       p.FORENAME || ' ' || p.SURNAME f,
                                       trq.num_plates, trq.request_date,
                                       trqsd.description
                                FROM   ligation l, transform_request trq,
                                       tr_status trqs, trstatusdict trqsd,
                                       team_person tp, person p
                                WHERE  l.clonename     = ?
                                AND    trq.id_ligation = l.id_ligation
                                AND    trq.id_request  = trqs.id_request
                                AND    trqs.iscurrent  = 1
                                AND    trqs.status     = trqsd.id_dict
                                AND    trq.REQUESTED_BY = p.ID_PERSON
                                AND    p.ID_PERSON      = tp.ID_PERSON
                                ORDER BY l.id_ligation, trq.request_date ]);

            $sth->execute($clone_name);
            my $ref = $sth->fetchall_arrayref();

            if( @{$ref} ){
                push @to_show, sprintf("%8s %11s %-20s %10s %12s %-20s",
                                       "Ligation",
                                       "Request num",
                                       "Requested by",
                                       "Num plates",
                                       "Requested on",
                                       "Status"
                                       );
                push @to_show, sprintf("%8s %-11s %20s %10s %12s %20s",
                                       "-"x8, "-"x11, "-"x20, "-"x10,
                                       "-"x12,"-"x20);

                foreach my $row (@{$ref}){
                    push @to_show, sprintf("%8s %11d %-20s %10s %12s %-20s",
                                           @{$row});
                }
            }
        }
    };

    my $error = $@;
    $dbh->disconnect() if $dbh;

    die $error if $error;

#    print join("\n", @to_show), "\n";

    return @to_show;
}


sub create_window {
    my ($self, $parent_window, $clone_name, $ref_to_show) = @_;

    my $mw = $parent_window->Toplevel();
    $self->{mw} = $mw;

    $mw->title("Requests for clone $clone_name");
    my $fixed_width_font =
        '-misc-fixed-medium-r-normal--20-200-75-75-c-100-iso8859-1',;

    # LISTBOX
    my $list_box =
        $mw->ScrlListbox(-font            => $fixed_width_font,
                         -width           => 87,
                         -height          => 10,
                         -scrollbars      => 'e',
                         -selectmode      => 'single',
                         -exportselection => 0
                         )->pack(-expand => 'y',
                                 -fill   => 'both');

    foreach my $text (@{$ref_to_show}){
        $list_box->insert('end', $text);
    }
    
    # Ok
    $mw->Button(-text    => 'Ok',
                -command => sub{ $self->{button_pressed} = 'Yes'; },
                )->pack();


    # make sure whole window appears on screen, not just the title.

    my $f = $self->{mw}->Frame(-width => 10, -height => 20);
    $f->pack(-side => 'top');
    $self->{mw}->idletasks();
    $self->{mw}->packPropagate(0);
    $f->packForget(); 

    # center window on screen

    my $x = int(($self->{mw}->screenwidth  - $self->{mw}->reqwidth)  / 2);
    my $y = int(($self->{mw}->screenheight - $self->{mw}->reqheight) / 2);
    
    $self->{mw}->geometry("+$x+$y");

    # grap focus and wait till the user has pressed one of the buttons

    $self->{mw}->raise();
    $self->{mw}->grab();
    $self->{mw}->waitVisibility;
    $self->{mw}->update;

    $self->{mw}->waitVariable(\$self->{button_pressed});
    $self->{mw}->grabRelease;
    $self->{mw}->withdraw;

    return $self->{button_pressed};
}

#End of module
1;

#
# $Log: LemurShowExistingRequests.pm,v $
# Revision 1.2  2001/01/09  10:12:00  pjm
# added column to show the date the request was "Requested on"
#
# Revision 1.1  2001/01/08  17:41:57  pjm
# Initial revision
#
#
