package Util::FITStable; ############################################################################## # # DESCRIPTION: This class is used for constructing fits tables # # HISTORY: # HISTORY: $Log: FITStable.pm,v $ # 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) = @_; 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)) { 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 $cols = FileHandle->new($cdfile, 'w'); my $data = FileHandle->new($datafile, 'w'); my $head = FileHandle->new($headfile, 'w'); if (not $cols or not $data or not $head) { $log->error(2, "unable to create database file [$!]"); return; } my $db = $self->{order}; # check integrity my $expect = @{ $db->[0]{data} }; foreach my $e (@$db) { 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}; } $cols->close; $head->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; unlink $headfile; unlink $cdfile; unlink $datafile; } # 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 = qq('$s1 $s2'); return $str; } 1;