File Coverage

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

Criterion	Covered	Total	%
statement	60	72	83.3
branch	12	18	66.6
condition	2	3	66.6
subroutine	16	20	80.0
pod	11	11	100.0
total	101	124	81.4

package Astro::STSDAS::Table::Columns;

require 5.005_62;
use strict;
use warnings;

use Carp;

use Astro::STSDAS::Table::Column;

our $VERSION = '0.01';

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


  my $self = {
	       cols  => {},
	       idxs  => {},
	       idxs_s => undef, # sorted indices
	     };

  bless $self, $class;
}

sub ncols
{
  scalar keys %{$_[0]->{cols}};
}

sub add
{
  my $self = shift;

  $self->_add( Astro::STSDAS::Table::Column->new( @_ ) );
}

sub _add
{
  my ( $self, $col ) = @_;

  croak( __PACKAGE__, "->add: duplicate column index `", $col->idx, "'\n" )
    if exists $self->{idxs}{$col->idx};

  croak( __PACKAGE__, "->add: duplicate column name `", $col->name, "'\n" )
    if exists $self->{cols}{lc $col->name};

  $self->{cols}{lc $col->name} = $col;
  $self->{idxs}{$col->idx} = $col;
  $_[0]->{idxs_s} = undef;
  $col;
}

sub del
{
  my $self = shift;
  my $col = shift;

  # first make sure its one of ours.
  return 0 unless grep { $col == $_ } values %{$self->{cols}};

  $self->delbyname( $col->name );
}

sub delbyname
{
  my $self = shift;
  my $name = lc shift;
  return 0 unless exists $self->{cols}{$name};

  delete $self->{idxs}{$self->{cols}{$name}->idx};
  delete $self->{cols}{$name};
  $_[0]->{idxs_s} = undef;
  1;
}

sub byidx
{
  exists $_[0]->{idxs}{$_[1]} ? $_[0]->{idxs}{$_[1]} : undef;
}


sub byname
{
  my $name = lc $_[1];
  return undef unless exists $_[0]->{cols}{$name};
  $_[0]->{cols}{$name};
}

sub cols
{
  $_[0]->_mkidxs_s unless defined $_[0]->{idxs_s};
  @{$_[0]->{idxs_s}};
}

sub _mkidxs_s
{
  $_[0]->{idxs_s} = [ sort { $a->idx <=> $b->idx} values %{$_[0]->{cols}} ];
}

sub names
{
  map { $_->name } $_[0]->cols;
}

sub rename
{
  my ( $self, $name, $newname ) = @_;

  my $col = $self->byname($name);
  return undef unless defined $col;

  $self->delbyname( $name );

  $col->name($newname);
  $self->_add( $col );
}

sub _access
{
  my $what = shift;

  sub {

    my $self = shift;
    my $name = lc shift;
    return undef unless exists $self->{cols}{$name};
    $self->{cols}{$name}->$what(@_);
  }
}

{
  no strict 'refs';
  *$_ = _access( $_ )
    foreach qw( units format idx offset type nelem fmt is_string is_undef );
}



sub copy
{
  my $self = shift;

  my $new = $self->new;

  $new->_add( $_->copy ) foreach values %{$self->{cols}};

  $new;
}


1;
__END__