package ATR::Tk::AtrNavigator;

use strict;
use warnings;

use Carp;
use Tk::ProgressBar;
use Tk::HList;

use Checkbarcode2; # for Verifynumber

use ATR::BioTables;
use ATR::Report;

use ATR::MicePE::Mouse; # XXX: Should only need to drag or use MicePE's methods
use ATR::MicePE::MatingPair;
use ATR::MicePE::Weaning;

use ATR::Tk::MatingCard;
use ATR::Tk::WeaningCard;
use ATR::Tk::ColonyEd;

use base qw(Tk::Derived Tk::Frame);
Tk::Widget->Construct('AtrNavigator');


sub Populate {
    my ($self, $args) = @_;

    $self->SUPER::Populate($args);
#    $self->ConfigSpecs();

# Header area
    my $hf = $self
      ->Frame(Name => 'head_f', -border => 2, -relief => 'groove')
	->form(-top => '%0', -left => '%0', -right => '%100');

    $hf->Label(-class => 'title', -text => "Navigation Page")->form(-left => '%0', -top => '%0');

# Status area
    $self->Advertise('status',
		     $self->Label(-text => 'Type or scan, then press Return', -relief => 'sunken')
		     ->form(-left => '%0', -right => '%100', -bottom => '%100')
		    );

# Barcode / jump query / navigation widgets
    my $nav_f = $self
      ->Frame(Name => 'nav_f', -border => 2, -relief => 'sunken')
	->form(-left => '%0', -right => '%100', -top => $hf);
    my $bar = '';
    my $bar_l = $nav_f->Label(-text => 'Scan barcode or enter name')
      ->form(-left => ['%0', 16], -top => ['%0', 16]);
    my $bar_e = $nav_f->Entry(-textvariable => \$bar)
      ->form(-left => $bar_l, -top => ['&', $bar_l],
	     -right => ['%100', -16]);
    $bar_e->bind ('<Return>' => sub { my $str = $bar; $bar = ''; $self->go_string($str) });

    $bar_e->bind('<FocusIn>' => sub { $bar_e->configure(-background => 'lightgreen') });
    $bar_e->bind('<FocusOut>' => sub { $bar_e->configure(-background => 'white') });
    $bar_e->focus;

    my $results_l = $nav_f
      ->HList(Name => 'results_l',
	      -columns => 5, -separator => ':', -header => 1,
	      -command => [ $self, 'go_result' ])
	->form(-top => [ $bar_e, 24 ], -left => [ '%0', 24 ],
	       -right => [ '%100', -24 ], -bottom => [ '%100', -24 ]);
    $self->Advertise(results_l => $results_l);

# Assorted button
    my $but_f = $self->Frame(Name => 'buttons_f') # config by optdb
	->form(-left => '%0', -right => '%100', -bottom => $self->Subwidget('status'));
    my $genXml_b = $but_f->Button(-text => 'Generate Report',
				  -command => [ $self, 'go_xml'])
      ->pack(-side => 'left');
    $self->Advertise('buttons_f', $but_f);

    my $new_matepair_b = $but_f->Button(-text => 'New Mating Pair',
					-command => [ $self, 'new_matepair' ])
      ->pack(-side => 'right');

# XXX: "New weaning card" button .. was broken, now no longer needed?
#    my $new_wean_b = $but_f->Button(-text => 'New Weaning Card',
#				    -state => 'disabled',
#				    -command => [ $self, 'new_wean'])
#      ->pack(-side => 'right');

    # XXX: Other operations that used to be greyed out on 'tools' menu: find mouse, manage licences
}

sub new_matepair {
    ATR::Tk::AtrMain->ShowPeCard('MatingCard');
}
#sub new_wean {
#    ATR::Tk::AtrMain->ShowPeCard('WeaningCard');
#}

sub go_xml { # XXX: Split: progress (show, cancel, tidy up) gubbins; file gubbins; HTML spew gubbins
    my $self = shift;
    my ($fh, $filename) = File::Temp::tempfile("/tmp/atr-XXXXXX", SUFFIX => '.xml', UNLINK => 1);

    # Provide ProgressBar which the reporter will update
    my $prog_f = $self
      ->Frame(Name => 'progress', -border => 2, -relief => 'groove')
	->form(-bottom => $self->Subwidget('buttons_f'), -left => '%0', -right => '%100');
    my $progbar = $prog_f
      ->ProgressBar(-length => 192, -width => 24, -borderwidth => 2)
	->pack(-side => 'top');
    $progbar->value(0);
    # Cancel button zaps the ProgressBar, causing the report to fall
    # over... functional, not pretty
    my $cancel_b = $prog_f
      ->Button(-text => 'Cancel',
	       -command => sub { $progbar->destroy })
	->pack(-side => 'bottom');

    # Do the report
    my $result = eval {
	ATR::Report->runSubclass("XML", $fh, $progbar, $self);
    };

    # Tidy up
    close $fh;
    if ($result) {
	$self->setStatus("Report complete, written to $filename");
	my $ATRdir = $result->getCodeDir;

	my ($htmlfh, $htmlname) = File::Temp::tempfile("/tmp/atr-XXXXXX", SUFFIX => '.html', UNLINK => 1);
	system("xsltproc $ATRdir/ReportXml2Html.xsl $filename > $htmlname"); # XXX: untidy, should redirect to $htmlfh
	system("mozilla $htmlname &"); # XXX: alternative might be to email it; average user will have an HTML friendly mail client, but what about on the G5?
	# XXX:RACE report deleted if user quits this application before mozilla loads the file
#	system("ssh deskpro261 dotty $filename &");
    } else {
	my $prob = $@;
	if (!Tk::Exists($progbar)) {
	    $prob = "Cancelled";
	} else {
	    warn "Report failed: $@"; # XXX:THROW should be logged neatly
	}
	$self->setStatus("Report failed: $prob");
	unlink $filename;
    }
    $prog_f->destroy;
}

# Send barcode-like strings to go_barcode
# and anything else to go_name
sub go_string {
    my ($self, $str) = @_;

    $self->results_set();

    local $self->{xfer_debug};
    if ($str =~ s/(^|\s+)xfer$//) {
	# XXX: a debugging shortcut - displayCard() method will pick it up
	my $dialog = $self->AnimalTransfer;
	$self->{xfer_debug} = $dialog;
    }

    if ($str =~ /^\d{8,}$/ || $str =~ /^[A-Z]{2}\d+[A-Z]$/) {
	# Looks like a barcode
# XXX: move this and part of go_barcode over to ATR::MicePE::Card, avoids need for Checkbarcode2 here
	my $hash_return = Checkbarcode2::Verifynumber($str, "AM"); # XXX: May need to deal with other prefixes?
	if ($hash_return->{Process} eq 'Good') {
	    $self->go_barcode($hash_return->{Type}, $hash_return->{Number});
	} else {
	    $self->_action([], [ "'$str' looks like a barcode, but is \l$$hash_return{Process}" ]);
	}
    } else {
	# Should be the name of something
	$self->go_name($str);
    }
}

sub results_set {
    my ($self, @cards) = @_;
    my $results_l = $self->Subwidget('results_l');
    $results_l->delete('all');
    $results_l->header(create => 0, -text => 'Card name');
    $results_l->header(create => 1, -text => 'Sex');
    $results_l->header(create => 2, -text => 'Mice');
    $results_l->header(create => 3, -text => 'Barcode');
    for (my $i=0; $i<@cards; $i++) {
	my $card = $cards[$i];
	$results_l->add("row$i", -data => $card);
	$results_l->itemCreate("row$i", 0, -text => $card->getCardName);
	$results_l->itemCreate("row$i", 1, -text => ($card->getIntendedSex)[1]);
	$results_l->itemCreate("row$i", 2, -text => scalar $card->getCurrentMice);
	$results_l->itemCreate("row$i", 3, -text => join "", $card->getBarcode);
    }
}

sub go_result {
    my $self = shift;
    my $results_l = $self->Subwidget('results_l');
    my @cards;
    foreach my $path ($results_l->info('selection')) {
	push @cards, $results_l->info('data', $path);
    }
    $self->_action(\@cards, []);
}

sub go_barcode {
    my ($self, $bc_pfx, $bc_num) = @_;
    my $found = eval { ATR::MicePE->findByBarcode($bc_pfx, $bc_num) || 'none' };
    if (!$found) {
	$self->_action([], [ "findByBarcode failed: $@" ]);
    } elsif ($found eq 'none') {
	$self->_action([], []);
    } else {
	$self->_action([ $found ], []);
    }
}

# e.g. count(@list, " item", " items")
sub count($$$) { join "", $_[0], ($_[0] == 1 ? $_[1] : $_[2]) }

# Find things by their name in ATR_NAME
sub go_name {
    my ($self, $name) = @_;
    my @found;
    my @error;
    foreach my $class (qw(ATR::MicePE::Mouse ATR::MicePE::MatingPair)) {
	my $found = eval { $class->findByName($name) || 'none' };
	if (!$found) {
	    push @error, "$class\->findByName($name) failed: $@";
	} elsif ($found eq 'none') {
	    # no match, no problem
	} else {
	    push @found, $found;
	}
    }

    # XXX: Search for mice in litter, then find their cards
    push @error, "Weaning card lookup failed: $@" unless
	  eval {
	      my @cards = ATR::MicePE::Weaning->listForLitter($name);
	      foreach my $item (sort { $a->[1] <=> $b->[1] } @cards) {
		  my ($virtual, $peid) = @$item;
		  push @found, ATR::MicePE::Weaning->findByPeId($peid);
	      }
	      1;
	  };

    # Call colony editor
    if ($name =~ /^[A-Z]+$/) {
	# XXX: Should get the current colony info class, send that to _action
	ATR::Tk::AtrMain->ShowColony($name);
    }

    # XXX: Also scan by colony (mice and cards?), litter (the mating, weanings x 2)
    $self->_action(\@found, \@error);
}

sub _action {
    my ($self, $found, $error) = @_;

    my $action;
    if (@$found == 1) {
	if ($found->[0]->isa('ATR::MicePE::Card')) {
	    $action = " - ".
	      $self->displayCard($found->[0]);

	} elsif ($found->[0]->isa('ATR::MicePE::Mouse')) {
	    my $mse = $found->[0];

	if (ATR::Proto->can('showMouseEditor')) {
	    ATR::Proto::showMouseEditor($self, $mse->getMouseName, $mse);
	    $action = " - sent to prototype mouse editor";
	} else {

	    my @cards = $mse->getCurrentCard();
	    warn "Searching for cards with mouse ".$mse->getMouseName."\n";
	    foreach my $c (@cards) {
		if ($c->isa('ATR::MicePE::Weaning')) {
		    warn "  Weaning...\n";
		} elsif ($c->isa('ATR::MicePE::MatingPair')) {
		    warn "  Mating ".$c->getMatingName."\n";
		} else {
		    warn "  Unknown card $c\n";
		}
	    }
	    $action = " - XXX: get matings, litters and card history: allow to navigate";
	}

	} else {
	    $action = " - display of this item not yet implemented";
	}
    } elsif (@$found > 1) {
	$self->results_set(@$found);
	$action = " - choose one from the list";
    } else {
	$action = " - nothing to display";
    }
    $self->setStatus("Found ".count(@$found, " item", " items").
		     ( @$error
		       ? " and ".count(@$error, " error", " errors")
		       : "" ).
		     $action);
    warn join "\n  ", "Errors:", @$error if @$error; # XXX: Show them!
}

# Display one Card
sub displayCard {
    my ($self, $item) = @_;

    my $xfer = $self->{xfer_debug};
    if ($xfer) {
	$xfer->addSourceCard($item);
	return "added to transfer window";
    }

    ATR::Tk::AtrMain->ShowPeCard($item); # may die
    return "displayed card (".$item->getCardName.")";
}

sub setStatus {
    my ($self, $status) = @_;
    if (Tk::Exists($self) && Tk::Exists($self->Subwidget('status'))) {
	my $box = $self->Subwidget('status');
	$box->configure(-text => $status);
	$box->update;
    }
}

1;
