=head1 NAME

CFX5::CCLI::Defaulted - Base class for an object storing its data in CCL

=head1 SYNOPSIS

  use base 'CFX5::CCL::Defaulted';

  sub cclpath {
    '/X/Y/Z';
  }

  # DO NOT COPY THIS CODE, see (eg) CFX5::Parallel::Host
  sub foo {
    my $self=shift;
    if (@_) {
      $self->set_parm('Parameter Name', shift);
    }
    if (!defined $self->get_parm('Parameter Name')
        or $self->is_default('Parameter Name')) {
      # No current value in CCL, or it is a default, maybe re-set the
      # default if it might have changed. 
      $self->set_default('Parameter Name', $self->calc_foo());
    }
    return $self->get_parm('Parameter Name');
  }

=head1 DESCRIPTION

C<CFX5::CCLI::Defaulted> provides a base class for objects which want
to have their settings based on, and stored in, a CCL database.  This
applies to some of the sub-objects used by L<CFX5::Job>, to allow easy
synchronisation between the current settings and the CCL which will be
written out for the run.

It is not expected to be instantiated directly.

It makes the assumption that the object is internally represented by a
hash reference, and uses a couple of keys with the prefix
'CFX5::CCLI::Defaulted::' to store its own part of the state.

We do our own CCL and default handling, in roughly the same way as the
CFX5::Job::Settings object does.  This is not ideal, but actually not
too bad, compared to trying to register default parameters for each
host ...

Most of the calls provided by this object should not be used directly;
instead, they are provided as services to subclassers.  Derived
classes should provide a custom accessor for I<all> settings, which
will usually be implemented in terms of the C<access*> calls, and
which is responsible for correctly providing defaults etc.

=cut

package CFX5::CCLI::Defaulted;

use strict;

use vars qw($CVSVersion);
$CVSVersion='$Id$ ';

use CFX5::Output qw(:all);
use CFX5::Config qw(%Config);
use CFX5::Commands qw(get_cmd_output parse_rv);

# for dummy calls
use CFX5::CCLI::Dummy;

=head2 REQUIRED CALLS IN THE DERIVED OBJECT

=head3 cclpath

I<Must be provided>

  sub cclpath {
    my $self=shift;
    return "/A/B/C/$_[0]";
  }

Returns the full path in CCL to the named setting.

=cut

sub cclpath {
  my $self=shift;
  internal_error("cclpath must be provided by subclasses of CFX5::CCLI::Defaulted");
}

=head2 CONSTRUCTORS

=head3 init

  $self->CFX5::CCLI::Defaulted::init($job)
    or return 0;

At an appropriate time in the parent object, the C<init> function
should be called to set up the CCL database object.  None of the other
calls should be made before this has been done.  Some subclassers may
find it appropriate to call this in their C<new> routine, but other
ways of doing it are possible.

The return value will be TRUE on success, or FALSE on failure.
Additionally, an error will be signalled on failure.  Some types of
error will signal errors with C<internal_error>, and so this call may
never return.

As a special case, if the CCL database object C<$job> is the string
'DUMMY', a dummy object will be used which has no connection to an
actual CCL database, but will store and retrieve parameters as
expected.  The initial state of this database will be empty.  A new
database is created for each object so constructed.

=cut

sub init {
  my $self=shift;

  my $job=shift;
  if (!ref($job) and defined $job and $job eq 'DUMMY') {
    # make a dummy database
    $job=CFX5::CCLI::Dummy->new();
  }
  # we are not too picky about what the job object is, as we only ever
  # make two calls to it.  This makes standalone testing a lot easier!
  unless (defined $job
          and $job->can('read_ccl_parm')
          and $job->can('set_ccl_parm')) {
    internal_error("Job object $job is not a job (settings) object!");
  }
  $self->{__PACKAGE__ . '::db'}=$job;

  # empty data structures we will use later
  $self->{__PACKAGE__ . '::isdef'}={};

  1;
}

=head2 PARAMETER ACCESS

=head3 get_parm

  $v=$self->get_parm("Number of Processors");

Retrieves a parameter value directly from the CCL, without worrying
about whether or not it is a default.  The defaults are provided by
the various access*() methods, which you should use instead.

=cut

sub get_parm {
  my $self=shift;
  my $parm=shift;

  $self->{__PACKAGE__ . '::db'}->read_ccl_parm($self->cclpath($parm));
}

=head3 set_parm

  $self->set_parm("Relative Speed",23.00);

Sets a parameter in the CCL, and notes that it is a real setting
rather than a default.  If the first parameter is a reference to a
hash, it is taken as a set of options (as is done in, for example,
L<CGI>).  These options are passed directly into the C<set_ccl_parm>
call in the CCL database provider object.

=cut

sub set_parm {
  my $self=shift;
  my $opts=(ref $_[0] eq 'HASH' ? shift : {});
  my $parm=shift;
  my $v=shift;

  # we've set it, so it's not a default any more
  $self->{__PACKAGE__ . '::isdef'}{$parm}=0;

  $self->{__PACKAGE__ . '::db'}->set_ccl_parm($opts,$self->cclpath($parm),$v);
}

=head3 set_default

  $self->set_default("Relative Speed",23.00);

Sets a parameter in the CCL, and notes that it is a default setting
rather than some explicitly-supplied information.  If the first
parameter is a reference to a hash, it is taken as a set of options
(as is done in, for example, L<CGI>).  These options are passed
directly into the C<set_ccl_parm> call in the CCL database provider
object.

=cut

sub set_default {
  my $self=shift;
  my $opts=(ref $_[0] eq 'HASH' ? shift : {});
  my $parm=shift;
  my $v=shift;

  if (exists $self->{__PACKAGE__ . '::isdef'}{$parm}
      and !$self->{__PACKAGE__ . '::isdef'}{$parm}
      and $^W) {
    warn "Setting default for $parm after it is explicitly set!";
  }

  # we've set it, but only as a default, so remember that
  $self->{__PACKAGE__ . '::isdef'}{$parm}=1;

  $self->{__PACKAGE__ . '::db'}->set_ccl_parm($opts,$self->cclpath($parm),$v);
}

=head3 is_default

  if ($self->is_default("Remote Host Name")) {
    # do something
  }

Returns TRUE if the named parameter is currently set to a default in
CCL, or FALSE otherwise.

=cut

sub is_default {
  my $self=shift;
  my $parm=shift;

  if (defined $self->{__PACKAGE__ . '::isdef'}{$parm}) {
    # we recorded it explicitly, just return it
    return $self->{__PACKAGE__ . '::isdef'}{$parm};
  } else {
    # if we haven't recorded anything, then there can't be a default
    # in this slot, or we'd know.  So it's a real value (if it
    # exists).
    return undef;
  }
}

=head2 PARAMETER PARSING

These calls interpret parameters as the various available types.  We
do it this way, rather than using getLoglValue etc directly, as that
allows us to share the same infrastructure at the string level for all
types.  The CCL API should be modified to export the interpretation
routines it uses.

=head3 interpret_logl

Interprets the supplied string -- presumably from the CCL -- as a
logical value, and returns TRUE or FALSE as appropriate.  If the
parameter cannot be interpreted as a logical, returns undef, but does
I<not> signal an error -- we don't know what the parameter is!  The
caller must signal the error is a more user-readable form.

=cut

sub interpret_logl {
  my $self=shift;
  my $string=shift;

  # taken from CCL::GlobalVars; we can't use that directly (I think)
  my $trueRE = '\s*(yes|true|y|t|on)\s*';   # RE to match true values
  my $falseRE = '\s*(no|false|f|n|off)\s*';  # RE to match false values

  return undef unless defined $string;
  return 1 if $string =~ m!$trueRE!i;
  return '' if $string =~ m!$falseRE!i;
  return undef;
}

=head2 DATABASE ACCESS

=head3 get_ccldb_obj

Returns the internal CCL database object (ie, the object of type
C<CFX5::Job::Settings>).

=cut

sub get_ccldb_obj {
  my $self=shift;
  $self->{__PACKAGE__ . '::db'};
}

=head4 format_ccl_error

 _error("Errors in CCL processing:\n", $self->format_ccl_error($rv));

Formats the errors from the CCL parser (a string containing a list of
newline-separated errors) into a form which is acceptable to the
word-wrapping code in the _error etc calls.  (It indents them by a
space, apart from the first line which is assumed to be indented by
the comma in the suggested usage above).

=cut

sub format_ccl_error {
  my $self=shift;
  $self->get_ccldb_obj()->format_ccl_error(@_);
}

=head3 parse_ccl_data

Calls the CCL API C<parseCCLData> method.  If any errors are
encountered, they will be signalled with C<_error>.  The return value
is TRUE on success, or FALSE on failure.

=cut

sub parse_ccl_data {
  my $self=shift;
  my $rv=$self->get_ccldb_obj()->ccl_api_obj()->parseCCLData(@_);
  if (defined $rv and $rv ne '') {
    _error("Errors in CCL processing:\n", $self->format_ccl_error($rv));
    return '';
  }
  1;
}

=head3 access

A general get/set accessor, used by subclasses to implement accessor
methods for CCL parameters.

  sub hostname {
    return $self->access({
                          parm => 'Remote Host Name', 
                          default => $self->name(),
                          store_default => ''
                         }, @_);
  }

The first parameter is an anonymous hash containing the details of the
parameter to read; the remaining parameters should be passed in from
the caller.

The default may change from call to call; if the parameter is "set to
default", and store_default is true, the CCL will be updated with the
current default whenever the parameter is queried.

If the parameter is not found, and no default is passed, an error is
signalled and undef is returned.  To suppress the error, pass an
explicit default of undef.

=cut

sub access {
  my $self=shift;
  my $parms=shift;

  my $cclname=$parms->{parm};
  unless (defined $cclname) {
    internal_error("Can't call access without a CCL name!");
  }

  # set?
  if (@_) {
    my $v=shift;
    internal_error("Too many arguments in call to", (caller(1))[3])
      if @_;
    if ($v =~ m/^[^\'\"\s]*$/) {
      $self->set_parm($cclname,$v);
    } else {
      _error("Invalid $cclname $v");
    }
  }

  my $v=$self->get_parm($cclname);

  # need to set or update default?
  if (defined $parms->{default}) {
    if (!defined $v or $self->is_default($cclname)) {
      $v=$parms->{default};
      # for some things it's not worth recording the defaults, they
      # aren't useful
      if ($parms->{store_default}) {
        $self->set_default($cclname,$v);
      }
    }
  }

  if (not defined $v and not exists $parms->{default}) {
    _error("Parameter \"$cclname\" missing from object", $self->cclpath());
  }

  return $v;
}

=head3 access_logl

Like C<access>, but the returned parameter is interpreted as a logical
value. 

=cut

sub access_logl {
  my $self=shift;
  my $parms=shift;

  my $v=$self->access($parms, @_);

  if (defined $v) {
    my $rv=$self->interpret_logl($v);
    if (not defined $rv) {
      _error("Error in Command Language parameter", $self->cclpath($parms->{parm}) . ":",
             $v, "should be a logical value (eg, 'yes' or 'no')");
    }

    return $rv;
  }

  # $v is undefined
  return undef;
}

=head3 mark_non_library

  $host->mark_non_library();

Ensures that the CCL for this object is not marked as library CCL in
the database.

=cut

sub mark_non_library {
  my $self=shift;

  my @path=grep { defined $_ and $_ ne '' } split('/',$self->cclpath(''));
  my @ccl;
  # first go down the tree ...
  for my $p (@path) {
    if ($p =~ m!:!) {
      push @ccl, $p;
    } else {
      push @ccl, "$p:";
    }
  }

  # ... and now straight back up again, we don't need to set any
  # parameters
  push @ccl, ("END") x scalar(@path);

  return $self->parse_ccl_data(\@ccl,0);
}

1;
