=head1 NAME

  CFX5::Simulation::Subtask - General sub-task base class for CFX5::Simulation::Configuration

=head1 SYNOPSIS

  use base 'CFX5::Simulation::Subtask';

=head1 DESCRIPTION

This object is a general base class for sub-tasks for L<CFX5::Simulation>.
Currently the interface is rather limited, but it will hopefully
expand later.

A subtask is an object separate from the fundamental job object, which
springs into life for the duration of a given part of the run and then
can be destroyed again.  Eventually, this will be part of a mechanism
for providing general run control to advanced developers (and me!),
but for now it mostly serves to keep the code under control a little.

$Id$

=cut

package CFX5::Simulation::Subtask;

use strict;

use CFX5::Output qw(:all);

=head2 new

The new call is called by L<CFX5::Simulation::Configuration> directly, and sets up the
internal structures.

=cut

sub new {
  my $this=shift;
  my $class=ref($this) || $this;
  my $job=shift;
  my $self={ __PACKAGE__.'::job' => $job };
  bless $self, $class;
  $self->initialize();
  return $self;
}

=head2 initialize

Initialize is called by the C<new> method, and should be overridden by
subclasses to provide custom initialisation.

=cut

sub initialize {
  1;
}

=head3 job

  my $job=$subt->job();

Returns the job object with which this subtask is associated.

=cut

sub job {
  my $self=shift;
  return $self->{__PACKAGE__.'::job'};
}

=head2 STANDARD METHODS

All sub-task objects have various standard methods.

=head4 Check

By default, runs C<_Do> with additional first argument 0.

=cut

sub Check {
  my $self=shift;
  $self->_Do(0,@_);
}

=head4 Prepare

By default, runs C<_Do> with additional first argument 1.

=cut

sub Prepare {
  my $self=shift;
  $self->_Do(1,@_);
}

=head4 Run

By default, runs C<_Do> with additional first argument 2.

=cut

sub Run {
  my $self=shift;
  $self->_Do(2,@_);
}

=head4 _Do

This must be overridden (unless the above three are).

=cut

sub _Do {
  my $self=shift;
  die "Class", ref($self), "must override _Do from ", __PACKAGE__;
}

=head2 UTILITIES

=head3 AUTOLOAD

We want to delegate many calls which we cannot handle ourselves to the
CFX5::Simulation::Configuration object with which we are associated.

This C<AUTOLOAD> routine will redirect all calls where:

=over

=item The first argument (the object argument) is a derivative of this package

This protects us against bizarre errors when Perl tries to use it for
missing non-method routines.

=item The method name is not a standard one

The only current method in the list of ones which are skipped is
C<DESTROY>, but others may be added in the future.

=item The method name does not begin with an underscore

The underscore is usually used to introduce private methods, and so no
methods like this will be passed on.

=back

In the future, it would be well nice to be able to specify a real
interface, and only allow calls to that interface, or something.

The AUTOLOAD routine does install a redirection on a successful call,
so it will not be called every time.  There is a slight overhead in
redirecting still, but it should be minimal; it basically boils down
to

  sub method {
    my $self=shift;
    $self->{job}->method(@_);
  }

=cut

use vars '$AUTOLOAD';
sub AUTOLOAD {
  my $self=shift;
  my $callref;
  {
    my @info=caller;
    $callref="at $info[1] line $info[2]";
  }

  unless (ref $self and $self->isa(__PACKAGE__)) {
    # this isn't ours ...
    internal_error "Cannot locate subroutine $AUTOLOAD $callref: the AUTOLOAD error is random.";
  }

  my ($pkg,$meth)= ($AUTOLOAD =~ m!^(.*)::([^:]*?)$!);
  my $parent=ref($self->job());

  my %deny=(DESTROY => 1);
  if ($deny{$meth}) {
    _debug("Not redirecting denied method $meth to $parent");
    # wot now?  In the case of DESTROY, I guess we just silently let
    # it fall through.
    return;
  };

  if ($meth =~ m!^_!) {
    internal_error "Refusing to redirect private method call $meth to $parent $callref";
  }

  _debug("Attempting to redirect $meth to $parent");
  # set up an indirection so we don't go this way again ...
  {
    no strict 'refs';
    *{$meth}=sub { my $self=shift; $self->{__PACKAGE__.'::job'}->$meth(@_); };
  }
  # ... and then call it.
  $self->$meth(@_);
}

1;
