view release on metacpan or  search on metacpan

lib/Astro/Catalog/IO/Cluster.pm  view on Meta::CPAN

package Astro::Catalog::IO::Cluster;

=head1 NAME

Astro::Catalog::IO::Cluster - Input/Output in ARK Cluster format

=head1 SYNOPSIS

    $catalog = Astro::Catalog::IO::Cluster->_read_catalog(\@lines);
    $lines = Astro::Catalog::IO::Cluster->_write_catalog($catalog, %opts);
    Astro::Catalog::IO::Cluster->_default_file();

=head1 DESCRIPTION

Performs ARK Cluster specific tasks for input/output of ARK Cluster format
files.

=cut

use strict;
use warnings;
use warnings::register;
use Scalar::Util;
use Carp;

use Astro::Catalog;
use Astro::Catalog::Item;
use Astro::Coords;

use Astro::FluxColor;
use Astro::Flux;
use Astro::Fluxes;

use Number::Uncertainty;

use base qw/Astro::Catalog::IO::ASCII/;

use Data::Dumper;

our $VERSION = '4.38';

=begin __PRIVATE_METHODS__

=head1 Private methods

These methods are for internal use only and are called from the
Astro::Catalog module. Its not expected that anyone would want to
call them from utside that module.

=over 4

=item B<_read_cluster>

Parses a reference to an array containing an ARK Cluster format
catalog, returns an Astro::Catalog object.

    $catalog = Astro::Catalog::IO::Cluster->_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 am Astro::Catalog object;
    my $catalog = new Astro::Catalog();

    # loop through lines
    foreach my $i (3 .. $#lines) {
        # remove leading spaces
        $lines[$i] =~ s/^\s+//;

        # split each line
        my @separated = split(/\s+/, $lines[$i]);

        # temporary star object
        my $star = new Astro::Catalog::Item();

        # field
        $star->field($separated[0]);

        # id
        $star->id($separated[1]);

        # ra
        my $objra = "$separated[2] $separated[3] $separated[4]";

        # dec
        my $objdec = "$separated[5] $separated[6] $separated[7]";

        # Assume J2000 and create an Astro::Coords object
        my $coords = new Astro::Coords(
            type  => 'J2000',
            units => 'sex',
            ra    => $objra,
            dec   => $objdec,
            name  => $star->id());

        # and push it into the Astro::Catalog::Item object
        $star->coords($coords);

        # x & y
        if ($separated[8] ne '0.000') {
            $star->x($separated[8]);
        }
        if ($separated[9] ne '0.000') {
            $star->y($separated[9]);
        }

        # number of magnitudes and colours
        $lines[1] =~ s/^\s+//;
        my @colours = split(/\s+/, $lines[1]);

        my @quality;
        my (@colors, @fluxes);
        foreach my $j (0 .. $#colours) {
            # colours have minus signs
            if (lc($colours[$j]) =~ "-") {
                # build a colour object and push it into the @colors array
                my @filters = split "-", $colours[$j];
                my $color = new Astro::FluxColor(
                        upper => new Astro::WaveBand(Filter => $filters[0]),
                        lower => new Astro::WaveBand(Filter => $filters[1]),
                        quantity => new Number::Uncertainty(
                            Value => $separated[3*$j+10],
                            Error => $separated[3*$j+11]));
                push @colors, $color;

                # quality flags
                $quality[$j] = $separated[3*$j+12];
            }
            else {
                my $mag = new Astro::Flux(
                        new Number::Uncertainty(
                            Value => $separated[3*$j+10],
                            Error => $separated[3*$j+11]),
                        'mag', $colours[$j]);
                push @fluxes, $mag;

                # quality flags
                $quality[$j] = $separated[3*$j+12];

                # increment counter
                $j = $j + 2;
            }
        }

        $star->fluxes(new Astro::Fluxes(@fluxes, @colors));

        # set default "good" quality
        $star->quality(0);

        # check and set quality flag
        foreach my $k (0 .. $#colours) {
            # if quality not good then set bad flag
            if (Scalar::Util::looks_like_number($quality[$k])) {
                if (defined $quality[$k] && $quality[$k] != 0) {
                    $star->quality(1);
                }
            }
            else {
                if (defined $quality[$k] && $quality[$k] ne "OO") {
                    $star->quality(1);
                }
            }
        }

        # push it onto the stack
        $catalog->pushstar($star);
    }

    $catalog->origin('IO::Cluster');
    return $catalog;

}

=item B<_write_catalog>

Will write the catalog object to an standard ARK Cluster format file

    $lines = Astro::Catalog::IO::Cluster->_write_catalog($catalog, %opts);

where $catalog is an Astro::Catalog object and allowable options are
currently C<Colours> and C<Mags>, e.g.

    $lines = Astro::Catalog::IO::Cluster->_write_catalog(
        $catalog, Magnitudes => \@mags, Colours => \@colours );

where magnitudes and colours passed in the array will be used in the catalog
despite the presence of other

    my @mags = ('R');
    my @colour = ('B-R', 'B-V');
    \@lines = Astro::Catalog::IO::Cluster->write_catalog(