package CFX5::IO::Base;

use strict;
use vars qw(@ISA $VERSION $CVSVersion);

use CFX5::IO::Const qw(:IO_req :IOP_DATARR :IO_ERR :misc);

use CFX5::IO::Header;
use CFX5::IO::Data;

require DynaLoader;

@ISA = qw(DynaLoader);
$VERSION = '0.01';
$CVSVersion=' $Id$ ';

bootstrap CFX5::IO::Base $VERSION;

use vars qw($GlobalInstance $IOErrno);

sub new {
  return $GlobalInstance if $GlobalInstance;
  my $class=shift;
  my $type=ref($class) || $class;
  my $self={ 
	    primary => undef, 
	    secondary => undef,
	    errno => undef,
	   };
  bless $self,$type;
  $GlobalInstance=$self;
  return $self;
}

sub DESTROY {
  my $self=shift;
  if ($self->have_primary()) {
    warn "Closing primary file: out of scope";
    $self->close_primaryfile();
  }
  if ($self->have_secondary()) {
    warn "Closing secondary file: out of scope";
    $self->close_secondaryfile();
  }
}

sub errno() {
  my $self=shift;
  $self->{errno};
}
sub errname() {
  my $self=shift;
  CFX5::IO::Const::str_IO_ERR($self->errno());
}
sub errtext() {
  my $self=shift;
  GETERRTEXT($self->errno());
}
sub msgtext() {
  my $self=shift;
  my $msg=LASTMSG();
  chomp $msg if defined $msg;
  $msg;
}
sub errstr() {
  my $self=shift;
  return undef unless defined $self->errno() or defined $self->msgtext();
  my $nm=$self->errname();
  my $txt=$self->errtext();
  my $num=$self->errno();
  $num = '?' unless defined $num;
  my $rv;
  if (defined $nm and defined $txt) {
    $rv="$nm($num): $txt";
  } elsif (defined $nm) {
    $rv="$nm($num)";
  } elsif (defined $txt) {
    $rv="unknown($num): $txt";
  } else {
    $rv="unknown($num)";
  }
  my $msg=$self->msgtext();
  if (defined $msg) {
    $rv="\"$msg\"\n$rv";
  }
  $rv;
}

=head1 NAME

CFX5::IO::Base - Low-level Perl access to the CFX-5 IO library

=head1 SYNOPSIS

  use CFX5::IO::Base;

=head1 DESCRIPTION

This module implements the low-level access to the CFX-5 IO library
from perl, and is used by L<CFX5::DefFile> to access CFX-5 definition
and results files.  It should never have to be used directly, but that
is no excuse for the lack of documentation ...

=head2 new

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

This function returns a reference to I<the> CFX5::IO::Base object in
this program.  This object is implemented using the 'Singleton'
pattern: any further calls to new will return the same object.
Because of this, no files will be closed automatically when the object
goes out of scope; you should ensure that you close them manually when
you are finished.

If any files are still open during global destruction, they will be
closed at that point and a warning given; you should really ensure
that you close files when you are finished.

=head2 ERROR HANDLING

When an error is encountered by the IO library, it returns an error
code; all the calls on this object will record the error code in the
object.  The methods in this section allow the handling of this code.

=head3 errno

  warn "Error number was ", $io->errno();

Returns the IO library error number (eg, 11).

=head3 errname

  warn "IO library error name was ", $io->errname();

Returns the symbolic name (eg, C<IO_WRITE_ERR>) as a string.

=head3 errstring

  warn $io->errstring();

Returns a string, taken from the IO library, describing the error (eg,
"C<Error writing to disk.>".

=cut

=head3 have_primary

  die "No primary file is open!" unless $io->have_primary();

Returns TRUE if there is a primary file open, or FALSE otherwise.

=cut

sub have_primary {
  my $self=shift;
  return (defined $self->{primary} ? 1 : '');
}

=head3 have_secondary

  die "No secondary file is open!" unless $io->have_secondary();

Returns TRUE if there is a secondary file open, or FALSE otherwise.

=cut

sub have_secondary {
  my $self=shift;
  return (defined $self->{secondary} ? 1 : '');
}

=head2 MESSAGE HANDLING

The IO module has a standard callback which is used to report errors
to the calling program.  The calls in this section allow Perl programs
to interface to this.  The CFX5::IO::Base module keeps a stack of
message handlers, all of which will be called when a message is
received.

If no handlers are registered, it will print the message to the
standard error stream.

Note that these are global to all uses of the IO module, and do not
currently depend on which object made the call.  Maybe they should.

=head3 add_message_handler

  $io->add_message_handler(sub { print $_[0], "\n" });

Adds a message handler.  The handler will be called whenever a message
is received from the IO module, with a single argument, the message
text, with no trailing newline.

=cut

use vars qw(@MessageHandlers);

sub add_message_handler {
  my $self=shift;
  push @MessageHandlers, @_;
}

=head3 MessageHandler

I<internal>

This is the routine which is called by the XS code to handle the
message.

=cut

sub MessageHandler {
  my $msg=shift;
  chomp $msg;
  if (@MessageHandlers) {
    for my $s (@MessageHandlers) {
      $s->($msg);
    }
  } else {
    print STDERR "IO: $msg\n";
  }
}

=head2 open_primaryfile

  $io->open_primaryfile('file');

Return value is 0 on success, or IO_ERROR on failure.

=cut

sub open_primaryfile {
  my $self=shift;

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

  undef $self->{errno};

  my $f=shift;

  # the filename
  $data->char($f);

  my $rv=iocntc(IO_OPEN_PRIMARYFILE(),$hdr,$data);

  $self->{errno}=$rv;

  unless ($rv) {
    $self->{primary}=$f;
  }

  $rv;
}

=head2 open_secondaryfile

  $io->open_secondaryfile('file');

Return value is 0 on success, or IO_ERROR on failure.

=cut

sub open_secondaryfile {
  my $self=shift;

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

  undef $self->{errno};

  my $f=shift;

  # the filename
  $data->char($f);

  my $rv=iocntc(IO_OPEN_SECONDARYFILE(),$hdr,$data);

  $self->{errno}=$rv;

  unless ($rv) {
    $self->{secondary}=$f;
  }

  $rv;
}

=head2 close_primaryfile

  $io->close_primaryfile('file');

Return value is 0 on success, or IO_ERROR on failure.

=cut

sub close_primaryfile {
  my $self=shift;
  my $hdr=new CFX5::IO::Header();
  my $data=new CFX5::IO::Data();

  undef $self->{errno};

  my $rv=iocntc(IO_CLOSE_PRIMARYFILE(),$hdr,$data);

  $self->{errno}=$rv;

  unless ($rv) {
    undef $self->{primary};
  }

  $rv;
}

=head2 close_secondaryfile

  $io->close_secondaryfile('file');

Return value is 0 on success, or IO_ERROR on failure.

=cut

sub close_secondaryfile {
  my $self=shift;
  my $hdr=new CFX5::IO::Header();
  my $data=new CFX5::IO::Data();

  undef $self->{errno};

  my $rv=iocntc(IO_CLOSE_SECONDARYFILE(),$hdr,$data);

  $self->{errno}=$rv;

  unless ($rv) {
    undef $self->{secondary};
  }

  $rv;
}

=head2 get_ds_number

  $num=$io->get_ds_number();

Return value is the number of datasets in the definition file on
success, or undef on failure.

=cut

sub get_ds_number {
  my $self=shift;
  my $hdr=new CFX5::IO::Header();
  my $data=new CFX5::IO::Data();

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  undef $self->{errno};

  # put aside some space for the return value
  $data->numintr(1);

  # do the call
  my $rv=iocntc(IO_GET_DS_NUMBER(),$hdr,$data);

  if ($rv) {
    $self->{errno}=$rv;
    return undef;
  }

  $data->intrelt(0);
}

=head2 locate_dataset

  my @list=$io->locate_dataset($what,$where,$when);

Uses C<IO_LOCATE_DATASET> to find the list of datasets matching the
WHAT/WHERE/WHEN triple.  The return value is the list of matching
datasets, which can be empty if no matching datasets were found.  In
addition, it will record an error (see C<errno>) if an error other
than C<IO_DS_NOT_FOUND> occurs.

If called in a scalar context, returns the number of matching
datasets.

=cut

sub locate_dataset {
  my $self=shift;
  $self->_locate_dataset(IO_LOCATE_DATASET(),@_);
}

sub _locate_dataset {
  my $self=shift;
  my $op=shift;

  unless ($op == IO_LOCATE_DATASET()
	  or $op == IO_LOCATE_PRIMARY_DS()) {
    die "_locate_dataset: $op is not a locate op!";
  }

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  # make sure all these have values
  my $what=shift().'';
  my $where=shift().'';
  my $when=shift()+0;

  my $hdr=shift || new CFX5::IO::Header();
  my $data=shift || new CFX5::IO::Data();

  undef $self->{errno};

  #
  # set aside some memory for the information
  #
  if ($what =~ m/\*/ or $where =~ m/\*/ or $when == -1) {
    # wildcards; we need to allocate enough space for up to all of the
    # datasets
    my $num=$self->get_ds_number();
    return () unless defined $num;
    $data->numoffset($num*2);
    $data->numstring($num*2);
    $data->numintr($num);
  } else {
    $data->numoffset(2);
    $data->numstring(2);
    $data->numintr(1);
  }

  #
  # set up the header
  #
  $hdr->what($what);
  $hdr->where($where);
  $hdr->when($when);

  my $rv=iocntc($op,$hdr,$data);

  if ($rv and $rv != IO_DS_NOT_FOUND()) {
    $self->{errno}=$rv;
    return ();
  }

  if ($rv == IO_DS_NOT_FOUND()) {
    return ();
  }

  my @rv;
  my $total=$data->numintr();
  for (my $i=0; $i < $total; $i++) {
    my @it;
    push @it, $data->stringelt($i*2), $data->stringelt($i*2+1);
    push @it, $data->intrelt($i);
    push @rv, \@it;
  }

  @rv;
}

=head2 locate_primary_dataset

  my @list=$io->locate_primary_dataset($what,$where,$when);

This routine behaves exactly like C<locate_dataset>, but if a
secondary file is open, it will operate on the primary file rather
than then secondary file.  Unlike the similarly-named IO module call,
if no secondary file is open, this call may still be used, and
translates itself into a simple C<locate_dataset> call.

=cut

sub locate_primary_dataset {
  my $self=shift;
  if ($self->have_secondary()) {
    return $self->_locate_dataset(IO_LOCATE_PRIMARY_DS(),@_);
  } else {
    return $self->_locate_dataset(IO_LOCATE_DATASET(),@_);
  }
}

=head2 read_dataset_data

  my ($hdr,$data)=$io->read_dataset_data($what,$where,$when);
  my $data=$io->read_dataset_data($what,$where,$when);

  print $data->dump();

Uses C<IO_LOCATE_DATASET> to find the list of datasets matching the
WHAT/WHERE/WHEN triple, and then reads the dataset into a pair of
C<CFX::IO::Header> and C<CFX5::IO::Data> objects and returns them.
There must be exactly one dataset matching the pattern given.  If an
error occurs, the return values will be C<undef> and the error will be
stored in C<errno>.

If called in a scalar context, it just returns the C<CFX5::IO::Data>
object from the pair.

It is hoped, at some point in the future, to provide a more perlish
wrapper around this routine.

=cut

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

sub _read_dataset_data {
  my $self=shift;

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  my $primary=shift;

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

  my @datasets;
  if ($primary) {
    @datasets=$self->locate_primary_dataset(@_[0..2],$hdr,$data);
  } else {
    @datasets=$self->locate_dataset(@_[0..2],$hdr,$data);
  }

  if (@datasets != 1) {
    $self->{errno}=IO_FOUND_MORE_DS();
    return undef;
  }

  # the information about offsets is now already stored in the $hdr
  # and $data structures, so we go ahead and read.  Note that there is
  # already possibly a fair whack of memory in $data from the
  # locate_dataset call, so we don't bother allocating any more.

  # note also that we have to pass some attribute space in, otherwise
  # things go horribly wrong ...
  $hdr->nattrb(IO_MAXATTRBS());

  my $op=($primary ? IO_READ_LOCATED_PRIMARY_DS() : IO_READ_LOCATED_DATASET());
  my $rv=iocntc($op,$hdr,$data);

  # ... but since there's no check in the IO library -- at least on
  # reading -- it seems prudent to check.
  if ($hdr->nattrb() > IO_MAXATTRBS()) {
    die ">",IO_MAXATTRBS()," attributes passed back by IO library, must have stomped on some memory";
  }

  if ($rv == IO_MEMORY_ERR()) {
    # need more memory, and the amount is stored in the data object
    # already.
    $data->_resetmemory(); 
    $rv=iocntc($op,$hdr,$data);
  }

  $self->{errno}=$rv;

  if ($rv) {
    # an error has occurred
    return undef;
  }

  # OK, we will return this data object, but first make sure it's not
  # chewing memory
  $data->_resetmemory();

  if (wantarray) {
    $hdr->_resetmemory();
    return ($hdr,$data);
  } else {
    return $data;
  }
}

=head2 read_primary_dataset_data

  my @list=$io->read_primary_dataset_data($what,$where,$when);

This routine behaves exactly like C<read_dataset_data>, but if a
secondary file is open, it will operate on the primary file rather
than then secondary file.  Unlike the similarly-named IO module call,
if no secondary file is open, this call may still be used, and
translates itself into a simple C<read_dataset_data> call.

=cut

sub read_primary_dataset_data {
  my $self=shift;
  if ($self->have_secondary()) {
    return $self->_read_dataset_data(1,@_);
  } else {
    return $self->_read_dataset_data(0,@_);
  }
}

=head2 read_dataset_header

  my ($hdr,$data)=$io->read_dataset_header($what,$where,$when);
  my $data=$io->read_dataset_header($what,$where,$when);

  print $data->dump();

Uses C<IO_LOCATE_DATASET> to find the list of datasets matching the
WHAT/WHERE/WHEN triple, and then reads the dataset into a pair of
C<CFX::IO::Header> and C<CFX5::IO::Data> objects and returns them.
There must be exactly one dataset matching the pattern given.  If an
error occurs, the return values will be C<undef> and the error will be
stored in C<errno>.

If called in a scalar context, it just returns the C<CFX5::IO::Data>
object from the pair.

It is hoped, at some point in the future, to provide a more perlish
wrapper around this routine.

=cut

sub read_dataset_header {
  my $self=shift;

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

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

  my @datasets=$self->locate_dataset(@_[0..2],$hdr,$data);

  if (@datasets != 1) {
    $self->{errno}=IO_FOUND_MORE_DS();
    return undef;
  }

  # the information about offsets is now already stored in the $hdr
  # and $data structures, so we go ahead and read.  Note that there is
  # already possibly a fair whack of memory in $data from the
  # locate_dataset call, so we don't bother allocating any more.

  # note also that we have to pass some attribute space in, otherwise
  # things go horribly wrong ...
  $hdr->nattrb(IO_MAXATTRBS());

  my $rv=iocntc(IO_READ_HEADER(),$hdr,$data);

  # ... but since there's no check in the IO library -- at least on
  # reading -- it seems prudent to check.
  if ($hdr->nattrb() > IO_MAXATTRBS()) {
    die ">",IO_MAXATTRBS()," attributes passed back by IO library, must have stomped on some memory";
  }

  $self->{errno}=$rv;

  if ($rv) {
    # an error has occurred
    return undef;
  }

  return $hdr;
}

=head2 copy_dataset_to_secondaryfile

  $io->copy_dataset_to_secondaryfile($what,$where,$when);

Uses C<IO_LOCATE_PRIMARY_DS> to find the dataset matching the
WHAT/WHERE/WHEN triple, and then copies the dataset from the primary
file into the secondary file.  There must be exactly one dataset
matching the pattern given.  The return value is the IO library error
code, which will be FALSE on success and TRUE on failure.

=cut

sub copy_dataset_to_secondaryfile {
  my $self=shift;

  unless ($self->have_primary() and $self->have_secondary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return $self->{errno};
  }

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

  my @datasets=$self->locate_primary_dataset(@_[0..2],$hdr,$data);

  if (@datasets != 1) {
    $self->{errno}=IO_FOUND_MORE_DS();
    return $self->{errno};
  }

  # TODO: this is a hack
  $self->delete_dataset(@_[0..2]);

  # the information about offsets is now already stored in the $hdr
  # and $data structures, so we go ahead and do the copy.

  my $rv=iocntc(IO_COPY_DATASET(),$hdr,$data);

  $self->{errno}=$rv;

  $rv;
}

=head2 copy_all_to_secondaryfile

  $io->copy_all_to_secondaryfile();

Copies all valid datasets from the primary file into the secondary file.
The return value is the IO library error code, which will be FALSE
on success and TRUE on failure.

=cut

sub copy_all_to_secondaryfile {
  my $self=shift;

  unless ($self->have_primary() and $self->have_secondary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return $self->{errno};
  }

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

  my $rv=iocntc(IO_COPY_ALLVALID_DS(),$hdr,$data);

  $self->{errno}=$rv;

  $rv;
}

=head2 delete_dataset

  $io->delete_dataset($what,$where,$when) or die $io->errstr();

This routine uses the IO_DELETE_DATASET call to delete the dataset
from the currently-active file.  The what, where and when may contain
wildcards, in which case all matching datasets are deleted.

The return value is FALSE on success, or the IO library error code
(which will be TRUE) on failure.

=cut

sub delete_dataset {
  my $self=shift;
  $self->_delete_dataset(IO_DELETE_DATASET(),@_);
}

sub _delete_dataset {
  my $self=shift;
  my $op=shift;

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  unless ($op == IO_DELETE_DATASET()
	  or $op == IO_DELETE_PRIMARY_DS()) {
    die "_delete_dataset: $op is not a delete op!";
  }

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

  my ($what,$where,$when)=@_[0..2];

  #
  # set up the header
  #
  $hdr->what($what);
  $hdr->where($where);
  $hdr->when($when);

  my $rv=iocntc($op,$hdr,$data);

  $self->{errno}=$rv;

  $rv;
}

=head2 delete_primary_dataset

  $io->delete_primary_dataset($what,$where,$when);

This routine behaves exactly like C<delete_dataset>, but if a
secondary file is open, it will operate on the primary file rather
than then secondary file.  Unlike the similarly-named IO module call,
if no secondary file is open, this call may still be used, and
translates itself into a simple C<delete_dataset> call.

=cut

sub delete_primary_dataset {
  my $self=shift;
  if ($self->have_secondary()) {
    return $self->_delete_dataset(IO_DELETE_PRIMARY_DS(),@_);
  } else {
    return $self->_delete_dataset(IO_DELETE_DATASET(),@_);
  }
}

=head2 write_dataset_hdrdata

  $io->write_dataset_hdrdata($hdr,$data) and die;

Given a header object and a data object, calls the IO_WRITE_DATASET
call to write them to the definition file.

=cut

sub write_dataset_hdrdata {
  my $self=shift;

  undef $self->{errno};

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  my $hdr=shift;
  my $data=shift;
  
  my $rv=iocntc(IO_WRITE_DATASET(),$hdr,$data);

  $self->{errno}=$rv;

  $rv;
}


=head3 read_dataset_initialize

  # Initialize buffered reading of a datset
  $io->read_dataset_initialize($hdr,$data);

Reads the header and other preliminary operations
in preparation for calling read_dataset_datablock().

To be called once before the first call to read_dataset_datablock().

=cut

sub read_dataset_initialize
{
  my $self = shift;

  # Should we do this?
  undef $self->{errno};

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  my $hdr=shift;
  my $data=shift;

  my $rv;

  $data->numoffset(2);
  $data->numstring(2);
  $data->numintr(1);

  $rv = iocntc(IO_LOCATE_DATASET(),$hdr,$data);
  return $rv if $rv;

  $hdr->nattrb(IO_MAXATTRBS());

  $rv = iocntc(IO_READ_HEADER(),$hdr,$data);
  return $rv if $rv;

  $rv = iocntc(IO_READ_DATATAG(),$hdr,$data);
  return $rv if $rv;

  # Ensure we have enough character memory allocated
  my $c = ' ';
  $c x= $hdr->blockfactor();
  $data->char($c);

  return 0;
}

=head3 read_dataset_datablock

  while (...)
  {
    # Read one block of data
    $io->read_dataset_datablock($hdr,$data);
  }

Reads one block of data from a dataset.

This function would typically be called multiple times to read
successive blocks of data from a dataset.

=cut

sub read_dataset_datablock
{
  my $self = shift;

  # Should we do this?
  undef $self->{errno};

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  my $hdr=shift;
  my $data=shift;

  my $rv = iocntc(IO_READ_DATA(),$hdr,$data);

  return $rv;
}

=head3 write_dataset_initialize

  # Initialize buffered writing of a dataset
  my $rv = $io->write_dataset_initialize($hdr,$data);

writes the header and other preliminary operations
To be called once before the first call to write_dataset_datablock().

=cut

sub write_dataset_initialize
{
  my $self = shift;

  # Should we do this?
  undef $self->{errno};

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  my $hdr=shift;
  my $data=shift;

  my $rv = 0;

  $data->numoffset(2);

  $rv = iocntc(IO_GET_INDEX_LOCATION(),$hdr,$data);
  return $rv if $rv;

  # Store start location for new dataset
  $self->{ilocation} = $data->offsetelt(0);

  $rv = iocntc(IO_WRITE_HEADER(),$hdr,$data);
  return $rv if $rv;

  # Save offset
  $self->{offset_saved} = $data->offsetelt(0);
  $self->{offset2} = $data->offsetelt(1);

  $rv = iocntc(IO_WRITE_DATATAG(),$hdr,$data);
  return $rv if $rv;

  return 0;
}

=head3 write_dataset_datablock

  while(...)
  {
    # Write a block of data
    $rv = $io->write_dataset_datablock($hdr,$data);
  }

Writes one block of data to a dataset.

This function would typically be called multiple times to write
successive blocks of data to a dataset.

=cut

sub write_dataset_datablock
{
  my $self = shift;

  # Should we do this?
  undef $self->{errno};

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  my $hdr=shift;
  my $data=shift;

  my $rv = iocntc(IO_WRITE_DATA(),$hdr,$data);
  return $rv if $rv;

  return 0;
}

=head3 write_dataset_finalize

  # Finalize the dataset
  $rv = $io->write_dataset_finalize($hdr,$data);

Finalizes the dataset after all data has been written.
To be called once after the last call to write_dataset_datablock().

=cut

sub write_dataset_finalize
{
  my $self = shift;

  # Should we do this?
  undef $self->{errno};

  unless ($self->have_primary()) {
    $self->{errno}=IO_FILE_NOT_OPEN();
    return undef;
  }

  my $hdr=shift;
  my $data=shift;

  my $rv = 0;

  # Restore saved offsets
  my $ilocation = $self->{ilocation};
  my $offset2 = $self->{offset2};
  my $offset_saved = $self->{offset_saved};

  $rv = iocntc(IO_WRITE_ENDTAG(),$hdr,$data);
  return $rv if $rv;

  $rv = iocntc(IO_GET_OFFSET(),$hdr,$data);
  return $rv if $rv;

  # Pick up offset
  my $location = $data->offsetelt(0);

  # Calculate the dataset length and set offset
  my $dslength = $location - $offset2;
  $data->numoffset(1);
  $data->offsetelt(0,$dslength);

  $rv = iocntc(IO_WRITE_DSLENGTH(),$hdr,$data);
  return $rv if $rv;

  $rv = iocntc(IO_SET_INDEX_LOCATION(),$hdr,$data);
  return $rv if $rv;

  # Restore offset and go back to the start of the dataset
  $data->numoffset(1);
  $data->offsetelt(0,$offset_saved);

  $rv = iocntc(IO_GOTO_OFFSET(),$hdr,$data);
  return $rv if $rv;

  # Set offset to dataset length and re-write the data set length
  $data->numoffset(1);
  $data->offsetelt(0,$dslength);

  $rv = iocntc(IO_WRITE_DSLENGTH(),$hdr,$data);
  return $rv if $rv;

  # Set offset and write the index
  $data->numoffset(2);
  $data->offsetelt(0,$dslength);
  $data->offsetelt(1,$ilocation);

  $rv = iocntc(IO_INSERT_INDEX(),$hdr,$data);
  return $rv if $rv;

  return 0;
}

1;

__END__

