File Coverage

blib/lib/Astro/Catalog/IO/VOTable.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

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 = "4.31";


# 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-mail]

=cut

# L A S T  O R D E R S ------------------------------------------------------

1;