package CFX5::IO::Header;

use strict;
use vars qw(@ISA);

use CFX5::IO::Const qw(:IOP_HEDARR); # for the IOP_* definitions

# Preloaded methods go here.

sub new {
  my $class=shift;
  my $type=ref($class) || $class;
  my $hdr=CFX5::IO::Header::NEW();
  bless $hdr,$type;
  $hdr;
}

sub DESTROY {
  CFX5::IO::Header::FREEMEM($_[0]);
}

=head1 NAME

CFX5::IO::Header - 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 header structure
for the CFX-5 IO library from perl, and is used by L<CFX5::IO> 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 ...

=head1 AUTHOR

Andy Mortimer <andy.mortimer@aeat.com>

=head1 SEE ALSO

L<CFX5::IO::Base>
L<CFX5::IO>

=head2 new

  $hdr=new CFX5::IO::Header();

Returns a fresh new CFX5::IO::Header object, just ready to be passed
into the IO library.

=cut

=head2 what

  my $what=$hdr->what();
  $hdr->what('G/COMMANDS');

Gets or sets the what field in the header.

=head2 where

  my $where=$hdr->where();
  $hdr->where('EVERY');

Gets or sets the where field in the header.

=cut

=head2 istrct

  my $istrct=$hdr->istrct();
  $hdr->istrct('EVERY');

Gets or sets the istrct field in the header.

=cut

sub bstr {
  my $self=shift;
  if (@_ > 2) {
    croak("Only 1 or 2 arguments to bstr");
  } elsif (@_ > 1) {
    return $self->SETBSTR($_[0],$_[1]);
  } else {
    return $self->GETBSTR($_[0]);
  }
}

sub what   { my $self=shift; $self->bstr(IOP_HEDARR_WHAT(),@_); }
sub where  { my $self=shift; $self->bstr(IOP_HEDARR_WHERE(),@_); }
sub istrct { my $self=shift; $self->bstr(IOP_HEDARR_ISTRCT(),@_); }

=head2 when

  $when=$hdr->when();
  $hdr->when(-1);

Gets or sets the when attribute in the header.

=head2 nattrb

  $nattrb=$hdr->nattrb();
  $hdr->nattrb(-1);

Gets or sets the nattrb attribute in the header.  Changing this value
also changes the size of the C<attrbs> array in the header structure.

=head2 nstrct

  $nstrct=$hdr->nstrct();
  $hdr->nstrct(-1);

Gets or sets the nstrct attribute in the header.

=head2 blockfactor

  $blockfactor=$hdr->blockfactor();
  $hdr->blockfactor(-1);

Gets or sets the blockfactor attribute in the header.

=cut

sub bnum {
  my $self=shift;
  if (@_ > 2) {
    croak("Only 1 or 2 arguments to bnum");
  } elsif (@_ > 1) {
    return $self->SETBNUM($_[0],$_[1]);
  } else {
    return $self->GETBNUM($_[0]);
  }
}

sub when         { my $self=shift; $self->bnum(IOP_HEDARR_WHEN(),@_); }
sub nattrb       { my $self=shift; $self->bnum(IOP_HEDARR_NATTRB(),@_); }
sub nstrct       { my $self=shift; $self->bnum(IOP_HEDARR_NSTRCT(),@_); }
sub blockfactor  { my $self=shift; $self->bnum(IOP_HEDARR_BLOCKFACTOR(),@_); }

=head2 attrb

  my $firstattr=$hdr->attrb(0);

Returns the attribute part of the header, one entry at a time.

=cut

sub attrb {
  my $self=shift;
  if (@_ > 2) {
    croak("Only 1 or 2 arguments to bnum");
  } elsif (@_ > 1) {
    return $self->SETATTRB($_[0],$_[1]);
  } else {
    return $self->GETATTRB($_[0]);
  }
}

=head2 _resetmemory

=cut

sub _resetmemory {
  my $self=shift;
  # it's only the numattrb here, so do it manually to force a realloc
  my $n=$self->bnum(IOP_HEDARR_NATTRB());
  $self->bnum(IOP_HEDARR_NATTRB(),$n);
}

=head2 dump

  print $hdr->dump();

Returns a string summarising the contents.  Not more than 10 items
from any class will be displayed, as it is mostly for debugging.

=cut

sub dump {
  my $self=shift;
  my @rv;

  for my $t (qw(what where istrct when nattrb nstrct blockfactor)) {
    push @rv, "  $t = ". $self->$t(). "\n";
  }
  if ($self->nattrb()) {
    push @rv, "  Attributes:\n";
    for (my $i=0; $i < $self->nattrb(); $i++) {
      push @rv, "    ".$i.". ".$self->attrb($i)."\n";
    }
  }

  join('',@rv);
}

1;
