view release on metacpan or  search on metacpan

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

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

=head2 Accessor methods

=over 4

=item B<_selected_catalog>

Catalog name selected by the user and currently configured for
this object. Not to be used outside this class..

=cut

sub _selected_catalog {
    my $self = shift;
    if (@_) {
        # The class has to be configured as a hash!!!
        $self->{SKYCAT_CATALOG} = shift;
    }

    return $self->{SKYCAT_CATALOG};
}

=back

=head2 General methods

=over 4

=item C<configure>

Configure the object. This calls the base class configure , after it has
made sure that a sky cat config file has been read (otherwise we will
not be able to vet the incoming arguments.

=cut

sub configure {
    my $self = shift;

    # load a config if we do not have one read yet
    # Note that this may force a remote URL read via directory
    # directives even though we do not have a user agent configured...
    $self->_load_config() unless %CONFIG;

    # Error if we have no config yet
    croak "Error instantiating SuperCOSMOS object since no config was located"
    unless %CONFIG;

    # Now we need to configure this object based on the
    # supplied catalog name. This is not really a public interface
    # let's call it a protected interface available to subclases
    # even though we are not technically a subclass...
    my %args = Astro::Catalog::_normalize_hash(@_);

    croak "A colour must be provided using the 'colour' key"
        unless exists $args{colour};

    # case-insensitive
    my $colour = lc($args{colour});

    if ($colour eq 'ukj') {
        $self->_selected_catalog('ssscat_ukj@wfau');

    }
    elsif ($colour eq 'ukr') {
        $self->_selected_catalog('ssscat_ukr@wfau');

    }
    elsif ($colour eq 'uki') {
        $self->_selected_catalog('ssscat_uki@wfau');

    }
    elsif ($colour eq 'esor') {
        $self->_selected_catalog('ssscat_esor@wfau');

    }
    else {
        # default to UKR
        $self->_selected_catalog('SSScat_UKR@WFAU');
    }

    # Configure
    $self->SUPER::configure(%args);
}

=item B<_build_query>

Construct a query URL based on the options.

    $url = $q->_build_query();

=cut

sub _build_query {
    my $self = shift;

    my $cat = $self->_selected_catalog();

    # Get the URL
    my $url = $CONFIG{$cat}->{url};

    # Translate all the options to the internal skycat format
    my %translated = $self->_translate_options();

    # Now for each token replace it in the URL
    for my $key (keys %translated) {
        my $tok = "%". $key;
        croak "Token $tok is mandatory but was not specified"
            unless defined $translated{$key};
        $url =~ s/$tok/$translated{$key}/;
    }

    return $url;
}


=item B<_parse_query>

All the SkyCat servers return data in TST format.
Need to make sure that column information is passed
into the TST parser.

=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

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

=back

=head2 Translations

SkyCat specific translations from the internal format to URL format
go here.

RA/Dec must match format described in
http://vizier.u-strasbg.fr/doc/asu.html
(at least for GSC) ie  hh:mm:ss.s+/-dd:mm:ss
or decimal degrees.

=over 4

=cut

sub _from_dec {
    my $self = shift;
    my $dec = $self->query_options("dec");
    my %allow = $self->_get_allowed_options();

    # Need colons
    $dec =~ s/\s+/:/g;

    # Need a + preprended
    $dec = "+" . $dec if $dec !~ /^[\+\-]/;

    return ($allow{dec},$dec);
}

sub _from_ra {
    my $self = shift;
    my $ra = $self->query_options("ra");
    my %allow = $self->_get_allowed_options();

    # need colons
    $ra =~ s/\s+/:/g;

    return ($allow{ra},$ra);
}

=item B<_translate_one_to_one>

Return a list of internal options (as defined in C<_get_allowed_options>)
that are known to support a one-to-one mapping of the internal value
to the external value.

    %one = $q->_translate_one_to_one();

Returns a hash with keys and no values (this makes it easy to
check for the option).

This method also returns, the values from the parent class.

=cut

sub _translate_one_to_one {
    my $self = shift;
    # convert to a hash-list
    return ($self->SUPER::_translate_one_to_one,
            map { $_, undef }(qw/
                cond
                /)
           );
}

1;

__END__

=back

=end __PRIVATE_METHODS__

=head1 COPYRIGHT

Copyright (C) 2001 University of Exeter. All Rights Reserved.
Some modifications copyright (C) 2003 Particle Physics and Astronomy
Research Council. All Rights Reserved.

This program was written as part of the eSTAR project 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