=head1 NAME

  CFX5::PlatformInfo - default architecture and attribute information

=head1 SYNOPSIS

  use CFX5::PlatformInfo;
  $pinf=CFX5::PlatformInfo->get();

=head1 DESCRIPTION

The C<CFX5::PlatformInfo> class provides access to default
architecture and attribute information for an installation.  It is
designed for use to determine the available parallel slave
architectures when the installation may not be necessarily shared, and
so we cannot simply use files from the local system.

In the future, it is hoped to extend this to handle lists of
components to rebuild and test and the platforms on which to do so.

=cut

package CFX5::PlatformInfo;

use strict;

use CFX5::CCLI qw(format_ccl_error);
use CFX5::Output qw(:all);
use CFX5::FileOps qw(get_file_contents);
use CFX5::Config qw(%Config);

use CFX5::PathManip qw(find_config_file join_file);

use CFX5::Config::def CFX5_PLATFORMINFO_CMDS => sub {
  # current directory
  #if (-f 'platforminfo.ccl') {
  #  return 'platforminfo.ccl';
  #}

  my $file=find_config_file('platforminfo.ccl');
  return $file if defined $file;

  # no user one, assume a system one.
  return join_file($Config{CFX_DATA_DIR},'platforminfo.ccl');
};

=head2 CONSTRUCTORS

=head3 new

The new call simply returns a new instance of this class.  This will
read the platform information file and initialise the object with all
the data it needs.

=cut

sub new {
  my $this=shift;
  my $class=ref($this) || $this;
  my $self={};
  bless $self, $class;
  $self->init(@_);
  return $self;
}

=head3 get

The get call implements a singleton variant of new: it keeps track
internally of one object from each subclass, and always returns the
same one.  It is recommended that this be used instead of the new call
unless the object is to be modified (which is not currently
possible!).

=cut

{
  my %singletonmap;
sub get {
  my $this=shift;
  my $class=ref($this) || $this;
  unless ($singletonmap{$class}) {
    $singletonmap{$class} = $class->new();
  }
  return $singletonmap{$class};
}
}

sub init {
  my $self=shift;

  my $api=CFX5::CCLI::new_api_object();
  $self->{api}=$api;

  # check the file
  my $file=$Config{CFX5_PLATFORMINFO_CMDS};
  if (!defined $file) {
    _error("No ANSYS CFX platform information command file (platforminfo.ccl) could be found.");
    return;
  }
  CFX5::FileTests::datafile($file,"ANSYS CFX platform information command file $file")
      or return;

  my $lines=get_file_contents($file);
  unless (defined $lines) {
    _error("Error reading from ANSYS CFX platform information command file $file: $!");
    return;
  }
  my @lines=split("\n",$lines);
  my $rv=$api->parseCCLData(\@lines, '');
  if ($rv) {
    _abort("Error parsing platform information command data from $file:\n", format_ccl_error($rv));
  }

  #my @ccl;
  #$api->getExpandedCCL(\@ccl);
  #print join("\n",@ccl,'');

}

=head2 DATA ACCESS

=head3 api

Internal call, really.  Returns the CCL API object used internally for the database.

=cut

sub api {
  my $self=shift;
  $self->{api};
}

=head3 full_list

  my @full=$pinf->full_list();

Returns a list of all supported operating systems and architectures
etc for further filtering.

=cut

sub full_list {
  my $self=shift;
  my $path=shift || '/PLATFORM INFORMATION:generic';
  my @rv;

  for my $i ($self->sub_kids($path)) {
    push @rv, "$path/$i", $self->full_list("$path/$i");
  }

  return @rv;
}

=head3 sub_kids

  my @kids=$pinf->sub_kids("/PLATFORM INFORMATION:generic/OS:hpux");

Returns a list of paths to objects under the given path.  This is
really an internal function.

=cut

sub sub_kids {
  my $self=shift;
  my $path=shift;

  my $kids;
  my $rv=$self->api()->getChildInfoList($path, \$kids);
  if ($rv) {
    _abort("Error reading child list for $path:\n", format_ccl_error($rv));
  }
  my @rv;
  for my $kid (@$kids) {
    next unless $kid->{className} eq 'Object';
    push @rv, $kid->{type}.':'.$kid->{name};
  }

  @rv;
}

=head3 find_setting

  my $level=$pinf->find_setting($path, 'Parallel Mode');

Finds the parameter for the requested setting, allowing defaults from
further up the tree (see C<ccl_path_list>), and returns the path at
which it was found.  Not usually used directly.

=cut

sub find_setting {
  my $self=shift;
  my $path=shift;
  my $parm=shift;

  my @search=$self->ccl_path_list($path);

  for my $p (@search) {
    if ($self->api()->haveParameter("$p/$parm")) {
      return $p;
    }
  }
  undef;
}

=head3 read_setting

  my $par=$pinf->read_setting($path, 'Parallel Mode');

Finds the value for the requested setting, allowing defaults from
further up the tree (see C<ccl_path_list>).

=cut

sub read_setting {
  my $self=shift;
  my $path=shift;
  my $parm=shift;

  my $p=$self->find_setting($path, $parm);
  return undef unless defined $p;

  my $v;
  my $rv=$self->api()->getStringValue("$p/$parm", \$v);
  if ($rv) {
    _abort("Error reading CCL parameter $p/$parm:\n", 
           format_ccl_error($rv));
  }
  return $v;
}

=head3 read_list_setting

  my @par=$pinf->read_list_setting($path, 'Parallel Mode');

This call does exactly the same as C<read_setting>, but uses
C<getStringList> to read a string list from the CCL rather than a
simple string.

=cut

sub read_list_setting {
  my $self=shift;
  my $path=shift;
  my $parm=shift;

  my $p=$self->find_setting($path, $parm);
  return () unless defined $p;

  my @v;
  my $rv=$self->api()->getStringList("$p/$parm", \@v);
  if ($rv) {
    _abort("Error reading CCL parameter $p/$parm:\n", 
           format_ccl_error($rv));
  }
  return @v;
}

=head2 PATH MANIPULATION

Much of the data is (currently!) returned in the form of a CCL path in
the internal database: these calls are used to get various pieces of
information about a path.  For example, to find all HP information:

  my @paths=grep { $pinf->os($_) eq 'hpux' } $pinf->full_list();

If there was to be much use made of these they should probably be made
objects in their own right, but that seems like overkill at the
moment.

=head3 os

Returns the CFX5OS type.

=cut

sub os {
  my $self=shift;
  my $path=shift;

  if ($path =~ m!/OS:([^/:]+)($|/)!) {
    return $1;
  }
  return undef;
}

=head3 attr

Returns the attributes which are part of this path, if any, or C<undef>.

=cut

sub attr {
  my $self=shift;
  my $path=shift;

  if ($path =~ m!/ATTR:([^/:]+)($|/)!) {
    (my $a=$1) =~ s!^attr +!!i;
    return $a;
  }
  return undef;
}

=head3 attr

Returns the optimised architecture which is part of this path, if any,
or C<undef>.

=cut

sub arch {
  my $self=shift;
  my $path=shift;

  if ($path =~ m!/ARCH:([^/:]+)($|/)!) {
    (my $a=$1) =~ s![- ]!_!g;
    return $a;
  }
  return undef;
}

=head3 archos

  my $arch=$pinf->archos($path);

Returns the architecture from this path if there is one; otherwise,
returns the os instead.

=cut

sub archos {
  my $self=shift;
  my $path=shift;

  if (defined (my $arch=$self->arch($path))) {
    return $arch;
  }
  return $self->os($path);
}

=head3 ccl_path

  my $path=$pinf->ccl_path('hpux','hp_pa2.0_hpux11.00',undef);

Returns the CCL path for the given triple of os/arch/attrs.

=cut

sub ccl_path {
  my $self=shift;
  my ($os,$arch,$attr)=@_;
  my $rv="/PLATFORM INFORMATION:generic";
  $rv .= "/OS:$os" if defined $os;
  if (defined $arch) {
    $arch =~ s!_!-!g;
    $rv .= "/ARCH:$arch";
  }
  if (defined $attr) {
    $attr = "attr $attr" if $attr =~ m!^\d!;
    $rv .= "/ATTR:$attr";
  }
  $rv;
}

=head3 ccl_path_list

I<internal>

  my @all=$pinf->ccl_path_list($path);

Given a CCL path, this call will return a list of all paths which
might provide a setting for the path, in order of precedence.  The
first in the list is always the original path.

=cut

sub ccl_path_list_worker {
  my $self=shift;
  my $path=shift;

  # the new way -- just split up the path, and cycle through them all
  (my $prefix=$path) =~ s!/([^/]*)$!!;
  my $last=$1;
  #warn "$prefix -/- $last";
  unless ($prefix ne '') {
    # if the prefix is empty, the rest of the path is in $last
    #warn "   outta here: $prefix -/- $last";
    return "/$last";
  }
  my @rv;
  for my $p ($self->ccl_path_list_worker($prefix)) {
    push @rv, "$p/$last", $p;
  }

  use Data::Dumper;
  #print Dumper($path,\@rv);

  return @rv;
}

sub ccl_path_list {
  my $self=shift;
  my $path=shift;

  if (1) {
    # we don't recurse on this call so we can overload it in children
    return $self->ccl_path_list_worker($path);
  } else {
    # the old way -- do it by explicit decomposition and recomposition
    my @attr=undef;
    if (defined (my $a=$self->attr($path))) {
      unshift @attr, $a;
    }
    my @arch=undef;
    if (defined (my $a=$self->arch($path))) {
      unshift @arch, $a;
    }
    my @os=undef;
    if (defined (my $a=$self->os($path))) {
      unshift @os, $a;
    }
    my @rv=$path;
    for my $os (@os) {
      for my $arch (@arch) {
        for my $attr (@attr) {
          push @rv, $self->ccl_path($os, $arch, $attr);
        }
      }
    }

    # sometimes the above gives us duplicates, so skip one if it has
    if ($rv[0] eq $rv[1]) {
      shift @rv;
    }

    use Data::Dumper;
    print Dumper($path,\@rv);

    return @rv;
  }
}

=head2 COMPONENT INFORMATION

=head3 expand_component

  my @comps=$pinf->expand_component($pinf->read_list_setting($path,'Component List'));

Uses the I<COMPONENT LIBRARY> in the CCL to expand the argument(s)
into their most basic list of components.

=cut

sub expand_component {
  my $self=shift;
  my @rv;
  my $api=$self->api();
  for my $c (@_) {
    my $path="/COMPONENT LIBRARY/COMPONENT:$c/Component List";
    if ($api->haveParameter($path)) {
      # have details, try to expand it
      my @n;
      my $rv=$api->getStringList($path,\@n);
      if ($rv) {
        _abort("Error reading component list for $c:\n",
               format_ccl_error($rv));
      }
      push @rv, $self->expand_component(@n);
    } else {
      # no details, assume it's a top-level component
      push @rv, $c;
    }
  }
  @rv;
}

=head2 EXECUTABLE SELECTION

We now have all the information to do in-memory the executable
selection step used by the solver script.

=head3 find_arch_for

  my $cclpath_to_use=$pinf->archos($pinf->find_arch_for('solver',$my_arch,$attrs,$ppe_mode));

Returns the CCL path of the settings to use for the given component,
being the best one which will run on C<$my_arch>, having the required
attributes.  If C<$ppe_mode> is defined, this will also be taken into
consideration; otherwise, it is ignored.

If called in scalar context, returns the path for the best
architecture; if called in list context, returns all matching
architectures.

=cut

sub find_arch_for {
  my $self=shift;

  my ($comp,$harch,$attrs,$ppe_mode)=@_;

  my $hostarch=new CFX5::Arch($harch);

  # First of all, we look through all directories in the base
  # directory, looking for ones which match the hostarch.
  _debug("Searching for matches",
         "with $harch",
         (defined $attrs ? "attrs $attrs" : "(ignoring attrs)"),
         (defined $ppe_mode ? "ppe $ppe_mode" : "(ignoring ppe_mode)"),
         (defined $comp ? "for $comp" : "(of no particular component)"),
        );
  my @totry;
  for my $path ($self->full_list()) {
    # filter on attrs
    if (defined $attrs) {
      my $tattrs=$self->attr($path);
      if (defined $tattrs) {
        next unless $tattrs eq $attrs;
      } else {
        next unless $attrs eq '';
      }
    }
    _debug("$path has the right attrs");
    # then filter on parallel mode
    if (defined $ppe_mode) {
      my @tmode=$self->read_list_setting($path,'Parallel Mode');
      my $ok;
      for my $tmode (@tmode) {
        $ok=1 if $tmode eq $ppe_mode;
      }
      next unless $ok;
    }
    _debug("$path is OK for parallel mode");
    # then filter on whether the component is actually available on
    # this platform!
    if (defined $comp) {
      my @tcomp=$self->expand_component($self->read_list_setting($path, 'Component List'));
      my $ok;
      for my $tcomp (@tcomp) {
        $ok=1 if $tcomp eq $comp;
      }
      next unless $ok;
      _debug("$path has component $comp");
    }
    my $arch=$self->archos($path);
    unless (CFX5::Arch->is_valid_arch($arch)) {
      _debug("invalid arch $arch");
      next;
    }
    if ($hostarch->run_code_for(new CFX5::Arch($arch))) {
      _debug("Will try $path");
      push @totry, $path;
    }
  }

  if (!@totry) {
    _debug("No matching architectures at all");
    return wantarray ? () : undef;
  }

  # now, we need to see which of these contain the executable we're
  # interested in.  First, though, we sort them, so if we're in scalar
  # context we need fewer stats.
  @totry = sort {
    (new CFX5::Arch($self->archos($b)))
      ->compare_codes(new CFX5::Arch($self->archos($a)))
  } @totry;

  # success, and we know we want a list, as we handled the scalar above
  return wantarray ? @totry : $totry[0];
}

1;
