1package Astro::SIMBAD::Query; 2 3# --------------------------------------------------------------------------- 4 5#+ 6# Name: 7# Astro::SIMBAD::Query 8 9# Purposes: 10# Perl wrapper for the SIMBAD database 11 12# Language: 13# Perl module 14 15# Description: 16# This module wraps the SIMBAD online database. 17 18# Authors: 19# Alasdair Allan (aa@astro.ex.ac.uk) 20 21# Revision: 22# $Id: Query.pm,v 1.14 2005/06/08 01:38:17 aa Exp $ 23 24# Copyright: 25# Copyright (C) 2001 University of Exeter. All Rights Reserved. 26 27#- 28 29# --------------------------------------------------------------------------- 30 31=head1 NAME 32 33Astro::SIMBAD::Query - Object definining an prospective SIMBAD query. 34 35=head1 SYNOPSIS 36 37 $query = new Astro::SIMBAD::Query( Target => $object, 38 RA => $ra, 39 Dec => $dec, 40 Error => $radius, 41 Units => $radius_units, 42 Frame => $coord_frame, 43 Epoch => $coord_epoch, 44 Equinox => $coord_equinox, 45 Proxy => $proxy, 46 Timeout => $timeout, 47 URL => $alternative_url ); 48 49 my $results = $query->querydb(); 50 51 $other = new Astro::SIMBAD::Query( Target => $object ); 52 53=head1 DESCRIPTION 54 55Stores information about an prospective SIMBAD query and allows the query to 56be made, returning an Astro::SIMBAD::Result object. Minimum information needed 57for a sucessful query is an R.A. and Dec. or an object Target speccification, 58other variables will be defaulted. 59 60The Query object supports two types of queries: "list" (summary) 61and "object" (detailed). The list query usually returns multiple results; 62the object query is expected to obtain only one result, but returns extra 63data about that target. An object query is performed if the target name 64is specified and the Error radius is 0; otherwise, a list query is done. 65 66The object will by default pick up the proxy information from the HTTP_PROXY 67and NO_PROXY environment variables, see the LWP::UserAgent documentation for 68details. 69 70=cut 71 72# L O A D M O D U L E S -------------------------------------------------- 73 74use strict; 75use vars qw/ $VERSION /; 76 77use LWP::UserAgent; 78use Net::Domain qw(hostname hostdomain); 79use Carp; 80use HTML::TreeBuilder; 81use HTML::Entities; 82 83use Astro::SIMBAD::Result; 84use Astro::SIMBAD::Result::Object; 85 86'$Revision: 1.14 $ ' =~ /.*:\s(.*)\s\$/ && ($VERSION = $1); 87 88sub trim { 89 my $s = shift; 90 $s =~ s/(^\s+)|(\s+$)//g; 91 return $s; 92} 93 94# C O N S T R U C T O R ---------------------------------------------------- 95 96=head1 REVISION 97 98$Id: Query.pm,v 1.14 2005/06/08 01:38:17 aa Exp $ 99 100=head1 METHODS 101 102=head2 Constructor 103 104=over 4 105 106=item B<new> 107 108Create a new instance from a hash of options 109 110 $query = new Astro::SIMBAD::Query( Target => $object, 111 RA => $ra, 112 Dec => $dec, 113 Error => $radius, 114 Units => $radius_units, 115 Frame => $coord_frame, 116 Epoch => $coord_epoch, 117 Equinox => $coord_equinox, 118 Proxy => $proxy, 119 Timeout => $timeout, 120 URL => $alternative_url ); 121 122returns a reference to an SIMBAD query object. 123 124=cut 125 126sub new { 127 my $proto = shift; 128 my $class = ref($proto) || $proto; 129 130 # bless the query hash into the class 131 my $block = bless { OPTIONS => {}, 132 RA => undef, 133 DEC => undef, 134 URL => undef, 135 QUERY => undef, 136 USERAGENT => undef, 137 BUFFER => undef, 138 LOOKUP => {} }, $class; 139 140 # Configure the object 141 $block->configure( @_ ); 142 143 return $block; 144 145} 146 147# Q U E R Y M E T H O D S ------------------------------------------------ 148 149=back 150 151=head2 Accessor Methods 152 153=over 4 154 155=item B<querydb> 156 157Returns an Astro::SIMBAD::Result object for an inital SIMBAD query 158 159 $results = $query->querydb(); 160 161=cut 162 163sub querydb { 164 my $self = shift; 165 166 # call the private method to make the actual SIMBAD query 167 $self->_make_query(); 168 169 # check for failed connect 170 return undef unless defined $self->{BUFFER}; 171 172 # return an Astro::SIMBAD::Result object 173 return $self->_parse_query(); 174 175} 176 177=item B<proxy> 178 179Return (or set) the current proxy for the SIMBAD request. 180 181 $query->proxy( 'http://wwwcache.ex.ac.uk:8080/' ); 182 $proxy_url = $query->proxy(); 183 184=cut 185 186sub proxy { 187 my $self = shift; 188 189 # grab local reference to user agent 190 my $ua = $self->{USERAGENT}; 191 192 if (@_) { 193 my $proxy_url = shift; 194 $ua->proxy('http', $proxy_url ); 195 } 196 197 # return the current proxy 198 return $ua->proxy('http'); 199 200} 201 202=item B<timeout> 203 204Return (or set) the current timeout in seconds for the SIMBAD request. 205 206 $query->timeout( 30 ); 207 $proxy_timeout = $query->timeout(); 208 209=cut 210 211sub timeout { 212 my $self = shift; 213 214 # grab local reference to user agent 215 my $ua = $self->{USERAGENT}; 216 217 if (@_) { 218 my $time = shift; 219 $ua->timeout( $time ); 220 } 221 222 # return the current timeout 223 return $ua->timeout(); 224 225} 226 227=item B<url> 228 229Return (or set) the current base URL for the ADS query. 230 231 $url = $query->url(); 232 $query->url( "simbad.u-strasbg.fr" ); 233 234if not defined the default URL is simbad.u-strasbg.fr 235 236=cut 237 238sub url { 239 my $self = shift; 240 241 # SETTING URL 242 if (@_) { 243 244 # set the url option 245 my $base_url = shift; 246 if( defined $base_url ) { 247 $self->{URL} = $base_url; 248 $self->{QUERY} = "http://$base_url/sim-id.pl?"; 249 } 250 } 251 252 # RETURNING URL 253 return $self->{URL}; 254} 255 256=item B<agent> 257 258Returns the user agent tag sent by the module to the ADS server. 259 260 $agent_tag = $query->agent(); 261 262=cut 263 264sub agent { 265 my $self = shift; 266 return $self->{USERAGENT}->agent(); 267} 268 269# O T H E R M E T H O D S ------------------------------------------------ 270 271 272=item B<RA> 273 274Return (or set) the current target R.A. defined for the SIMBAD query 275 276 $ra = $query->ra(); 277 $query->ra( $ra ); 278 279where $ra should be a string of the form "HH MM SS.SS", e.g. 21 42 42.66 280 281=cut 282 283sub ra { 284 my $self = shift; 285 286 # SETTING R.A. 287 if (@_) { 288 289 # grab the new R.A. 290 my $ra = shift; 291 292 # mutilate it and stuff it and the current $self->{RA} 293 # into the ${$self->{OPTIONS}}{"Ident"} hash item. 294 $ra =~ s/\s/\+/g; 295 $self->{RA} = $ra; 296 297 # grab the currently set DEC 298 my $dec = $self->{DEC}; 299 300 # set the identifier 301 ${$self->{OPTIONS}}{"Ident"} = "$ra+$dec"; 302 } 303 304 # un-mutilate and return a nicely formated string to the user 305 my $ra = $self->{RA}; 306 $ra =~ s/\+/ /g; 307 return $ra; 308} 309 310=item B<Dec> 311 312Return (or set) the current target Declination defined for the SIMBAD query 313 314 $dec = $query->dec(); 315 $query->dec( $dec ); 316 317where $dec should be a string of the form "+-HH MM SS.SS", e.g. +43 35 09.5 318or -40 25 67.89 319 320=cut 321 322sub dec { 323 my $self = shift; 324 325 # SETTING DEC 326 if (@_) { 327 328 # grab the new Dec 329 my $dec = shift; 330 331 # mutilate it and stuff it and the current $self->{DEC} 332 # into the ${$self->{OPTIONS}}{"Ident"} hash item. 333 $dec =~ s/\+/%2B/g; 334 $dec =~ s/\s/\+/g; 335 $self->{DEC} = $dec; 336 337 # grab the currently set RA 338 my $ra = $self->{RA}; 339 340 # set the identifier 341 ${$self->{OPTIONS}}{"Ident"} = "$ra+$dec"; 342 } 343 344 # un-mutilate and return a nicely formated string to the user 345 my $dec = $self->{DEC}; 346 $dec =~ s/\+/ /g; 347 $dec =~ s/%2B/\+/g; 348 return $dec; 349 350} 351 352=item B<Target> 353 354Instead of querying SIMBAD by R.A. and Dec., you may also query it by object 355name. Return (or set) the current target object defined for the SIMBAD query 356 357 $ident = $query->target(); 358 $query->target( "HT Cas" ); 359 360using an object name will override the current R.A. and Dec settings for the 361Query object (if currently set) and the next querydb() method call will query 362SIMBAD using this identifier rather than any currently set co-ordinates. 363 364=cut 365 366sub target { 367 my $self = shift; 368 369 # SETTING IDENTIFIER 370 if (@_) { 371 372 # grab the new object name 373 my $ident = shift; 374 375 # mutilate it and stuff it into ${$self->{OPTIONS}}{"Ident"} 376 $ident =~ s/\s/\+/g; 377 ${$self->{OPTIONS}}{"Ident"} = $ident; 378 379 # refigure object/list search type 380 $self->_update_nbident(); 381 } 382 383 return ${$self->{OPTIONS}}{"Ident"}; 384 385} 386 387=item B<Error> 388 389The error radius to be searched for SIMBAD objects around the target R.A. 390and Dec, the radius defaults to 10 arc seconds, with the radius unit being 391set using the units() method. 392 393 $error = $query->error(); 394 $query->error( 20 ); 395 396=cut 397 398sub error { 399 my $self = shift; 400 401 if (@_) { 402 # If searching with a nonzero radius, do a list query. 403 # If radius is zero, get a detailed object query. 404 ${$self->{OPTIONS}}{"Radius"} = shift; 405 406 # refigure object/list search type 407 $self->_update_nbident(); 408 } 409 410 return ${$self->{OPTIONS}}{"Radius"}; 411 412} 413 414=item B<Units> 415 416The unit for the error radius to be searched for SIMBAD objects around the 417target R.A. and Dec, the radius defaults to 10 arc seconds, with the radius itself being set using the error() method 418 419 $error = $query->units(); 420 $query->units( "arcmin" ); 421 422valid unit types are "arcsec", "arcmin" and "deg". 423 424=cut 425 426sub units { 427 my $self = shift; 428 429 if (@_) { 430 431 my $unit = shift; 432 if( $unit eq "arcsec" || $unit eq "arcmin" || $unit eq "deg" ) { 433 ${$self->{OPTIONS}}{"Radius.unit"} = $unit; 434 } 435 } 436 437 return ${$self->{OPTIONS}}{"Radius.unit"}; 438 439} 440 441=item B<use_list_query> 442 443When searching by coordinates, or if the radius is nonzero, we perform a 444"list query" that is expected to return multiple results. However, if 445searching for a target by name, and the error radius is zero, it is pretty 446clear that we want a specific target. In that case, we use a more detailed 447"object query." 448 449This method returns true if the criteria are such that we will use a list 450query and false if it is an object query. 451 452=cut 453sub use_list_query { 454 my $self = shift; 455 return ((${$self->{OPTIONS}}{"Ident"} =~ m/^(\d{1,3}\+){2}/) || (${$self->{OPTIONS}}{"Radius"} > 0)); 456} 457 458=item B<Frame> 459 460The frame in which the R.A. and Dec co-ordinates are given 461 462 $frame = $query->frame(); 463 $query->frames( "FK5" ); 464 465valid frames are "FK5" and "FK4", if not specified it will default to FK5. 466 467=cut 468 469sub frame { 470 my $self = shift; 471 472 if (@_) { 473 474 my $frame = shift; 475 if( $frame eq "FK5" || $frame eq "FK4" ) { 476 ${$self->{OPTIONS}}{"CooFrame"} = $frame; 477 } 478 } 479 480 return ${$self->{OPTIONS}}{"CooFrame"}; 481 482} 483 484=item B<Epoch> 485 486The epoch for the R.A. and Dec co-ordinates 487 488 $epoch = $query->epoch(); 489 $query->epoch( "1950" ); 490 491defaults to 2000 492 493=cut 494 495sub epoch { 496 my $self = shift; 497 498 if (@_) { 499 ${$self->{OPTIONS}}{"CooEpoch"} = shift; 500 } 501 502 return ${$self->{OPTIONS}}{"CooEpoch"}; 503 504} 505 506=item B<Equinox> 507 508The equinox for the R.A. and Dec co-ordinates 509 510 $equinox = $query->equinox(); 511 $query->equinox( "2000" ); 512 513defaults to 2000 514 515=cut 516 517sub equinox { 518 my $self = shift; 519 520 if (@_) { 521 ${$self->{OPTIONS}}{"CooEqui"} = shift; 522 } 523 524 return ${$self->{OPTIONS}}{"CooEqui"}; 525 526} 527 528=item B<Queryurl> 529 530Returns the URL used to query the Simbad database 531 532=cut 533 534sub queryurl { 535 my $self = shift; 536 537 # grab the base URL 538 my $URL = $self->{QUERY}; 539 my $options = ""; 540 541 # loop round all the options keys and build the query 542 foreach my $key ( keys %{$self->{OPTIONS}} ) { 543 $options = $options . "&$key=${$self->{OPTIONS}}{$key}"; 544 } 545 546 # build final query URL 547 $URL = $URL . $options; 548 549 return $URL; 550} 551 552# C O N F I G U R E ------------------------------------------------------- 553 554=back 555 556=head2 General Methods 557 558=over 4 559 560=item B<configure> 561 562Configures the object, takes an options hash as an argument 563 564 $query->configure( %options ); 565 566Does nothing if the array is not supplied. 567 568=cut 569 570sub configure { 571 my $self = shift; 572 573 # CONFIGURE DEFAULTS 574 # ------------------ 575 576 # default the R.A. and DEC to blank strings to avoid uninitialized 577 # value problems when creating the object 578 $self->{RA} = ""; 579 $self->{DEC} = ""; 580 581 # define the default base URLs 582 $self->{URL} = "simbad.u-strasbg.fr"; 583 584 # define the query URLs 585 my $default_url = $self->{URL}; 586 $self->{QUERY} = "http://$default_url/sim-id.pl?"; 587 588 # Setup the LWP::UserAgent 589 my $HOST = hostname(); 590 my $DOMAIN = hostdomain(); 591 $self->{USERAGENT} = new LWP::UserAgent( timeout => 30 ); 592 $self->{USERAGENT}->agent("Astro::SIMBAD/$VERSION ($HOST.$DOMAIN)"); 593 594 # Grab Proxy details from local environment 595 $self->{USERAGENT}->env_proxy(); 596 597 # configure the default options 598 ${$self->{OPTIONS}}{"protocol"} = "html"; 599 ${$self->{OPTIONS}}{"Ident"} = undef; 600 ${$self->{OPTIONS}}{"NbIdent"} = "around"; 601 ${$self->{OPTIONS}}{"Radius"} = "10"; 602 ${$self->{OPTIONS}}{"Radius.unit"} = "arcsec"; 603 ${$self->{OPTIONS}}{"CooFrame"} = "FK5"; 604 ${$self->{OPTIONS}}{"CooEpoch"} = "2000"; 605 ${$self->{OPTIONS}}{"CooEqui"} = "2000"; 606 ${$self->{OPTIONS}}{"output.max"} = "all"; 607 ${$self->{OPTIONS}}{"o.catall"} = "on"; 608 ${$self->{OPTIONS}}{"output.mesdisp"} = "A"; 609 ${$self->{OPTIONS}}{"Bibyear1"} = "1983"; 610 ${$self->{OPTIONS}}{"Bibyear2"} = "2001"; 611 612 # Frame 1, FK5 2000/2000 613 ${$self->{OPTIONS}}{"Frame1"} = "FK5"; 614 ${$self->{OPTIONS}}{"Equi1"} = "2000.0"; 615 ${$self->{OPTIONS}}{"Epoch1"} = "2000.0"; 616 617 # Frame 2, FK4 1950/1950 618 ${$self->{OPTIONS}}{"Frame2"} = "FK4"; 619 ${$self->{OPTIONS}}{"Equi2"} = "1950.0"; 620 ${$self->{OPTIONS}}{"Epoch2"} = "1950.0"; 621 622 # Frame 3, Galactic 623 ${$self->{OPTIONS}}{"Frame3"} = "G"; 624 ${$self->{OPTIONS}}{"Equi3"} = "2000.0"; 625 ${$self->{OPTIONS}}{"Epoch3"} = "2000.0"; 626 627 # TYPE LOOKUP HASH TABLE 628 # ---------------------- 629 630 # build the data table 631 ${$self->{LOOKUP}}{"?"} = "Object of unknown nature"; 632 ${$self->{LOOKUP}}{"Rad"} = "Radio-source"; 633 ${$self->{LOOKUP}}{"mR"} = "metric Radio-source"; 634 ${$self->{LOOKUP}}{"cm"} = "centimetric Radio-source"; 635 ${$self->{LOOKUP}}{"mm"} = "millimetric Radio-source"; 636 ${$self->{LOOKUP}}{"Mas"} = "Maser"; 637 ${$self->{LOOKUP}}{"IR"} = "Infra-Red source"; 638 ${$self->{LOOKUP}}{"IR1"} = "IR source at lambda > 10 microns"; 639 ${$self->{LOOKUP}}{"IR0"} = "IR source at lambda < 10 microns"; 640 ${$self->{LOOKUP}}{"red"} = "Very red source"; 641 ${$self->{LOOKUP}}{"blu"} = "Blue object"; 642 ${$self->{LOOKUP}}{"UV"} = "UV-emission source"; 643 ${$self->{LOOKUP}}{"X"} = "X-ray source"; 644 ${$self->{LOOKUP}}{"gam"} = "gamma-ray source"; 645 ${$self->{LOOKUP}}{"gB"} = "gamma-ray Burster"; 646 ${$self->{LOOKUP}}{"grv"} = "Gravitational Source"; 647 ${$self->{LOOKUP}}{"Lev"} = "(Micro)Lensing Event"; 648 ${$self->{LOOKUP}}{"mul"} = "Composite object"; 649 ${$self->{LOOKUP}}{"reg"} = "Region defined in the sky"; 650 ${$self->{LOOKUP}}{"vid"} = "Underdense region of the Universe"; 651 ${$self->{LOOKUP}}{"SCG"} = "Supercluster of Galaxies"; 652 ${$self->{LOOKUP}}{"ClG"} = "Cluster of Galaxies"; 653 ${$self->{LOOKUP}}{"GrG"} = "Group of Galaxies"; 654 ${$self->{LOOKUP}}{"CGG"} = "Compact Group of Galaxies"; 655 ${$self->{LOOKUP}}{"PaG"} = "Pair of Galaxies"; 656 ${$self->{LOOKUP}}{"Gl?"} = "Possible Globular Cluster"; 657 ${$self->{LOOKUP}}{"Cl*"} = "Cluster of Stars"; 658 ${$self->{LOOKUP}}{"GlC"} = "Globular Cluster"; 659 ${$self->{LOOKUP}}{"OpC"} = "Open (galactic) Cluster"; 660 ${$self->{LOOKUP}}{"As*"} = "Association of Stars"; 661 ${$self->{LOOKUP}}{"**"} = "Double or multiple star"; 662 ${$self->{LOOKUP}}{"EB*"} = "Eclipsing binary"; 663 ${$self->{LOOKUP}}{"Al*"} = "Eclipsing binary of Algol type"; 664 ${$self->{LOOKUP}}{"bL*"} = "Eclipsing binary of beta Lyr type"; 665 ${$self->{LOOKUP}}{"WU*"} = "Eclipsing binary of W UMa type"; 666 ${$self->{LOOKUP}}{"SB*"} = "Spectrocopic binary"; 667 ${$self->{LOOKUP}}{"CV*"} = "Cataclysmic Variable Star"; 668 ${$self->{LOOKUP}}{"DQ*"} = "Cataclysmic Var. DQ Her type"; 669 ${$self->{LOOKUP}}{"AM*"} = "Cataclysmic Var. AM Her type"; 670 ${$self->{LOOKUP}}{"NL*"} = "Nova-like Star"; 671 ${$self->{LOOKUP}}{"No*"} = "Nova"; 672 ${$self->{LOOKUP}}{"DN*"} = "Dwarf Nova"; 673 ${$self->{LOOKUP}}{"XB*"} = "X-ray Binary"; 674 ${$self->{LOOKUP}}{"LXB"} = "Low Mass X-ray Binary"; 675 ${$self->{LOOKUP}}{"HXB"} = "High Mass X-ray Binary"; 676 ${$self->{LOOKUP}}{"Neb"} = "Nebula of unknown nature"; 677 ${$self->{LOOKUP}}{"PoC"} = "Part of Cloud"; 678 ${$self->{LOOKUP}}{"PN?"} = "Possible Planetary Nebula"; 679 ${$self->{LOOKUP}}{"CGb"} = "Cometary Globule"; 680 ${$self->{LOOKUP}}{"EmO"} = "Emission Object"; 681 ${$self->{LOOKUP}}{"HH"} = "Herbig-Haro Object"; 682 ${$self->{LOOKUP}}{"Cld"} = "Cloud of unknown nature"; 683 ${$self->{LOOKUP}}{"GNe"} = "Galactic Nebula"; 684 ${$self->{LOOKUP}}{"BNe"} = "Bright Nebula"; 685 ${$self->{LOOKUP}}{"DNe"} = "Dark Nebula"; 686 ${$self->{LOOKUP}}{"RNe"} = "Reflection Nebula"; 687 ${$self->{LOOKUP}}{"HI"} = "HI (neutral) region"; 688 ${$self->{LOOKUP}}{"MoC"} = "Molecular Cloud"; 689 ${$self->{LOOKUP}}{"HVC"} = "High-velocity Cloud"; 690 ${$self->{LOOKUP}}{"HII"} = "HII (ionized) region"; 691 ${$self->{LOOKUP}}{"PN"} = "Planetary Nebula"; 692 ${$self->{LOOKUP}}{"sh"} = "HI shell"; 693 ${$self->{LOOKUP}}{"SR?"} = "SuperNova Remnant Candidate"; 694 ${$self->{LOOKUP}}{"SNR"} = "SuperNova Remnant"; 695 ${$self->{LOOKUP}}{"*"} = "Star"; 696 ${$self->{LOOKUP}}{"*iC"} = "Star in Cluster"; 697 ${$self->{LOOKUP}}{"*iN"} = "Star in Nebula"; 698 ${$self->{LOOKUP}}{"*iA"} = "Star in Association"; 699 ${$self->{LOOKUP}}{"*i*"} = "Star in double system"; 700 ${$self->{LOOKUP}}{"V*?"} = "Star suspected of Variability"; 701 ${$self->{LOOKUP}}{"Pe*"} = "Peculiar Star"; 702 ${$self->{LOOKUP}}{"HB*"} = "Horizontal Branch Star"; 703 ${$self->{LOOKUP}}{"Em*"} = "Emission-line Star"; 704 ${$self->{LOOKUP}}{"Be*"} = "Be Star"; 705 ${$self->{LOOKUP}}{"WD*"} = "White Dwarf"; 706 ${$self->{LOOKUP}}{"ZZ*"} = "Variable White Dwarf of ZZ Cet type"; 707 ${$self->{LOOKUP}}{"C*"} = "Carbon Star"; 708 ${$self->{LOOKUP}}{"S*"} = "S Star"; 709 ${$self->{LOOKUP}}{"OH*"} = "Star with envelope of OH/IR type"; 710 ${$self->{LOOKUP}}{"CH*"} = "Star with envelope of CH type"; 711 ${$self->{LOOKUP}}{"pr*"} = "Pre-main sequence Star"; 712 ${$self->{LOOKUP}}{"TT*"} = "T Tau-type Star"; 713 ${$self->{LOOKUP}}{"WR*"} = "Wolf-Rayet Star"; 714 ${$self->{LOOKUP}}{"PM*"} = "High proper-motion Star"; 715 ${$self->{LOOKUP}}{"HV*"} = "High-velocity Star"; 716 ${$self->{LOOKUP}}{"V*"} = "Variable Star"; 717 ${$self->{LOOKUP}}{"Ir*"} = "Variable Star of irregular type"; 718 ${$self->{LOOKUP}}{"Or*"} = "Variable Star in Orion Nebula"; 719 ${$self->{LOOKUP}}{"V* RI*"} = "Variable Star with rapid variations"; 720 ${$self->{LOOKUP}}{"Er*"} = "Eruptive variable Star"; 721 ${$self->{LOOKUP}}{"Fl*"} = "Flare Star"; 722 ${$self->{LOOKUP}}{"FU*"} = "Variable Star of FU Ori type"; 723 ${$self->{LOOKUP}}{"RC*"} = "Variable Star of R CrB type"; 724 ${$self->{LOOKUP}}{"Ro*"} = "Rotationally variable Star"; 725 ${$self->{LOOKUP}}{"a2*"} = "Variable Star of alpha2 CVn type"; 726 ${$self->{LOOKUP}}{"El*"} = "Elliptical variable Star"; 727 ${$self->{LOOKUP}}{"Psr"} = "Pulsars"; 728 ${$self->{LOOKUP}}{"BY*"} = "Variable of BY Dra type"; 729 ${$self->{LOOKUP}}{"RS*"} = "Variable of RS CVn type"; 730 ${$self->{LOOKUP}}{"Pu*"} = "Pulsating variable Star"; 731 ${$self->{LOOKUP}}{"Mi*"} = "Variable Star of Mira Cet type"; 732 ${$self->{LOOKUP}}{"RR*"} = "Variable Star of RR Lyr type"; 733 ${$self->{LOOKUP}}{"Ce*"} = "Classical Cepheid variable Star"; 734 ${$self->{LOOKUP}}{"eg sr*"} = "Semi-regular pulsating Star"; 735 ${$self->{LOOKUP}}{"dS*"} = "Variable Star of delta Sct type"; 736 ${$self->{LOOKUP}}{"RV*"} = "Variable Star of RV Tau type"; 737 ${$self->{LOOKUP}}{"WV*"} = "Variable Star of W Vir type"; 738 ${$self->{LOOKUP}}{"SN*"} = "SuperNova"; 739 ${$self->{LOOKUP}}{"Sy*"} = "Symbiotic Star"; 740 ${$self->{LOOKUP}}{"G"} = "Galaxy"; 741 ${$self->{LOOKUP}}{"PoG"} = "Part of a Galaxy"; 742 ${$self->{LOOKUP}}{"GiC"} = "Galaxy in Cluster of Galaxies"; 743 ${$self->{LOOKUP}}{"GiG"} = "Galaxy in Group of Galaxies"; 744 ${$self->{LOOKUP}}{"GiP"} = "Galaxy in Pair of Galaxies"; 745 ${$self->{LOOKUP}}{"HzG"} = "Galaxy with high redshift"; 746 ${$self->{LOOKUP}}{"ALS"} = "Absorption Line system"; 747 ${$self->{LOOKUP}}{"LyA"} = "Ly alpha Absorption Line system"; 748 ${$self->{LOOKUP}}{"DLy"} = "Dumped Ly alpha Absorption Line system"; 749 ${$self->{LOOKUP}}{"mAL"} = "metallic Absorption Line system"; 750 ${$self->{LOOKUP}}{"rG"} = "Radio Galaxy"; 751 ${$self->{LOOKUP}}{"H2G"} = "HII Galaxy"; 752 ${$self->{LOOKUP}}{"Q?"} = "Possible Quasar"; 753 ${$self->{LOOKUP}}{"EmG"} = "Emission-line galaxy"; 754 ${$self->{LOOKUP}}{"SBG"} = "Starburst Galaxy"; 755 ${$self->{LOOKUP}}{"BCG"} = "Blue compact Galaxy"; 756 ${$self->{LOOKUP}}{"LeI"} = "Gravitationnaly Lensed Image"; 757 ${$self->{LOOKUP}}{"LeG"} = "Gravitationnaly Lensed Image of a Galaxy"; 758 ${$self->{LOOKUP}}{"LeQ"} = "Gravitationnaly Lensed Image of a Quasar"; 759 ${$self->{LOOKUP}}{"AGN"} = "Active Galaxy Nucleus"; 760 ${$self->{LOOKUP}}{"LIN"} = "LINER-type Active Galaxy Nucleus"; 761 ${$self->{LOOKUP}}{"SyG"} = "Seyfert Galaxy"; 762 ${$self->{LOOKUP}}{"Sy1"} = "Seyfert 1 Galaxy"; 763 ${$self->{LOOKUP}}{"Sy2"} = "Seyfert 2 Galaxy"; 764 ${$self->{LOOKUP}}{"Bla"} = "Blazar"; 765 ${$self->{LOOKUP}}{"BLL"} = "BL Lac - type object"; 766 ${$self->{LOOKUP}}{"OVV"} = "Optically Violently Variable object"; 767 ${$self->{LOOKUP}}{"QSO"} = "Quasar"; 768 769 # CONFIGURE FROM ARGUMENTS 770 # ------------------------- 771 772 # return unless we have arguments 773 return undef unless @_; 774 775 # grab the argument list 776 my %args = @_; 777 778 # Loop over the allowed keys and modify the default query options, note 779 # that due to the order these are called in supplying both and RA and Dec 780 # and an object Identifier (e.g. HT Cas) will cause the query to default 781 # to using the identifier rather than the supplied co-ordinates. 782 for my $key (qw / RA Dec Target Error Units Frame Epoch Equinox 783 Proxy Timeout URL / ) { 784 my $method = lc($key); 785 $self->$method( $args{$key} ) if exists $args{$key}; 786 } 787 788} 789 790# T I M E A T T H E B A R -------------------------------------------- 791 792=back 793 794=begin __PRIVATE_METHODS__ 795 796=head2 Private methods 797 798These methods are for internal use only. 799 800=over 4 801 802=item B<_make_query> 803 804Private function used to make an SIMBAD query. Should not be called directly, 805since it does not parse the results. Instead use the querydb() assessor method. 806 807=cut 808 809sub _make_query { 810 my $self = shift; 811 812 # grab the user agent 813 my $ua = $self->{USERAGENT}; 814 815 # clean out the buffer 816 $self->{BUFFER} = ""; 817 818 # grab the base URL 819 my $URL = $self->queryurl(); 820 821 # build request 822 my $request = new HTTP::Request('GET', $URL); 823 824 # grab page from web 825 my $reply = $ua->request($request); 826 827 if ( ${$reply}{"_rc"} eq 200 ) { 828 # stuff the page contents into the buffer 829 $self->{BUFFER} = ${$reply}{"_content"}; 830 } else { 831 $self->{BUFFER} = undef; 832 croak("Error ${$reply}{_rc}: Failed to establish network connection"); 833 } 834} 835 836=item B<_parse_query> 837 838Private function used to parse the results returned in an SIMBAD query. Should 839not be called directly. Instead use the querydb() assessor method to make and 840parse the results. 841 842=cut 843 844sub _parse_query { 845 my $self = shift; 846 my $tree = HTML::TreeBuilder->new_from_content($self->{BUFFER}); 847 $tree->elementify(); 848 my $result; 849 if ($self->use_list_query()) { 850 $result = $self->_parse_list_query($tree); 851 } else { 852 $result = $self->_parse_object_query($tree); 853 } 854 $tree->delete(); # yes, this is necessary 855 return $result; 856} 857 858=item B<_parse_list_query> 859 860Private method to parse the results of a list query. Should not be called 861directly. Instead use the querydb() assessor method to make and parse the 862results. 863 864=cut 865 866sub _parse_list_query { 867 my $self = shift; 868 my $tree = shift; 869 870 my $pretag = $tree->find_by_tag_name('pre'); # find the <pre> element 871 my $idtext = decode_entities($pretag->as_HTML()); 872 chomp($idtext); 873 874 my @buffer = split( /\n/, $idtext); 875 876 # create an Astro::SIMBAD::Result object to hold the search results 877 my $result = new Astro::SIMBAD::Result(); 878 879 # loop round the returned buffer 880 foreach my $linepos (2 .. $#buffer-1) { 881 my $starline = $buffer[$linepos]; 882 883 # create a temporary place holder object 884 my $object = new Astro::SIMBAD::Result::Object(); 885 886 # split each line using the "pipe" symbol separating the table columns 887 my @separated = split( /\|/, $starline ); 888 889 890 $self->_insert_query_params($object); 891 892 # URL 893 # --- 894 895 # grab the url based on quotes around the string 896 my $start_index = index( $separated[0], q/"/ ); 897 my $last_index = rindex( $separated[0], q/"/ ); 898 my $url = substr( $separated[0], $start_index+1, 899 $last_index-$start_index-1); 900 901 # push it into the object 902 $object->url( $url ); 903 904 # NAME 905 # ---- 906 907 # get the object name from the same section 908 my $final_index = rindex( $separated[0], "<" ) - 1; 909 my $name = substr($separated[0],$last_index+2,$final_index-$last_index-1); 910 911 # push it into the object 912 $object->name( $name ); 913 914 # TYPE 915 # ---- 916 my $type = trim($separated[1]); 917 918 # push it into the object 919 $object->type( $type ); 920 921 # LONG TYPE 922 # --------- 923 924 # do the lookup 925 for my $key (keys %{$self->{LOOKUP}}) { 926 927 if( $object->type() eq $key ) { 928 929 # push it into the object 930 my $long = ${$self->{LOOKUP}}{$key}; 931 $object->long( $long ); 932 last; 933 } 934 } 935 936 # RA and DEC 937 my ($ra, $dec) = $self->_coordinates($separated[2]); 938 $object->ra($ra); 939 $object->dec($dec); 940 941 # B, V magnitudes; field may contain none, one or both 942 my ($bmag, $vmag) = split /\s+/, trim($separated[3]); 943 if ($bmag && $bmag ne ":") { 944 $object->bmag($bmag); 945 } 946 $object->vmag($vmag); 947 948 # SPECTRAL TYPE 949 # ------------- 950 my $spectral = trim($separated[4]); 951 952 # push it into the object 953 $object->spec($spectral); 954 955 # Add the target object to the Astro::SIMBAD::Result object 956 # --------------------------------------------------------- 957 $result->addobject( $object ); 958 } 959 960 # return an Astro::SIMBAD::Result object, or undef if no abstracts returned 961 return $result; 962} 963 964=item B<_parse_object_query> 965 966Private method to parse the results of an object query. Should not be called 967directly. Instead use the querydb() assessor method to make and parse the 968results. 969 970=cut 971 972sub _parse_object_query { 973 my $self = shift; 974 my $tree = shift; 975 976 my $result = new Astro::SIMBAD::Result(); 977 my $object = new Astro::SIMBAD::Result::Object(); 978 979 # The object's detail URL is the query URL 980 $object->url($self->queryurl()); 981 982 # Find the <a> tag named lab_basic1 983 my $basic_anchor = $tree->look_down("_tag", "a", sub { $_[0]->attr("name") eq "lab_basic1"} ); 984 985 # Under lab_basic1, find the table cell containing name and long description 986 my $objtitle = $basic_anchor->look_down("_tag", "td", sub { $_[0]->as_text() =~ /^Basic data :/ })->as_text(); 987 my ($label, $name, $long) = split /:|--/, $objtitle; 988 $object->name($name); 989 $object->long($long); 990 991 # "Basic data" table 992 my $bdtable = $basic_anchor->look_down("_tag", "table", sub { $_[0]->attr("cols") eq "3" }); 993 994 # Grab the left-hand column of table cells 995 my @bdlabels = $bdtable->look_down("_tag", "td", sub { $_[0]->right() }); 996 997 my %basic_data = {}; 998 foreach my $bdlabel (@bdlabels) { 999 my $key = trim($bdlabel->as_text()); 1000 my $value = trim($bdlabel->right()->as_text()); 1001 $basic_data{$key} = $value; 1002 } 1003 1004 $self->_insert_query_params($object); 1005 1006 # Set RA and DEC 1007 my @coord_types = ( ["ICRS", 2000, 2000, "ICRS 2000.0 coordinates"], 1008 ["FK5", 2000, 2000, "FK5 2000.0/2000.0 coordinates"], 1009 ["FK4", 1950, 1950, "FK4 1950.0/1950.0 coordinates"], 1010 ); 1011 foreach my $row (@coord_types) { 1012 if (join('*', @{$row}[0..2]) eq join('*', $object->frame())) { 1013 $label = @{$row}[3]; 1014 my $coord_string = $basic_data{$label}; 1015 my ($ra, $dec) = $self->_coordinates($coord_string); 1016 $object->ra($ra); 1017 $object->dec($dec); 1018 last; 1019 } 1020 } 1021 1022 # Spectral type 1023 $object->spec($basic_data{"Spectral type"}); 1024 1025 # B, V magnitudes 1026 my ($bmag, $vmag) = split ',', $basic_data{"B magn, V magn, Peculiarities"}; 1027 $object->bmag($bmag); 1028 $object->vmag($vmag); 1029 1030 # Proper motion 1031 if ((my $pm = $basic_data{"Proper motion (mas/yr) [error ellipse]"})) { 1032 $object->pm(split /\s+/, $pm); 1033 } 1034 1035 # Parallax 1036 if ((my $plx = $basic_data{"Parallaxes (mas)"})) { 1037 $object->plx(split /\s+/, $plx); 1038 } 1039 1040 # Radial velocity/redshift 1041 if ((my $rvterm = $basic_data{"Radial velocity (v:Km/s) or Redshift (z)"})) { 1042 my ($type, $mag) = split /\s+/, $rvterm; 1043 if ($type eq "v") { 1044 $object->radial($mag); 1045 } elsif ($type eq "z") { 1046 $object->redshift($mag); 1047 } 1048 } 1049 1050 # Build an array of designations for this object 1051 my @idents; 1052 # Find the <pre> block under the 'lab_ident1' anchor 1053 my $iptag = $tree->look_down("_tag", "a", sub { $_[0]->attr("name") eq "lab_ident1"} )->find('pre'); 1054 foreach my $idref ($iptag->find("a")) { 1055 push @idents, trim($idref->as_text()); 1056 $idref = $idref->right(); 1057 } 1058 $object->ident(\@idents); 1059 1060 $result->addobject( $object ); 1061 return $result; 1062} 1063 1064=item B<_insert_query_params> 1065 1066Copies frame, epoch and equinox and target from the query params into 1067the result object. 1068 1069=cut 1070sub _insert_query_params { 1071 my $self = shift; 1072 my $object = shift; 1073 1074 # FRAME 1075 # ----- 1076 1077 # grab the current co-ordinate frame from the query object itself 1078 my @coord_frame = ( ${$self->{OPTIONS}}{"CooFrame"}, 1079 ${$self->{OPTIONS}}{"CooEpoch"}, 1080 ${$self->{OPTIONS}}{"CooEqui"} ); 1081 # push it into the object 1082 $object->frame( \@coord_frame ); 1083 1084 # TARGET 1085 $object->target($self->target()); 1086} 1087 1088=item B<_update_nbident> 1089 1090If the search is for a specific object and the radius is 0, do a detailed 1091(i.e., object) query, rather than a more general list (summary) query 1092that is expected to return multiple results. 1093 1094=cut 1095sub _update_nbident { 1096 my $self = shift; 1097 if ($self->use_list_query()) { 1098 ${$self->{OPTIONS}}{"NbIdent"} = "around"; 1099 } else { 1100 ${$self->{OPTIONS}}{"NbIdent"} = "1"; 1101 } 1102} 1103 1104=item B<_coordinates> 1105 1106Private function used to split a coordinate line into RA and DEC values 1107 1108=cut 1109sub _coordinates { 1110 my $self = shift; 1111 1112 # RA 1113 # -- 1114 1115 my $coords = trim(shift); 1116 1117 # split the RA and Dec line into an array elements 1118 my @radec = split( /\s+/, $coords ); 1119 1120 # ...and then rebuild it 1121 my $ra; 1122 unless( $radec[2] =~ '\+' || $radec[2] =~ '-' ) { 1123 $ra = "$radec[0] $radec[1] $radec[2]"; 1124 } else { 1125 $ra = "$radec[0] $radec[1] 00.0"; 1126 } 1127 1128 1129 # DEC 1130 # --- 1131 1132 # ...and rebuild the Dec 1133 my $dec; 1134 unless ( $radec[2] =~ '\+' || $radec[2] =~ '-' ) { 1135 $dec = "$radec[3] $radec[4] $radec[5]"; 1136 } else { 1137 $dec = "$radec[2] $radec[3] 00.0"; 1138 } 1139 1140 return ($ra, $dec); 1141} 1142 1143=item B<_dump_raw> 1144 1145Private function for debugging and other testing purposes. It will return 1146the raw output of the last SIMBAD query made using querydb(). 1147 1148=cut 1149 1150sub _dump_raw { 1151 my $self = shift; 1152 1153 # split the BUFFER into an array 1154 my @portable = split( /\n/,$self->{BUFFER}); 1155 chomp @portable; 1156 1157 return @portable; 1158} 1159 1160=item B<_dump_options> 1161 1162Private function for debugging and other testing purposes. It will return 1163the current query options as a hash. 1164 1165=cut 1166 1167sub _dump_options { 1168 my $self = shift; 1169 1170 return %{$self->{OPTIONS}}; 1171} 1172 1173=back 1174 1175=end __PRIVATE_METHODS__ 1176 1177=head1 COPYRIGHT 1178 1179Copyright (C) 2001 University of Exeter. All Rights Reserved. 1180 1181This program was written as part of the eSTAR project and is free software; 1182you can redistribute it and/or modify it under the terms of the GNU Public 1183License. 1184 1185=head1 AUTHORS 1186 1187Alasdair Allan E<lt>aa@astro.ex.ac.ukE<gt>, 1188 1189=cut 1190 1191# L A S T O R D E R S ------------------------------------------------------ 1192 11931; 1194