view release on metacpan or  search on metacpan

Table/Binary.pm  view on Meta::CPAN

package Astro::STSDAS::Table::Binary;

our $VERSION = '0.13';

use strict;
use warnings;
use FileHandle;
use Carp qw( carp croak );


our @ISA = qw( Astro::STSDAS::Table::Base );

use Astro::STSDAS::Table::Base;
use Astro::STSDAS::Table::Constants;


# things read in from the table
our @hdr_fields = ( 
		   'nhp',	# number of header parameters
		   'nhp_a',	# number of header parameters allocated
		   'nrows',	# number of rows written to table
		   'nrows_a',	# number of rows allocated
		   'ncols',	# number of column descriptors in table
		   'ncols_a',	# number of column descriptors allocated
		   'row_used',	# size in CHAR_SZ of space used in row
		   'row_len',	# size in CHAR_SZ of row length
		   'ttype',	# type of table (row or column ordered)
		   'version',	# STSDAS software version number
		  );




 # row_len  - the row length, in bytes, for row-ordered tables
 # row_used - the actual length of the row in the file, in bytes, for
 #            row-ordered tables
 # row_els  - the number of elements in a row (includes vector elements)
 # nrows_a  - the number of rows allocated (in a column ordered table)
 # ttype    - the type of table (either TT_ROW_ORDER or TT_COL_ORDER)
 # version  - "table software version number" from STSDAS created tables
 # row      - the next record (zero based) to be read in
 # last_col_idx - index of the last column read, for column ordered tables
 # last_col - the last column read, for column ordered tables
 # buf      - the input buffer, row_len bytes wide.
 # have_vecs - the table has vectors


sub new
{ 
  my $this = shift;
  my $class = ref($this) || $this;

  my $self = $class->SUPER::new();

  $self->{last_col_idx} = -1;
  $self->{last_col} = undef;
  $self->{row} = 0;

  bless $self, $class;
}


# _read_hdr

# _read_hdr is an internal routine which digests the binary table
# header.  besides stocking the table hash with the information, it
# converts lengths into bytes and creates a pack() compatible format
# for reading in rows.  It also initializes various things.

sub _read_hdr
{
  my $self = shift;

  my $buf;
  read( $self->{fh}, $buf, 12 * $TypeSize{TY_INT()} ) == 
    12 * $TypeSize{TY_INT()} or
    croak( "no data or error reading header\n");

  my %rawhdr;
  @rawhdr{@hdr_fields} = unpack( 'i10', $buf );

  # save a few of the values
  $self->{row_len}  = $rawhdr{row_len}  * CHAR_SZ;
  $self->{row_used} = $rawhdr{row_used} * CHAR_SZ;
  $self->{nrows}    = $rawhdr{nrows};
  $self->{nrows_a}  = $rawhdr{nrows_a};
  $self->{ttype}    = $rawhdr{ttype};
  $self->{version}  = $rawhdr{version};


  if ( $rawhdr{nhp} )
  {
    my $pars = $self->{pars};

    for my $i ( 1 .. $rawhdr{nhp} )
    {
      read( $self->{fh}, $buf, 80 ) == 80 or
	croak( "ran out of data reading header parameter $i\n" );

      my $name = unpack('A*', substr($buf, 0, 8));
      my $type = $HdrType{substr( $buf, 8, 1 )};
      ( my $value = substr( $buf, 9, 71 ) ) =~ s/\0.*//g;

      if ( $type eq TY_STRING )
      {
	$value =~ s/^'|'$//g;
      }

      $pars->add( $name, $value, undef, $type );
    }
  }

  if ( $rawhdr{nhp_a} > $rawhdr{nhp} )