Astro::SIMBAD::Query - Object definining an prospective SIMBAD query.
Index
Code Index:
NAME
Astro::SIMBAD::Query - Object definining an prospective SIMBAD query.
SYNOPSIS
$query = new Astro::SIMBAD::Query( Target => $object,
RA => $ra,
Dec => $dec,
Error => $radius,
Units => $radius_units,
Frame => $coord_frame,
Epoch => $coord_epoch,
Equinox => $coord_equinox,
Proxy => $proxy,
Timeout => $timeout,
URL => $alternative_url );
my $results = $query->querydb();
$other = new Astro::SIMBAD::Query( Target => $object );
DESCRIPTION
Stores information about an prospective SIMBAD query and allows the query to
be made, returning an Astro::SIMBAD::Result object. Minimum information needed
for a sucessful query is an R.A. and Dec. or an object Target speccification,
other variables will be defaulted.
The Query object supports two types of queries: "list" (summary)
and "object" (detailed). The list query usually returns multiple results;
the object query is expected to obtain only one result, but returns extra
data about that target. An object query is performed if the target name
is specified and the Error radius is 0; otherwise, a list query is done.
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.
REVISION
$Id: Query.pm,v 1.14 2005/06/08 01:38:17 aa Exp $
METHODS
Constructor
- new
-
Create a new instance from a hash of options
$query = new Astro::SIMBAD::Query( Target => $object,
RA => $ra,
Dec => $dec,
Error => $radius,
Units => $radius_units,
Frame => $coord_frame,
Epoch => $coord_epoch,
Equinox => $coord_equinox,
Proxy => $proxy,
Timeout => $timeout,
URL => $alternative_url );
returns a reference to an SIMBAD query object.
Accessor Methods
- querydb
-
Returns an Astro::SIMBAD::Result object for an inital SIMBAD query
$results = $query->querydb();
- proxy
-
Return (or set) the current proxy for the SIMBAD request.
$query->proxy( 'http://wwwcache.ex.ac.uk:8080/' );
$proxy_url = $query->proxy();
- timeout
-
Return (or set) the current timeout in seconds for the SIMBAD request.
$query->timeout( 30 );
$proxy_timeout = $query->timeout();
- url
-
Return (or set) the current base URL for the ADS query.
$url = $query->url();
$query->url( "simbad.u-strasbg.fr" );
if not defined the default URL is simbad.u-strasbg.fr
- agent
-
Returns the user agent tag sent by the module to the ADS server.
$agent_tag = $query->agent();
- RA
-
Return (or set) the current target R.A. defined for the SIMBAD query
$ra = $query->ra();
$query->ra( $ra );
where $ra should be a string of the form "HH MM SS.SS", e.g. 21 42 42.66
- Dec
-
Return (or set) the current target Declination defined for the SIMBAD query
$dec = $query->dec();
$query->dec( $dec );
where $dec should be a string of the form "+-HH MM SS.SS", e.g. +43 35 09.5
or -40 25 67.89
- Target
-
Instead of querying SIMBAD by R.A. and Dec., you may also query it by object
name. Return (or set) the current target object defined for the SIMBAD query
$ident = $query->target();
$query->target( "HT Cas" );
using an object name will override the current R.A. and Dec settings for the
Query object (if currently set) and the next querydb() method call will query
SIMBAD using this identifier rather than any currently set co-ordinates.
- Error
-
The error radius to be searched for SIMBAD objects around the target R.A.
and Dec, the radius defaults to 10 arc seconds, with the radius unit being
set using the units() method.
$error = $query->error();
$query->error( 20 );
- Units
-
The unit for the error radius to be searched for SIMBAD objects around the
target R.A. and Dec, the radius defaults to 10 arc seconds, with the radius itself being set using the error() method
$error = $query->units();
$query->units( "arcmin" );
valid unit types are "arcsec", "arcmin" and "deg".
- use_list_query
-
When searching by coordinates, or if the radius is nonzero, we perform a
"list query" that is expected to return multiple results. However, if
searching for a target by name, and the error radius is zero, it is pretty
clear that we want a specific target. In that case, we use a more detailed
"object query."
This method returns true if the criteria are such that we will use a list
query and false if it is an object query.
- Frame
-
The frame in which the R.A. and Dec co-ordinates are given
$frame = $query->frame();
$query->frames( "FK5" );
valid frames are "FK5" and "FK4", if not specified it will default to FK5.
- Epoch
-
The epoch for the R.A. and Dec co-ordinates
$epoch = $query->epoch();
$query->epoch( "1950" );
defaults to 2000
- Equinox
-
The equinox for the R.A. and Dec co-ordinates
$equinox = $query->equinox();
$query->equinox( "2000" );
defaults to 2000
- Queryurl
-
Returns the URL used to query the Simbad database
General Methods
- configure
-
Configures the object, takes an options hash as an argument
$query->configure( %options );
Does nothing if the array is not supplied.
COPYRIGHT
Copyright (C) 2001 University of Exeter. 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.
AUTHORS
Alasdair Allan <aa@astro.ex.ac.uk>,
package Astro::SIMBAD::Query;
# ---------------------------------------------------------------------------
#+
# Name:
# Astro::SIMBAD::Query
# Purposes:
# Perl wrapper for the SIMBAD database
# Language:
# Perl module
# Description:
# This module wraps the SIMBAD online database.
# Authors:
# Alasdair Allan (aa@astro.ex.ac.uk)
# Revision:
# $Id: Query.pm,v 1.14 2005/06/08 01:38:17 aa Exp $
# Copyright:
# Copyright (C) 2001 University of Exeter. All Rights Reserved.
#-
# ---------------------------------------------------------------------------
# L O A D M O D U L E S --------------------------------------------------
use strict;
use vars qw/ $VERSION /;
use LWP::UserAgent;
use Net::Domain qw(hostname hostdomain);
use Carp;
use HTML::TreeBuilder;
use HTML::Entities;
use Astro::SIMBAD::Result;
use Astro::SIMBAD::Result::Object;
'$Revision: 1.14 $ ' =~ /.*:\s(.*)\s\$/ && ($VERSION = $1);
sub trim {
my $s = shift;
$s =~ s/(^\s+)|(\s+$)//g;
return $s;
}
# 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 => {},
RA => undef,
DEC => undef,
URL => undef,
QUERY => undef,
USERAGENT => undef,
BUFFER => undef,
LOOKUP => {} }, $class;
# Configure the object
$block->configure( @_ );
return $block;
}
# Q U E R Y M E T H O D S ------------------------------------------------
sub querydb {
my $self = shift;
# call the private method to make the actual SIMBAD query
$self->_make_query();
# check for failed connect
return undef unless defined $self->{BUFFER};
# return an Astro::SIMBAD::Result object
return $self->_parse_query();
}
sub proxy {
my $self = shift;
# grab local reference to user agent
my $ua = $self->{USERAGENT};
if (@_) {
my $proxy_url = shift;
$ua->proxy('http', $proxy_url );
}
# return the current proxy
return $ua->proxy('http');
}
sub timeout {
my $self = shift;
# grab local reference to user agent
my $ua = $self->{USERAGENT};
if (@_) {
my $time = shift;
$ua->timeout( $time );
}
# return the current timeout
return $ua->timeout();
}
sub url {
my $self = shift;
# SETTING URL
if (@_) {
# set the url option
my $base_url = shift;
if( defined $base_url ) {
$self->{URL} = $base_url;
$self->{QUERY} = "http://$base_url/sim-id.pl?";
}
}
# RETURNING URL
return $self->{URL};
}
sub agent {
my $self = shift;
return $self->{USERAGENT}->agent();
}
# O T H E R M E T H O D S ------------------------------------------------
sub ra {
my $self = shift;
# SETTING R.A.
if (@_) {
# grab the new R.A.
my $ra = shift;
# mutilate it and stuff it and the current $self->{RA}
# into the ${$self->{OPTIONS}}{"Ident"} hash item.
$ra =~ s/\s/\+/g;
$self->{RA} = $ra;
# grab the currently set DEC
my $dec = $self->{DEC};
# set the identifier
${$self->{OPTIONS}}{"Ident"} = "$ra+$dec";
}
# un-mutilate and return a nicely formated string to the user
my $ra = $self->{RA};
$ra =~ s/\+/ /g;
return $ra;
}
sub dec {
my $self = shift;
# SETTING DEC
if (@_) {
# grab the new Dec
my $dec = shift;
# mutilate it and stuff it and the current $self->{DEC}
# into the ${$self->{OPTIONS}}{"Ident"} hash item.
$dec =~ s/\+/%2B/g;
$dec =~ s/\s/\+/g;
$self->{DEC} = $dec;
# grab the currently set RA
my $ra = $self->{RA};
# set the identifier
${$self->{OPTIONS}}{"Ident"} = "$ra+$dec";
}
# un-mutilate and return a nicely formated string to the user
my $dec = $self->{DEC};
$dec =~ s/\+/ /g;
$dec =~ s/%2B/\+/g;
return $dec;
}
sub target {
my $self = shift;
# SETTING IDENTIFIER
if (@_) {
# grab the new object name
my $ident = shift;
# mutilate it and stuff it into ${$self->{OPTIONS}}{"Ident"}
$ident =~ s/\s/\+/g;
${$self->{OPTIONS}}{"Ident"} = $ident;
# refigure object/list search type
$self->_update_nbident();
}
return ${$self->{OPTIONS}}{"Ident"};
}
sub error {
my $self = shift;
if (@_) {
# If searching with a nonzero radius, do a list query.
# If radius is zero, get a detailed object query.
${$self->{OPTIONS}}{"Radius"} = shift;
# refigure object/list search type
$self->_update_nbident();
}
return ${$self->{OPTIONS}}{"Radius"};
}
sub units {
my $self = shift;
if (@_) {
my $unit = shift;
if( $unit eq "arcsec" || $unit eq "arcmin" || $unit eq "deg" ) {
${$self->{OPTIONS}}{"Radius.unit"} = $unit;
}
}
return ${$self->{OPTIONS}}{"Radius.unit"};
}
sub use_list_query {
my $self = shift;
return ((${$self->{OPTIONS}}{"Ident"} =~ m/^(\d{1,3}\+){2}/) || (${$self->{OPTIONS}}{"Radius"} > 0));
}
sub frame {
my $self = shift;
if (@_) {
my $frame = shift;
if( $frame eq "FK5" || $frame eq "FK4" ) {
${$self->{OPTIONS}}{"CooFrame"} = $frame;
}
}
return ${$self->{OPTIONS}}{"CooFrame"};
}
sub epoch {
my $self = shift;
if (@_) {
${$self->{OPTIONS}}{"CooEpoch"} = shift;
}
return ${$self->{OPTIONS}}{"CooEpoch"};
}
sub equinox {
my $self = shift;
if (@_) {
${$self->{OPTIONS}}{"CooEqui"} = shift;
}
return ${$self->{OPTIONS}}{"CooEqui"};
}
sub queryurl {
my $self = shift;
# grab the base URL
my $URL = $self->{QUERY};
my $options = "";
# loop round all the options keys and build the query
foreach my $key ( keys %{$self->{OPTIONS}} ) {
$options = $options . "&$key=${$self->{OPTIONS}}{$key}";
}
# build final query URL
$URL = $URL . $options;
return $URL;
}
# C O N F I G U R E -------------------------------------------------------
sub configure {
my $self = shift;
# CONFIGURE DEFAULTS
# ------------------
# default the R.A. and DEC to blank strings to avoid uninitialized
# value problems when creating the object
$self->{RA} = "";
$self->{DEC} = "";
# define the default base URLs
$self->{URL} = "simbad.u-strasbg.fr";
# define the query URLs
my $default_url = $self->{URL};
$self->{QUERY} = "http://$default_url/sim-id.pl?";
# Setup the LWP::UserAgent
my $HOST = hostname();
my $DOMAIN = hostdomain();
$self->{USERAGENT} = new LWP::UserAgent( timeout => 30 );
$self->{USERAGENT}->agent("Astro::SIMBAD/$VERSION ($HOST.$DOMAIN)");
# Grab Proxy details from local environment
$self->{USERAGENT}->env_proxy();
# configure the default options
${$self->{OPTIONS}}{"protocol"} = "html";
${$self->{OPTIONS}}{"Ident"} = undef;
${$self->{OPTIONS}}{"NbIdent"} = "around";
${$self->{OPTIONS}}{"Radius"} = "10";
${$self->{OPTIONS}}{"Radius.unit"} = "arcsec";
${$self->{OPTIONS}}{"CooFrame"} = "FK5";
${$self->{OPTIONS}}{"CooEpoch"} = "2000";
${$self->{OPTIONS}}{"CooEqui"} = "2000";
${$self->{OPTIONS}}{"output.max"} = "all";
${$self->{OPTIONS}}{"o.catall"} = "on";
${$self->{OPTIONS}}{"output.mesdisp"} = "A";
${$self->{OPTIONS}}{"Bibyear1"} = "1983";
${$self->{OPTIONS}}{"Bibyear2"} = "2001";
# Frame 1, FK5 2000/2000
${$self->{OPTIONS}}{"Frame1"} = "FK5";
${$self->{OPTIONS}}{"Equi1"} = "2000.0";
${$self->{OPTIONS}}{"Epoch1"} = "2000.0";
# Frame 2, FK4 1950/1950
${$self->{OPTIONS}}{"Frame2"} = "FK4";
${$self->{OPTIONS}}{"Equi2"} = "1950.0";
${$self->{OPTIONS}}{"Epoch2"} = "1950.0";
# Frame 3, Galactic
${$self->{OPTIONS}}{"Frame3"} = "G";
${$self->{OPTIONS}}{"Equi3"} = "2000.0";
${$self->{OPTIONS}}{"Epoch3"} = "2000.0";
# TYPE LOOKUP HASH TABLE
# ----------------------
# build the data table
${$self->{LOOKUP}}{"?"} = "Object of unknown nature";
${$self->{LOOKUP}}{"Rad"} = "Radio-source";
${$self->{LOOKUP}}{"mR"} = "metric Radio-source";
${$self->{LOOKUP}}{"cm"} = "centimetric Radio-source";
${$self->{LOOKUP}}{"mm"} = "millimetric Radio-source";
${$self->{LOOKUP}}{"Mas"} = "Maser";
${$self->{LOOKUP}}{"IR"} = "Infra-Red source";
${$self->{LOOKUP}}{"IR1"} = "IR source at lambda > 10 microns";
${$self->{LOOKUP}}{"IR0"} = "IR source at lambda < 10 microns";
${$self->{LOOKUP}}{"red"} = "Very red source";
${$self->{LOOKUP}}{"blu"} = "Blue object";
${$self->{LOOKUP}}{"UV"} = "UV-emission source";
${$self->{LOOKUP}}{"X"} = "X-ray source";
${$self->{LOOKUP}}{"gam"} = "gamma-ray source";
${$self->{LOOKUP}}{"gB"} = "gamma-ray Burster";
${$self->{LOOKUP}}{"grv"} = "Gravitational Source";
${$self->{LOOKUP}}{"Lev"} = "(Micro)Lensing Event";
${$self->{LOOKUP}}{"mul"} = "Composite object";
${$self->{LOOKUP}}{"reg"} = "Region defined in the sky";
${$self->{LOOKUP}}{"vid"} = "Underdense region of the Universe";
${$self->{LOOKUP}}{"SCG"} = "Supercluster of Galaxies";
${$self->{LOOKUP}}{"ClG"} = "Cluster of Galaxies";
${$self->{LOOKUP}}{"GrG"} = "Group of Galaxies";
${$self->{LOOKUP}}{"CGG"} = "Compact Group of Galaxies";
${$self->{LOOKUP}}{"PaG"} = "Pair of Galaxies";
${$self->{LOOKUP}}{"Gl?"} = "Possible Globular Cluster";
${$self->{LOOKUP}}{"Cl*"} = "Cluster of Stars";
${$self->{LOOKUP}}{"GlC"} = "Globular Cluster";
${$self->{LOOKUP}}{"OpC"} = "Open (galactic) Cluster";
${$self->{LOOKUP}}{"As*"} = "Association of Stars";
${$self->{LOOKUP}}{"**"} = "Double or multiple star";
${$self->{LOOKUP}}{"EB*"} = "Eclipsing binary";
${$self->{LOOKUP}}{"Al*"} = "Eclipsing binary of Algol type";
${$self->{LOOKUP}}{"bL*"} = "Eclipsing binary of beta Lyr type";
${$self->{LOOKUP}}{"WU*"} = "Eclipsing binary of W UMa type";
${$self->{LOOKUP}}{"SB*"} = "Spectrocopic binary";
${$self->{LOOKUP}}{"CV*"} = "Cataclysmic Variable Star";
${$self->{LOOKUP}}{"DQ*"} = "Cataclysmic Var. DQ Her type";
${$self->{LOOKUP}}{"AM*"} = "Cataclysmic Var. AM Her type";
${$self->{LOOKUP}}{"NL*"} = "Nova-like Star";
${$self->{LOOKUP}}{"No*"} = "Nova";
${$self->{LOOKUP}}{"DN*"} = "Dwarf Nova";
${$self->{LOOKUP}}{"XB*"} = "X-ray Binary";
${$self->{LOOKUP}}{"LXB"} = "Low Mass X-ray Binary";
${$self->{LOOKUP}}{"HXB"} = "High Mass X-ray Binary";
${$self->{LOOKUP}}{"Neb"} = "Nebula of unknown nature";
${$self->{LOOKUP}}{"PoC"} = "Part of Cloud";
${$self->{LOOKUP}}{"PN?"} = "Possible Planetary Nebula";
${$self->{LOOKUP}}{"CGb"} = "Cometary Globule";
${$self->{LOOKUP}}{"EmO"} = "Emission Object";
${$self->{LOOKUP}}{"HH"} = "Herbig-Haro Object";
${$self->{LOOKUP}}{"Cld"} = "Cloud of unknown nature";
${$self->{LOOKUP}}{"GNe"} = "Galactic Nebula";
${$self->{LOOKUP}}{"BNe"} = "Bright Nebula";
${$self->{LOOKUP}}{"DNe"} = "Dark Nebula";
${$self->{LOOKUP}}{"RNe"} = "Reflection Nebula";
${$self->{LOOKUP}}{"HI"} = "HI (neutral) region";
${$self->{LOOKUP}}{"MoC"} = "Molecular Cloud";
${$self->{LOOKUP}}{"HVC"} = "High-velocity Cloud";
${$self->{LOOKUP}}{"HII"} = "HII (ionized) region";
${$self->{LOOKUP}}{"PN"} = "Planetary Nebula";
${$self->{LOOKUP}}{"sh"} = "HI shell";
${$self->{LOOKUP}}{"SR?"} = "SuperNova Remnant Candidate";
${$self->{LOOKUP}}{"SNR"} = "SuperNova Remnant";
${$self->{LOOKUP}}{"*"} = "Star";
${$self->{LOOKUP}}{"*iC"} = "Star in Cluster";
${$self->{LOOKUP}}{"*iN"} = "Star in Nebula";
${$self->{LOOKUP}}{"*iA"} = "Star in Association";
${$self->{LOOKUP}}{"*i*"} = "Star in double system";
${$self->{LOOKUP}}{"V*?"} = "Star suspected of Variability";
${$self->{LOOKUP}}{"Pe*"} = "Peculiar Star";
${$self->{LOOKUP}}{"HB*"} = "Horizontal Branch Star";
${$self->{LOOKUP}}{"Em*"} = "Emission-line Star";
${$self->{LOOKUP}}{"Be*"} = "Be Star";
${$self->{LOOKUP}}{"WD*"} = "White Dwarf";
${$self->{LOOKUP}}{"ZZ*"} = "Variable White Dwarf of ZZ Cet type";
${$self->{LOOKUP}}{"C*"} = "Carbon Star";
${$self->{LOOKUP}}{"S*"} = "S Star";
${$self->{LOOKUP}}{"OH*"} = "Star with envelope of OH/IR type";
${$self->{LOOKUP}}{"CH*"} = "Star with envelope of CH type";
${$self->{LOOKUP}}{"pr*"} = "Pre-main sequence Star";
${$self->{LOOKUP}}{"TT*"} = "T Tau-type Star";
${$self->{LOOKUP}}{"WR*"} = "Wolf-Rayet Star";
${$self->{LOOKUP}}{"PM*"} = "High proper-motion Star";
${$self->{LOOKUP}}{"HV*"} = "High-velocity Star";
${$self->{LOOKUP}}{"V*"} = "Variable Star";
${$self->{LOOKUP}}{"Ir*"} = "Variable Star of irregular type";
${$self->{LOOKUP}}{"Or*"} = "Variable Star in Orion Nebula";
${$self->{LOOKUP}}{"V* RI*"} = "Variable Star with rapid variations";
${$self->{LOOKUP}}{"Er*"} = "Eruptive variable Star";
${$self->{LOOKUP}}{"Fl*"} = "Flare Star";
${$self->{LOOKUP}}{"FU*"} = "Variable Star of FU Ori type";
${$self->{LOOKUP}}{"RC*"} = "Variable Star of R CrB type";
${$self->{LOOKUP}}{"Ro*"} = "Rotationally variable Star";
${$self->{LOOKUP}}{"a2*"} = "Variable Star of alpha2 CVn type";
${$self->{LOOKUP}}{"El*"} = "Elliptical variable Star";
${$self->{LOOKUP}}{"Psr"} = "Pulsars";
${$self->{LOOKUP}}{"BY*"} = "Variable of BY Dra type";
${$self->{LOOKUP}}{"RS*"} = "Variable of RS CVn type";
${$self->{LOOKUP}}{"Pu*"} = "Pulsating variable Star";
${$self->{LOOKUP}}{"Mi*"} = "Variable Star of Mira Cet type";
${$self->{LOOKUP}}{"RR*"} = "Variable Star of RR Lyr type";
${$self->{LOOKUP}}{"Ce*"} = "Classical Cepheid variable Star";
${$self->{LOOKUP}}{"eg sr*"} = "Semi-regular pulsating Star";
${$self->{LOOKUP}}{"dS*"} = "Variable Star of delta Sct type";
${$self->{LOOKUP}}{"RV*"} = "Variable Star of RV Tau type";
${$self->{LOOKUP}}{"WV*"} = "Variable Star of W Vir type";
${$self->{LOOKUP}}{"SN*"} = "SuperNova";
${$self->{LOOKUP}}{"Sy*"} = "Symbiotic Star";
${$self->{LOOKUP}}{"G"} = "Galaxy";
${$self->{LOOKUP}}{"PoG"} = "Part of a Galaxy";
${$self->{LOOKUP}}{"GiC"} = "Galaxy in Cluster of Galaxies";
${$self->{LOOKUP}}{"GiG"} = "Galaxy in Group of Galaxies";
${$self->{LOOKUP}}{"GiP"} = "Galaxy in Pair of Galaxies";
${$self->{LOOKUP}}{"HzG"} = "Galaxy with high redshift";
${$self->{LOOKUP}}{"ALS"} = "Absorption Line system";
${$self->{LOOKUP}}{"LyA"} = "Ly alpha Absorption Line system";
${$self->{LOOKUP}}{"DLy"} = "Dumped Ly alpha Absorption Line system";
${$self->{LOOKUP}}{"mAL"} = "metallic Absorption Line system";
${$self->{LOOKUP}}{"rG"} = "Radio Galaxy";
${$self->{LOOKUP}}{"H2G"} = "HII Galaxy";
${$self->{LOOKUP}}{"Q?"} = "Possible Quasar";
${$self->{LOOKUP}}{"EmG"} = "Emission-line galaxy";
${$self->{LOOKUP}}{"SBG"} = "Starburst Galaxy";
${$self->{LOOKUP}}{"BCG"} = "Blue compact Galaxy";
${$self->{LOOKUP}}{"LeI"} = "Gravitationnaly Lensed Image";
${$self->{LOOKUP}}{"LeG"} = "Gravitationnaly Lensed Image of a Galaxy";
${$self->{LOOKUP}}{"LeQ"} = "Gravitationnaly Lensed Image of a Quasar";
${$self->{LOOKUP}}{"AGN"} = "Active Galaxy Nucleus";
${$self->{LOOKUP}}{"LIN"} = "LINER-type Active Galaxy Nucleus";
${$self->{LOOKUP}}{"SyG"} = "Seyfert Galaxy";
${$self->{LOOKUP}}{"Sy1"} = "Seyfert 1 Galaxy";
${$self->{LOOKUP}}{"Sy2"} = "Seyfert 2 Galaxy";
${$self->{LOOKUP}}{"Bla"} = "Blazar";
${$self->{LOOKUP}}{"BLL"} = "BL Lac - type object";
${$self->{LOOKUP}}{"OVV"} = "Optically Violently Variable object";
${$self->{LOOKUP}}{"QSO"} = "Quasar";
# CONFIGURE FROM ARGUMENTS
# -------------------------
# return unless we have arguments
return undef unless @_;
# grab the argument list
my %args = @_;
# Loop over the allowed keys and modify the default query options, note
# that due to the order these are called in supplying both and RA and Dec
# and an object Identifier (e.g. HT Cas) will cause the query to default
# to using the identifier rather than the supplied co-ordinates.
for my $key (qw / RA Dec Target Error Units Frame Epoch Equinox
Proxy Timeout URL / ) {
my $method = lc($key);
$self->$method( $args{$key} ) if exists $args{$key};
}
}
# T I M E A T T H E B A R --------------------------------------------
sub _make_query {
my $self = shift;
# grab the user agent
my $ua = $self->{USERAGENT};
# clean out the buffer
$self->{BUFFER} = "";
# grab the base URL
my $URL = $self->queryurl();
# build request
my $request = new HTTP::Request('GET', $URL);
# grab page from web
my $reply = $ua->request($request);
if ( ${$reply}{"_rc"} eq 200 ) {
# stuff the page contents into the buffer
$self->{BUFFER} = ${$reply}{"_content"};
} else {
$self->{BUFFER} = undef;
croak("Error ${$reply}{_rc}: Failed to establish network connection");
}
}
sub _parse_query {
my $self = shift;
my $tree = HTML::TreeBuilder->new_from_content($self->{BUFFER});
$tree->elementify();
my $result;
if ($self->use_list_query()) {
$result = $self->_parse_list_query($tree);
} else {
$result = $self->_parse_object_query($tree);
}
$tree->delete(); # yes, this is necessary
return $result;
}
sub _parse_list_query {
my $self = shift;
my $tree = shift;
my $pretag = $tree->find_by_tag_name('pre'); # find the <pre> element
my $idtext = decode_entities($pretag->as_HTML());
chomp($idtext);
my @buffer = split( /\n/, $idtext);
# create an Astro::SIMBAD::Result object to hold the search results
my $result = new Astro::SIMBAD::Result();
# loop round the returned buffer
foreach my $linepos (2 .. $#buffer-1) {
my $starline = $buffer[$linepos];
# create a temporary place holder object
my $object = new Astro::SIMBAD::Result::Object();
# split each line using the "pipe" symbol separating the table columns
my @separated = split( /\|/, $starline );
$self->_insert_query_params($object);
# URL
# ---
# grab the url based on quotes around the string
my $start_index = index( $separated[0], q/"/ );
my $last_index = rindex( $separated[0], q/"/ );
my $url = substr( $separated[0], $start_index+1,
$last_index-$start_index-1);
# push it into the object
$object->url( $url );
# NAME
# ----
# get the object name from the same section
my $final_index = rindex( $separated[0], "<" ) - 1;
my $name = substr($separated[0],$last_index+2,$final_index-$last_index-1);
# push it into the object
$object->name( $name );
# TYPE
# ----
my $type = trim($separated[1]);
# push it into the object
$object->type( $type );
# LONG TYPE
# ---------
# do the lookup
for my $key (keys %{$self->{LOOKUP}}) {
if( $object->type() eq $key ) {
# push it into the object
my $long = ${$self->{LOOKUP}}{$key};
$object->long( $long );
last;
}
}
# RA and DEC
my ($ra, $dec) = $self->_coordinates($separated[2]);
$object->ra($ra);
$object->dec($dec);
# B, V magnitudes; field may contain none, one or both
my ($bmag, $vmag) = split /\s+/, trim($separated[3]);
if ($bmag && $bmag ne ":") {
$object->bmag($bmag);
}
$object->vmag($vmag);
# SPECTRAL TYPE
# -------------
my $spectral = trim($separated[4]);
# push it into the object
$object->spec($spectral);
# Add the target object to the Astro::SIMBAD::Result object
# ---------------------------------------------------------
$result->addobject( $object );
}
# return an Astro::SIMBAD::Result object, or undef if no abstracts returned
return $result;
}
sub _parse_object_query {
my $self = shift;
my $tree = shift;
my $result = new Astro::SIMBAD::Result();
my $object = new Astro::SIMBAD::Result::Object();
# The object's detail URL is the query URL
$object->url($self->queryurl());
# Find the <a> tag named lab_basic1
my $basic_anchor = $tree->look_down("_tag", "a", sub { $_[0]->attr("name") eq "lab_basic1"} );
# Under lab_basic1, find the table cell containing name and long description
my $objtitle = $basic_anchor->look_down("_tag", "td", sub { $_[0]->as_text() =~ /^Basic data :/ })->as_text();
my ($label, $name, $long) = split /:|--/, $objtitle;
$object->name($name);
$object->long($long);
# "Basic data" table
my $bdtable = $basic_anchor->look_down("_tag", "table", sub { $_[0]->attr("cols") eq "3" });
# Grab the left-hand column of table cells
my @bdlabels = $bdtable->look_down("_tag", "td", sub { $_[0]->right() });
my %basic_data = {};
foreach my $bdlabel (@bdlabels) {
my $key = trim($bdlabel->as_text());
my $value = trim($bdlabel->right()->as_text());
$basic_data{$key} = $value;
}
$self->_insert_query_params($object);
# Set RA and DEC
my @coord_types = ( ["ICRS", 2000, 2000, "ICRS 2000.0 coordinates"],
["FK5", 2000, 2000, "FK5 2000.0/2000.0 coordinates"],
["FK4", 1950, 1950, "FK4 1950.0/1950.0 coordinates"],
);
foreach my $row (@coord_types) {
if (join('*', @{$row}[0..2]) eq join('*', $object->frame())) {
$label = @{$row}[3];
my $coord_string = $basic_data{$label};
my ($ra, $dec) = $self->_coordinates($coord_string);
$object->ra($ra);
$object->dec($dec);
last;
}
}
# Spectral type
$object->spec($basic_data{"Spectral type"});
# B, V magnitudes
my ($bmag, $vmag) = split ',', $basic_data{"B magn, V magn, Peculiarities"};
$object->bmag($bmag);
$object->vmag($vmag);
# Proper motion
if ((my $pm = $basic_data{"Proper motion (mas/yr) [error ellipse]"})) {
$object->pm(split /\s+/, $pm);
}
# Parallax
if ((my $plx = $basic_data{"Parallaxes (mas)"})) {
$object->plx(split /\s+/, $plx);
}
# Radial velocity/redshift
if ((my $rvterm = $basic_data{"Radial velocity (v:Km/s) or Redshift (z)"})) {
my ($type, $mag) = split /\s+/, $rvterm;
if ($type eq "v") {
$object->radial($mag);
} elsif ($type eq "z") {
$object->redshift($mag);
}
}
# Build an array of designations for this object
my @idents;
# Find the <pre> block under the 'lab_ident1' anchor
my $iptag = $tree->look_down("_tag", "a", sub { $_[0]->attr("name") eq "lab_ident1"} )->find('pre');
foreach my $idref ($iptag->find("a")) {
push @idents, trim($idref->as_text());
$idref = $idref->right();
}
$object->ident(\@idents);
$result->addobject( $object );
return $result;
}
sub _insert_query_params {
my $self = shift;
my $object = shift;
# FRAME
# -----
# grab the current co-ordinate frame from the query object itself
my @coord_frame = ( ${$self->{OPTIONS}}{"CooFrame"},
${$self->{OPTIONS}}{"CooEpoch"},
${$self->{OPTIONS}}{"CooEqui"} );
# push it into the object
$object->frame( \@coord_frame );
# TARGET
$object->target($self->target());
}
sub _update_nbident {
my $self = shift;
if ($self->use_list_query()) {
${$self->{OPTIONS}}{"NbIdent"} = "around";
} else {
${$self->{OPTIONS}}{"NbIdent"} = "1";
}
}
sub _coordinates {
my $self = shift;
# RA
# --
my $coords = trim(shift);
# split the RA and Dec line into an array elements
my @radec = split( /\s+/, $coords );
# ...and then rebuild it
my $ra;
unless( $radec[2] =~ '\+' || $radec[2] =~ '-' ) {
$ra = "$radec[0] $radec[1] $radec[2]";
} else {
$ra = "$radec[0] $radec[1] 00.0";
}
# DEC
# ---
# ...and rebuild the Dec
my $dec;
unless ( $radec[2] =~ '\+' || $radec[2] =~ '-' ) {
$dec = "$radec[3] $radec[4] $radec[5]";
} else {
$dec = "$radec[2] $radec[3] 00.0";
}
return ($ra, $dec);
}
sub _dump_raw {
my $self = shift;
# split the BUFFER into an array
my @portable = split( /\n/,$self->{BUFFER});
chomp @portable;
return @portable;
}
sub _dump_options {
my $self = shift;
return %{$self->{OPTIONS}};
}
# L A S T O R D E R S ------------------------------------------------------
1;