Util::FITStable (version 0.0)

package Util::FITStable;
##############################################################################
#
# DESCRIPTION: This class is used for constructing fits tables
#
# HISTORY: 
# HISTORY: $Log: FITStable.pm,v $
# HISTORY: Revision 1.5  2005/12/01 20:52:08  apsop
# HISTORY: Put a T between the date and the time in timeString output.
# HISTORY:
# HISTORY: Revision 1.4  2005/08/16 21:38:57  apsop
# HISTORY: Pruned some debug junk.
# HISTORY:
# HISTORY: Revision 1.3  2005/08/16 21:21:22  apsop
# HISTORY: Allow the user to specify a constant value for a column.  Write
# HISTORY: column comments.
# HISTORY:
# HISTORY: Revision 1.2  2004/10/24 19:59:28  apsop
# HISTORY: Remove bad history entry
# HISTORY:
# HISTORY: Revision 1.1  2004/10/24 19:55:53  apsop
# HISTORY: New utility for making FITS files.
# HISTORY:
#
# VERSION: 0.0
#
##############################################################################

use strict;

use FileHandle;
use Util::HEAdas;



sub new
{
	my ($class, $specs, %args) = @_;

	my %data = (
		order => $specs,
		lookup => { map { $_->{name} => $_ } @$specs },
		log => $args{log} || Util::NoLog->new,
		which => $args{which} || 'unnamed',
	);

	my $obj =  bless(\%data, $class);

	return $obj;
}


sub set
{
	my ($self, $key, $data, %args) = @_;

	my $e = $self->{lookup}{$key};

	if (not defined($e)) {
		$self->{log}->error(2, "invalid column name '$key'");
		return;
	}

	my $value = undef;

	if (UNIVERSAL::isa($data, 'HASH')) {
		$value = exists($data->{$e->{key}}) ? $data->{$e->{key}} : 'INDEF';
	}
	elsif (UNIVERSAL::isa($data, 'ARRAY')) {
		$e->{data} = $data;
	}
	else {
		$value = $data;
	}

	if (defined($value)) {
		if ($args{constant}) {
			$e->{constant} = $value;
		}
		else {
			push(@{ $e->{data} }, $value);
		}
	}
}




sub write
{
	my ($self, $outfile) = @_;

	my $log = $self->{log};

	my $cdfile = 'cols.tmp';
	my $datafile = 'data.tmp';
	my $headfile = 'head.tmp';
	my $editfile = 'edit.tmp';

	my $cols = FileHandle->new($cdfile, 'w');
	my $data = FileHandle->new($datafile, 'w');
	my $head = FileHandle->new($headfile, 'w');
	my $edit = FileHandle->new($editfile, 'w');

	if (not $cols or not $data or not $head or not $edit) {
		$log->error(2, "unable to create database files [$!]");
		return;
	}


	my $db = $self->{order};

	# check integrity
	my $expect = $self->{rows} || @{ $db->[0]{data} };
	foreach my $e (@$db) {
		if (exists($e->{constant})) {
			$e->{data} = [ ($e->{constant}) x $expect ];
		}
		my $length = @{ $e->{data} };
		if ($length != $expect) {
			$log->error(1,
				"column $e->{name} has $length instead of $expect values");
		}
	}


	# populate the column description and header files
	my $index = 0;
	foreach my $e (@$db) {
		$e->{index} = ++$index;

		my $coldesc = "$e->{name} $e->{type}";
		$coldesc .= " $e->{unit}"
			if $e->{unit};

		$cols->print("$coldesc\n");

		$head->print("TDISP$e->{index} = $e->{disp}\n")
			if $e->{disp};
		$head->print("TNULL$e->{index} = $e->{null}\n")
			if $e->{null};

		$edit->print("TTYPE$e->{index} = $e->{name} / $e->{comment}\n")
			if $e->{comment};
	}

	$cols->close;
	$head->close;
	$edit->close;


	# populate the data file

	# every column must either have scalar data or an array of the same size
	if (ref($db->[0]{data})) {

		my $length = @{ $db->[0]{data} };

		for (my $i = 0; $i < $length; ++$i) {
			my $record = join(' ', map { $_->{data}[$i] } @$db);
			$data->print("$record\n");
		}
	}
	else {
		my $record = join(' ', map { $_->{data} } @$db);
		$data->print("$record\n");
	}

	$data->close;

	$log->entry("Create $self->{which} database file.");

	my $create = Util::HEAdas->new('ftcreate')
			->params({
					cdfile => $cdfile,
					headfile => $headfile,
					datafile => $datafile,
					outfile => $outfile,
					clobber => 'yes',
				})
			->run;

	if (-f $editfile) {
		Util::HEAdas->new('fthedit')
			->params({
				infile => $outfile,
				keyword => '@' . $editfile,
			})
			->run;
	}

	unlink $headfile;
	unlink $cdfile;
	unlink $datafile;
	unlink $editfile;

} # end of write method



sub timeString
{
	my ($self, $s) = @_;
	my $date = Util::Date->new($s);
	my $s1 = $date->date;
	my $s2 = $date->time;
	my $str = $s1 ."T". $s2;
	return $str;
}



1;