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

package APE::Tk::Result;

use Tk::widgets qw/Label Font DialogBox ROText/;
use base qw/Tk::Derived Tk::Frame/;
use strict;
use Carp;

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

use constant UNFLUSHED  => 'Unflushed';
use constant COMMITTED  => 'Committed';
use constant ROLLEDBACK => 'Rolled Back';

Construct Tk::Widget 'Result';

sub ClassInit {
    my ($class,$mw) = @_;
    $class->SUPER::ClassInit($mw);
}


sub Populate {
    my ($self,$args) = @_;
    $self->{_result} = delete $args->{-result} || croak "ERROR: argument -result is missing";
    croak "ERROR: argument -result must be of type APE::FlushControllerFactory::ConcreteFlushController::Result"
    	unless UNIVERSAL::isa($self->{_result},'APE::FlushControllerFactory::ConcreteFlushController::Result');
    $self->{_flushController} = $self->{_result}->getFlushController;
    $self->{_resultName}      = $self->{_result}->getType . $self->{_result}->getId;
    $self->{_status} = UNFLUSHED;
    $args->{-state}  = 'disabled' unless $self->{_flushController};
    $self->ConfigSpecs(-state => [qw/METHOD state State disabled/]);

    $self->SUPER::Populate($args);
    $self->_createDataFrame;
    $self->_populateDataFrame;
    $self->_createStatusLabel;
    $self->_createButtons;
}

sub _createDataFrame {
    my $self = shift;
    my $font       = $self->Font(-family=>'helvetica',-size=>20,-weight=>'bold');
    $self->Label(-text=>"Result: ".$self->{_resultName},-bg=>'red',
		 -font=>$font)
	->pack(-fill=>'x',-anchor=>'n');
    $self->{_dataFrame} =
	$self->Frame(-relief=>'ridge',-border=>1)->pack(-fill=>'both',-expand=>1,-pady=>5,-padx=>5,-anchor=>'n');
}


sub _populateDataFrame {
    my $self = shift;
    my $font = $self->Font(-family=>'helvetica',-size=>14);
    foreach my $data (qw/Type Id Format/) {
	my $method = "get".$data;
	$self->{_dataFrame}->Label(-text=>$data,-font=>$font)
	    ->grid($self->{_dataFrame}->Label(-text=>':',-font=>$font),
		   $self->{_dataFrame}->Label(-text=>$self->{_result}->$method,-font=>$font)
		   ,-sticky=>'w');
	
    }

    my $description = $self->{_result}->getDescription;

    foreach my $key (keys %$description) {
	$self->{_dataFrame}->Label(-text=>'Description',-font=>$font)
	    ->grid($self->{_dataFrame}->Label(-text=>':',-font=>$font),
		   $self->{_dataFrame}->Label(-text=>"$key -> $description->{$key}",-font=>$font)
		   ,-sticky=>'w');

    }
}

sub _createStatusLabel {
    my $self = shift;
    $self->{_statusLabel} =
	$self->Label(-text=>"Result Status: ".$self->{_status})->pack(-pady=>5,-padx=>5);
}


sub _createButtons {
    my $self = shift;
    my $bttnFrame = $self->Frame->pack(-side=>'bottom',-fill=>'x',-expand=>1);
    $self->{_rollbackBttn} = 
	$bttnFrame->Button(-text=>'Roll Back',-command=>[\&_rollback,$self],
			   -state=>'disabled'); #$self->{_flushController} ? "normal" : "disabled")
    #->grid(-column=>0,-row=>0,-pady=>5,-padx=>2);
    $self->{_commitBttn} =
	$bttnFrame->Button(-text=>'Commit',-command=>[\&_commit,$self],
			   -state=>'disabled'); #$self->{_flushController} ? "normal" : "disabled")
    #->grid(-column=>1,-row=>0,-pady=>5,-padx=>2);
    $self->{_viewReportBttn} =
	$bttnFrame->Button(-text=>'View Report',-command=>[\&_viewReport,$self])
	->grid(-column=>2,-row=>0,-pady=>5,-padx=>2);
    
}


sub state {
    my ($self,$state) = @_;
    $self->{_rollbackBttn}->configure(-state=>$state);
    $self->{_commitBttn}->configure(-state=>$state);
}


sub _updateStatus {
    my ($self,$status) = @_;
    $self->{_status} = $status;
    $self->{_statusLabel}->configure(-text=>"Result Status: ".$status);
    if($status eq ROLLEDBACK || $status eq COMMITTED) {
	$self->configure(-state=>'disabled');
    }
}

sub _rollback {
    my $self = shift;
    croak "Error: no flush controller" unless $self->{_flushController};
    eval  { ${$self->{_flushController}}->rollbackTransaction; };
    if($@){ croak "ERROR: problems rolling back transaction for result: '$self->{_resultName}': $@"; }
    $self->_updateStatus(ROLLEDBACK);
}


sub _commit {
    my $self = shift;
    croak "Error: no flush controller" unless $self->{_flushController};
    eval  { ${$self->{_flushController}}->commitTransaction; };
    if($@){ croak "ERROR: problems commiting transaction for result: $self->{_resultName}': $@"; }
    $self->_updateStatus(COMMITTED);
}


sub _viewReport {
    my $self = shift;
    my $db = $self->DialogBox(-title=>"Report for result: ".$self->{_resultName},
			      -buttons=>['OK']);
    my $roText = $db->add('Scrolled','ROText',-scrollbars=>'osoe',-wrap=>'none')->pack(-fill=>'both',-expand=>1);
    foreach my $line (@{$self->{_result}->getReport}) { 
    	$roText->insert('end',$line);
    }
    $db->Show;
}


sub getStatus {
    my $self = shift;
    return $self->{_status};
}


sub setStatus {
    my ($self,$status) = @_;
    croak "ERROR: status must be one of 'Unflushed', 'Rolled Back' or 'Committed' - '$status'"
	unless $status =~ /[Unflushed|Rolled Back|Committed]$/;
    $self->_updateStatus($status);
}


1;
