Astro::Catalog::Query - Base class for Astro::Catalog query objects

  use base qw/ Astro::Catalog::Query /;

package Astro::Catalog::Query;

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

use strict;
use warnings;
use warnings::register;
use vars qw/ $VERSION /;

use File::Spec;
use Carp;

# generic catalog objects
use Astro::Coords;
use Astro::Catalog;
use Astro::Catalog::Star;
'$Revision: 1.8 $ ' =~ /.*:\s(.*)\s\$/ && ($VERSION = $1);

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

  # Configure the object [even if there are no args]
  $block->configure( @_ );

  return $block;

}

sub query_options {
  my $self = shift;
  if (@_) {
    my $opt = lc(shift);
    my %allow = $self->_get_allowed_options;

    if (!exists $allow{$opt}) {
      warnings::warnif("Option $opt not supported by this cataloge");
      return;
    }
    return $self->{OPTIONS}->{$opt};
  }
  return %{ $self->{OPTIONS} };
}

sub ra {
  my $self = shift;

  # SETTING R.A.
  if (@_) {
    # grab the new R.A.
    my $ra = shift;
    $self->_set_query_options( ra => $ra );
  }
  # Return it
  return $self->query_options("ra");
}

sub dec {
  my $self = shift;

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

  return $self->query_options("dec");
}

sub target {
  my $self = shift;

  # SETTING IDENTIFIER
  if (@_) { 

    # grab the new object name
    my $ident = shift;

    # Need to clear RA and Dec iff they are allowed options
    my %allow = $self->_get_allowed_options();

    my %clear;
    $clear{ra} = undef if exists $allow{ra};
    $clear{dec} = undef if exists $allow{dec};

    # Store it in the options table
    $self->_set_query_options(
			      object => $ident,
			      %clear
			     );
  }
  return $self->query_options("object");
}

sub radius {
  my $self = shift;

  if (@_) {
    $self->_set_query_options( radmax => shift );
  }

  return $self->query_options("radmax");
}

sub faint {
  my $self = shift;

  if (@_) {
    $self->_set_query_options( magfaint => shift );
  }

  return $self->query_options("magfaint");
}

sub bright {
  my $self = shift;

  if (@_) {
    $self->_set_query_options( magbright => shift );
  }

  return $self->query_options("magbright");
}

sub sort {
  my $self = shift;

  if (@_) {
    my $sort = shift;
    $self->_set_query_options( sort => $sort );
  }

  # return the sort option
  return $self->query_options("sort");

}

sub number {
  my $self = shift;

  if (@_) {
    $self->_set_query_options( nout => shift );
  }

  return $self->query_options("nout");
}

sub nout {
  my $self = shift;
  warnings::warnif("deprecated","The nout() method is deprecated. Please use number()");
  return $self->number( @_ );
}

sub configure {
  my $self = shift;

  # CONFIGURE DEFAULTS
  # ------------------

  # configure the default options
  $self->_set_default_options();


  # CONFIGURE FROM ARGUMENTS
  # -------------------------

  # return unless we have arguments
  return undef unless @_;

  # grab the argument list
  my %args = Astro::Catalog::_normalize_hash(@_);

  # Grab the allowed options
  my %allow = $self->_get_allowed_options();

  # Loop over the supplied arguments. If they correspond to
  # a method, run it, if they correspond to an option, set it
  for my $key (keys %args) {
    my $lckey = lc($key);
    if ($self->can($lckey)) {
      $self->$lckey( $args{$key} );
    } elsif (exists $allow{$lckey}) {
      # set the option explcitly
      $self->_set_query_options( $lckey => $args{$key} );
    } else {
      #warnings::warnif("Unrecognized option: $key. Ignoring it.");
    }
  }

}

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

sub _set_query_options {
  my $self = shift;
  my %newopt = @_;

  my %allow = $self->_get_allowed_options();

  for my $newkey (keys %newopt) {

    if (!exists $allow{$newkey}) {
      warnings::warnif("Option $newkey not supported by catalog ".
		       ref($self)."\n");
      next;
    }
    # set the option
    $self->{OPTIONS}->{$newkey} = $newopt{$newkey};
  }
  return;
}

sub _get_allowed_options {
  return (
	  ra => 'ra',
	  dec => 'dec',
	  object => 'object',
	  radmax => 'radmax',
	  radmin => 'radmin',
	  width => 'width',
	  height => 'height',
	  magbright => 'magbright',
	  magfaint => 'magfaint',
	  sort => 'sort',
	  nout => 'nout',
	 );
}

sub _get_supported_accessor_options {
  return (
	  ra => 'ra',
	  dec => 'dec',
	  faint => 'magfaint',
	  bright => 'magbright',
	  radius => 'radmax',
	  target => 'object',
	  sort => 'sort',
	  number => 'nout',
	  format => 'format',
  );
}

sub _get_default_options {
  croak "get_default_options must be subclassed";
}

sub _set_default_options {
  my $self = shift;

  # get the defaults
  my %defaults = $self->_get_default_options();

  # set them
  $self->_set_query_options( %defaults );
  return;

}

sub _dump_raw {
   my $self = shift;

   # split the BUFFER into an array
   my @portable = split( /\n/,$self->{BUFFER});
   chomp @portable;

   return @portable;
}

sub _set_raw {
   my $self = shift;
   $self->{BUFFER} = shift;
}

sub _dump_options {
   my $self = shift;

   return $self->query_options;
}

sub _parse_query {
  croak "Query parsing is not generic. Please write one\n";
}

sub _translate_options {
  my $self = shift;

  my %outhash;
  my %allow = $self->_get_allowed_options();
  my %one_one = $self->_translate_one_to_one();

  foreach my $key ( keys %allow ) {
    # Need to translate them...
    my $cvtmethod = "_from_" . $key;
    my ($outkey, $outvalue);
    if ($self->can($cvtmethod)) {
      ($outkey, $outvalue) = $self->$cvtmethod();
    } else {
      # This is the one-to-one mapping section
      # issue a warning if the method has not been declared
      # as supporting that simply mapping
      warnings::warnif("Unable to find translation for key $key. Assuming 1 to 1 mapping.\n")
	  unless exists $one_one{$key};

      # Translate the key and copy the value
      $outkey = $allow{$key};
      $outvalue = $self->query_options($key);
    }
    $outhash{$outkey} = $outvalue;
  }
  return %outhash;
}

sub _translate_one_to_one {
  # convert to a hash-list
  return map { $_, undef }(qw/
			   object radmax radmin magfaint magbright
			   nout format
			   /);
}


# RA and Dec replace spaces with pluses and + sign with special code

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

  # Must replace spaces with +
  $ra =~ s/\s/\+/g if defined $ra;

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

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

  if (defined $dec) {
    # Must replace + with %2B
    $dec =~ s/\+/%2B/g;

    # Must replace spaces with +
    $dec =~ s/\s/\+/g;
  }

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

sub _from_sort {
  my $self = shift;
  my $key = "sort";
  # case insensitive conversion
  my $value = uc($self->query_options($key));

  my $sort;
  # pick an option
  if( $value eq "RA" ) {
    # sort by RA
    $sort = "ra";
  } elsif ( $value eq "DEC" ) {
    # sort by Dec
    $sort = "dec";
  } elsif ( $value eq "RMAG" ) {
    # sort by R magnitude
    $sort = "mr";
  } elsif ( $value eq "BMAG" ) {
    # sort by B magnitude
    $sort = "mb";
  } elsif ( $value eq "DIST" ) {
    # sort by distance from field centre
    $sort = "d";
  } elsif ( $value eq "POS" ) {
    # sort by position angle to field centre
    $sort = "pos";
  } else {
    # in case there are no valid options sort by RA
    warnings::warnif("Unknown sort type [$value]: using ra");
    $sort = "ra";
  }
  my %allow = $self->_get_allowed_options();
  return ($allow{$key}, $sort);
}

# This is a template methdo that can be extended. This one
# implements a one to one mapping

#sub _from_XXX {
#  my $self = shift;
#  my $key = "XXX";
#  my $value = $self->query_options($key);
#  my %allow = $self->_get_allowed_options();
#  return ($allow{$key}, $value);
#}

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

1;