File Coverage

blib/lib/Astro/STSDAS/Table/Column.pm

Criterion	Covered	Total	%
statement	43	44	97.7
branch	15	24	62.5
condition	3	6	50.0
subroutine	14	15	93.3
pod	6	6	100.0
total	81	95	85.2

package Astro::STSDAS::Table::Column;

require 5.005_62;
use strict;
use warnings;

use Carp;

our $VERSION = '0.01';

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

  # Column attributes
  #
  # All tables:
  #
  #  name	        - the column name
  #  units	- the units string
  #  format	- the format string
  #  idx		- the column number (unary based)
  #
  # Binary Tables:
  #
  #  offset       - the byte offset from the start of the row
  #		    (for row ordered tables)
  #
  #  type         - the data representation type (TY_REAL,
  #  	          TY_DOUBLE, TY_INT, etc.)  see the constants defined
  #  	          above
  #
  #  nelem	- the number of elements in the cell. if the data type
  #                 is TY_STRING, this is the maximum number of
  #		  characters.  if not a string, and if greater than
  #		  one, it indicates a vector.
  #
  #  fmt          - the pack() compatible format to parse this column
  #                 (taking into account vectors)
  #
  #  size         - # bytes in the data type
  #  ifmt	  - pack() compatible format for this type (doesn't take
  #                 into account vectors)

our @colkeys = qw { name units format idx offset type nelem };

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

  my $self = bless {}, $class;

  @{$self}{@colkeys} = @_;

  $self->{nelem} = 1 unless defined $self->{nelem};

  if ( defined $self->{type} )
  {
    croak( __PACKAGE__, '->new: illegal column type' )
      unless exists $Types{$self->{type}};
    $self->{size} = $TypeSize{$self->{type}};
    $self->{fmt} = $self->{ifmt} = $TypeUPack{$self->{type}};
    $self->{fmt} .= $self->{nelem} if $self->{nelem} > 1;
    $self->{indef} = $TypeIndef{$self->{type}};
  }

  $self;
}

sub _access_rw
{
  my $what = shift;

  sub {
    my $self = shift;
    $self->{$what} = $_[0] if @_;
    $self->{$what};
  }
}

sub _access_ro
{
  my $what = shift;
  sub { croak( __PACKAGE__, "->$what: attempt to write to RO attribute" )
	  if @_ > 1;
	$_[0]->{$what}
      }
}

{
  no strict 'refs';
  *$_ = _access_rw( $_ )
    foreach qw( name units format );

  *$_ = _access_ro( $_ )
    foreach qw ( idx offset type fmt size ifmt );
}

sub is_string
{
  defined $_[0]->{type} ? ($_[0]->{type} == TY_STRING ? 1 : 0) : undef;
}

sub is_indef
{
  $_[0]->{type} != TY_STRING && $_[0]->{indef} == $_[1];
}

sub is_vector
{
  $_[0]->{type} != TY_STRING && $_[0]->{nelem} > 1;
}

sub nelem
{
  croak( __PACKAGE__, "->nelem: attempt to write to RO attribute" )
	  if @_ > 1;

  defined $_[0]->{type} && $_[0]->{type} == TY_STRING ?
    1 : $_[0]->{nelem};
}

sub copy
{
  $_[0]->new( @{$_[0]}{@colkeys} );
}

1;
__END__