$APE::Tk::ResultContainer::VERSION = '1.0';

package APE::Tk::ResultContainer;

use Tk::widgets qw/Label Font Button Pane/;
use base qw/Tk::Derived Tk::Frame/;
use strict;
use Carp;

use APE::Tk::Result;

use constant TRUE  => 1;
use constant FALSE => 0;

Construct Tk::Widget 'ResultContainer';


########################################################################
## Standard Tk mega widget method for creating this mega widget and 
## initialising the super class widget.
########################################################################
sub ClassInit {
    my ($class,$mw) = @_;
    $class->SUPER::ClassInit($mw);
    $mw->bind($class,'<Configure>'=>\&_adjustWidgets);
    $mw->bind($class,'<Map>'=>\&_adjustWidgets);
}


########################################################################
## Standard Tk mega widget method for defining mega widget
## characteristics and capturing arguments unknown to Tk.
########################################################################
sub Populate {
    my ($self,$args) = @_;
    eval {
	$self->{_results} = delete $args->{-results} 
	|| croak "ERROR: argument -results is missing.";
	$self->{_outputController} = delete $args->{-outputController}
	|| croak "ERROR: argument -outputController is missing.";
	$self->{_transactionControl} = delete $args->{-transactionControl} || 0;
	$self->{_description} = delete $args->{-description} || 'Unknown';
	$self->{_sessionId} = $self->_findSessionData;
	$self->{_outputBox} = delete $args->{-outputBox};
	$self->SUPER::Populate($args);
	my $bttnFrame = $self->_createBttns;
	my $dataFrame = $self->_createHeaders;
	my $pane      = $self->_displayResults($dataFrame);
    };
    if($@) {
	my $error = $@;
	eval { $self->_rollbackAll; };
	croak $@ if $@;
	croak $error;
    }
    ## Commit the Result objects to the database if no transaction
    ## control has been requested.
    unless($self->{_transactionControl}) {
	eval { $self->_commitAll; };
	croak $@ if $@;
    }
}


########################################################################
## Method to find the session data. The session data is currently
## considered the session id number/s.
########################################################################
sub _findSessionData {
    my $self = shift;
    my %sessionIds=();
    foreach my $result (@{$self->{_results}}) {
	$sessionIds{ $result->getSessionId }++;
    }
    return join(", ",sort{ $a <=> $b } keys(%sessionIds));
}


########################################################################
## Method to adjust the label widget containing the title at the top of
## this ResultContainer is showing the Requirement objects of.  This
## method is called when the ResultContainer is mapped to the screen
## for the first time and each time the widget is configure - this
## includes the window container being resized.
########################################################################
sub _adjustWidgets {
    my $self = shift;
    $self->update('idletasks');
    my $titleWidth    = 
	$self->{_titleLabel}->width == 1 ? $self->{_titleLabel}->reqwidth : $self->{_titleLabel}->width;
    my $subTitleWidth = 
	$self->{_sessionLabel}->width == 1 ? $self->{_sessionLabel}->reqwidth : $self->{_sessionLabel}->width;
    $self->{_titleLabel}->configure(-wraplength=>$titleWidth);
    $self->{_sessionLabel}->configure(-wraplength=>$subTitleWidth);
    $self->update('idletasks');
}


########################################################################
## Method to create the header date based on the tract and process name
## of which this RequirementDisplayer is going to show Requirement
## objects for. The _titleLabel is resized by the _adjustWidgets method
## callback.
########################################################################
sub _createHeaders {
    my $self = shift;
    my $dataFrame    = $self->Frame(-relief=>'ridge',-border=>1)->pack(-side=>'left',-fill=>'both',-expand=>1);
    my $headerFrame  = $dataFrame->Frame(-relief=>'raised',-border=>5)->pack(-fill=>'x',-pady=>5,-padx=>5);
    my $titleFont    = $self->Font(-family=>'helvetica',-size=>24);
    my $subTitleFont = $self->Font(-family=>'helvetica',-size=>14);
    $self->{_titleLabel} = $headerFrame->Label(-text=>$self->{_description},-font=>$titleFont)
	->pack(-fill=>'x');
    $self->{_sessionLabel} = $headerFrame->Label(-text=>"Session id: ".$self->{_sessionId},-font=>$subTitleFont)
	->pack(-fill=>'x');
    
    return $dataFrame;
}


########################################################################
## Method to display the results in this ResultContainer widget.  
########################################################################
sub _displayResults {
    my ($self,$dataFrame) = @_;
    my $pane = $dataFrame->Scrolled('Pane',-scrollbars=>'osoe')
	->pack(-fill=>'both',-expand=>1)->Subwidget('pane');
    foreach (@{$self->{_results}}) {
	my $result = 
	    $pane->Result(-result=>$_,-relief=>'ridge',-border=>1)
	    ->pack(-fill=>'x',-expand=>1,-pady=>5,-padx=>3);
	push(@{$self->{_resultObjects}},$result);
    }
    
}


########################################################################
## Method to create the buttons that run down the left side of this
## mega widget. The buttons are created on the fly based on the
## capabilities of the attached OutputController. The transaction
## buttons are enabled if the -trasactionControl flag was set to true
## when this widget was created.
########################################################################
sub _createBttns {
    my $self = shift;
    my $bttnFrame = $self->Frame->pack(-side=>'left',-fill=>'y');

    my %bttn;

    ## These buttons are based on the advertised output capabilities
    ## of the attached OutputController
    foreach my $option (@{$self->{_outputController}->getOptions}) {
	$bttn{$option} = 
	    $bttnFrame->Button(-text    => $option." (0)",
			       -width   => 15)->pack(-pady=>3,-padx=>3);
	$bttn{$option}->configure(-command => [\&_createOutput,$self,$option,$bttn{$option}]);
    }
    

    ## Transaction control buttons. These buttons are disabled unless
    ## the -trasactionControl flag was set to true at init.
    my $commitAllBttn   = 
	$bttnFrame->Button(-text =>'Commit All',-width=>15,-command=>[\&_commitAll,$self],
			   -state=>$self->{_transactionControl} ? 'normal' : 'disabled')
	->pack(-pady=>3,-padx=>3);
    my $deselectAllBttn = 
	$bttnFrame->Button(-text=>'Roll Back All',-width=>15,-command=>[\&_rollBackAll,$self],
			   -state=>$self->{_transactionControl} ? 'normal' : 'disabled')
	->pack(-pady=>3,-padx=>3);
    
    return $bttnFrame;
}


########################################################################
## Method to create the buttons that run down the left side of this
## mega widget. The buttons are created on the fly based on the
## capabilities of the attached OutputController. The transaction
## buttons are enabled if the -trasactionControl flag was set to true
## when this widget was created.
########################################################################
sub _createOutput {
    my ($self,$option,$bttn) = @_;
    $self->toplevel->Busy;
    my $outputController = $self->{_outputController};
    eval  { $outputController->createOutput($option,$self->{_results}); };

    if($@){ $self->toplevel->Unbusy; croak $@; }
    $self->{_outputCount}{$bttn}++;
    $bttn->configure(-text=>$option." (".$self->{_outputCount}{$bttn}.")");
    $self->_outputBox(-textStruct=>["Output command '$option' executed for results attached to ".
				    "session id $self->{_sessionId}",[$self->_getDateTime]]);
    $self->toplevel->Unbusy;
}


########################################################################
## Method to commit all transactions to the database. 
########################################################################
sub _commitAll {
    my $self = shift;
    eval {
	foreach my $resultObj (@{$self->{_resultObjects}}) {
	    $resultObj->_commit if $resultObj->getStatus eq 'Unflushed';
	}
    };

    croak "ERROR: problems during call to commit all: $@" if $@;
}


########################################################################
## Method to roll back all transactions currently outstanding on a 
## database handle.
########################################################################
sub _rollBackAll {
    my $self = shift;
    eval { 
	foreach my $resultObj (@{$self->{_resultObjects}}) {
	    $resultObj->_rollback if $resultObj->getStatus eq 'Unflushed';
	}
    };
    croak "ERROR: problems during call to rollback all: $@" if $@;
}


########################################################################
## Method to find if any of the results have not been flushed to the
## database.
########################################################################
sub hasUnflushedResult {
    my $self = shift;
    foreach my $resultObj (@{$self->{_resultObjects}}) {
	if($resultObj->getStatus eq 'Unflushed') {
	    return TRUE;
	}
    }
    return FALSE;
}


sub _getDateTime {
    my $self = shift;
    my ($s,$min,$h,$d,$m,$y) = (localtime)[0,1,2,3,4,5];
    my $month = ( 'JAN','FEB','MAR','APR','MAY','JUN','JUL','AUG','SEP','OCT','NOV','DEC' )[$m];
    return $h.":".$min.":".$s."_".$d . "-" . $month . "-" . ( $y + 1900 );
}

sub _outputBox {
    my ($self,%args) = @_;
    if(Tk::Exists($self->{_outputBox})) {
	$self->{_outputBox}->updateBox(%args);
    }
}

1;
