package ATR::Report;

use strict;
use warnings;

use ATR::Report::XML;
use Sys::Hostname ();
our ($VERSION) = (qw$Revision: 1.14 $)[1];

# XXX: Could 'require' the relevant module at runtime / reduce start time,
# but need to get decent error messages
# and need to ensure all the code is "working" (compiles)
sub runSubclass {
    my $pkg = shift;
    my $type = shift;
    my ($fh, $progbar, $navpage) = @_;
    my $class = "$pkg\::$type";
#    require $class;
    my $self = $class->new($fh, $progbar, $navpage);
    $self->go_tree();
    $self->finish;
    return $self;
}

#----------------------------------------------------------------------------
#
# Initialisation and housekeeping

sub new {
    my $proto = shift;
    my $self = bless {}, ref($proto) || $proto;

    my @left = $self->_init(@_);
    die "Args (@left) not understood" if @left;
    return $self;
}

sub _init {
    my $self = shift;
    my @args = @_;
    ($self->{fileHandle},
     $self->{progressBar},
     $self->{navPage}) = splice @args, 0, 3;

    $self->{progressVar} = 0;
    $self->{progressBar}->configure(-variable => \$self->{progressVar},
				    -colors => [0, 'green'],
				    -blocks => 100,
				    -gap => 0);

    return @args;
}

sub print {
    my ($self, @print) = @_;
    $self->{fileHandle}->print(@print);
}

# read or increment the progress; may die
sub progress {
    my $self = shift;
    return $self->{progressVar} if !@_;

    my $add = shift;
    my $update = @_ ? shift : $add; # default: update if we added some

    $self->{progressVar} += $add;

    # nb. calling 'update' will fail if the user pressed the 'Cancel'
    # button!
    $self->{progressBar}->update if $update;
}

# set the remaining distance to go; works at any time during progress
sub progressRemaining {
    my ($self, $size) = (shift, shift);
    $self->{progressBar}->configure(-from => 0,
				    -to => $size + $self->{progressVar});
    $self->{progressBar}->value($self->{progressVar}); # ensure it recalculates the bar
    $self->{progressBar}->update;
}

sub status {
    my ($self, $message) = @_;
    $self->{navPage}->setStatus($message);
}

# Return list of key/value pairs; subclass can override to append
sub getCodeVersionInfo {
    my $self = shift;
    return (dbReport => "v$VERSION");
}

# Class/object method, used for finding the XSL
sub getCodeDir {
    my $ATRdir = $INC{'ATR/Report.pm'};
    $ATRdir =~ s{/[^/]+$}{};
    die "Can't find my own code at $ATRdir" unless defined $ATRdir && -d $ATRdir;
    return $ATRdir;
}

#----------------------------------------------------------------------------

sub go_tree {
    my $self = shift;
    my ($progbar, $navpage) = @_;

    my @mate_ids = ATR::GTx->listEntitiesWithType(ATR::GTx::ENT_TYPE_ATR_MOUSE_MATING);
    my @mouse_ids = ATR::GTx->listEntitiesWithType(ATR::GTx::ENT_TYPE_ATR_MOUSE);
    $self->progressRemaining(2 * @mouse_ids + 3 * @mate_ids);

    # Scan each mating
    for (my $N=0; $N<@mate_ids; $N++) {
	my $id = $mate_ids[$N];

	my $mating = ATR::MicePE::MatingPair->findByPeId($id);
	$self->addMatingPair($mating);
	$self->progress(1, 0);

	my $mate_name = $mating->getMatingName;
	$self->status("Examining $mate_name...");

	my @parents_obj = grep { defined $_ } $mating->getParents; # XXX: Why do we return undef parents?!
	# likely to be a double adopt since many parent are also pups...

	foreach my $p (@parents_obj) {
	    $self->addMouse($p);
	    $self->addMatingParent($mating, $p);
	}
	$self->progress(scalar @parents_obj);

	# Scan each litter
	my $litters = $mating->getLitterCount;
	for (my $i=0; $i<$litters; $i++) {
	    my $L = $mating->getLitter(-idx => $i);
	    $self->addMatingLitter($mating, $L);

	    my @mice_obj = sort { ATR::MicePE::Mouse->cmpByName($a, $b) } $L->getPups; # XXX: push sort into method? cheap enough...
	    $self->progress(scalar @mice_obj);

	    foreach my $m (@mice_obj) {
		$self->addMouse($m);
		$self->addLitterMouse($L, $m);
	    }
	}
    }

    # Adjust the count, because we guessed the size of the first loop
    $self->progressRemaining(scalar @mouse_ids);

    # Check for spare mice  XXX:SPEED could remove seen mice from the list
    $self->status("Checking ".@mouse_ids." mice");
    for (my $N=0; $N<@mouse_ids; $N++) {
	my $id = $mouse_ids[$N];
	my $M = ATR::MicePE::Mouse->findByPeId($id);
	$self->addMouse($M);
	$self->progress(1, $N % 25 == 0);
    }
}


1;
