File Coverage

blib/lib/Astro/Catalog/Query/GSC.pm
Criterion Covered Total %
statement 12 12 100.0
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 16 16 100.0


line stmt bran cond sub pod time code
1             package Astro::Catalog::Query::GSC;
2              
3             =head1 NAME
4              
5             Astro::Catalog::Query::GSC - A query request to the GSC Catalog
6              
7             =head1 SYNOPSIS
8              
9             $gsc = new Astro::Catalog::Query::GSC( RA => $ra,
10             Dec => $dec,
11             Radius => $radius,
12             Bright => $magbright,
13             Faint => $magfaint,
14             Sort => $sort_type,
15             Nout => $number_out );
16              
17             my $catalog = $gsc->querydb();
18              
19             =head1 DESCRIPTION
20              
21             The module is an object orientated interface to the online Guide Star
22             catalogue at the ESO/ST-ECF archive site.
23              
24             Stores information about an prospective GSC query and allows the query to
25             be made, returning an Astro::Catalog::GSC::Catalog object.
26              
27             The object will by default pick up the proxy information from the HTTP_PROXY
28             and NO_PROXY environment variables, see the LWP::UserAgent documentation for
29             details.
30              
31             See L for the catalog-independent methods.
32              
33             =cut
34              
35             # L O A D M O D U L E S --------------------------------------------------
36              
37 2     2   8246782 use 5.006;
  2         16  
  2         158  
38 2     2   16 use strict;
  2         11  
  2         188  
39 2     2   64 use warnings;
  2         6  
  2         166  
40 2     2   12 use base qw/ Astro::Catalog::Transport::REST /;
  2         4  
  2         2234  
41             use vars qw/ $VERSION /;
42              
43             use File::Spec;
44             use Carp;
45              
46             # generic catalog objects
47             use Astro::Catalog;
48             use Astro::Catalog::Star;
49             use Astro::Flux;
50             use Astro::Fluxes;
51             use Number::Uncertainty;
52              
53             $VERSION = "4.31";
54              
55             =head1 REVISION
56              
57             $Id: GSC.pm,v 1.5 2005/06/16 01:57:35 aa Exp $
58              
59             =begin __PRIVATE_METHODS__
60              
61             =head2 Private methods
62              
63             These methods are for internal use only.
64              
65             =over 4
66              
67             =item B<_default_remote_host>
68              
69             =cut
70              
71             sub _default_remote_host {
72             return "archive.eso.org";
73             }
74              
75             =item B<_default_url_path>
76              
77             =cut
78              
79             sub _default_url_path {
80             return "gsc/gsc?";
81             }
82              
83             =item B<_get_allowed_options>
84              
85             Returns a hash with keys, being the internal options supported
86             by this subclass, and values being the key name actually required
87             by the remote system (and to be included in the query).
88              
89             =cut
90              
91             sub _get_allowed_options {
92             my $self = shift;
93             return (
94             ra => 'ra',
95             dec => 'dec',
96             object => 'object',
97             radmax => 'radmax',
98             magbright => 'magbright',
99             magfaint => 'magfaint',
100             sort => 'sort',
101             nout => 'nout',
102             format => 'format',
103             catalogue => 'catalogue',
104             epoch => 'epoch',
105             chart => 'chart',
106             multi => 'multi',
107             );
108             }
109              
110             =item B<_get_default_options>
111              
112             Get the default query state.
113              
114             =cut
115              
116             sub _get_default_options {
117             return (
118             # Hidden
119             catalogue => 'gsc',
120             epoch => '2000.0',
121             chart => 1,
122              
123             # Target information
124             ra => undef,
125             dec => undef,
126             object => undef,
127              
128             # Limits
129             radmax => 5,
130             magbright => 0,
131             magfaint => 100,
132             format => 1,
133             sort => 'RA',
134             nout => 20000,
135             multi => 1,
136             );
137             }
138              
139             =item B<_parse_query>
140              
141             Private function used to parse the results returned in an GSC query.
142             Should not be called directly. Instead use the querydb() assessor method to
143             make and parse the results.
144              
145             =cut
146              
147             sub _parse_query {
148             my $self = shift;
149              
150             # get a local copy of the current BUFFER
151             my @buffer = split( /\n/,$self->{BUFFER});
152             chomp @buffer;
153              
154             # create an Astro::Catalog object to hold the search results
155             my $catalog = new Astro::Catalog();
156              
157             # create a temporary object to hold stars
158             my $star;
159              
160             my ( $line, $counter );
161             my %field; # field centre
162              
163             # loop round the returned buffer and stuff the contents into star objects
164             foreach $line ( 0 ... $#buffer ) {
165              
166             # Parse field centre
167             # ------------------
168              
169             # RA
170             if( lc($buffer[$line]) =~ "ra:" ) {
171             $_ = lc($buffer[$line]);
172             my ( $ra ) = /^\s*ra:\s+(.*)<\/td>/;
173             $field{RA} = $ra;
174             }
175              
176             # Dec
177             if( lc($buffer[$line]) =~ "dec:" ) {
178             $_ = lc($buffer[$line]);
179             my ( $dec ) = /^\s+dec:\s+(.*)<\/td>/;
180             $field{Dec} = $dec;
181             }
182              
183             # Radius
184             if( lc($buffer[$line]) =~ "search radius:" ) {
185             $_ = lc($buffer[$line+1]);
186             my ( $radius ) = />\s+(.*)\s\w/;
187             $field{Radius} = $radius;
188             }
189             $catalog->fieldcentre( %field );
190              
191             # Parse list of objects
192             # ---------------------
193              
194             if( lc($buffer[$line]) =~ "
" ) { 
195              
196             # reached the catalog block, loop through until reached
197             $counter = $line+2;
198             until ( lc($buffer[$counter+1]) =~ "" ) {
199              
200             # split each line
201             my @separated = split( /\s+/, $buffer[$counter] );
202              
203             # debugging (leave in)
204             #foreach my $thing ( 0 .. $#separated ) {
205             # print " $thing # $separated[$thing] #\n";
206             #}
207              
208             # check that there is something on the line
209             if ( defined $separated[0] ) {
210              
211             # create a temporary place holder object
212             $star = new Astro::Catalog::Star();
213              
214             # ID
215             my $id = $separated[2];
216             $star->id( $id );
217              
218             # debugging
219             #my $num = $counter - $line -2;
220             #print "# ID $id star $num\n";
221              
222             # RA
223             my $objra = "$separated[3] $separated[4] $separated[5]";
224              
225             # Dec
226             my $objdec = "$separated[6] $separated[7] $separated[8]";
227              
228             $star->coords( new Astro::Coords(ra => $objra,
229             dec => $objdec,
230             units => 'sex',
231             type => 'J2000',
232             name => $id,
233             ),
234             );
235              
236             # B Magnitude
237             #my %b_mag = ( B => $separated[10] );
238             #$star->magnitudes( \%b_mag );
239              
240             $star->fluxes( new Astro::Fluxes( new Astro::Flux(
241             new Number::Uncertainty( Value => $separated[10],
242             Error => $separated[11] ),
243             'mag', "B" )));
244              
245             # B mag error
246             #my %mag_errors = ( B => $separated[11] );
247             #$star->magerr( \%mag_errors );
248              
249             # Quality
250             my $quality = $separated[13];
251             $quality = 1 if $quality == 3; # 3 == non-stellar
252             $star->quality( $quality );
253              
254             # Field
255             my $field = $separated[12];
256             $star->field( $field );
257              
258             # GSC, obvious!
259             $star->gsc( "TRUE" );
260              
261             # Distance
262             my $distance = $separated[16];
263             $star->distance( $distance );
264              
265             # Position Angle
266             my $pos_angle = $separated[17];
267             $star->posangle( $pos_angle );
268              
269             }
270              
271             # Push the star into the catalog
272             # ------------------------------
273             $catalog->pushstar( $star );
274              
275             # increment counter
276             # -----------------
277             $counter = $counter + 1;
278             }
279              
280             # reset $line to correct place
281             $line = $counter;
282             }
283              
284             }
285             # Set the field centre
286             $catalog->fieldcentre( %field );
287              
288             return $catalog;
289             }
290              
291              
292             =back
293              
294             =head2 Translation Methods
295              
296             The query options stored internally in the object are not necessarily
297             the form required for a query to a remote server. Methods for converting
298             from the internal representation to the external query format are
299             provided in the form of _from_$opt. ie:
300              
301             ($outkey, $outvalue) = $q->_from_ra();
302             ($outkey, $outvalue) = $q->_from_object();
303              
304             The base class only includes one to one mappings.
305              
306             =item B<_translate_one_to_one>
307              
308             Return a list of internal options (as defined in C<_get_allowed_options>)
309             that are known to support a one-to-one mapping of the internal value
310             to the external value.
311              
312             %one = $q->_translate_one_to_one();
313              
314             Returns a hash with keys and no values (this makes it easy to
315             check for the option).
316              
317             This method also returns, the values from the parent class.
318              
319             =cut
320              
321             sub _translate_one_to_one {
322             my $self = shift;
323             # convert to a hash-list
324             return ($self->SUPER::_translate_one_to_one,
325             map { $_, undef }(qw/
326             chart epoch catalogue
327             /)
328             );
329             }
330              
331              
332             sub _from_multi {
333             my $self = shift;
334             my $key = "multi";
335             my $value = $self->query_options($key);
336              
337             # convert boolean to "yes" or "no"
338             if (!$value || $value =~ /^no%/i) {
339             # boolean false is always false
340             # as is "no"
341             $value = 'no';
342             } else {
343             # must be true
344             $value = 'yes';
345             }
346              
347             my %allow = $self->_get_allowed_options();
348             return ($allow{$key}, $value);
349             }
350              
351             =end __PRIVATE_METHODS__
352              
353             =head1 COPYRIGHT
354              
355             Copyright (C) 2001 University of Exeter. All Rights Reserved.
356             Some modifications copyright (C) 2003 Particle Physics and Astronomy
357             Research Council. All Rights Reserved.
358              
359             This program was written as part of the eSTAR project and is free software;
360             you can redistribute it and/or modify it under the terms of the GNU Public
361             License.
362              
363             =head1 AUTHORS
364              
365             Alasdair Allan Eaa@astro.ex.ac.ukE,
366             Tim Jenness Etjenness@cpan.orgE
367              
368             =cut
369              
370             # L A S T O R D E R S ------------------------------------------------------
371              
372             1;