package Astro::Catalog::IO::VOTable;
=head1 NAME
Astro::Catalog::IO::VOTable - VOTable Input/Output format
=head1 SYNOPSIS
$catalog = Astro::Catalog::IO::VOTable->_read_catalog( \@lines );
\@lines = Astro::Catalog::IO::VOTable->_write_catalog( $catalog );
Astro::Catalog::IO::VOTable->_default_file();
=head1 DESCRIPTION
Performs simple IO, reading or writing a VOTable.
=cut
# L O A D M O D U L E S --------------------------------------------------
use 5.006;
use strict;
use warnings;
use warnings::register;
use vars qw/ $VERSION /;
use Carp;
use Astro::Catalog;
use Astro::Catalog::Star;
use Astro::Coords;
use Astro::Flux;
use Astro::FluxColor;
use Astro::Fluxes;
use Astro::VO::VOTable::Document;
use base qw/ Astro::Catalog::IO::ASCII /;
use Data::Dumper;
$VERSION = "2.00";
# C O N S T R U C T O R ----------------------------------------------------
=head1 REVISION
$Id: VOTable.pm,v 1.10 2005/06/15 19:03:42 aa Exp $
=begin __PRIVATE_METHODS__
=head1 Private methods
These methods are for internal use only and are called from the
Astro::Catalog module. It is not expected that anyone would want to
call them from outside that module.
=over 4
=item B<_read_catalog>
Parses a reference to an array containing a simply formatted catalogue
$catalog = Astro::Catalog::IO::VOTable->_read_catalog( \@lines );
=cut
sub _read_catalog {
#croak( 'Astro::IO::VOTable, _read_catalog() - Function not implemented' );
croak( 'Usage: _read_catalog( \@lines )' ) unless scalar(@_) >= 1;
my $class = shift;
my $arg = shift;
my @lines = @{$arg};
# create an Astro::Catalog object;
my $catalog = new Astro::Catalog();
# make the array a string
my $string = "";
foreach my $i ( 0 ... $#lines ) {
$string = $string . $lines[$i] . "\n";
}
#print Dumper( @lines );
#print Dumper( $string );
#return;
# create a VOTable object from the string.
my $doc = Astro::VO::VOTable::Document->new_from_string($string);
# Get the VOTABLE element.
my $votable = ($doc->get_VOTABLE())[0];
# Get the RESOURCE element.
my $resource = ($votable->get_RESOURCE())[0];
# Get the DESCRIPTION element and its contents.
my $description = ($resource->get_DESCRIPTION())[0];
# Get the DEFINITIONS element and its contents.
my $definitions = ( $votable->get_DEFINITIONS())[0];
# Get the coordinate system (COOSYS) and its contents.
my $coosys = ( $definitions->get_COOSYS())[0];
# ...and the equinox and epoch and system. I LOVE VOTABLE.
my $equinox = $coosys->get_equinox();
my $epoch = $coosys->get_epoch();
my $system = $coosys->get_system();
if( $system =~ /fk4/i ) {
$equinox = "B" . $equinox;
} else {
$equinox = "J" . $equinox;
}
# Get the TABLE element.
my $table = ($resource->get_TABLE())[0];
# Get the FIELD elements.
my (@field_names, @field_ucds, @field_datatypes, @field_units, @field_sizes);
foreach my $field ( $table->get_FIELD()) {
push @field_names, $field->get_name();
push @field_ucds, $field->get_ucd();
push @field_datatypes, $field->get_datatype();
push @field_units, $field->get_unit();
push @field_sizes, $field->get_arraysize();
}
# Get the DATA element.
my $data = ($table->get_DATA())[0];
# Get the TABLEDATA element.
my $tabledata = ($data->get_TABLEDATA())[0];
# loop round UCDs and try and figure out what everthing is so
# we can stuff the table contents into the relevant places
my %contents;
foreach my $i ( 0 ... $#field_ucds ) {
$contents{"id"} = $i if $field_ucds[$i] =~ "ID_MAIN";
$contents{"ra"} = $i if $field_ucds[$i] =~ "POS_EQ_RA_MAIN";
$contents{"dec"} = $i if $field_ucds[$i] =~ "POS_EQ_DEC_MAIN";
$contents{"quality"} = $i if $field_ucds[$i] =~ "CODE_QUALITY";
if( $field_ucds[$i] =~ "PHOT_" ) {
$contents{ $field_ucds[$i] } = $i;
}
$contents{"parallax"} = $i if $field_ucds[$i] =~ "POS_EQ_PLX_FACTOR";
$contents{"pm_dec"} = $i if $field_ucds[$i] =~ "POS_EQ_PMDEC";
$contents{"pm_ra"} = $i if $field_ucds[$i] =~ "POS_EQ_PMRA";
}
# loop over each row in the TABLEDATA (ie each star)
foreach my $j ( 0 ... $tabledata->get_num_rows()-1 ) {
# grab a row
my @row = $tabledata->get_row($j);
#print "# ROW $j\n";
#print Dumper( @row ) . "\n";
# loop around the contents and grab the magnitudes and colours
my ( @fluxes, @colours );
foreach my $key ( keys %contents ) {
# drop through unless we have a magntiude
next unless $key =~ "PHOT";
my $identifier = $key;
$identifier =~ s/^PHOT_[A-Z]+_//;
# okay we either have a magnitude or a colour, why did I ever
# make these two different things? Maybe I should re-engineer
# the Astro::Catalog::Star so that it hides the difference in
# some sort of meta API for both? Oh God this is so yuck...
# colours
if ( $identifier =~ /^(\w+)-(\w+)$/ ) { # non-greedy
# we might have a colour, who knows?
#print "COLOUR IN COLUMN $contents{$key}\n";
#$colours{$identifier} = $row[$contents{$key}];
my $color = new Astro::FluxColor(
upper => new Astro::WaveBand( Filter => $1 ),
lower => new Astro::WaveBand( Filter => $2 ),
quantity => $row[$contents{$key}] );
unshift @colours, $color; # I don't understand why I have
# to unshift here rather than
# push, this is oddly disturbing
} else {
# we might have a magnitude, who knows?
#print "MAGNITUDE IN COLUMN $contents{$key}\n";
#$mags{$identifier} = $row[$contents{$key}];
my $flux = new Astro::Flux( $row[$contents{$key}],
'mag', $identifier );
push @fluxes, $flux;
}
}
my $fluxes = new Astro::Fluxes( @fluxes, @colours );
# Set defaults for the proper motions and parallax.
my $pm_dec = ( exists( $contents{"pm_dec"} ) && defined( $contents{"pm_dec"} ) ? $row[$contents{"pm_dec"}] : undef );
my $pm_ra = ( exists( $contents{"pm_ra"} ) && defined( $contents{"pm_ra"} ) ? $row[$contents{"pm_ra"}] : undef );
my @pm;
if( ! defined( $pm_dec ) && ! defined( $pm_ra ) ) {
@pm = ();
} else {
@pm = ( $pm_ra, $pm_dec );
}
my $parallax = ( exists( $contents{"parallax"} ) && defined( $contents{"parallax"} ) ? $row[$contents{"parallax"}] : undef );
# Create an Astro::Coords object for the star.
my $coords = new Astro::Coords( ra => $row[$contents{"ra"}],
dec => $row[$contents{"dec"}],
type => $equinox,
epoch => $epoch,
pm => \@pm,
parallax => $parallax,
units => 's',
);
# create a star
my $star = new Astro::Catalog::Star(
id => $row[$contents{"id"}],
coords => $coords,
#magnitudes => \%mags,
#colours => \%colours,
fluxes => $fluxes,
quality => $row[$contents{"quality"}] );
# push the star onto the catalog
$catalog->pushstar( $star );
}
# return the catalogue
$catalog->origin( 'IO::VOTable' );
return $catalog;
}
=item B<_write_catalog>
Will write the catalogue object to an simple output format
\@lines = Astro::Catalog::IO::VOTable->_write_catalog( $catalog );
where $catalog is an Astro::Catalog object.
=cut
sub _write_catalog {
croak ( 'Usage: _write_catalog( $catalog )') unless scalar(@_) >= 1;
my $class = shift;
my $catalog = shift;
# debugging, drop the catalogue to disk as it flys right by...
#use Data::Dumper;
#print "Dumping Catalogue to disk 'catalog_dump.cat'\n";
#my $status = open my $fh, ">catalog_dump.cat";
#if (!$status) {
# print "Error: cannot open dump file catalog_dump.cat\n";
# return;
#}
#print $fh Dumper($catalog);
#close( $fh );
# real list of filters and colours in the catalogue
my @mags = $catalog->starbyindex(0)->what_filters();
my @cols = $catalog->starbyindex(0)->what_colours();
# number of stars in catalogue
my $number = $catalog->sizeof();
# number of filters & colours
my $num_mags = $catalog->starbyindex(0)->what_filters();
my $num_cols = $catalog->starbyindex(0)->what_colours();
# reference to the $self->{STARS} array in Astro::Catalog
my $stars = $catalog->stars();
# generate the field headers
# --------------------------
my (@field_names, @field_ucds, @field_datatypes, @field_units, @field_sizes);
# field names
push @field_names, "Identifier";
push @field_names, "RA";
push @field_names, "Dec";
foreach my $i ( 0 .. $#mags ) {
push @field_names, $mags[$i] . " Magnitude";
push @field_names, $mags[$i] . " Error";
}
foreach my $i ( 0 .. $#cols ) {
push @field_names, $cols[$i] . " Colour";
push @field_names, $cols[$i] . " Error";
}
push @field_names, "Quality";
# field ucds
push @field_ucds, "ID_MAIN";
push @field_ucds, "POS_EQ_RA_MAIN";
push @field_ucds, "POS_EQ_DEC_MAIN";
foreach my $i ( 0 .. $#mags ) {
push @field_ucds, "PHOT_MAG_" . $mags[$i];
#push @field_ucds, "PHOT_MAG_" . $mags[$i] . "_ERROR";
push @field_ucds, "CODE_ERROR";
}
foreach my $i ( 0 .. $#cols ) {
push @field_ucds, "PHOT_CI_" . $cols[$i];
#push @field_ucds, "PHOT_CI_" . $cols[$i] . "_ERROR";
push @field_ucds, "CODE_ERROR";
}
push @field_ucds, "CODE_QUALITY";
# field datatypes
push @field_datatypes, "char";
push @field_datatypes, "char";
push @field_datatypes, "char";
foreach my $i ( 0 .. $#mags ) {
push @field_datatypes, "double";
push @field_datatypes, "double";
}
foreach my $i ( 0 .. $#cols ) {
push @field_datatypes, "double";
push @field_datatypes, "double";
}
push @field_datatypes, "int";
# field units
push @field_units, "";
push @field_units, '"h:m:s.ss"';
push @field_units, '"d:m:s.ss"';
foreach my $i ( 0 .. $#mags ) {
push @field_units, "mag";
push @field_units, "mag";
}
foreach my $i ( 0 .. $#cols ) {
push @field_units, "mag";
push @field_units, "mag";
}
push @field_units, "";
# array size
push @field_sizes, "*";
push @field_sizes, "*";
push @field_sizes, "*";
# generate the data table
# -----------------------
my @data;
foreach my $star ( 0 .. $#$stars ) {
my @row;
# Check to see if we should be writing out the proper motions
# and parallax.
my $coords = ${$stars}[$star]->coords;
if( scalar( $coords->pm ) ) {
push @field_names, "RA Proper Motion";
push @field_names, "Dec Proper Motion";
push @field_ucds, "POS_EQ_PMRA";
push @field_ucds, "POS_EQ_PMDEC";
push @field_datatypes, "double";
push @field_datatypes, "double";
push @field_units, "arcsec/yr";
push @field_units, "arcsec/yr";
}
if( defined( $coords->parallax ) ) {
push @field_names, "Parallax";
push @field_ucds, "POS_EQ_PLX_FACTOR";
push @field_datatypes, "double";
push @field_units, "arcsec";
}
# id
if ( defined ${$stars}[$star]->id() ) {
push @row, ${$stars}[$star]->id();
} else {
push @row, $star;
}
# ra & dec -- we want these in J2000.
push @row, $coords->ra2000(format => 's');
push @row, $coords->dec2000(format => 's');
# magnitudes
foreach my $i ( 0 .. $#mags ) {
if ( defined ${$stars}[$star]->get_magnitude($mags[$i]) ) {
push @row, ${$stars}[$star]->get_magnitude($mags[$i]);
} else {
push @row, "0.000";
}
if ( defined ${$stars}[$star]->get_errors($mags[$i]) ) {
push @row, ${$stars}[$star]->get_errors($mags[$i]);
} else {
push @row, "0.000";
}
}
# colours
foreach my $i ( 0 .. $#cols ) {
if ( defined ${$stars}[$star]->get_colour($cols[$i]) ) {
push @row, ${$stars}[$star]->get_colour($cols[$i]);
} else {
push @row, "0.000";
}
if ( defined ${$stars}[$star]->get_colourerr($cols[$i]) ) {
push @row, ${$stars}[$star]->get_colourerr($cols[$i]);
} else {
push @row, "0.000";
}
}
# quality
if ( defined ${$stars}[$star]->quality() ) {
push @row, ${$stars}[$star]->quality();
} else {
push @row, "0";
}
# Proper motions and parallax
if( defined ${$stars}[$star]->coords ) {
my $coords = ${$stars}[$star]->coords;
my @pm = $coords->pm;
push @row, $pm[0];
push @row, $pm[1];
push @row, $coords->parallax;
}
# push a reference to the row into the data
push @data, \@row;
} # end of loop around the stars array
# Create the VOTABLE document.
my $doc = new Astro::VO::VOTable::Document();
# Get the VOTABLE element.
my $votable = ($doc->get_VOTABLE)[0];
# Create the DESCRIPTION element and its contents, and add it to the VOTABLE
my $description = new Astro::VO::VOTable::DESCRIPTION();
$description->set('Created using Astro::Catalog::IO::VOTable');
$votable->set_DESCRIPTION($description);
# Create a DEFINITION element and its contents and add it to the VOTABLE
my $definitions = new Astro::VO::VOTable::DEFINITIONS();
my $coosys = new Astro::VO::VOTable::COOSYS();
$coosys->set_ID( "J2000" );
$coosys->set_equinox( 2000.0 );
$coosys->set_epoch( 2000.0 );
$coosys->set_system( 'eq_FK5' );
$definitions->set_COOSYS( $coosys );
$votable->set_DEFINITIONS( $definitions );
# Create the RESOURCE element and add it to the VOTABLE.
my $resource = new Astro::VO::VOTable::RESOURCE();
$votable->set_RESOURCE($resource);
#create the LINK element and its contents, and add it to the VOTABLE
my $link = new Astro::VO::VOTable::LINK();
$link->set_title('eSTAR Project');
$link->set_href('http://www.estar.org.uk/');
$link->set_content_role('doc');
$resource->set_LINK($link);
# Create the TABLE element and add it to the RESOURCE.
my $table = new Astro::VO::VOTable::TABLE();
$resource->set_TABLE($table);
# Create and add the FIELD elements to the TABLE.
my($i);
my($field);
for ($i = 0; $i < @field_names; $i++) {
$field = new Astro::VO::VOTable::FIELD();
$field->set_name($field_names[$i]);
$field->set_ucd($field_ucds[$i]);
$field->set_datatype($field_datatypes[$i]);
$field->set_unit($field_units[$i]);
$field->set_arraysize($field_sizes[$i]) if defined $field_sizes[$i];
$table->append_FIELD($field);
}
# Create and append the DATA element.
my $data = new Astro::VO::VOTable::DATA();
$table->set_DATA($data);
# Create and append the TABLEDATA element.
my $tabledata = new Astro::VO::VOTable::TABLEDATA();
$data->set_TABLEDATA($tabledata);
# Create and append each TR element, and each TD element.
my($tr, $td);
my($j);
for ($i = 0; $i < @data; $i++) {
$tr = new Astro::VO::VOTable::TR();
for ($j = 0; $j < @field_names; $j++) {
$td = new Astro::VO::VOTable::TD();
$td->set($data[$i][$j]);
$tr->append_TD($td);
}
$tabledata->append_TR($tr);
}
# Print the finished document.
my $output_string = $doc->toString(1);
my @output = split("\n", $output_string );
#print $output_string;
#use Data::Dumper; print Dumper(@output);
# return a reference to an array
return \@output;
}
=item B<_default_file>
If Astro::Catalog is created with a Format but no Filename or other data
source it checked this routine to see whether there is a default file
that should be read. This is mainly for Astro::Catalo::IO::JCMT and the
JAC, but might prive useful elsewhere.
=cut
sub _default_file {
# returns an empty list
return;
}
=back
=end __PRIVATE_METHODS__
=head1 FORMAT
This class implements an interface to VOTable documents. This uses the
GSFC VOTable classes which inherits from XML::LibXML::Document class.
=head1 COPYRIGHT
Copyright (C) 2001-2003 University of Exeter. All Rights Reserved.
Some modificiations Copyright (C) 2003 Particle Physics and Astronomy
Research Council. All Rights Reserved.
This module was written as part of the eSTAR project in collaboration
with the Joint Astronomy Centre (JAC) in Hawaii and is free software;
you can redistribute it and/or modify it under the terms of the GNU
Public License.
=head1 AUTHORS
Alasdair Allan E<lt>aa@astro.ex.ac.ukE<gt>
=cut
# L A S T O R D E R S ------------------------------------------------------
1;