package Astro::Catalog::IO::Simple;
=head1 NAME
Astro::Catalog::IO::Simple - Simple Input/Output format
=head1 SYNOPSIS
$catalog = Astro::Catalog::IO::Simple->_read_catalog( \@lines );
\@lines = Astro::Catalog::IO::Simple->_write_catalog( $catalog );
Astro::Catalog::IO::Cluster->_default_file();
=head1 DESCRIPTION
Performs simple IO, reading or writing "id_string hh mm ss.s +dd mm ss.s"
formated strings for each Astro::Catalog::Star object in the catalog.
=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 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: Simple.pm,v 1.6 2005/03/31 01:24:53 cavanagh 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::Simple->_read_catalog( \@lines );
=cut
sub _read_catalog {
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();
# loop through lines
MAINLOOP:
foreach my $i ( 0 .. $#lines ) {
# Skip commented and blank lines
next if ($lines[$i] =~ /^\s*[\#\*\%]/);
next if ($lines[$i] =~ /^\s*$/);
# temporary star object
my $star = new Astro::Catalog::Star();
# Use a pattern match parser
my @match = ( $lines[$i] =~ m/^(.*?) # Target name (non greedy)
\s* # optional trailing space
(\d{1,2}) # 1 or 2 digits [RA:h] [greedy]
[:\s]+ # separator
(\d{1,2}) # 1 or 2 digits [RA:m]
[:\s]+ # separator
(\d{1,2}(?:\.\d*)?) # 1|2 digits opt .fraction [RA:s]
# no capture on fraction
[:\s]+
([+-]?\s*\d{1,2}) # 1|2 digit [dec:d] inc sign
[:\s]+
(\d{1,2}) # 1|2 digit [dec:m]
[:\s]+
(\d{1,2}(?:\.\d*)?) # arcsecond (optional fraction)
# no capture on fraction
\s*
(RB|RJ|AZ|GA|AZEL|J2000|B1950|Galactic)? # coordinate type
# most everything else is optional
\s*
(?:\#\s*(.*))?$ # comment [8]
/xi);
# Abort if we do not have matches for the first 8 fields
# type is optional
for (0 ... 6) {
next MAINLOOP unless defined $match[$_];
}
# Read the values
my $target = $match[0];
my $ra = join(":",@match[1..3]);
my $dec = join(":",@match[4..6]);
$dec =~ s/\s//g; # remove space between the sign and number
# Type defaults to J2000
my $type = $match[7] || "J2000";
$type = uc($type);
# Comment can be undefined
my $comment = $match[8];
# push the target id
$star->id( $target );
# push the comment
$star->comment( $comment ) if defined $comment;
# Allow simple mapping of TYPE from JCMT abbreviations.
# This does not hurt things or break simplicity of the format.
# The form of the hash depends on the type
my %c;
if ($type =~ /(RB|RJ|J2000|B1950)/ ) {
# Standard RADEC
$c{ra} = $ra;
$c{dec} = $dec;
if ($type =~ /B/) {
$c{type} = "B1950";
} else {
$c{type} = "J2000";
}
} elsif ($type =~ /^(GA|SUPERGAL)/) {
$c{long} = $ra;
$c{lat} = $dec;
if ($type =~ /S/) {
$c{type} = "SUPERGALACTIC";
} else {
$c{type} = "GALACTIC";
}
} elsif ($type =~ /^AZ/) {
$c{az} = $ra;
$c{el} = $dec;
} else {
croak "Unexpected coordinate type: $type\n";
}
# Assume J2000 and create an Astro::Coords object
my $coords = new Astro::Coords( units => 'sex',
name => $star->id(),
%c );
croak "Error creating coordinate object from $ra / $dec "
unless defined $coords;
# and push it into the Astro::Catalog::Star object
$star->coords( $coords );
# push it onto the stack
$catalog->pushstar( $star );
}
$catalog->origin( 'IO::Simple' );
return $catalog;
}
=item B<_write_catalog>
Will write the catalogue object to an simple output format
\@lines = Astro::Catalog::IO::Simple->_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;
# write header
# ------------
my @output;
my $output_line;
push (@output, "# Catalog written automatically by class ". __PACKAGE__ ."\n");
push (@output, "# on date " . gmtime . "UT\n" );
push (@output, "# Origin of catalogue: ". $catalog->origin ."\n");
# write body
# ----------
# Keep track of star count for unnamed stars
my $starcnt = 0;
# loop through all the stars in the catalogue
foreach my $star ($catalog->stars) {
# Extract the information into an array for later formatting
my @chunks;
my $comment; # in case we need to create a whole comment line
# Star ID
push(@chunks, (defined $star->id() ? $star->id : $starcnt));
# Get the coordinate information
my $c = $star->coords;
if (defined $c) {
my $type = $c->type;
if ($type eq 'RADEC') {
# Standard J2000
push(@chunks, $c->ra(format=>'s'),$c->dec(format=>'s'), "J2000");
} elsif ($type eq 'FIXED') {
push(@chunks, $c->az(format=>'s'),$c->el(format=>'s'),"AZEL");
} else {
$comment = "Can not represent star $chunks[0] in catalogue since it is of type $type";
}
} else {
$comment = "Star $chunks[0] has no coordinates.";
}
# now the line. If we have comment set this is just a comment line
if (defined $comment) {
push(@output, "# $comment");
} else {
my $cmt = '';
$cmt = " # " .$star->comment()
if $star->comment();
push(@output, sprintf("%-15s %s %s %s", @chunks) . $cmt);
}
}
# clean up
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
The Simple format is defined as follows: Any line that looks like
ID HH MM SS.SS +/-DD MM SS.SS TYPE # Comment
will be matched. A space is allowed between the sign and the
declination. The type is optional (as is the comment) and
can be one of J2000, B1950, GALACTIC, AZEL or SUPERGALACTIC
or the JCMT abbreviations (RJ, RB, GA or AZ). If TYPE is not
present J2000 is assumed.
=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>
Tim Jenness E<lt>tjenness@cpan.orgE<gt>
=cut
# L A S T O R D E R S ------------------------------------------------------
1;