view release on metacpan or  search on metacpan

lib/Astro/Catalog/Query/SuperCOSMOS.pm  view on Meta::CPAN

# to make the regexp more generic. In the interim, I've cut and pasted
# the entire module into this sub-class so I can do queries.
#
# Yes Tim, I know this sucks.

=head1 NAME

Astro::Catalog::Query::SuperCOSMOS - A query request to the SuperCOSMOS catalogue

=head1 SYNOPSIS

    $supercos = new Astro::Catalog::Query::SuperCOSMOS(
            RA     => $ra,
            Dec    => $dec,
            Radius => $radius,
            Nout   => $number_out,
            Colour => $band);

    my $catalog = $supercos->querydb();

=head1 WARNING

This code totally ignores the epoch of the observations and the associated
proper motions, this pretty much means that for astrometric work the catalogs
you get back from the query are pretty much bogus. This should be sorted in
the next distribution.

=head1 DESCRIPTION

The module is an object orientated interface to the online SuperCOSMOS
catalogue using the generic Astro::Catalog::Query::SkyCat class

Stores information about an prospective query and allows the query to
be made, returning an Astro::Catalog::Query::SuperCOSMOS object.

The object will by default pick up the proxy information from the HTTP_PROXY
and NO_PROXY environment variables, see the LWP::UserAgent documentation for
details.

See L<Astro::Catalog::BaseQuery> for the catalog-independent methods.

=cut

use strict;
use warnings;
use warnings::register;
use base qw/Astro::Catalog::Transport::REST/;

use Data::Dumper;
use Carp;
use File::Spec;
use Carp;

# generic catalog objects
use Astro::Catalog;
use Astro::Catalog::Item;

use Astro::Flux;
use Astro::FluxColor;
use Astro::Fluxes;
use Number::Uncertainty;

our $VERSION = '4.38';
our $DEBUG = 0;

# Controls whether we follow 'directory' config entries and recursively
# expand those. Default to false at the moment.
our $FOLLOW_DIRS = 0;

# This is the name of the config file that was used to generate
# the content in %CONFIG. Can be different to the contents ofg_file
# if that
my $CFG_FILE;

# This is the content of the config file
# organized as a hash indexed by remote server shortname
# this has the advantage of removing duplicates
my %CONFIG;

=head1 METHODS

=head2 Constructor

=over 4

=item B<new>

Simple constructor, handles the 'Colour' option, e.g.

    long_name:      SuperCOSMOS catalog - blue (UKJ) southern survey
    short_name:     SSScat_UKJ@WFAU

    long_name:      SuperCOSMOS catalog - red (UKR) southern survey
    short_name:     SSScat_UKR@WFAU

    long_name:      SuperCOSMOS catalog - near IR (UKI) southern survey
    short_name:     SSScat_UKI@WFAU

    long_name:      SuperCOSMOS catalog - red (ESOR) southern survey
    short_name:     SSScat_ESOR@WFAU

    $q = new Astro::Catalog::Query::SuperCOSMOS(colour => 'UKJ', %options);

Allowed options are 'UKJ', 'UKR', 'UKI', and 'ESOR' for the UK Blue, UK Red,
UK near-IR and ESO Red catalogues respectively.

All other options are passed on to SUPER::new().

=cut

sub new {
    my $proto = shift;
    my $class = ref($proto) || $proto;

    # Instantiate via base class
    my $block = $class->SUPER::new( @_ );

    return $block;
}

=back

lib/Astro/Catalog/Query/SuperCOSMOS.pm  view on Meta::CPAN

=cut

sub _parse_query {
    my $self = shift;

    # Get the catalog info
    my $cat = $self->_selected_catalog();

    # and extract formatting information needed by the TST parser
    my %params;
    for my $key (keys %{ $CONFIG{$cat} }) {
        if ($key =~ /_col$/) {
            $params{$key} = $CONFIG{$cat}->{$key};
        }
    }

    # Time to pad the params with known values, this is yet another un-Godly
    # hack for which I'm duely ashamed. God help us if they ever change the
    # catalogs. Why is SuperCOSMOS so much bloody trouble?

    # Make sure we set origin and field centre if we know it
    my $query = new Astro::Catalog(
            Format => 'TST',
            Data => $self->{BUFFER},
            ReadOpt => \%params,
            Origin => $CONFIG{$cat}->{long_name});

    # Grab each star in the catalog and add some value to it
    my $catalog = new Astro::Catalog();
    $catalog->origin($query->origin());
    $catalog->set_coords($query->get_coords()) if defined $query->get_coords();

    my @stars = $query->allstars();

    my (@mags, @cols);
    foreach my $i (0 ... $#stars) {
        my ($cval, $err, $mag, $col);
        my @mags = undef;
        my @cols = undef;

        my $star = $stars[$i];

        # if we have a non-zero quality, set the quality to 1 (this sucks!)
        $star->quality(1) if( $star->quality() != 0 );

        # calulate the errors

        $err = 0.04;
        if ( $star->get_magnitude( "BJ" ) != 99.999 ) {
            $err = 0.04 if $star->get_magnitude( "BJ" ) > 15.0;
            $err = 0.05 if $star->get_magnitude( "BJ" ) > 17.0;
            $err = 0.06 if $star->get_magnitude( "BJ" ) > 19.0;
            $err = 0.07 if $star->get_magnitude( "BJ" ) > 20.0;
            $err = 0.12 if $star->get_magnitude( "BJ" ) > 21.0;
            $err = 0.08 if $star->get_magnitude( "BJ" ) > 22.0;
        }
        else {
            $err = 99.999;
        }
        $mag = new Astro::Flux(new Number::Uncertainty(
                    Value => $star->get_magnitude("BJ"),
                    Error => $err ),
                'mag', 'BJ' );
        push @mags, $mag;

        $err = 0.06;
        if ( $star->get_magnitude( "R1" ) != 99.999 ) {
            $err = 0.06 if $star->get_magnitude( "R1" ) > 11.0;
            $err = 0.03 if $star->get_magnitude( "R1" ) > 12.0;
            $err = 0.09 if $star->get_magnitude( "R1" ) > 13.0;
            $err = 0.10 if $star->get_magnitude( "R1" ) > 14.0;
            $err = 0.12 if $star->get_magnitude( "R1" ) > 18.0;
            $err = 0.18 if $star->get_magnitude( "R1" ) > 19.0;
        }
        else {
            $err = 99.999;
        }
        $mag = new Astro::Flux(new Number::Uncertainty(
                    Value => $star->get_magnitude("R1"),
                    Error => $err),
                'mag', 'R1' );
        push @mags, $mag;

        $err = 0.02;
        if ( $star->get_magnitude( "R2" ) != 99.999 ) {
            $err = 0.02 if $star->get_magnitude( "R2" ) > 12.0;
            $err = 0.03 if $star->get_magnitude( "R2" ) > 13.0;
            $err = 0.04 if $star->get_magnitude( "R2" ) > 15.0;
            $err = 0.05 if $star->get_magnitude( "R2" ) > 17.0;
            $err = 0.06 if $star->get_magnitude( "R2" ) > 18.0;
            $err = 0.11 if $star->get_magnitude( "R2" ) > 19.0;
            $err = 0.16 if $star->get_magnitude( "R2" ) > 20.0;
        }
        else {
            $err = 99.999;
        }
        $mag = new Astro::Flux( new Number::Uncertainty(
                    Value => $star->get_magnitude("R2"),
                    Error => $err ),
                'mag', 'R2' );
        push @mags, $mag;

        $err = 0.05;
        if ( $star->get_magnitude( "I" ) != 99.999 ) {
            $err = 0.05 if $star->get_magnitude( "I" ) > 15.0;
            $err = 0.06 if $star->get_magnitude( "I" ) > 16.0;
            $err = 0.09 if $star->get_magnitude( "I" ) > 17.0;
            $err = 0.16 if $star->get_magnitude( "I" ) > 18.0;
        }
        else {
            $err = 99.999;
        }
        $mag = new Astro::Flux( new Number::Uncertainty(
                    Value => $star->get_magnitude("I"),
                    Error => $err ),
                'mag', 'I' );
        push @mags, $mag;

        # calculate colours UKST Bj - UKST R, UKST Bj - UKST I

        if ($star->get_magnitude( "BJ" ) != 99.999 &&
                $star->get_magnitude( "R2" ) != 99.999) {
            my $bj_minus_r2 = $star->get_magnitude( "BJ" ) -
                $star->get_magnitude( "R2" );
            $bj_minus_r2 =  sprintf("%.4f", $bj_minus_r2 );

            my $delta_bjmr = ( ( $star->get_errors( "BJ" ) )**2.0 +
                    ( $star->get_errors( "R2" ) )**2.0     )** (1/2);
            $delta_bjmr = sprintf("%.4f", $delta_bjmr );

            $cval = $bj_minus_r2;
            $err = $delta_bjmr;
        }
        else {
            $cval = 99.999;
            $err = 99.999;
        }
        $col = new Astro::FluxColor(
                upper => 'BJ',
                lower => "R2",
                quantity => new Number::Uncertainty(
                    Value => $cval,
                    Error => $err ) );
        push @cols, $col;

        if ($star->get_magnitude( "BJ" ) != 99.999 &&
                $star->get_magnitude( "I" ) != 99.999) {

            my $bj_minus_i = $star->get_magnitude( "BJ" ) -
                $star->get_magnitude( "I" );
            $bj_minus_i =  sprintf("%.4f", $bj_minus_i );

            my $delta_bjmi = ( ( $star->get_errors( "BJ" ) )**2.0 +
                    ( $star->get_errors( "I" ) )**2.0     )** (1/2);
            $delta_bjmi = sprintf("%.4f", $delta_bjmi );

            $cval = $bj_minus_i;
            $err = $delta_bjmi;

        }
        else {
            $cval = 99.999;
            $err = 99.999;
        }
        $col = new Astro::FluxColor(
                upper => 'BJ',
                lower => "I",
                quantity => new Number::Uncertainty(
                    Value => $cval,
                    Error => $err ) );
        push @cols, $col;

        # Push the data back into the star object, overwriting ther previous
        # values we got from the initial Skycat query. This isn't a great
        # solution, but it wasn't easy in version 3 syntax either, so I guess
        # your milage may vary.

        my $fluxes = new Astro::Fluxes( @mags, @cols );
        $star->fluxes( $fluxes, 1 );  # the 1 means overwrite the previous values

        # push it onto the stack
        $stars[$i] = $star if defined $star;
    }

    $catalog->allstars( @stars );

    # set the field centre
    my %allow = $self->_get_allowed_options();
    my %field;
    for my $key ("ra","dec","radius") {
        if (exists $allow{$key}) {
            $field{$key} = $self->query_options($key);
        }
    }
    $catalog->fieldcentre( %field );

    return $catalog;
}

=item B<_get_allowed_options>

This method declares which options can be configured by the user
of this service. Generated automatically by the skycat config
file and keyed to the requested catalog.

=cut

sub _get_allowed_options {
    my $self = shift;
    my $cat = $self->_selected_catalog();

    return %{ $CONFIG{$cat}->{allow} };
}

=item B<_get_default_options>

Get the default options that are relevant for the selected
catalog.

    %defaults = $q->_get_default_options();

=cut

sub _get_default_options {
    my $self = shift;

    # Global skycat defaults
    my %defaults = (