Astro::Aladin::LowLevel - Perl class designed to drive CDS Aladin Application

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

package Astro::Aladin::LowLevel;

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

#+ 
#  Name:
#    Astro::Aladin::LowLevel

#  Purposes:
#    Perl class designed to drive the standalone CDS Aladin Application

#  Language:
#    Perl module

#  Description:
#    This module drives the CDS Aladin Java application through an
#    anonymous pipe. 
#
#    This isn't an optimal solution, its a kludge hack and I hope
#    nobody I know is reading the code. There is a higher level class
#    full of convience methods for a reason. Use it!

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

#  Revision:
#     $Id: LowLevel.pm,v 1.2 2003/02/24 22:45:56 aa Exp $

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

#-

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

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

use strict;
use vars qw/ $VERSION /;

use File::Spec;
use Carp;

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

# G L O B A L  V A R I A B L E ---------------------------------------------

# Don't know off the top of my head how to bless a typeglob into an
# class. For now we're going to use a global scalar and carry the
# filehandle around in that. This is a not nice kludge, but then
# the entire modle is fairly icky so do I really care at this point?
my $ALADIN = undef;

# 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 { DUMMY  => undef }, $class;

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

  return $block;

}

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

sub close {
  my $self = shift;

  # set the "quit" command to Aladin
  print $ALADIN "quit\n";
  
  # close the pipe
  close( $ALADIN );
  $ALADIN = undef;

}

sub reopen {
  my $self = shift;

  # check that the pipe is closed and undefined
  unless ( defined $self->{PIPE} ) {
     
     my $aladin_jar;
     if ( defined $ENV{"ALADIN_JAR"} ) { 
         $aladin_jar = File::Spec->catfile($ENV{"ALADIN_JAR"});
     } else {
         croak( "Error: Environment variable \$ALADIN_JAR not defined".
                " see package README file");
     }
  
     # open the pipe to the application
     $ENV{ALADIN_MEM} = "128m" unless defined $ENV{ALADIN_MEM};
     open( $ALADIN ,"| java -mx$ENV{ALADIN_MEM} -jar $ENV{ALADIN_JAR} -script" );
     return;  
  }   

  return undef;
}

sub status {
  my $self = shift;

  # set the "status" command to Aladin
  print $ALADIN "status\n";

}

sub sync {
  my $self = shift;

  # set the "sync" command to Aladin
  print $ALADIN "sync\n";

}

sub export {
  my $self = shift;
  my $number = shift;
  my $file = shift;

  # set the "export" command to Aladin
  print $ALADIN "export $number $file\n";

}

sub get {
  my ( $self, $server, $args_ref, $object, $radius );

  # Parse the incoming arguements and see whether we have
  # any arguements to pass to the image/catalog server
  if( scalar @_  == 5 ) {
    ( $self, $server, $args_ref, $object, $radius ) = @_;
  } elsif( scalar @_  == 4 ) {
    ( $self, $server, $args_ref, $object ) = @_;
  } elsif (  scalar @_  == 3 ) {
    ( $self, $server, $object ) = @_;
    $args_ref = [""];
  }
    
  # Call the _get() private method
  _get( $server, $args_ref, $object, $radius );

}


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

sub configure {
  my $self = shift;

  # Call the reopen() method to open the anonymous pipe
  reopen();

}

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

sub _get {
  my ( $server, $args_ref, $object, $radius ) = @_;
  
  # Grab the args array 
  my @args = @{$args_ref};
  
  # process the args array
  my $args_string = "";
  
  for my $i ( 0 .. $#args ) {
    if( $i == 0 ) {
       $args_string = $args[$i];
    } else {
       $args_string = "," . $args[$i];
    }      
  }
  
  
  # set the "status" command to Aladin
  if( $args_string eq "" ) {
     unless ( $radius ) {
        print "Sending: get $server() $object\n";
        print $ALADIN "get $server() $object\n";
     } else {
        print "Sending: get $server() $object $radius"."arcmin\n";
        print $ALADIN "get $server() $object $radius"."arcmin\n";
     }  
  } else {
     unless ( $radius ) {
        print "Sending: get $server($args_string) $object\n";
        print $ALADIN "get $server($args_string) $object\n";
     } else {
        print "Sending: get $server($args_string) $object $radius"."arcmin\n";
        print $ALADIN "get $server($args_string) $object $radius"."arcmin\n";
     } 
  }
  
}

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

1;