$APE::Tk::AtomicProcessEngine2::VERSION = '0.1';

package APE::Tk::AtomicProcessEngine2;

use strict;
use warnings;

use Tk::widgets qw/MainWindow Button Frame Splashscreen JPEG Font ROText DialogBox/;
use base qw/Tk::Derived Tk::MainWindow/;

use APE::Tk::ProcessTree;
use APE::Tk::TractSelector;
use APE::Tk::ProcessRoleManager::ProcessRoleManager;

use APE::AtomicProcessEngine;
use APE::InputControllerFactory::ExoApeInputControllerFactory;
use APE::OutputControllerFactory::ExoApeOutputControllerFactory;
use APE::FlushControllerFactory::ExoApeFlushControllerFactory;
use ExoSeq::APE::ApplicationFactory;

use SITk::LoginBar;
use SITk::SLabel;
use SITk::Status;

use User;
use Tk::IO;

Construct Tk::Widget 'AtomicProcessEngine2';

use constant TRUE  => 1;
use constant FALSE => 0;
use constant DEFAULT_PROCESS_ID => 5001; #5008; ## Load the 48 x8 tract as default.


## 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);
}


## Standard Tk mega widget method for defining mega widget
## characteristics and capturing arguments unknown to Tk.
sub Populate {
    my ($self,$args) = @_;
    $self->SUPER::Populate($args);
    $self->{_smallFont} = $self->Font(-family=>'Helvetica',-size=>10);
    $self->{_user}      = User->new(noPopulate=>TRUE);
    $SIG{INT}           = 'IGNORE';
    $SIG{QUIT}          = 'IGNORE';
    $self->{_column}    = 1;
    $self->{_row}       = 0;
    $self->protocol('WM_DELETE_WINDOW' => [\&_exit,$self]);
    $self->createControllers($args);
    $self->createMenuFrame;
    $self->addDefaultMenuItems;
    $self->createLoginBar;
    $self->createBttnFrame;
    $self->createApeFrame;
    $self->createProcessTree($self->{_apeFrame});

    $self->gridColumnconfigure (1,-weight=>1);
    $self->gridRowconfigure    (2,-weight=>1);
    $self->Advertise('-frame' => $self->{_bttnFrame});
}


## Create default controller objects or use the passed ones.
sub createControllers {
    my ($self,$args) = @_;
    $self->{_acf} = delete $args->{applicationFactory}      || ExoSeq::APE::ApplicationFactory->new();
    $self->{_icf} = delete $args->{inputControllerFactory}  || APE::InputControllerFactory::ExoApeInputControllerFactory->new();
    $self->{_ocf} = delete $args->{outputControllerFactory} || APE::OutputControllerFactory::ExoApeOutputControllerFactory->new();
    $self->{_fcf} = delete $args->{flushControllerFactory}  || APE::FlushControllerFactory::ExoApeFlushControllerFactory->new
      (userObj => \$self->{_user});
}


## Method to create the frame that will be packed with menu items by
## this widget and added to by the user.
sub createMenuFrame {
    my $self = shift;
    $self->{_menuFrame} =
	$self->Frame
	(-relief      => 'ridge',
	 -borderwidth => 1)
	->grid(-column     => 0,
	       -row        => 0,
	       -columnspan => 2,
	       -sticky     => 'news');
}


## Method to create the SITk::LoginBar widget that handles all user
## log in/out requests as well as team, role and printer settings.
sub createLoginBar {
    my $self = shift;
    $self->LoginBar
	(-roleType => 'ExoSeq',
	 -roleType => qr/^APE_.*/,
	 -rolecommand   => [\&_roleChange,$self],
	 -logincommand  => [\&_login, $self],
	 -logoutcommand => [\&_logout,$self])
	->grid(-column     => 0,
	       -row        => 1,
	       -columnspan => 2,
	       -sticky  => 'news');
}


## Method to create the button frame that will contain all of the
## buttons used in the consolodation of ExoSeq applications.
sub createBttnFrame {
    my ($self) = @_;

    $self->{_bttnFrame} = 
	$self->Frame
	(-relief      => 'ridge',
	 -borderwidth => 1)
	->grid(-column  => 0,
	       -row     => 2,
	       -sticky  => 'news');

    $self->{_bttnFrame}->SLabel
	(-text  => 'Old ExoSeq Options',
	 -bg    => 'white',
	 -state => 'disabled')
	->pack(-fill => 'x',
	       -pady => 2,
	       -padx => 5);
}


## Method to create the frame that contains the APE::Tk::ProcessTree
## widget. This widget displays the APE process tree. Some of the
## processes (prefixed with a circle) may be executed.
sub createApeFrame {
    my $self = shift;
    $self->{_apeFrame} =
	$self->Frame
	(-relief       => 'ridge',
	 -borderwidth  => 1)
	->grid(-column => 1,
	       -row    => 2,
	       -sticky => 'news');
}


## Method to create the one and only APE::Tk::ProcessTree widget that
## loads and manages APE process trees. This widget is created with no
## APE processes loaded and in a disabled state until the user logs
## in.
sub createProcessTree {
    my ($self,$frame) = @_;

    $frame->SLabel
	(-text  => 'ExoApe Processes',
	 -bg    => 'white',
	 -state => 'disabled')
	->pack(-fill => 'x',
	       -pady => 2,
	       -padx => 5);

    $self->{_processTree} =
	$frame->ProcessTree
	(-user           => \$self->{_user},
	 -state          => 'disabled',
	 -discoveryMode  => TRUE,
	 -showProcessIds => TRUE,
	 -apecommand     => [\&createApe,$self],
	 -postloadcmd    => [\&cacheAPE,$self],
	 -startcommand   => [\&start,$self])
	->pack(-fill   => 'both',
	       -expand => 1);
}


## Callback method from the APE::Tk::ProcessTree widget. This method
## is called when a user selects a process in the APE::Tk::ProcessTree
## widget to execute.
sub start {
    my ($self,$selectedProcessList) = @_;

    my $selectedProcess   = $selectedProcessList->[0];
    my $processParentDesc = $selectedProcess->[0];
    my $processDesc       = $selectedProcess->[1];
    my $process           = $selectedProcess->[2];
    my $isPlaceholder     = $process->isPlaceholder;
    return unless $process->containsAtomicProcessContainer || $isPlaceholder;
    my $processId         = $process->getProcessId;
    my $tag               = "process_$processId";
    my $userCmdLineInfo   = $self->extractUserInfo;
    my $execPath          = "";

    if($isPlaceholder) {
	my $appInstance = $self->{_acf}->getInstance(process => $process);
	print "Got APPLICATION: instance: $appInstance\n";
	$execPath = $appInstance->getFullPath() . " $userCmdLineInfo";
    }else{
	print "Sorry - I don't know what to do with ordinary processes yet\n";
	return;
    }

    $self->toplevel->Busy;
    my %cache = ();
    my $tree  = $self->{_processTree}->Subwidget('tree');
    my @paths = $tree->infoSelection;
    foreach my $entryPath (@paths) {
	$cache{$entryPath} = $tree->entrycget($entryPath,-text);
	$tree->entryconfigure($entryPath,-text=>"Starting - please wait...");
    }
    $self->startApp
	(-tag             => $tag,
	 -execPath        => $execPath,
	 -lineCommand     => sub { $self->_processReconfigure($tree,\%cache); },
	 -reconfigCommand => sub { $self->_processReconfigure($tree,\%cache); });

}


sub _processReconfigure {
    my ($self,$tree,$cache) = @_;
    foreach my $entryPath (keys %$cache) {
	$tree->entryconfigure($entryPath,-text=>$cache->{$entryPath});
    }
    $self->Unbusy;
}

sub extractUserInfo {
    my $self = shift;
    my $user     = $self->{_user};
    my $personId = $user->getPersonId;
    my $team     = $user->getWorkingTeam;
    my $teamName = $team->getTeamName;
    my $role     = $team->getWorkingRole;
    my $roleType = $role->getRoleType;
    my $printerObj  = $team->getDefaultBarcodePrinter;
    my $printer  = $printerObj ? $printerObj->getName : " ";
    return "-personId $personId -team $teamName -role $roleType -printer $printer";
}


## Method to add the default menu items to the menu bar. These menu
## buttons are populated with the return array refs of menu items from
## the method name corresponding to their title i.e. File is populated
## with the array ref returned from the _FileItems menu.
sub addDefaultMenuItems {
    my $self = shift;
    no strict 'refs';
    foreach my $menu (qw/File Edit View Tools Help/) {
	my $menuSub = "_$menu"."Items";
	my $menuWid =
	    $self->addMenuItem
	    (-text      => $menu,
	     -tearoff   => FALSE,
	     -underline => 0,
	     -menuitems => &{$menuSub}($self));
	my $side = $menu eq 'Help' ? 'right' : 'left';
	$menuWid->pack(-side=>$side);
    }
}


## Method that adds a new menu item button to the menu bar. Examples
## of this methods use can be seen in the addDefaultMenuItems method.
sub addMenuItem {
    my ($self,%args) = @_;
    _showHash(%args);
    return $self->{_menuFrame}->Menubutton
	(%args);
}


## Callback method from the SITk::LoginBar widget. This method is
## passed a User object representing the user that has successfully
## logged in. This method alters the state of the main components to
## normal and presents the APE::Tk::TractSelector widget so the user
## can select and load a tract.
sub _login {
    my ($self,$user) = @_;
    $self->{_user} = $user;
    $self->{_role} = $user->getWorkingTeam->getWorkingRole;
    $self->_alterMainState('normal');
    $self->_loadProcess([DEFAULT_PROCESS_ID]);
}


## Callback method from the SITk::LoginBar widget. This method is
## called when the user opts to log out of the system. The state of
## the main components are configured to disabled.
sub _logout {
    my $self = shift;
    $self->{_processTree}->unloadAllProcessIds;
    $self->_alterMainState('disabled');
    $self->{_user} = new User(noPopulate=>TRUE);
    return TRUE;
}


## Method to create a new APE::AtomicProcessEngine object. This method
## is a callback from the APE::Tk::ProcessTree widget. This method is
## called as a replacement for the widgets default
## APE::AtomicProcessEngine creation method. The
## APE::AtomicProcessEngine object created by this method uses the
## roleType attribute to populate the process tree with APE::Process
## objects that have a roletype that matches.
sub createApe {
    my ($self,$processTree,$topLevelProcessId) = @_;
    return APE::AtomicProcessEngine->new
	(topLevelProcessId       => $topLevelProcessId,
	 discoveryMode           => TRUE,
	 roleType                => $self->{_role}->getRoleType,
	 inputControllerFactory  => $self->{_icf},
	 outputControllerFactory => $self->{_ocf},
	 flushControllerFactory  => $self->{_fcf});
}


## Callback method that is executed when the user selects a new role
## type in the SITk::LoginBar widget. This method sets the selected
## role type as the default role in this widgets User object, it then
## reloads each of the previously loaded tracts using the selected
## role type.
sub _roleChange {
    my ($self,$user) = @_;
    my $newRole = $user->getWorkingTeam->getWorkingRole;
    if($self->{_role} && $newRole == $self->{_role}) {
	return;
    }
    $self->{_role} = $newRole;
    $self->{_processTree}->unloadAllProcessIds;
    foreach my $ape (@{$self->{_loadedApe}}) {
	my $topLevelProcessId = $ape->getTopLevelProcessId;
	$self->{_processTree}->loadProcessId($topLevelProcessId);
    }
}


## Callback method that is executed by the SITk::LoginBar widget after
## a new APE object is loaded. This method caches the APE object so
## that it may be used when a new role type is selected (see
## _roleChange method).
sub cacheAPE {
    my ($self,$loadedApeCount,$loadedApe) = @_;
    push(@{$self->{_loadedApe}},$loadedApe);
}


## Method to alter the state of the main components. The main
## components are the child widgets within the bttn frame and the ape
## frame. Their state is altered to the passed state.
sub _alterMainState {
    my ($self,$state) = @_;
    my @childWidgets1 = $self->{_apeFrame}->children;
    my @childWidgets2 = $self->{_bttnFrame}->children;
    foreach my $widget (@childWidgets1,@childWidgets2) {
	$widget->configure(-state=>$state);
    }
}


## Method to add a button to the button frame. If the button arguments
## include an execution path (-execPath) then the button is created
## with clean up support. This means that this widget retains the pid
## of the process that the button starts and allow the user to kill it
## if something goes wrong (or they're lazy).
sub addBttn {
    my ($self,%args) = @_;
    my $execPath = delete $args{-execPath};
    my $bttn     = $self->{_bttnFrame}->Button(%args);
    my $kids     = $self->{_kids};
    if($execPath) {
	$bttn->configure(-command => sub {
	    my $standardBg = $bttn->cget(-background);
	    my ($child, $return);
	    $bttn->configure
		(-state      => 'disabled',
		 -text       => "Please wait",
		 -background => 'Lightgoldenrod');
	    $args{-background} = $standardBg;
	    $self->startApp(-tag         => $bttn->cget(-text),
			    -execPath    => $execPath,
			    -lineCommand => sub {
				$args{-state} = 'normal';
				$bttn->configure(%args);
			    },
			    -reconfigCommand => sub {
				$args{-state} = 'normal';
				$bttn->configure(%args);
			    });
	});
    }
    $bttn->pack(-fill => 'x',
		-pady => 2,
		-padx => 2);
}


## Method to fork a new process that starts a new application. The pid
## of the application is stored so that this widget can manage the
## forked processes, to an extent. Management really means killing
## processes!
sub startApp {
    my ($self,%args) = @_;
    die "Error: argument '-tag' is required\n"      unless $args{-tag};
    die "Error: argument '-execPath' is required\n" unless $args{-execPath};
    print "Starting: $args{-execPath}\n";
    my ($child,$returnVal);
    $child = Tk::IO->new
	(-linecommand  => ($args{-lineCommand}  ? delete $args{-lineCommand}  : sub {}),
	 -childcommand => ($args{-childCommand} ? delete $args{-childCommand} : sub { $child->wait() }));
    $args{-pid} = $child->exec("$args{-execPath}");
    push(@{$self->{_kids}},\%args);
}


## Method to kill all processes that have been started by this process
## (see _kill method) and to exit.
sub _exit {
    my $self = shift;
    print "Exit called\n";
    $self->_kill;
    &Tk::exit;
}


## Method to kill all sub processes that have been started by this
## process. This prevents orphan processes and offers a clean shutdown
## for this main window widget.
sub _kill {
    my $self = shift;
    print "Kill called\n";
    foreach(@{$self->{_kids}}){
	my $tag = $_->{-tag};
	my $pid = $_->{-pid};
	print "\tKilling pid '$pid' with tag '$tag'\n";
	if (kill 0 => $pid){
	    kill 9 => $pid;
	    print "\t\t...killed\n";
	}
	$_->{-reconfigCommand}->() 
	    if exists $_->{-reconfigCommand};
    }
}


## Method to create and show the tract selector dialog box. The user
## may then select any or all of the tracts they wish to have loaded or
## unloaded from the ProcessTree widget.
sub _selectTract {
    my ($self,%args) = @_;
    die "Error: argument '-loadedApeHash' is required\n" unless $args{-loadedApeHash};
    die "Error: argument '-isLoading' is required\n" unless exists $args{-isLoading};
    my ($selected,$selectedProcessList) = $self->TractSelector(%args)->Show;
    if($selected eq 'Cancel' || scalar(@{$selectedProcessList})==0) { 
	return undef;
    }
    return $selectedProcessList;
}


## Method to load/unload a process tract. This method displays a
## TractSelector dialog widget requesting the user to select the
## process tract to load/unload.  The selected tracts are then sent to
## the ProcessTree widget to load/unload as required.
sub _loadProcessTract {
    my ($self,$isLoading) = @_;
    return unless $self->{_user}->isPopulated;
    eval { my $selectedProcessList =
	       $self->_selectTract
	       (-loadedApeHash => $self->{_processTree}->getLoadedProcesses,
		-roleType      => $self->{_role}->getRoleType,
		-isLoading     => $isLoading);
	   if($isLoading && ref $selectedProcessList eq 'ARRAY') {
	       $self->_loadProcess($selectedProcessList);
	   }else{
	       foreach my $process (@{$selectedProcessList}) {
		   $self->{_processTree}->unloadProcessId
		       ($process->getProcessId) if !$isLoading;
	       }
	   }
       };
    die $@ if $@; 
}


## Method to load a list of processes into the
## APE::Tk::ProcessTree. This method displays the splash screen and
## resets the sig warning rountine so that messages from APE are
## displayed in the splash screen.
sub _loadProcess {
    my ($self,$selectedProcessList) = @_;
    my $splashScreen = $self->_createSplashScreen;
    local $SIG{__WARN__} = sub {
	my $msg = shift;
	push(@{$self->{_tractLoadingData}},$msg);
	$self->{_splText}->insert('end',$msg);
	$self->{_splText}->see('end');
	$self->{_splText}->update('idletasks');
    };
    foreach my $process (@{$selectedProcessList}) {
	my $toLoad = $process;
	if(UNIVERSAL::isa($process,"APE::Process")) {
	    $toLoad = $process->getProcessId;
	}
	$self->{_processTree}->loadProcessId($toLoad);
    }
    $splashScreen->Destroy;
}


## Method to display the splash screen to the user during startup and 
## APE initialisation.
sub _createSplashScreen {
    my $self = shift;
    my $splash    = $self->Splashscreen;
    my $logo      = $self->Photo("-format"=>'jpeg',
				  -file=>Tk::findINC("APE/Tk/Images/Splash.jpg"));
    my $width     = $logo->width;
    my $height    = $logo->height;
    my $canvas    = $splash->Canvas(-width=>$width,-height=>$height,-bg=>'black')->pack(-fill=>'x',-expand=>1);
    my $dataFrame = $splash->Frame(-bd=>3,-bg=>'black')->pack(-fill=>'x',-expand=>1);
    $canvas->createImage(1,1,-anchor=>'nw',-image=>$logo);
    $self->{_splText} = $dataFrame->ROText(-bg=>"#666666",-font=>$self->{_smallFont},-height=>8,-bd=>0);
    $self->{_splText}->pack(-fill=>'both',-expand=>1);
    $splash->Splash;
    $splash->update('idletasks');
    return $splash;
}


## Method to create and display a dialog box containing a
## APE::Tk::ProcessRoleManager mega widget. This widget allows role
## types to be added to processes.
sub _manageRoleTypes {
    print "Manage Role Types: @_\n";
    my $self = shift;
    my $db   = $self->DialogBox;
    my %args = (); 
    if($self->{_user}->isPopulated) {
	print "ManageRoleType: user object is populated\n";
	my @loadedProcesses = sort keys %{$self->{_processTree}->getLoadedProcesses};
	$args{-topLevelProcessIdList} = \@loadedProcesses;
	$args{-roleType}              = $self->{_role}->getRoleType;
    }
    foreach my $key (keys(%args)) {
	print "Arg: $key -> $args{$key}\n";
    }
    $db->add('ProcessRoleManager',%args)
	#-topLevelProcessIdList => \@loadedProcesses,
	#     -roleType              => $self->{_role}->getRoleType)
	->pack(-fill=>'both',-expand=>1);
    $db->Show;
}


## Method to return the menu items that will appear under the File
## menu button on the menu bar widget.
sub _FileItems {
    my $self = shift;
    return [['command','Exit',-command=>[\&_exit,$self]]];
}


## Method to return the menu items that will appear under the View
## menu button on the menu bar widget.
sub _ViewItems {
    my $self = shift;
    return [['command','Clean up',-command=>[\&_kill,$self]]];
}


## Method to return the menu items that will appear under the Edit
## menu button on the menu bar widget.
sub _EditItems {
    my $self = shift;
    return [];
}


## Method to return the menu items that will appear under the Tools
## menu button on the menu bar widget.
sub _ToolsItems {
    my $self = shift;
    [
     ['command','Load process tract...',-command=>[\&_loadProcessTract,$self,TRUE]],
     ['command','Unload process tract...',-command=>[\&_loadProcessTract,$self,FALSE]],
     
     ['cascade','Start...',-tearoff=>0,-menuitems=>
      [
       ['command','Manage Roles',-underline=>0,-command=>[\&_manageRoleTypes,$self]],
       ['command','Reports',-underline=>0,-command=>
	[\&startApp,$self,-tag=>"Reports",-execPath=>"Reports"]],
       ['command','Ets',-underline=>0,-command=>
	[\&startApp,$self,-tag=>"ets",-execPath=>"ets"]]
       ]
      ]
     ];
}


## Method to return the menu items that will appear under the Help
## menu button on the menu bar widget.
sub _HelpItems {
    return [];
}


sub _showHash {
    my (%hash) = @_;
    foreach my $key (keys %hash) {
	print "Hash element: $key -> $hash{$key}\n";
    }
}

