#~cfxdev/tools/share/bin/perl -I/home/cfdasm/src/cfx5/new-solver-script/iproduct/perl -MCFX5::External='CFX5ROOT,/home/cfx5test/cfx,CFX5VERSION,5.4dev' -MCFX5::DefFile -MData::Dumper -e '$f=new CFX5::DefFile(q(kho.def)); print Dumper($f->read_dataset(-what => q(M/REFINER/PARAMETERS/BUILD))->data());'

=head1 NAME

CFX5::DefFile - An object representing a ANSYS CFX Solver Input File

=head1 SYNOPSIS

  # create a new object representing a definition file
  $file=new CFX5::DefFile('cube1.def');

  # multizone def file?
  if ($file->have_dataset(-what => 'G/NZN')) {
    print "Definition file contains data for ", 
          $file->read_dataset('WHAT', 'G/NZN')->data(),
          " zones.\n";
  } else {
    print "G/NZN dataset missing\n";
  }

  # list all the G/KELPF datasets in the file
  for my $ds ($file->have_dataset(-WHAT => 'G/KELPF')) {
    print join(' ',@$ds,"\n");
  }

=head1 DESCRIPTION

This class allows object-oriented access to a ANSYS CFX definition file.
It does not provide the full functionality of the io library.  In
particular, it does not support the concept of a secondary file.

Note that the term "definition file" also refers to results files, and
any other file in the format handled by the ANSYS CFX "io library".

Each C<CFX5::DefFile> object represents a single definition file.
Because of the way the library is currently implemented, the
definition file is not kept open while the object exists, but this may
be subject to change.  

The library is currently capable of reading indices and datasets from
a definition file; no writing is possible at the moment, but this is
expected to change at a later date.

=head2 USE OF IO MODULE

Currently, this module will use L<CFX5::IO::Base> to access the IO
module directly if possible; if this is not available, it will fall
back to calling the iotool helper executable.  So that the results it
gives are consistent in both these modes, some operations are
implemented internally which might, in an ideal world, be simple calls
to the IO library.

In the future, once L<CFX5::IO::Base> has stabilised and is available
on all platforms, the code to use the "IOtool helper" should be
removed, and all operations reimplemented in terms of the IO module
directly.

=cut

package CFX5::DefFile;

use strict;

use CFX5::FileTests;
use CFX5::PathManip qw(basename dirname fullpath join_file);
use CFX5::Config qw(%Config);
use CFX5::Commands qw(get_cmd_output do_cmd_quiet handle_rv);
use CFX5::FileOps qw(get_file_contents move_file);
use CFX5::Output qw(:all);

use CFX5::DefFile::DataSet;

# this constant decides whether to use the CFX5::IO::Base routines, or
# the IOtool helper, by default.
sub USE_IO_BASE { 1; }

=head2 CONSTRUCTORS

=head3 new

  my $deffile=new CFX5::DefFile('one.def');

Creates a new CFX5::DefFile object, based on the named CFX-5
definition file.

=cut

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

sub initialize {
  my $self=shift;
  my $file=shift;
  $self->{mode} = (USE_IO_BASE() ? 'cfx5-io-base' : 'iotool-helper');
  return 0 unless CFX5::FileTests::datafile($file);
  $self->{file}=fullpath($file);
  1;
}

=head3 new_file

  my $def=CFX5::DefFile->new_file('new.def');

Creates a new C<CFX5::DefFile> object, but representing a file which
will be created if written to rather than one which already exists.

=cut

sub new_file {
  my $this = shift;
  my $class = ref($this) || $this;
  my $self = {};
  bless $self, $class;
  $self->initialize_new(@_) or $self=undef;
  return $self;
}

sub initialize_new {
  my $self=shift;
  my $file=shift;
  $self->{mode} = (USE_IO_BASE() ? 'cfx5-io-base' : 'iotool-helper');
  return 0 unless CFX5::FileTests::datafile_w($file);
  $self->{file}=fullpath($file);
  1;
}

=head2 FILE CONTROL

=head3 file_time

  $time = $def->file_time();

Returns a number indicating the age of the file.  This can be used to
cache information about the file, rather than re-reading it every time
it is needed.

=cut

sub file_time {
  my $self=shift;
  my @st=stat $self->{file};
  return undef unless @st;
  return $st[9];
}

=head3 locked

  die "Cannot access definition file: file is locked"
    if $def->locked();

Returns TRUE if the file is currently locked (ie, a .lck file exists),
and FALSE otherwise.

=cut

sub locked {
  my $self=shift;
  return (-f $self->{file}.'.lck' ? 1 : '');
}

=head3 clear_caches

Clears any internal caches, called when we know the file has changed
(as sometimes the checks don't seem to notice -- eg, if we update it
within a second of the previous time)

=cut

sub clear_caches {
  my $self=shift;
  delete $self->{dslist};
}

=head3 call_helper

I<internal function>

  $result = $def->call_helper(what => 'G/ZN1', req => 0);

Pass a given request through the iotool_helper program.  This
involves:

=over

=item 1.

If the F<cfxtmp> file exists already, wait a bit for it to disappear.  If
it still exists, carry on anyway.

=item 2.

Provide defaults for what/where/when as appropriate.

=item 3.

Create a F<cfxtmp> file if required.

=item 4.

Call the F<iotool_helper> with the correct arguments.

=item 5.

If required, read the F<cfxtmp> file.

=item 6.

If there is one, remove the F<cfxtmp> file.

=back

Parameters are named, with an optional leading hyphen.  The following
parameters can be used:

=over

=item req

Should be one of the valid integer arguments to -r.

=item what, where, when

Guess!

=back

=cut

sub normalize_key {
  my $key=shift;
  $key =~ s/^-*//g;
  uc($key);
}
sub normalize_arghash {
  my %old=@_;
  my %new;
  for my $k (keys %old) {
    $new{normalize_key($k)} = $old{$k};
  }
  %new;
}

use CFX5::Config::def CFX5_IOTOOL_HELPER =>
  sub { join_file($Config{CFX5EXECDIR},'iotool_helper.exe'); };

sub call_helper {
  my $self=shift;

  die "Don't call_helper if we can use CFX5::IO::Base" if ($self->use_io_base());

  my %www = 
    (
     WHAT => '*',
     WHERE => '*',
     WHEN => '-1',
    );
	     
  my $req;

  #
  # parse the arguments
  #
  while (@_) {
    my $arg=shift;
    my $val=shift;
    $arg = normalize_key($arg);
    if ($arg eq 'REQ') {
      $req = $val;
      internal_error("Bad request $req") unless $req =~ m/^[0-7]$/;
    } elsif ($arg eq 'WHAT' or $arg eq 'WHERE' or $arg eq 'WHEN') {
      $www{$arg} = $val;
    } else {
      internal_error("Bad argument $arg to call_helper");
    }
  }

  internal_error("Missing req argument")
    unless defined $req;

  #
  # check for a cfxtmp file
  #
  my $had_cfxtmp='';
  if (-f 'cfxtmp') {
    sleep 5;
    $had_cfxtmp = 1 if -f 'cfxtmp';
  }

  #
  # call the iotool_helper command
  #
  CFX5::FileTests::execfile($Config{CFX5_IOTOOL_HELPER}) or return undef;
  my @out;
  my @cmd = ($Config{CFX5_IOTOOL_HELPER},
	     "-f$self->{file}",
	     "-a$www{WHAT}",
	     "-b$www{WHERE}",
	     "-c$www{WHEN}",
	     "-r$req");
  if ($req == 0) {
    @out = get_cmd_output(@cmd);
  } elsif ($req == 1) {
    my $st = handle_rv(do_cmd_quiet(@cmd));
    if ($st) {
      _warn("Definition file reader exited with return code $st");
    }
  } else {
    internal_error("Request $req NYI");
  }

  if ($req == 1) {
    if (defined -s 'cfxtmp' and -s _ > 1*1024*1024) {
      _error("This library cannot be used to read large datasets (tempfile size", -s _, ">", 1024*1024, "bytes)");
      @out=();
    } else {
      @out = split /\n\r?/, get_file_contents('cfxtmp');
    }
  }

  unlink 'cfxtmp' if -f 'cfxtmp';

  return @out;
}

=head2 FILE TYPE DETECTION

The routines in this section can be used to extract information about
a definition file, such as whether it is a CFX-5.3 or CFX-5.4+ file,
or whether it contains results etc.

=head3 cfx5_version

  if ($def->cfx5_version() >= 4.00) {
    # do something with the CCL
  }

  if ($def->cfx5_version() >= 4.00 and $def->cfx5_version() < 4.10) {
    # promote to multiphase
  }

Tries to guess the release of ANSYS CFX which created the definition file.
The return value is a floating-point number, the first digit of which
is the minor version.  The first decimal digit is the "sub-release",
and the second decimal digit is a sub-version within that release.
For example, a 5.4.0 definition file might be reported as 4.00, and a
5.4.1 definition file from the released code might report itself as
4.12, if two incompatible changes had been made to the contents during
development.

The current criteria in use, and the versions to which they
correspond, are:

=over

=item 3.00

Any definition file containing no CCL data will be reported as version
3.00.  This includes both 5.2 and 5.3 files.

=item 4.00

Any other file will currently be reported as version 4.00.

=back

For forwards compatibility, you should usually code checks of this
number as a range, as shown in the example above.

=cut

sub cfx5_version {
  my $self=shift;

  $self->{autotype}={} unless exists $self->{autotype};
  return($self->{autotype}{cfx5_version})
    if exists $self->{autotype}{cfx5_version};

  unless ($self->have_dataset(-what => 'G/COMMANDS')) {
    # no CCL, it's a 5.3 file
    $self->{autotype}{cfx5_version} = '3.00';
    return $self->{autotype}{cfx5_version};
  }

  # got CCL, so currently, it's a 5.4 file.
  $self->{autotype}{cfx5_version} = '4.00';
  return $self->{autotype}{cfx5_version};
}

=head2 INDICES AND DATASET LISTS

=head3 list_datasets

  @dslist=$def->list_datasets();

Returns a list of the datasets in the def file.  Each element of the
list is an anonymous list ref to the "what, where, when" triple.

The information is cached in the def file object until the
modification time of the def file changes.

=cut

sub list_datasets {
  my $self=shift;

  $self->{dslist} = {} unless exists $self->{dslist};
  my $fmtime=$self->file_time();
  if (defined $self->{dslist}{mtime} and defined $fmtime
      and $fmtime == $self->{dslist}{mtime}) {
    # we already have the information, and the definition file hasn't
    # changed, so just return what we have.
    _debug("File", $self->{file}, "unchanged");
    return @{$self->{dslist}{list}};
  }

  # read the definition file
  my $time=$self->file_time();

  my @list;

  if ($self->use_io_base()) {
    #
    # implementation with CFX5::IO::Base
    #

    init_xs();

    my $io=CFX5::IO::Base->new();
    if ($io->open_primaryfile('<'.$self->{file})) {
      _error("Error from IO module while opening $self->{file}:\n",
	     $io->errstr());
      return ();
    }
    @list=$io->locate_dataset('*','*',-1);
    if ($io->errno()) {
      _error("Error from IO module while getting dataset list for $self->{file}:\n",
	     $io->errstr());
      return ();
    }

    _debug(scalar(@list),"datasets");

    # now we close the file
    $io->close_primaryfile();

  } else {
    #
    # implementation with iotool helper
    #

    my @rawlist = $self->call_helper(req => 0);
    chomp @rawlist;

    unless(@rawlist) {
      _error("An error was encountered while reading the ANSYS CFX Solver Input File\n$self->{file}\nNo output from index list");
      return ();
    }

    @list = map { [ split /\s+/ ] } @rawlist;
  }

  $self->{dslist}{list} = \@list;
  $self->{dslist}{mtime} = $time;
    
  @list;
}

=head3 have_dataset

  die "CCL dataset missing" unless $def->have_dataset(-what => 'G/COMMANDS');

Checks for the existance of a dataset.  In a scalar context, returns
the number of matches; in a list context, returns the what/where/when
triples in the same form as C<list_datasets>.

Note that this function I<is implemented internally> in terms of the
full list of datasets in the file, and does not use the io library to
get this information.  This is a possible area for incompatibility,
but it does have the advantage of being efficient!

=head4 wildcard_re

I<internal function>

  my $re = wildcard_re('G/*');
  if ('G/COMMANDS' =~ m/$re/) {
    # ...
  }

Returns a regular expression corresponding to the wildcard given.
This regular expression may then be used as a search criterion to look
for matches in a given field.  Some effort is made to make the RE
efficient.  It will be anchored if necessary, so you do not need
leading/trailing ^ or $.

=cut

sub wildcard_re {
  my $pat=shift;

  # first quote all special characters
  $pat=quotemeta($pat);
  # now un-quote '*'s, which are the only characters we allow in
  # wildcards.
  $pat =~ s/\\\*/\*/g;

  # leading/trailing '*' handled by not adding anchors
  if (substr($pat,0,1) eq '*') {
    $pat=substr($pat,1);
  } else {
    $pat = '^' . $pat;
  }
  if (substr($pat,length($pat)-1,1) eq '*') {
    $pat=substr($pat,0,length($pat)-1);
  } else {
    $pat = $pat . "\$";
  }
  
  # embedded '*' handled by replacing with '.*'
  $pat =~ s/\*/\.\*/g;

  # we don't compile it for now, but perhaps we should later
  $pat;
}

sub have_dataset {
  my $self=shift;
  my %args=normalize_arghash(@_);

  my %okargs=(WHAT => 1, WHERE => 1, WHEN => 1);
  for my $a (keys %args) {
    unless ($okargs{$a}) {
      internal_error("Invalid argument $a to have_dataset");
    }
  }

  # get the current list
  my @list = $self->list_datasets();
  
  # filter according to our arguments
  if (exists $args{WHAT} and $args{WHAT} ne '*') {
    my $re=wildcard_re($args{WHAT});
    @list = grep { $_->[0] =~ m/$re/ } @list;
  }
  if (exists $args{WHERE} and $args{WHERE} ne '*') {
    my $re=wildcard_re($args{WHERE});
    @list = grep { $_->[1] =~ m/$re/ } @list;
  }
  if (exists $args{WHEN} and $args{WHEN} ne '*' and $args{WHEN} ne '-1') {
    if ($args{WHEN} =~ m/^[0-9]+$/) {
      @list = grep { $_->[2] == $args{WHEN} } @list;
    } else {
      _error("Bad WHEN condition $args{WHEN}");
      @list=();
    }
  }

  _debug("Found", scalar(@list), "datasets");

  # and return the results
  if (wantarray) {
    return @list;
  } else {
    return scalar(@list);
  }
}

=head2 READING AND WRITING DATASETS

=head3 new_dataset

Returns an empty object from L<CFX5::DefFile::DataSet>.  (This
probably is broken right now).

=cut

sub new_dataset {
  my $self=shift;
  init_xs();
  my $dsclass = __PACKAGE__.'::DataSet';
  return $dsclass->new();
}

=head3 read_dataset

  my $ds=$def->read_dataset(-what => 'G/COMMANDS');

Returns a L<CFX5::DefFile::DataSet> object representing the requested
dataset.  If more than one dataset matches the specified conditions,
returns undef.  If this dataset has already been read, returns the
object which was created last time.

As ever, some checks and caching are done, so this function may not
correspond to the exact behaviour of the io library.  No discrepancies
are known, however.

=cut

sub read_dataset {
  my $self=shift;
  my %args=normalize_arghash(@_);

  my @list=$self->have_dataset(%args);

  if (@list == 0) {
    _error("No such dataset in definition file");
    return undef;
  }
  if (@list > 1) {
    _error("Ambiguous request for dataset", join(":",%args), scalar(@list), "matches");
    return undef;
  }

  # we think we've only got one, and we know what it is, so create a
  # new dataset object for it.
  #
  # first, we read it from the def file in some way.

  my $ds = $self->new_dataset();
  if ($self->use_io_base()) {
    #
    # using CFX5::IO::Base and so on
    #
    my $io=CFX5::IO::Base->new();
    if ($io->open_primaryfile('<'.$self->{file})) {
      _error("Error from IO module while opening $self->{file}:\n",
	     $io->errstr());
      return ();
    }

    my ($hdr,$data)=$io->read_dataset_data($list[0][0],$list[0][1],$list[0][2]);

    $io->close_primaryfile();

    unless (defined $hdr and defined $data) {
      _error("Error from IO module while reading $list[0][0]/$list[0][1]/$list[0][2]:\n", $io->errstr());
    }

    $ds->from_hdr_data($hdr,$data);
  } else {
    #
    # using the IOtool helper
    #
    my @ds = $self->call_helper(-req   => 1,
				-what  => $list[0][0],
				-where => $list[0][1],
				-when  => $list[0][2]
			       );
    $ds->from_helper_text(@ds);
  }
  $ds;
}

=head3 read_header

  my $ds=$def->read_header(-what => 'G/COMMANDS');

Returns a L<CFX5::DefFile::DataSet> object representing the header of
the requested dataset.  If more than one dataset matches the specified
conditions, returns undef.

As ever, some checks and caching are done, so this function may not
correspond to the exact behaviour of the io library.  No discrepancies
are known, however.

=cut

sub read_header {
  my $self=shift;
  my %args=normalize_arghash(@_);

  my @list=$self->have_dataset(%args);

  if (@list == 0) {
    _error("No such dataset in definition file");
    return undef;
  }
  if (@list > 1) {
    _error("Ambiguous request for dataset", join(":",%args), scalar(@list), "matches");
    return undef;
  }

  # we think we've only got one, and we know what it is, so create a
  # new dataset object for it.
  #
  # first, we read it from the def file in some way.

  my $ds = $self->new_dataset();
  if ($self->use_io_base()) {
    #
    # using CFX5::IO::Base and so on
    #
    my $io=CFX5::IO::Base->new();
    if ($io->open_primaryfile('<'.$self->{file})) {
      _error("Error from IO module while opening $self->{file}:\n",
	     $io->errstr());
      return ();
    }

    my ($hdr)=$io->read_dataset_header($list[0][0],$list[0][1],$list[0][2]);

    $io->close_primaryfile();

    unless (defined $hdr) {
      _error("Error from IO module while reading $list[0][0]/$list[0][1]/$list[0][2]:\n", $io->errstr());
    }

    # this is safe, so long as you don't actually try to access the
    # data! 
    $ds->from_hdr_data($hdr, undef);
  } else {
    internal_error("Can't just read the header using the iotool helper");
  }
  $ds;
}

=head3 extract_text_dataset

  my $rv=$def->extract_text_dataset($destfile, what => 'G/MON',
                                               where => 'EVERY',
                                               when => $when));

Extracts the contents of a 'CHAR' or 'STRI' dataset to a specified
filename, or to stdout if the filename is specified as '-'.

If more than one dataset matches the specified conditions,
returns undef.

For 'CHAR' datasets, a buffered read/write method is used.
For 'STRI' datasets however, data is read/written in one operation.

This call is only available when using the shared
library C<CFX5::IO::Base> routines.
In all cases, the data size is limited to 2GB.

=cut

sub extract_text_dataset {
  my $self=shift;
  my $destfile=shift;
  my %args=normalize_arghash(@_);

  my @list=$self->have_dataset(%args);

  if (@list == 0) {
    _error("No such dataset in definition file");
    return '';
  }
  if (@list > 1) {
    _error("Ambiguous request for dataset", join(":",%args), scalar(@list), "matches");
    return '';
  }

  # we think we've only got one, and we know what it is, so create a
  # new dataset object for it.
  #
  # first, we extract it from the def file in some way.

  unless ($self->use_io_base()) {
    internal_error("Cannot use extract_dataset without CFX5::IO::Base");
  }

  init_xs();

  my $io=CFX5::IO::Base->new();

  # Open the ASCII file for output or use stdout
  local *FILE;
  my $fh;
  if ($destfile eq '-') {
    $fh=\*STDOUT;
  } else {
    unless (open FILE, ">$destfile") {
      _error("Unable to write to $destfile: $!");
      return '';
    }
    $fh=\*FILE;
  }
  unless (binmode $fh) {
    _error("Cannot set $destfile for binary mode: $!");
    return '';
  }

  # Open the input file
  if ($io->open_primaryfile('<'.$self->{file})) {
    _error("Error from IO module while opening $self->{file}:\n",
           $io->errstr());
    return '';
  }

  my $rv = 1;

  # Read the header, check dataset type
  my $hdr=$io->read_dataset_header($list[0][0],$list[0][1],$list[0][2]);

  # Character dataset (i.e., a binary dump of the file) -> buffered read
  if ($hdr->istrct() eq 'CHAR') {

    my $data=CFX5::IO::Data->new();

    if ($io->read_dataset_initialize($hdr,$data)) {
      _error("Error from IO module initializing block read from $list[0][0]/$list[0][1]/$list[0][2]:\n", $io->errstr());
      $rv = ''
    } else {
      my $nbyte = $hdr->nstrct();

      if ($nbyte < 1) {
        _error("Invalid data size reading $list[0][0]/$list[0][1]/$list[0][2]:\n");
        $rv = ''
      }

      my $nblock = $nbyte / $hdr->blockfactor();
      $nblock = ($nblock == int($nblock)) ? $nblock : int($nblock + 1);

      for (my $iblock=0; $iblock<$nblock; $iblock++) {
        my $nread = ($iblock+1)*$hdr->blockfactor();
           $nread = $nbyte if ($nbyte < $nread);
           $nread -= $iblock*$hdr->blockfactor();

        # Read a block of data from the res file
        $hdr->nstrct($nread);
        if ($io->read_dataset_datablock($hdr,$data)) {
          _error("Error from IO module while reading block from $list[0][0]/$list[0][1]/$list[0][2]:\n", $io->errstr());
          $rv = '';
          last;
        }

        # Remove any trailing null from last block to handle legacy datasets
        if ($nblock-$iblock == 1) {
          my $cont = $data->char();
          $cont =~ s/\0$//;
          $data->char($cont);
        }

        # Write the data to the ASCII file
        print $fh $data->char();
      }
    }

  } elsif ($hdr->istrct() eq 'STRI') {
    # an old-style wrapped string dataset.  We'll create a dataset
    # object, read its contents, and then let the dataset go back out
    # of scope.
    _trace("Triggered old string dataset text file read");
    my ($hdr,$data)=$io->read_dataset_data($list[0][0],$list[0][1],$list[0][2]);
    if (defined $hdr and defined $data) {
      my $ds = $self->new_dataset();
      $ds->from_hdr_data($hdr,$data);
      print $fh map { "$_\n" } $ds->data_text();
    } else {
      _error("Error from IO module while reading $list[0][0]/$list[0][1]/$list[0][2]:\n", $io->errstr());
      $rv = '';
    }
  } else {
    _error("Unable to extract dataset $list[0][0]/$list[0][1]/$list[0][2]: bad type", $hdr->istrct());
    $rv = '';
  } 

  $io->close_primaryfile();

  unless ($destfile eq '-') {
    close FILE
      or _error("Cannot finish write to $destfile: $!");
  }

  return $rv;
}

=head3 write_dataset

  $def->write_dataset($ds) or die "Cannot write";

Given an object of type C<CFX5::DefFile::DataSet>, writes it into the
definition file.  This call is only available when using the shared
library C<CFX5::IO::Base> routines.

Any existing dataset of the same name will be overwritten.

=cut

sub write_dataset {
  my $self=shift;
  my $ds=shift;
  my %args=normalize_arghash(@_);

  $self->clear_caches();

  if ($self->use_io_base()) {
    #
    # using CFX5::IO::Base and so on
    #
    init_xs();

    my $io=CFX5::IO::Base->new();

    my ($hdr,$data)=$ds->to_hdr_data();

    unless (defined $hdr and defined $data) {
      _error("Unable to construct header and data objects to write");
      return '';
    }

    if ($io->open_primaryfile($self->{file})) {
      _error("Error from IO module while opening $self->{file}:\n",
	     $io->errstr());
      return ();
    }

    my $rv=$io->write_dataset_hdrdata($hdr,$data);

    if ($rv) {
      _error("Error from IO module while writing", $ds->short_name(). ":\n", $io->errstr());
    }

    $io->close_primaryfile();

    return '' if $rv;
    return 1;
  } else {
    internal_error("Cannot write datasets in iotool-helper mode");
  }
}

=head3 store_text_dataset

  $def->store_text_dataset($file, what => 'G/COMMANDS',
                                  where => 'EVERY',
                                  when => 0)
    or die "Cannot store $file";

Given a file name or list of file names, stores the file contents into the
definition file as a 'CHAR' dataset of specified signature using
a buffered read/write method.

This call is only available when using the shared
library C<CFX5::IO::Base> routines.

The total data size is limited to 2GB.

Any existing dataset of the same name will be overwritten.

=cut

sub store_text_dataset {
  my $self=shift;
  my $afile=shift;

  my @files;
  if (ref $afile) {
    @files=@$afile;
  } else {
    @files=$afile;
  }

  my %args=normalize_arghash(@_);

  unless (defined $args{WHAT} and defined $args{WHERE} and defined $args{WHEN}) {
    _error("You must give what, where and when values");
    return '';
  }

  $self->clear_caches();

  if ($self->use_io_base()) {
    #
    # using CFX5::IO::Base and so on
    #
    init_xs();

    my $io=CFX5::IO::Base->new();

    my $hdr=CFX5::IO::Header->new();
    my $data=CFX5::IO::Data->new();

    $hdr->what($args{WHAT});
    $hdr->where($args{WHERE});
    $hdr->when($args{WHEN});
    $hdr->istrct('CHAR');

    # any more arguments, we assume to be attributes.
    {
      my %attrs=%args;
      for my $a (qw(WHAT WHERE WHEN)) {
        delete $attrs{$a};
      }
      if (keys %attrs) {
        $hdr->nattrb(scalar keys %attrs);
        my $c=0;
        for my $a (keys %attrs) {
          $hdr->attrb($c => "$a=$attrs{$a}");
          ++$c;
        }
      }
    }

    # Find total data size of all input files (error if > 2GB)
    my $nfile = 0;
    my $ndata = 0;
    for my $file (@files) {
      next if (-z $file) ;
      my $fs = -s $file;
      $ndata += $fs;
      $nfile++;
    }

    if ($ndata < 1)
    {
      _error("Error: Data smaller than 1 byte when writing to $args{WHAT} $args{WHERE} $args{WHEN}:\n");
      return ();
    }
    elsif ($ndata > (2**31 - 1))
    {
      _error("Error: Data larger than 2GB when writing to $args{WHAT} $args{WHERE} $args{WHEN}:\n");
      return ();
    }

    # Buffered write of data
    $hdr->nstrct($ndata);
    $hdr->blockfactor(100000);

    if ($io->open_primaryfile($self->{file})) {
      _error("Error from IO module while opening $self->{file}:\n",
      $io->errstr());
      return ();
    }

    my $rv = $io->write_dataset_initialize($hdr,$data);
    if ($rv) {
      _error("Error from IO module initializing block write to $args{WHAT} $args{WHERE} $args{WHEN}:\n", $io->errstr());
    } else {
      my $nbuf = 0;
      my $buf = '';

      my $ifile = 0;

      for my $file (@files) {
        next if (-z $file) ;
        $ifile++;
        _debug("Reading $file ...");

        local *FILE;
        unless (open FILE, "<$file") {
          _error("Cannot open $file for reading: $!");
          return '';
        }
        unless (binmode FILE) {
          _error("Cannot set $file for binary mode: $!");
          return '';
        }

        my $nread = 1;
        while ($nread > 0 && $rv == 0) {
          # Read data from ASCII file, appending to buffer
          $nread = read FILE,$buf,$hdr->blockfactor()-$nbuf,$nbuf;

          unless (defined $nread) {
            $rv = 1;
            _error("Error reading file $file\n");
            last;
          }

          $nbuf += $nread;

          # Full buffer OR end of final ASCII file: Write data block to res file
          if ($nbuf == $hdr->blockfactor() || ($ifile==$nfile && $nread==0)) {
            $hdr->nstrct($nbuf);
            $data->char($buf);
            $rv = $io->write_dataset_datablock($hdr,$data);
            $nbuf = 0;
            $buf = '';
          }
        }

        close FILE;
        last if ($rv);
      }
      unless ($rv) {
        $rv = $io->write_dataset_finalize($hdr,$data);
      }
    }

    if ($rv) {
      _error("Error from IO module while writing $args{WHAT}:$args{WHERE}:$args{WHEN}:\n", $io->errstr());
    }

    $io->close_primaryfile();

    return '' if $rv;
    return 1;
  } else {
    internal_error("Cannot store datasets in iotool-helper mode");
  }
}

=head3 purge_deleted_datasets

  my $ds=$def->purge_datasets();

Purge all deleted datasets

Note that this involves copying all valid datasets to a new file.

=cut

sub purge_deleted_datasets {
  my $self=shift;

  if ($self->use_io_base()) {
    #
    # using CFX5::IO::Base and so on
    #
    my $io=CFX5::IO::Base->new();

    # Assemble temporary filename
    my $dir=dirname($self->{file});
    (my $base = basename($self->{file})) =~ s/(.+)\.[^.]*$/$1/g;
    my $tempfile = undef;
    for (my $count=255; $count>0; $count--)
    {
      $tempfile = join_file($dir,sprintf("%s_temp.%02x.res",$base,$count));
      last unless (CFX5::FileTests::test_f($tempfile));
    }
    _abort("Cannot assemble temporary filename") unless (defined $tempfile);

    # Open existing file primary file
    if ($io->open_primaryfile($self->{file}))
    {
      _error("Error from IO module opening $self->{file}:\n", $io->errstr());
      return '';
    }

    # Open temporary file as secondary file
    if ($io->open_secondaryfile($tempfile))
    {
      _error("Error from IO module opening $tempfile:\n", $io->errstr());
      return '';
    }

    # Copy all valid datasets from primary to secondary
    if ($io->copy_all_to_secondaryfile())
    {
      _error("Error from IO module copying datasets.", $io->errstr());
      return '';
    }

    # Close files
    $io->close_primaryfile();
    $io->close_secondaryfile();

    # Move temporary file to existing file
    unless (move_file($tempfile,$self->{file}))
    {
      _error("Error moving temporary file $tempfile to $self->{file}");
      return '';
    }
    
  } else {
    internal_error("Can't purge deleted datsets using the iotool helper");
  }
  1;
}

=head3 delete_dataset

  my $ds=$def->delete_dataset(-what => 'G/COMMANDS');

Deletes the dataset(s) matching the pattern.

As ever, some checks and caching are done, so this function may not
correspond to the exact behaviour of the io library.  No discrepancies
are known, however.

=cut

sub delete_dataset {
  my $self=shift;
  my %args=normalize_arghash(@_);

  if ($self->use_io_base()) {
    my $what=$args{WHAT} || '*';
    my $where=$args{WHERE} || '*';
    my $when=$args{WHEN} || -1;

    _debug("Deleting datasets matching $what:$where:$when");

    $self->clear_caches();

    #
    # using CFX5::IO::Base and so on
    #
    my $io=CFX5::IO::Base->new();
    if ($io->open_primaryfile($self->{file})) {
      _error("Error from IO module while opening $self->{file}:\n",
	     $io->errstr());
      return '';
    }

    my $rv=$io->delete_dataset($what, $where, $when);

    $io->close_primaryfile();

    if ($rv) {
      _error("Error from IO module while reading $what:$where:$when:\n", $io->errstr());
      return '';
    }
  } else {
    internal_error("Can't just read the header using the iotool helper");
  }
  1;
}

=head2 ACCESS MODE

Calls to get and set the access mode used by a particular instance.
This should not normally be used, but is useful for testing the modes
against each other.  The mode should only be changed before any calls
which access the definition file.

=head3 mode

  my $mode=$def->mode();
  $def->mode('iotool-helper');

Gets/sets the mode in use by the object in question.  The available
modes are:

=over

=item cfx5-io-base

Using the CFX5::IO::Base object.  This is the default.

=item iotool-helper

Using the external IOtool helper program.

=back

=cut

sub mode {
  my $self=shift;
  my $old=$self->{mode};
  if (@_) {
    $self->{mode}=$_[0];
  }
  $old;
}

=head3 use_io_base

  if ($def->use_io_base()) {
    # ...
  }

=cut

sub use_io_base {
  $_[0]->{mode} eq 'cfx5-io-base' ? 1 : '';
}

=head2 MESSAGE HANDLING

Using the CFX5::IO::Base message handler, we set up a message handler
of our own to simply call _error.

=cut

#
# code to pull in the XS IO library access stuff.  How do we do this?
# Well, on NT, we need to pull this in at compile time, so it's linked
# correctly, but on UNIX, we can't pull it in until runtime, as we
# don't know CFX5LIBDIR when the scripts are executed.  What fun, joy
# and excitement all this causes!  Rather than checking for NT, or the
# compiler, we check whether we can find it at compile time; if we
# can, we pull it in then.  Otherwise, we will have to do it later.
#
use vars qw($HaveXSCode);
use lib;
if (exists $ENV{CFX5_PERL_MODDIR}) {
  # manual override
  init_xs($ENV{CFX5_PERL_MODDIR});
} elsif (exists $ENV{CFX5LIBDIR} and -d "$ENV{CFX5LIBDIR}/CFX5") {
  init_xs($ENV{CFX5LIBDIR});
} else {
  #warn "Unable to find ANSYS CFX libraries at compile-time, delaying load";
}

sub init_xs {
  return if $HaveXSCode;

  my $libdir=shift;
  if (!defined $libdir) {
    $libdir=$Config{CFX5LIBDIR};
  }

  unless (defined $libdir) {
    internal_error("Unable to locate library directory for compiled Perl modules");
  }

  # we use lib, as it adds lots of useful things based on this name,
  # rather than simply the directory name.
  #warn "Loading XS code ...";
  eval {
    import lib ($libdir);
    require CFX5::IO::Base;
    $HaveXSCode=1;

    if ($^C) {
      # strip dynaloader from @ISA, we don't need it any more, and it
      # confuses the compiler
      @CFX5::IO::Base::ISA = grep { $_ ne 'DynaLoader' } @CFX5::IO::Base::ISA;
    }
  };
  if ($@) {
    # failed
    _abort("Failed to load CFX5::IO::Base:\n  $@");
  }

  CFX5::IO::Base->add_message_handler(sub { _error("Error reported by IO module:", @_); });
}

=head2 DATASET COPYING

This code does copying of datasets from one definition file to
another.  It is a hack for the beta, and should be removed before
shipping.

=head3 copy_datasets

  CFX5::DefFile::copy_dataset('file1.def' => 'file2.def',
			      ['G/COMMANDS','*',0]);

  $defsrc->CFX5::DefFile::copy_dataset($defdest,
			      ['G/COMMANDS','*',0]);


This function copies the named dataset(s) from the first file into the
second file.  If the named datasets do not exist, they are silently
skipped.  The return value is FALSE but not 0 if some error occurred,
or the count of datasets transferred (which may be 0).

The arguments may be either C<CFX5::DefFile> objects, or filenames.

=cut

sub copy_datasets {
  my $src=shift;
  my $dest=shift;

  my $srcf=$src;
  if ($src->isa('CFX5::DefFile')) {
    $srcf=$src->{file};
  }    
  my $destf=$dest;
  if ($dest->isa('CFX5::DefFile')) {
    $destf=$dest->{file};
  }
    
  init_xs();

  # first, open the files
  my $io=CFX5::IO::Base->new();
  return '' unless defined $io;
  if ($io->open_primaryfile($srcf)) {
    warn $io->errstr();
    return '';
  }
  if ($io->open_secondaryfile($destf)) {
    $io->close_primaryfile();
    warn $io->errstr();
    return '';
  }

  my $count;
  for my $dst (@_) {
    # we use the CFX5::IO::Base::iocntc routine 
    my ($what,$where,$when)=@$dst;
    $when=-1 if $when eq '*';

    # now expand any wildcards ...
    my @ds=$io->locate_primary_dataset($what,$where,$when);

    # ... and go through them one-by-one
    for my $ds (@ds) {
      _debug("Copying dataset", join(':',@$ds));
      unless ($io->copy_dataset_to_secondaryfile(@$ds)) {
	$count++;
      } else {
	# error
	_debug "Error!";
      }
    }
  }

  $io->close_secondaryfile();
  $io->close_primaryfile();

  $count;
}

=head2 BACKWARDS COMPATIBILITY

This section contains various routines used to enable
backwards-compatibility for definition files.

=head3 create_namemap_53

  @namemap=$def53->create_namemap_53();

This call generates the contents for a C<G/NAMEMAP> dataset from the
data in a 5.3 definition file.  If it cannot do this, it will signal
an error with _error and return an empty list.

=cut

# get a map entry for the only zone
sub create_namemap_53 {
  my $deffile=shift;

  #
  # read the boundary conditions
  #
  my @bcmap;
  {
    unless ($deffile->have_dataset(what => 'G/BCS')) {
      _error("Error creating namemap: G/BCS missing");
      return ();
    }
    my @bcs=$deffile->read_dataset(what => 'G/BCS')->data();

    for my $bc (@bcs) {
      unless ($deffile->have_dataset(what => "G/$bc")) {
	_error("Error creating namemap: Missing information for $bc");
	return ();
      }
      my $ds=$deffile->read_dataset(what => "G/$bc");

      my $uname=$ds->header('USERNAME');
      (my $nbc = $bc) =~ s!BC!BCP!;
      push @bcmap, [ $uname, $nbc, 'BOUNDARY', 'BCP' ];
    }
  }

  #
  # read the subdomain information
  #
  my @vpmap;
  if ($deffile->have_dataset(what => 'G/VPS')) {
    # it is not an error if this dataset is missing
    my @vps=$deffile->read_dataset(what => 'G/VPS')->data();

    for my $vp (@vps) {
      unless ($deffile->have_dataset(what => "G/$vp")) {
	_error("Error creating namemap: Missing information for $vp");
	return ();
      }
      my $ds=$deffile->read_dataset(what => "G/$vp");
      
      my $uname=$ds->header('USERNAME');
      push @vpmap, [ $uname, $vp, 'SUBDOMAIN', 'VP' ];
    }
  }

  #
  # now, we try to work out the name of the domain.  This is,
  # surprisingly, the hardest part.
  #
  my @znmap;
  {
    unless ($deffile->have_dataset(what => "G/CLBVL", where => 'ZN1')) {
      _error "Error creating namemap: G/CLBVL missing";
      return ();
    }
    my $ds=$deffile->read_dataset(what => "G/CLBVL", where => 'ZN1');

    # this dataset contains all subdomain names, and the overall domain
    # name.  I reckon the domain name is probably the final one in the
    # list, but to play safe, let's get rid of the names of any
    # subdomains.
    my @vls=$ds->data();
    my $name;
    if (@vpmap) {
      my @subs=map { $_->[0] } @vpmap;
      my %all=map { $_ => 1 } @vls;
      for my $s (@subs) {
	delete $all{$s};
      }
      my @name=keys %all;
      if (@name > 1) {
	_error "Error creating namemap: unable to find unique domain name from", join("; ", @name);
	return ();
      } elsif (!@name) {
	# we removed this one too; just put back the last one as a
	# guess!
	push @name, $vls[$#vls];
      }
      $name=$name[0];
    } else {
      # no subdomains, it should be easy
      if (@vls > 1) {
	_error("Error creating namemap: multiple volume names with no subdomain");
	return ();
      }
      $name=$vls[0];
    }
    push @znmap, [ $name, 'ZN1', 'DOMAIN', 'ZN' ];
  }

  my @namemap = map { 
    # translate any 5.3 names into 5.4 style, in the same way that
    # Build does
    $_->[0] =~ s![^A-Za-z0-9]! !g;
    # and flatten out the list
    @$_;
  } (@znmap, @bcmap, @vpmap);

  @namemap;
}

1;
