Astro::Aladin - Perl class giving access to images and catalogues

  my $aladin = new Astro::Aladin();

  my $aladin = new Astro::Aladin( RA     => $ra, 
                                  Dec    => $dec, 
                                  Radius => $radius );

package Astro::Aladin;

# ---------------------------------------------------------------------------

#+ 
#  Name:
#    Astro::Aladin

#  Purposes:
#    High level Perl class designed to access images and catalogues
#    available using the CDS Aladin Application

#  Language:
#    Perl module

#  Description:
#    This module gives a high level interface to images and catalogues
#    available using the CDS Aladin Application. It sits ontop of the
#    Astro::Aladin::LowLevel module which drives Aladin directly
#    through an anonymous pipe. You should use this module for access 
#    to resources rather than the lower level.


#  Authors:
#    Alasdair Allan (aa@astro.ex.ac.uk)

#  Revision:
#     $Id: Aladin.pm,v 1.3 2003/02/26 19:21:37 aa Exp $

#  Copyright:
#     Copyright (C) 2003 University of Exeter. All Rights Reserved.

#-

# ---------------------------------------------------------------------------

# L O A D   M O D U L E S --------------------------------------------------

use 5.7.3;

use strict;
use vars qw/ $VERSION /;

use File::Spec;
use POSIX qw/sys_wait_h/;
use Errno qw/EAGAIN/;
use Carp;
use threads;
use threads::shared;
use Astro::Aladin::LowLevel;

'$Revision: 1.3 $ ' =~ /.*:\s(.*)\s\$/ && ($VERSION = $1);

# Check for threading
#use Config;
#print "Config: useithreads = " . $Config{'useithreads'} . "\n";
#print "Config: threads::shared loaded\n" if($threads::shared::threads_shared);


# A N O N Y M O U S   S U B R O U T I N E S ---------------------------------

my $threaded_supercos_catalog = sub {
    my ( $ra, $dec, $radius, $band, $file ) = @_;
  
    # create a lowlevel object
    my $aladin = new Astro::Aladin::LowLevel( );

    # grab waveband
    my $waveband = undef;
    if( $band eq "UKST Red" ) {
       $waveband = "2";  
    } elsif ( $band eq "UKST Infrared" ) {
       $waveband = "3";  
    } elsif ( $band eq "ESO Red" ) {
       $waveband = "4";  
    } elsif ( $band eq "POSS-I Red" ) {
       $waveband = "5";  
    } else {
       $waveband = "1"; # Go with default, UKST Blue (Bj)  
    }
    
    # grab catalogue
    $aladin->get( "SSS.cat", [$waveband], "$ra $dec", $radius );
    $aladin->sync();
    $aladin->status();
    $aladin->export( 1, $file );
    $aladin->close();

    return $file;
  
};

# C O N S T R U C T O R ----------------------------------------------------

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

  # bless the query hash into the class
  my $block = bless { RA     => undef,
                      DEC    => undef,
                      RADIUS => undef,
                      BAND   => undef,
                      FIlE   => undef }, $class;

  # Configure the object
  $block->configure( @_ );

  return $block;

}

# Q U E R Y  M E T H O D S ------------------------------------------------

sub ra {
  my $self = shift;

  # SETTING R.A.
  if (@_) { 
    # grab the new R.A.
    $self->{RA} = shift;
  }
  
  return $self->{RA};
}

sub dec { 
  my $self = shift;

  # SETTING DEC
  if (@_) { 
    # grab the new Dec
    $self->{DEC} = shift;
  }

  return $self->{DEC};

}

sub radius {
  my $self = shift;

  if (@_) { 
    $self->{RADIUS} = shift;
  }
  
  return $self->{RADIUS};

}

sub band {
  my $self = shift;

  if (@_) { 
    $self->{BAND} = shift;
  }
  
  return $self->{BAND};

}

sub file {
  my $self = shift;

  if (@_) { 
    $self->{FILE} = File::Spec->catfile( shift );
  }
  
  return $self->{FILE};

}

sub supercos_catalog {
  my $self = shift;
  
  # return unless we have arguements
  return undef unless @_;

  my %args = @_;
  
  # Loop over the allowed keys and modify the default query options
  for my $key (qw / RA Dec Radius Band File/ ) {
      my $method = lc($key);
      $self->$method( $args{$key} ) if exists $args{$key};
  }  
  
  # Check query parameters
  my $ra = $self->{RA};
  my $dec = $self->{DEC};
  my $radius = $self->{RADIUS};
  my $band = $self->{BAND};
  my $file = $self->{FILE};

  # return undef if we're missing stuff
  return undef unless ( $ra && $dec && $radius && $band && $file );

  my $status = "bibble";

  share( $ra );
  share( $dec );
  share( $radius );
  share( $band );
  share( $file );
  share( $status );

  my $supercos_thread = threads->create( sub { 
  
     $status = &$threaded_supercos_catalog( $ra, $dec, $radius, $band, $file ); 
  });   
  
  # wait for the supercos thread to join
  $supercos_thread->join();
  
  # return the status, with luck this will be set to $file, however
  # if we get an error (and sucessfully pick up on it) it will be undef
  return $status;
  
}

# C O N F I G U R E -------------------------------------------------------

sub configure {
  my $self = shift;
  

  # CONFIGURE FROM ARGUEMENTS
  # -------------------------

  # return unless we have arguments
  return undef unless @_;
  
  # configure the default options
  $self->{RA}     = undef;
  $self->{DEC}    = undef;
  $self->{RADIUS} = 10;
  $self->{BAND}   = undef;
  $self->{FILE}   = undef;
  
  # grab the argument list
  my %args = @_;

  # Loop over the allowed keys and modify the default query options
  for my $key (qw / RA Dec Radius Band File / ) {
      my $method = lc($key);
      $self->$method( $args{$key} ) if exists $args{$key};
  }  

}

# T I M E   A T   T H E   B A R  --------------------------------------------

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

1;