1=head1 NAME
2
3Astro::SIMBAD::Client - Fetch astronomical data from SIMBAD 4.
4
5=head1 SYNOPSIS
6
7 use Astro::SIMBAD::Client;
8 my $simbad = Astro::SIMBAD::Client->new ();
9 print $simbad->query (id => 'Arcturus');
10
11=head1 NOTICE
12
13As of release 0.027_01 the SOAP interface is deprecated. The University
14of Strasbourg has announced at
15L<https://cds.u-strasbg.fr/resources.gml?id=soap> that this
16interface will not be maintained after April 1 2014, and that
17B<this interface will be stopped on December 31 2018>.
18
19Because the SOAP interface is still sort of functional (except for
20VO-format queries) as of June 4 2014, I have revised the transition plan
21announced with the release of 0.027_01 on October 28 2014.
22
23What I have done as of version 0.031_01 is to add attribute
24C<emulate_soap_queries>. This was false by default. If this attribute is
25true, the C<query()> method and friends, instead of issuing a SOAP
26request to the SIMBAD server, will instead construct an equivalent
27script query, and issue that. The deprecation warning will not be issued
28if C<emulate_soap_queries> is true, since the SOAP interface is not
29being used.
30
31As of March 22 2021, SOAP queries started returning 404. Because of
32this, I have made the default of C<emulate_soap_queries> true. Well,
33actually I have made it the Boolean inverse of environment variable
34L<ASTRO_SIMBAD_CLIENT_USE_SOAP|/ASTRO_SIMBAD_CLIENT_USE_SOAP>. This is
35mostly for my benefit, so I can see if SOAP has come back.
36
37If SOAP still has not come back after six months, SOAP queries will
38become fatal, as will setting C<emulate_soap_queries> to a false value.
39
40Eventually the SOAP code will be removed. In the meantime all tests are
41skipped unless C<ASTRO_SIMBAD_CLIENT_USE_SOAP> is true, and are marked
42TODO. Support of SOAP by this module will be on a best-effort basis;
43that is, if I can make it work without a huge amount of work I will --
44otherwise SOAP will become unsupported.
45
46=head1 DESCRIPTION
47
48This package implements several query interfaces to version 4 of the
49SIMBAD on-line astronomical database, as documented at
50L<http://simbad.u-strasbg.fr/simbad4.htx>. B<This package will not work
51with SIMBAD version 3.> Its primary purpose is to obtain SIMBAD data,
52though some rudimentary parsing functionality also exists.
53
54There are three ways to access these data.
55
56- URL queries are essentially page scrapers, but their use is
57documented, and output is available as HTML, text, or VOTable. URL
58queries are implemented by the url_query() method.
59
60- Scripts may be submitted using the script() or script_file() methods.
61The former takes as its argument the text of the script, the latter
62takes a file name.
63
64- Queries may be made using the web services (SOAP) interface. The
65query() method implements this, and queryObjectByBib,
66queryObjectByCoord, and queryObjectById have been provided as
67convenience methods. As of version 0.027_01, SOAP queries are
68deprecated. See the L<NOTICE|/NOTICE> section above for the deprecation
69schedule.
70
71Astro::SIMBAD::Client is object-oriented, with the object supplying not
72only the URL scheme and SIMBAD server name, but the default format and
73output type for URL and web service queries.
74
75A simple command line client application is also provided, as are
76various examples in the F<eg> directory.
77
78=head2 Methods
79
80The following methods should be considered public:
81
82=over 4
83
84=cut
85
86package Astro::SIMBAD::Client;
87
88# We require Perl 5.008 because of MailTools, used by SOAP::Lite.
89# Otherwise it would be 5.006 because of 'our'.
90
91use 5.008;
92
93use strict;
94use warnings;
95
96use Carp;
97use LWP::UserAgent;
98use LWP::Protocol;
99use HTTP::Request::Common qw{POST};
100use Scalar::Util 1.01 qw{looks_like_number};
101use URI::Escape ();
102use XML::DoubleEncodedEntities;
103# use Astro::SIMBAD::Client::WSQueryInterfaceService;
104
105use constant ARRAY_REF	=> ref [];
106use constant CODE_REF	=> ref sub {};
107
108my $have_time_hires;
109BEGIN {
110    $have_time_hires = eval {
111	require Time::HiRes;
112	Time::HiRes->import (qw{time sleep});
113	1;
114    };
115
116    *_escape_uri = URI::Escape->can( 'uri_escape_utf8' )
117	|| URI::Escape->can( 'uri_escape' )
118	|| sub { return $_[0] };
119}
120
121our $VERSION = '0.046';
122
123our @CARP_NOT = qw{Astro::SIMBAD::Client::WSQueryInterfaceService};
124
125# TODO replace this with s///r if we ever get to the point where we
126# require Perl 5.13.2 or greater.
127sub _strip_returns {
128    my ( $data ) = @_;
129    $data =~ s/ \n //smxg;
130    return $data;
131}
132
133use constant FORMAT_TXT_SIMPLE_BASIC => _strip_returns( <<'EOD' );
134---\n
135name: %IDLIST(NAME|1)\n
136type: %OTYPE\n
137long: %OTYPELIST\n
138ra: %COO(d;A)\n
139dec: %COO(d;D)\n
140plx: %PLX(V)\n
141pmra: %PM(A)\n
142pmdec: %PM(D)\n
143radial: %RV(V)\n
144redshift: %RV(Z)\n
145spec: %SP(S)\n
146bmag: %FLUXLIST(B)[%flux(F)]\n
147vmag: %FLUXLIST(V)[%flux(F)]\n
148ident: %IDLIST[%*,]
149EOD
150
151use constant FORMAT_TXT_YAML_BASIC => _strip_returns( <<'EOD' );
152---\n
153name: '%IDLIST(NAME|1)'\n
154type: '%OTYPE'\n
155long: '%OTYPELIST'\n
156ra: %COO(d;A)\n
157dec: %COO(d;D)\n
158plx: %PLX(V)\n
159pm:\n
160  - %PM(A)\n
161  - %PM(D)\n
162radial: %RV(V)\n
163redshift: %RV(Z)\n
164spec: %SP(S)\n
165bmag: %FLUXLIST(B)[%flux(F)]\n
166vmag: %FLUXLIST(V)[%flux(F)]\n
167ident:\n%IDLIST[  - '%*'\n]
168EOD
169
170#	Documentation errors/omissions:
171#	%PLX:
172#	     P = something. Yields '2' for Arcturus
173#	%SP: is really %sptype
174#	     B = bibcode? Yields '~' for Arcturus
175#	     N = don't know -- yields 'S' for Arcturus
176#	     Q = quality? Yields 'C' for Arcturus
177#	     S = spectral type
178
179use constant FORMAT_VO_BASIC => join ',', qw{
180    id(NAME|1) otype ra(d) dec(d) plx_value pmra pmdec rv_value z_value
181    sp_type flux(B) flux(V)};
182    # Note that idlist was documented at one point as being the
183    # VOTable equivalent of %IDLIST. But it is no longer documented,
184    # and never returned anything but '<TD>?IDLIST</TD>'.
185
186my %static = (
187    autoload => 1,
188    debug => 0,
189    delay => 3,
190    emulate_soap_queries	=> ! $ENV{ASTRO_SIMBAD_CLIENT_USE_SOAP},
191    format => {
192	txt => FORMAT_TXT_YAML_BASIC,
193	vo => FORMAT_VO_BASIC,
194	script => '',
195    },
196    parser => {
197	txt => '',
198	vo => '',
199	script => '',
200    },
201    post => 1,
202    # lc(...) per https://tools.ietf.org/html/rfc3986#section-3.1
203    scheme => lc( $ENV{ASTRO_SIMBAD_CLIENT_SCHEME} || 'http' ),
204##    server => 'simbad.u-strasbg.fr',
205    server => $ENV{ASTRO_SIMBAD_CLIENT_SERVER} || 'simbad.u-strasbg.fr',
206    type => 'txt',
207    url_args => {},
208    verbatim => 0,
209);
210
211if ( my $msg = _is_scheme_valid(
212	$static{scheme},
213	q<Unsupported ASTRO_SIMBAD_CLIENT_SCHEME '%s'; falling back to 'http'>,
214    ) ) {
215    carp $msg;
216    $static{scheme} = 'http';
217}
218
219=item $simbad = Astro::SIMBAD::Client->new ();
220
221This method instantiates an Astro::SIMBAD::Client object. Any arguments will be
222passed to the set() method once the object is instantiated.
223
224=cut
225
226# The set() method does the unpacking. CAVEAT: do _NOT_ modify the
227# contents of @_, as this will be seen by the caller. Modifying @_
228# itself is fine.
229sub new {	## no critic (RequireArgUnpacking)
230    my $class = shift;
231    $class = ref $class if ref $class;
232    my $self = bless {}, $class;
233    $self->set (%static, @_);
234    return $self;
235}
236
237=item $string = $simbad->agent ();
238
239This method retrieves the user agent string used to identify this
240package in queries to SIMBAD. This string will be the default string for
241LWP::UserAgent, with this package name and version number appended in
242parentheses. This method is exposed for the curious.
243
244=cut
245
246{
247    my $agent_string;
248    sub agent {
249	return ($agent_string ||= join (' ', LWP::UserAgent->_agent,
250	    __PACKAGE__ . '/' . $VERSION));
251    }
252}
253
254=item @attribs = $simbad->attributes ();
255
256This method retrieves the names of all public attributes, in
257alphabetical order. It can be called as a static method, or
258even as a subroutine.
259
260=cut
261
262sub attributes {
263    return wantarray ? sort keys %static : [sort keys %static]
264}
265
266=item $value = $simbad->get ($attrib);
267
268This method retrieves the current value of the named
269L<attribute|/Attributes>. It can be called as a static method to
270retrieve the default value.
271
272=cut
273
274sub get {
275    my $self = shift;
276    croak "Error - First argument must be an @{[__PACKAGE__]} object"
277	unless eval {$self->isa(__PACKAGE__)};
278    $self = \%static unless ref $self;
279    my $name = shift;
280    croak "Error - Attribute '$name' is unknown"
281	unless exists $static{$name};
282    return $self->{$name};
283}
284
285=item $result = Parse_TXT_Simple ($data);
286
287This subroutine (B<not> method) parses the given text data under the
288assumption that it was generated using FORMAT_TXT_SIMPLE_BASIC or
289something similar. The data is expected to be formatted as follows:
290
291A line consisting of exactly '---' separates objects.
292
293Data appear on lines that look like
294
295 name: data
296
297and are parsed into a hash keyed by the given name. If the line ends
298with a comma, it is assumed to contain multiple items, and the data
299portion of the line is split on the commas; the resultant hash value
300is a list reference.
301
302The user would normally not call this directly, but specify it as the
303parser for 'txt'-type queries:
304
305 $simbad->set (parser => {txt => 'Parse_TXT_Simple'});
306
307=cut
308
309sub Parse_TXT_Simple {
310    my $text = shift;
311    my $obj = {};
312    my @data;
313    foreach (split '\s*\n', $text) {
314	next unless $_;
315	if (m/^-+$/) {
316	    $obj = {};
317	    push @data, $obj;
318	} else {
319	    my ($name, $val) = split ':\s*', $_;
320	    $val =~ s/,$// and $val = [split ',', $val];
321	    $obj->{$name} = $val;
322	}
323    }
324    return @data;
325}
326
327=item $result = Parse_VO_Table ($data);
328
329This subroutine (B<not> method) parses the given VOTable data,
330returning a list of anonymous hashes describing the data. The $data
331value is split on '<?xml' before parsing, so that you get multiple
332VOTables back (rather than a parse error) if that is what the input
333contains.
334
335This is B<not> a full-grown VOTable parser capable of handling
336the full spec (see L<https://www.ivoa.net/documents/latest/VOT.html>).
337It is oriented toward returning E<lt>TABLEDATAE<gt> contents, and the
338metadata that can reasonably be associated with those contents.
339
340B<NOTE> that as of version 0.026_01, the requisite modules
341to support VO format are B<not> required. If you need VO format you will
342need to install L<XML::Parser|XML::Parser> or L<XML::Parser::Lite>
343
344The return is a list of anonymous hashes, one per E<lt>TABLEE<gt>. Each
345hash contains two keys:
346
347  {data} is the data contained in the table, and
348  {meta} is the metadata for the table.
349
350The {meta} element for the table is a reference to a list of data
351gathered from the E<lt>TABLEE<gt> tag. Element zero is the tag name
352('TABLE'), and element 1 is a reference to a hash containing the
353attributes of the E<lt>TABLEE<gt> tag. Subsequent elements if any
354represent metadata tags in the order encountered in the parse.
355
356The {data} contains an anonymous list, each element of which is a row of
357data from the E<lt>TABLEDATAE<gt> element of the E<lt>TABLEE<gt>, in the
358order encountered by the parse. Each row is a reference to a list of
359anonymous hashes, which represent the individual data of the row, in the
360order encountered by the parse. The data hashes contain two keys:
361
362 {value} is the value of the datum with undef for '~', and
363 {meta} is a reference to the metadata for the datum.
364
365The {meta} element for a datum is a reference to the metadata tag that
366describes that datum. This will be an anonymous list, of which element 0
367is the tag ('FIELD'), element 1 is a reference to a hash containing that
368tag's attributes, and subsequent elements will be the contents of the
369tag (typically including a reference to the list representing the
370E<lt>DESCRIPTIONE<gt> tag for that FIELD).
371
372All values are returned as provided by the XML parser; no further
373decoding is done. Specifically, the datatype and arraysize attributes
374are ignored.
375
376This parser is based on XML::Parser.
377
378The user would normally not call this directly, but specify it as the
379parser for 'vo'-type queries:
380
381 $simbad->set (parser => {vo => 'Parse_VO_Table'});
382
383=cut
384
385{	# Begin local symbol block.
386
387    my $xml_parser;
388
389    # TODO get rid of XML::Parser::Lite when you get rid of SOAP
390    foreach (qw{XML::Parser XML::Parser::Lite}) {
391	eval { _load_module( $_ ); 1 } or next;
392	$xml_parser = $_;
393	last;
394    }
395
396    sub Parse_VO_Table {
397	my $data = shift;
398
399	defined $xml_parser
400	    or croak 'Error - No XML parser available. Need XML::Parser or XML::Parser::Lite';
401
402	my $root;
403	my @tree;
404	my @table;
405	my @to_strip;
406
407#	Arguments:
408#	Init ($class)
409#	Start ($class, $tag, $attr => $value ...)
410#	Char ($class, $text)
411#	End ($class, $tag)
412#	Final ($class)
413
414	my $psr = $xml_parser->new (
415	    Handlers => {
416		Init => sub {
417		    $root = [];
418		    @tree = ($root);
419		    @table = ();
420		},
421		Start => sub {
422		    shift;
423		    my $tag = shift;
424		    my $item = [$tag, {@_}];
425		    push @{$tree[-1]}, $item;
426		    push @tree, $item;
427		},
428		Char => sub {
429		    push @{$tree[-1]}, $_[1];
430		},
431		End => sub {
432		    my $tag = $_[1];
433		    die <<eod unless @tree > 1;
434Error - Unmatched end tag </$tag>
435eod
436		    die <<eod unless $tag eq $tree[-1][0];
437Error - End tag </$tag> does not match start tag <$tree[-1][0]>
438eod
439
440#	From here to the end of the subroutine is devoted to detecting
441#	the </TABLE> tag and extracting the data of the table into what
442#	is hopefully a more usable format. Any relationship of tables
443#	to resources is lost.
444
445		    my $element = pop @tree;
446		    if ($element->[0] eq 'TABLE') {
447			my (@meta, @data, @descr);
448			foreach (@$element) {
449			    next unless ARRAY_REF eq ref $_;
450			    if ($_->[0] eq 'FIELD') {
451				push @meta, $_;
452				push @descr, $_;
453			    } elsif ($_->[0] eq 'DATA') {
454				foreach (@$_) {
455				    next unless ARRAY_REF eq ref $_;
456				    next unless $_->[0] eq 'TABLEDATA';
457				    foreach (@$_) {
458					next unless ARRAY_REF eq ref $_;
459					next unless $_->[0] eq 'TR';
460					my @row;
461					foreach (@$_) {
462					    next unless ARRAY_REF eq ref $_;
463					    next unless $_->[0] eq 'TD';
464					    my @inf = grep {!ref $_} @$_;
465					    shift @inf;
466					    push @row, join ' ', @inf;
467					}
468					push @data, \@row;
469				    }
470				}
471			    } else {
472				push @descr, $_;
473			    }
474			}
475			foreach (@data) {
476			    my $inx = 0;
477			    @$_ = map { {
478				    value => (defined $_ && $_ eq '~')
479					? undef : $_,
480				    meta => $meta[$inx++],
481				} } @$_;
482			}
483			push @to_strip, @descr;
484			push @table, {
485			    data => \@data,
486			    meta => [$element->[0],
487				$element->[1], @descr],
488			};
489		    }
490		},
491		Final => sub {
492		    die <<eod if @tree > 1;
493Error - Missing end tags.
494eod
495
496##		    _strip_empty ($root);
497##		    @$root;
498#	If the previous two lines were uncommented and the following two
499#	commented, the parser would return the parse tree for the
500#	VOTable.
501		    _strip_empty (\@to_strip);
502		    @table;
503		},
504	    });
505	return map {$_ ? $psr->parse ($_) : ()} split '(?=<\?xml)', $data
506    }
507
508}	# End of local symbol block.
509
510#	_strip_empty (\@tree)
511#
512#	splices out anything in the tree that is not a reference and
513#	does not match m/\S/.
514
515sub _strip_empty {
516    my $ref = shift;
517    my $inx = @$ref;
518    while (--$inx >= 0) {
519	my $val = $ref->[$inx];
520	my $typ = ref $val;
521	if ( ARRAY_REF eq $typ ) {
522	    _strip_empty ($val);
523	} elsif (!$typ) {
524	    splice @$ref, $inx, 1 unless $val =~ m/\S/ms;
525	}
526    }
527    return;
528}
529
530=item $result = $simbad->query ($query => @args);
531
532This method is B<deprecated>, and will cease to work in April 2014.
533Please choose a method that does not use SOAP. See the L<NOTICE|/NOTICE>
534above for details.
535
536This method issues a web services (SOAP) query to the SIMBAD database.
537The $query specifies a SIMBAD query method, and the @args are the
538arguments for that method. Valid $query values and the corresponding
539SIMBAD methods and arguments are:
540
541  bib => queryObjectByBib ($bibcode, $format, $type)
542  coo => queryObjectByCoord ($coord, $radius, $format, $type)
543  id => queryObjectById ($id, $format, $type)
544
545where:
546
547  $bibcode is a SIMBAD bibliographic code
548  $coord is a set of coordinates
549  $radius is an angular radius around the coordinates
550  $type is the type of data to be returned
551  $format is a format appropriate to the data type.
552
553The $type defaults to the value of the L<type|/type> attribute, and
554the $format defaults to the value of the L<format|/format> attribute
555for the given $type.
556
557The return value depends on a number of factors:
558
559If the query found nothing, you get undef in scalar context, and an
560empty list in list context.
561
562If a L<parser|/parser> is defined for the given type, the returned
563data will be fed to the parser, and the output of the parser will be
564returned. This is assumed to be a list, so a reference to the list
565will be used in scalar context. Parser exceptions are not trapped,
566so the caller will need to be prepared to deal with malformed data.
567
568Otherwise, the result of the query is returned as-is.
569
570B<NOTE> that this functionality makes use of the
571L<SOAP::Lite|SOAP::Lite> module. As of version 0.026_01 of
572C<Astro::SIMBAD::Client>, L<SOAP::Lite|SOAP::Lite> is not a prerequisite
573of this module. If you wish to use the C<query()> method, you will have
574to install L<SOAP::Lite|SOAP::Lite> separately. This can be done after
575C<Astro::SIMBAD::Client> is installed.
576
577=cut
578
579{	# Begin local symbol block
580
581    my %query_args = (
582	id => {
583	    type => 2,
584	    format => 1,
585	    method => 'queryObjectById',
586	},
587	bib => {
588	    type => 2,
589	    format => 1,
590	    method => 'queryObjectByBib',
591	},
592	coo => {
593	    type => 3,
594	    format => 2,
595	    method => 'queryObjectByCoord',
596	},
597    );
598
599    my %transform = (
600	txt => sub {
601	    local $_ = $_[0];
602	    s/\n//gm;
603	    return $_
604	},
605	vo => sub {
606	    local $_ = ref $_[0] ? join (',', @{$_[0]}) : $_[0];
607	    if ( defined $_ ) {
608		s/\s+/,/gms;
609		s/^,+//;
610		s/,+$//;
611		s/,+/,/g;
612	    }
613	    return $_
614	},
615    );
616
617    my %make_script = (
618	txt	=> sub {
619	    my ( $self, $query, @args ) = @_;
620	    return <<"EOD";
621format object "@{[ $transform{txt}->( $self->get( 'format' )->{txt} ) ]}"
622query $query @args
623EOD
624	},
625	vo	=> sub {
626	    my ( $self, $query, @args ) = @_;
627	    return <<"EOD";
628votable myvo {
629@{[ $transform{vo}->( $self->get( 'format' )->{vo} ) ]}
630}
631votable open myvo
632query $query @args
633votable close myvo
634EOD
635	},
636    );
637
638    sub query {
639	my ( $self, $query, @args ) = @_;
640	if ( $self->get( 'emulate_soap_queries' ) ) {
641	    my $type = $self->get( 'type' );
642	    my $code = $make_script{$type} || sub {
643		my ( undef, $query, @args ) = @_;	# Invocant unused
644		return "query $query @args\n";
645	    };
646	    return $self->_script(
647		parser	=> $type,
648		script	=> $code->( $self, $query, @args ),
649		verbatim	=> 0,
650	    );
651	}
652	$self->_deprecation_notice( method => 'query', 'a non-SOAP method' );
653	eval { _load_module( 'SOAP::Lite' ); 1 }
654	    or croak 'Error - query() requires SOAP::Lite';
655	eval { _load_module(
656		'Astro::SIMBAD::Client::WSQueryInterfaceService' ); 1 }
657	    or croak "Programming Error - Can not load Astro::SIMBAD::Client::WSQueryInterfaceService: $@";
658	croak "Error - Illegal query type '$query'"
659	    unless $query_args{$query};
660	my $method = $query_args{$query}{method};
661	croak "Programming error - Illegal query $query method $method"
662	    unless Astro::SIMBAD::Client::WSQueryInterfaceService->can ($method);
663	my $debug = $self->get ('debug');
664	my $parser;
665	if (defined (my $type = $query_args{$query}{type})) {
666	    $args[$type] ||= $self->get ('type');
667	    if (defined (my $format = $query_args{$query}{format})) {
668		$args[$format] ||= $self->get ('format')->{$args[$type]};
669		$args[$format] = $transform{$args[$type]}->($args[$format])
670		    if $transform{$args[$type]};
671		warn "$args[$type] format: $args[$format]\n" if $debug;
672		$args[$format] = undef unless $args[$format];
673	    }
674	    $parser = $self->_get_parser ($args[$type]);
675	}
676	SOAP::Lite->import (+trace => $debug ? 'all' : '-all');
677	$self->_delay ();
678##	$debug and SOAP::Trace->import ('all');
679	my $resp = Astro::SIMBAD::Client::WSQueryInterfaceService->$method(
680	    $self, @args);
681	return unless defined $resp;
682	$resp = XML::DoubleEncodedEntities::decode ($resp);
683	return wantarray ? ($parser->($resp)) : [$parser->($resp)]
684	    if $parser;
685	return $resp;
686    }
687
688}	# End local symbol block.
689
690=item $value = $simbad->queryObjectByBib ($bibcode, $format, $type);
691
692This method is B<deprecated>, and will cease to work on December 31
6932018. Please choose a method that does not use SOAP. See the
694L<NOTICE|/NOTICE> above for details.
695
696This method is just a convenience wrapper for
697
698 $value = $simbad->query (bib => $bibcode, $format, $type);
699
700See the query() documentation for more information.
701
702=cut
703
704sub queryObjectByBib {
705    my $self = shift;
706    return $self->query (bib => @_);
707}
708
709=item $value = $simbad->queryObjectByCoord ($coord, $radius, $format, $type);
710
711This method is B<deprecated>, and will cease to work on December 31
7122018. Please choose a method that does not use SOAP. See the
713L<NOTICE|/NOTICE> above for details.
714
715This method is just a convenience wrapper for
716
717 $value = $simbad->query (coo => $coord, $radius, $format, $type);
718
719See the query() documentation for more information.
720
721=cut
722
723sub queryObjectByCoord {
724    my $self = shift;
725    return $self->query (coo => @_);
726}
727
728=item $value = $simbad->queryObjectById ($id, $format, $type);
729
730This method is B<deprecated>, and will cease to work on December 31
7312018. Please choose a method that does not use SOAP. See the
732L<NOTICE|/NOTICE> above for details.
733
734This method is just a convenience wrapper for
735
736 $value = $simbad->query (id => $id, $format, $type);
737
738See the query() documentation for more information.
739
740=cut
741
742sub queryObjectById {
743    my $self = shift;
744    return $self->query (id => @_);
745}
746
747=item $release = $simbad->release ();
748
749This method returns the current SIMBAD4 release, as scraped from the
750top-level web page. This will look something like 'SIMBAD4 1.045 -
75127-Jul-2007'
752
753If called in list context, it returns ($major, $minor, $point, $patch,
754$date).  The returned information corresponding to the scalar example
755above is:
756
757 $major => 4
758 $minor => 1
759 $point => 45
760 $patch => ''
761 $date => '27-Jul-2007'
762
763The $patch will usually be empty, but occasionally you get something
764like release '1.019a', in which case $patch would be 'a'.
765
766Please note that this method is B<not> based on a published interface,
767but is simply a web page scraper, and subject to all the problems such
768software is heir to. What the algorithm attempts to do is to find (and
769parse, if called in list context) the contents of the next E<lt>tdE<gt>
770after 'Release:' (case-insensitive).
771
772=cut
773
774sub release {
775    my $self = shift;
776    my $rslt = $self->_retrieve( 'simbad/' );
777    my ($rls) = $rslt->content =~
778	m{Release:.*?</td>.*?<td.*?>(.*?)</td>}sxi
779	or croak "Error - Release information not found";
780    $rls =~ s{<.*?>}{}g;
781    $rls =~ s/^\s+//;
782    $rls =~ s/\s+$//;
783    wantarray or return $rls;
784    $rls =~ s/\s+-\s+/ /;
785    my ($major, $minor, $date) = split '\s+', $rls
786	or croak "Error - Release '$rls' is ill-formed";
787    $major =~s/^\D+//;
788    $major += 0;
789    ($minor, my $point) = split '\.', $minor, 2;
790    $minor += 0;
791    ($point, my $patch) = $point =~ m/^(\d+)(.*)/
792	or croak "Error - Release '$rls' is ill-formed: bad point";
793    defined $patch or $patch = '';
794    $point += 0;
795    return ($major, $minor, $point, $patch, $date);
796}
797
798=item $value = $simbad->script ($script);
799
800This method submits the given script to SIMBAD4. The $script variable
801contains the text if the script; if you want to submit a script file
802by name, use the script_file() method.
803
804If the L<verbatim|/verbatim> attribute is false, the front matter of the
805result (up to and including the '::data:::::' line) is stripped. If
806there is no '::data:::::' line, the entire script output is raised as an
807exception.
808
809If a 'script' L<parser|/parser> was specified, the output of the script
810(after stripping front matter if that was specified) is passed to it.
811The parser is presumed to return a list, so if script() was called in
812scalar context you get a reference to that list back.
813
814If no 'script' L<parser|/parser> is specified, the output of the script
815(after stripping front matter if that was specified) is simply returned
816to the caller.
817
818=cut
819
820sub script {
821    my ( $self, $script ) = @_;
822    return $self->_script(
823	parser	=> 'script',
824	script	=> $script,
825	verbatim	=> $self->get( 'verbatim' ),
826    );
827}
828
829{
830    my %dflt = (
831	parser	=> sub { return 'script' },
832	script	=> sub {
833	    confess 'Programming error - script argument required';
834	},
835	verbatim	=> sub {
836	    my ( $self ) = @_;
837	    return $self->get( 'verbatim' );
838	},
839    );
840
841    sub _script {
842	my ( $self, %arg ) = @_;
843
844	foreach my $key ( keys %dflt ) {
845	    defined $arg{$key}
846		or $arg{$key} = $dflt{$key}->( $self );
847	}
848
849	my $debug = $self->get( 'debug' );
850
851	$debug
852	    and warn "Debug - script\n$arg{script} ";
853
854	my $resp = $self->_retrieve( 'simbad/sim-script', {
855		submit	=> 'submit+script',
856		script	=> $arg{script},
857	    },
858	);
859
860	my $rslt = $resp->content
861	    or return;
862
863	unless ( $arg{verbatim} ) {
864	    $rslt =~ s/.*?::data:+\s*//sm or croak $rslt;
865	}
866
867	$debug
868	    and warn "Debug - result:\n$rslt ";
869
870	$rslt = XML::DoubleEncodedEntities::decode( $rslt );
871	if ( my $parser = $self->_get_parser( $arg{parser} ) ) {
872	    $debug
873		and warn "Debug - Parser $arg{parser}";
874	    ## $rslt =~ s/.*?::data:+.?$//sm or croak $rslt;
875	    my @rslt = $parser->($rslt);
876	    $debug
877		and eval {	## no critic (RequireCheckingReturnValueOfEval)
878		require YAML;
879		warn "Debug - Parsed to:\n", YAML::Dump( \@rslt ), ' ';
880	    };
881	    return wantarray ? @rslt : \@rslt;
882	} else {
883	    $debug
884		and warn "Debug - No parser for $arg{parser}";
885	    return $rslt;
886	}
887    }
888}
889
890=item $value = $simbad->script_file ($filename);
891
892This method submits the given script file to SIMBAD, returning the
893result of the script. Unlike script(), the argument is the name of the
894file containing the script, not the text of the script. However, if a
895parser for 'script' has been specified, it will be applied to the
896output.
897
898=cut
899
900sub script_file {
901    my ( $self, $file ) = @_;
902
903    my $url = $self->__build_url( 'simbad/sim-script' );
904    my $rqst = POST $url,
905	Content_Type => 'form-data',
906	Content => [
907	    submit => 'submit file',
908	    scriptFile => [$file, undef],
909    	    # May need to specify Content_Type => application/octet-stream.
910	];
911    my $resp = $self->_retrieve( $rqst );
912
913    my $rslt = $resp->content or return;
914    unless ($self->get ('verbatim')) {
915	$rslt =~ s/.*?::data:+\s*//sm or croak $rslt;
916    }
917    if (my $parser = $self->_get_parser ('script')) {
918##	$rslt =~ s/.*?::data:+.?$//sm or croak $rslt;
919##	$rslt =~ s/\s+//sm;
920	my @rslt = $parser->($rslt);
921	return wantarray ? @rslt : \@rslt;
922    } else {
923	return $rslt;
924    }
925
926}
927
928=item $simbad->set ($name => $value ...);
929
930This method sets the value of the given L<attributes|/Attributes>. More
931than one name/value pair may be specified. If called as a static method,
932it sets the default value of the attribute.
933
934=cut
935
936{	# Begin local symbol block.
937
938    my $ckpn = sub {
939	(looks_like_number ($_[2]) && $_[2] >= 0)
940	    or croak "Attribute '$_[1]' must be a non-negative number";
941	+$_[2];
942    };
943
944    my %mutator = (
945	format => \&_set_hash,
946	parser => \&_set_hash,
947	scheme	=> \&_set_scheme,
948	url_args => \&_set_hash,
949    );
950
951    my %transform = (
952	delay => ($have_time_hires ?
953	    $ckpn :
954	    sub {+sprintf '%d', $ckpn->(@_) + .5}),
955	format => sub {
956##	    my ( $self, $name, $val, $key ) = @_;
957	    my ( $self, undef, $val ) = @_;	# Name and key unused
958	    if ($val !~ m/\W/ && (my $code = eval {
959			$self->_get_coderef ($val)})) {
960		$val = $code->();
961	    }
962	    $val;
963	},
964	parser => sub {
965##	    my ( $self, $name, $val, $key ) = @_;
966	    my ( $self, undef, $val ) = @_;	# Name and key unused
967	    if (!ref $val) {
968		unless ($val =~ m/::/) {
969		    my $pkg = $self->_parse_subroutine_name ($val);
970		    $val = $pkg . '::' . $val;
971		}
972		$self->_get_coderef ($val);	# Just to see if we can.
973	    } elsif ( CODE_REF ne ref $val ) {
974		croak "Error - $_[1] value must be scalar or code reference";
975	    }
976	    $val;
977	},
978    );
979
980    foreach my $key (keys %static) {
981	$transform{$key} ||= sub {$_[2]};
982	$mutator{$key} ||= sub {
983	    my $hash = ref $_[0] ? $_[0] : \%static;
984	    $hash->{$_[1]} = $transform{$_[1]}->(@_)
985	};
986    }
987
988    sub set {
989	my ($self, @args) = @_;
990	croak "Error - First argument must be an @{[__PACKAGE__]} object"
991	    unless eval {$self->isa(__PACKAGE__)};
992	while (@args) {
993	    my $name = shift @args;
994	    croak "Error - Attribute '$name' is unknown"
995		unless exists $mutator{$name};
996	    $mutator{$name}->($self, $name, shift @args);
997	}
998	return $self;
999    }
1000
1001    sub _set_hash {
1002	my ($self, $name, $value) = @_;
1003	my $hash = ref $self ? $self : \%static;
1004	unless (ref $value) {
1005	    $value = {$value =~ m/=/ ?
1006		split ('=', $value, 2) : ($value => undef)};
1007	}
1008	$hash->{$name} = {} if $value->{clear};
1009	delete $value->{clear};
1010	foreach my $key (keys %$value) {
1011	    my $val = $value->{$key};
1012	    if (!defined $val) {
1013		delete $hash->{$name}{$key};
1014	    } elsif ($val) {
1015		$hash->{$name}{$key} =
1016		    $transform{$name}->($self, $name, $value->{$key}, $key);
1017	    } else {
1018		$hash->{$name}{$key} = '';
1019	    }
1020	}
1021	return;
1022    }
1023
1024    sub _set_scheme {
1025	my ( $self, $name, $value ) = @_;
1026	if ( my $msg = _is_scheme_valid( $value ) ) {
1027	    croak $msg;
1028	}
1029	my $hash = ref $self ? $self : \%static;
1030	$hash->{$name} = lc $value;
1031	return;
1032    }
1033
1034}	# End local symbol block.
1035
1036=item $value = $simbad->url_query ($type => ...)
1037
1038This method performs a query by URL, returning the results. The type
1039is one of:
1040
1041 id = query by identifier,
1042 coo = query by coordinates,
1043 ref = query by references,
1044 sam = query by criteria.
1045
1046The arguments depend on on the type, and are documented at
1047L<http://simbad.u-strasbg.fr/guide/sim-url.htx>. They are
1048specified as name => value. For example:
1049
1050 $simbad->url_query (id =>
1051    Ident => 'Arcturus',
1052    NbIdent => 1
1053 );
1054
1055Note that in an id query you must specify 'Ident' explicitly. This is
1056true in general, because it is not always possible to derive the first
1057argument name from the query type, and consistency was chosen over
1058brevity.
1059
1060The output.format argument can be defaulted based on the object's type
1061setting as follows:
1062
1063 txt becomes 'ASCII',
1064 vo becomes 'VOTable'.
1065
1066Any other value is passed verbatim.
1067
1068If the query succeeds, the results will be passed to the appropriate
1069parser if any. The reverse of the above translation is done to determine
1070the appropriate parser, so the 'vo' parser (if any) is called if
1071output.format is 'VOTable', and the 'txt' parser (if any) is called if
1072output.format is 'ASCII'. If output.format is 'HTML', you will need to
1073explicitly set up a parser for that.
1074
1075The type of HTTP interaction depends on the setting of the L<post|/post>
1076attribute: if true a POST is done; otherwise all arguments are tacked
1077onto the end of the URL and a GET is done.
1078
1079=cut
1080
1081{	# Begin local symbol block.
1082
1083    my %type_map = (	# Map SOAP type parameter to URL output.format.
1084	txt	=> 'ASCII',
1085	vo	=> 'VOTable',
1086    );
1087    my %type_unmap = reverse %type_map;
1088
1089    # Perl::Critic objects to the use of @_ (rather than values
1090    # unpacked from it) but the parity check lets me give a less
1091    # unfriendly error message. CAVEAT: do NOT modify the contents
1092    # of @_, since this will be seen by the caller. Modifying @_
1093    # itself is fine.
1094    sub url_query {	## no critic (RequireArgUnpacking)
1095	@_ % 2 and croak <<eod;
1096Error - url_query needs an even number of arguments after the query
1097        type.
1098eod
1099	my ($self, $query, %args) = @_;
1100###	my $debug = $self->get ('debug');
1101	my $dflt = $self->get ('url_args');
1102	foreach my $key (keys %$dflt) {
1103	    exists ($args{$key}) or $args{$key} = $dflt->{$key};
1104	}
1105	unless ($args{'output.format'}) {
1106	    my $type = $self->get ('type');
1107	    $args{'output.format'} = $type_map{$type} || $type;
1108	}
1109	my $resp = $self->_retrieve( "simbad/sim-$query", \%args );
1110
1111	$resp = XML::DoubleEncodedEntities::decode ($resp->content);
1112
1113	my $parser;
1114	if (my $type = $type_unmap{$args{'output.format'}}) {
1115	    $parser = $self->_get_parser ($type);
1116	    return wantarray ? ($parser->($resp)) : [$parser->($resp)]
1117		if $parser;
1118	}
1119
1120	return $resp;
1121    }
1122
1123}	# End local symbol block.
1124
1125########################################################################
1126#
1127#	Utility routines
1128#
1129
1130#	__build_url
1131#
1132#	Builds a URL based on the currently-set scheme and server, and
1133#	the fragment provided as an argument. If the fragment is an
1134#	HTTP::Request object it is simply returned.
1135
1136sub __build_url {
1137    my ( $self, $fragment ) = @_;
1138    defined $fragment
1139	or $fragment = '';
1140    eval { $fragment->isa( 'HTTP::Request' ) }
1141	and return $fragment;
1142    $fragment =~ s< \A / ><>smx;	# Defensive programming
1143    return sprintf '%s://%s/%s', $self->get( 'scheme' ),
1144	$self->get( 'server' ), $fragment;
1145}
1146
1147#	_callers_caller();
1148#
1149#	Returns the name of the subroutine that called the caller.
1150#	Results undefined if not called from a subroutine nested at
1151#	least two deep.
1152
1153sub _callers_caller {
1154    my $inx = 1;
1155    my $caller;
1156    foreach ( 1 .. 2 ) {
1157	do {
1158	    $caller = ( caller $inx++ )[3]
1159	} while '(eval)' eq $caller;
1160    }
1161    return $caller;
1162}
1163
1164#	$self->_delay
1165#
1166#	Delays the desired amount of time before issuing the next
1167#	query.
1168
1169{
1170    my %last;
1171    sub _delay {
1172	my $self = shift;
1173	my $last = $last{$self->{server}} ||= 0;
1174	if ((my $delay = $last + $self->{delay} - time) > 0) {
1175	    sleep ($delay);
1176	}
1177	return ($last{$self->{server}} = time);
1178    }
1179}
1180
1181#	$self->_deprecation_notice( $type, $name );
1182#
1183#	This method centralizes deprecation. Type is 'attribute' or
1184#	'method'. Deprecation is driven of the %deprecate hash. Values
1185#	are:
1186#	    false - no warning
1187#	    1 - warn on first use
1188#	    2 - warn on each use
1189#	    3 - die on each use.
1190#
1191#	$self->_deprecation_in_progress( $type, $name )
1192#
1193#	This method returns true if the deprecation is in progress. In
1194#	practice this means the %deprecate value is defined.
1195#	This is currently unused and commented out
1196
1197{
1198
1199    my %deprecate = (
1200	method	=> {
1201	    query	=> 2,
1202	},
1203    );
1204
1205    sub _deprecation_notice {
1206	my ( undef, $type, $name, $repl ) = @_;	# Invocant unused
1207	$deprecate{$type} or return;
1208	$deprecate{$type}{$name} or return;
1209	my $msg = sprintf 'The %s %s is %s', $name, $type,
1210	    $deprecate{$type}{$name} > 2 ? 'removed' : 'deprecated';
1211	defined $repl
1212	    and $msg .= "; use $repl instead";
1213	$deprecate{$type}{$name} >= 3
1214	    and croak( $msg );
1215	warnings::enabled( 'deprecated' )
1216	    and carp( $msg );
1217	$deprecate{$type}{$name} == 1
1218	    and $deprecate{$type}{$name} = 0;
1219	return;
1220    }
1221
1222=begin comment
1223
1224    sub _deprecation_in_progress {
1225	my ( undef, $type, $name ) = @_;	# Invocant unused
1226	$deprecate{$type} or return;
1227	return defined $deprecate{$type}{$name};
1228    }
1229
1230=end comment
1231
1232=cut
1233
1234}
1235
1236#	$ref = $self->_get_coderef ($string)
1237#
1238#	Translates the given string into a code reference, loading
1239#	modules if needed. If the string is not a fully-qualified
1240#	subroutine name, it is assumed to be in the namespace of
1241#	the first caller not in this namespace. Failed loads are
1242#	cached so that they will not be tried again.
1243
1244{
1245
1246    sub _get_coderef {
1247	my $self = shift;
1248	my $parser = shift;
1249	if ($parser && !ref $parser) {
1250	    my ($pkg, $code) =
1251		$self->_parse_subroutine_name ($parser);
1252	    unless (($parser = $pkg->can ($code)) || !$self->get ('autoload')) {
1253		_load_module ($pkg);
1254		$parser = $pkg->can ($code);
1255	    }
1256	    $parser or croak "Error - ${pkg}::$code undefined";
1257	}
1258	return $parser;
1259    }
1260
1261}
1262
1263#	$parser = $self->_get_parser ($type)
1264
1265#	returns the code reference to the parser for the given type of
1266#	data, or false if none. An exception is thrown if the value
1267#	is a string which does not specify a defined subroutine.
1268
1269sub _get_parser {
1270    my ($self, $type) = @_;
1271    return $self->_get_coderef ($self->get ('parser')->{$type});
1272}
1273
1274# Return false if the argument is a URI scheme we know how to deal with;
1275# otherwise return an error message. The optional second argument is a
1276# template for the message, with a single '%s' that gets the actual
1277# value of the scheme.
1278
1279{
1280    my %supported;
1281
1282    BEGIN {
1283	%supported = map { $_ => 1 } qw{ http https };
1284    }
1285
1286    sub _is_scheme_valid {
1287	my ( $scheme, $msg ) = @_;
1288	$scheme = lc( $scheme || '' );
1289	$msg ||= q<Unsupported scheme '%s'>;
1290	$supported{$scheme}
1291	    or return sprintf $msg, $scheme;
1292	LWP::Protocol::implementor( $scheme )
1293	    and return;
1294	$msg .= "; have you installed LWP::Protocol::$scheme?";
1295	return sprintf $msg, $scheme;
1296    }
1297}
1298
1299#	$rslt = _load_module($name)
1300#
1301#	This subroutine loads the named module using 'require'. It
1302#	croaks if the load fails, or returns the result of the
1303#	'require' if it succeeds. Results are cached, so subsequent
1304#	calls simply do what the first one did.
1305
1306{	# Local symbol block. Oh, for 5.10 and state variables.
1307    my %error;
1308    my %rslt;
1309    sub _load_module {
1310	my  ($module) = @_;
1311	exists $error{$module} and croak $error{$module};
1312	exists $rslt{$module} and return $rslt{$module};
1313	$rslt{$module} = eval "require $module";
1314	$@ and croak ($error{$module} = $@);
1315	return $rslt{$module};
1316    }
1317}	# End local symbol block.
1318
1319#	$ua = _get_user_agent ();
1320#
1321#	This subroutine returns an LWP::UserAgent object with its agent
1322#	string set to the default, with our class name and version
1323#	appended in parentheses.
1324
1325sub _get_user_agent {
1326    my $ua = LWP::UserAgent->new (
1327    );
1328##    $ua->agent ($ua->_agent . ' (' . __PACKAGE__ . ' ' . $VERSION .
1329##	')');
1330    $ua->agent (&agent);
1331    return $ua;
1332}
1333
1334#	($package, $subroutine) = $self->_parse_subroutine_name ($name);
1335#
1336#	This method parses the given name, and returns the package name
1337#	in which the subroutine is defined and the subroutine name. If
1338#	the $name is a bare subroutine name, the package is the calling
1339#	package unless that package contains no such subroutine but
1340#	$self->can($name) is true, in which case the package is
1341#	ref($self).
1342#
1343#	If called in scalar context, the package is returned.
1344
1345sub _parse_subroutine_name {
1346    my ($self, $parser) = @_;
1347    my @parts = split '::', $parser;
1348    my $code = pop @parts;
1349    my $pkg = join '::', @parts;
1350    unless ($pkg) {
1351	my %tried = (__PACKAGE__, 1);
1352	my $inx = 1;
1353	while ($pkg = (caller ($inx++))[0]) {
1354	    next if $tried{$pkg};
1355	    $tried{$pkg} = 1;
1356	    last if $pkg->can ($code);
1357	}
1358	$pkg = ref $self if !$pkg && $self->can ($code);
1359	defined $pkg or croak <<eod;
1360Error - '$parser' yields undefined package name.
1361eod
1362	@parts = split '::', $pkg;
1363    }
1364    return wantarray ? ($pkg, $code) : $pkg;
1365}
1366
1367#	my $resp = $self->_retrieve( $fragment, \%args );
1368#
1369#	Build a URL from the contents of the 'scheme' and 'server'
1370#	attributes, and the given fragment, and retrieve the data from
1371#	that URL.  The \%args argument is optional.
1372#
1373#	The return is an HTTP::Response object. If the response is
1374#	indicates that the request is unsuccessful we croak with the URL
1375#	(if that can be retrieved) and the status line.
1376#
1377#	The details depend on the arguments and the state of the
1378#	invocant as follows:
1379#
1380#	If $url is an HTTP::Request object, it is executed and the
1381#	response returned. Otherwise
1382#
1383#	If \%args is present and not empty, and the 'post' attribute is
1384#	true, an HTTP post() request is done to the URL, sending the
1385#	data. Otherwise
1386#
1387#	If there are arguments they are appended to the URL, and an HTTP
1388#	get() is done to the URL.
1389
1390sub _retrieve {
1391    my ($self, $fragment, $args) = @_;
1392    my $url = $self->__build_url( $fragment );
1393    $args ||= {};
1394    my $debug = $self->get ('debug');
1395    my $ua = _get_user_agent ();
1396    $self->_delay ();
1397    my $resp;
1398    if (eval {$url->isa('HTTP::Request')}) {
1399	$debug
1400	    and print 'Debug ', _callers_caller(), 'executing ',
1401		$url->as_string, "\n";
1402	$resp = $ua->request ($url);
1403    } elsif ($self->get ('post') && %$args) {
1404	if ($debug) {
1405	    print 'Debug ', _callers_caller(), " posting to $url\n";
1406	    foreach my $key (sort keys %$args) {
1407		print "    $key => $args->{$key}\n";
1408	    }
1409	}
1410	$resp = $ua->post ($url, $args);
1411    } else {
1412	my $join = '?';
1413	foreach my $key (sort keys %$args) {
1414	    $url .= $join . _escape_uri( $key ) .  '=' . _escape_uri (
1415		$args->{$key} );
1416	    $join = '&';
1417	}
1418	$debug
1419	    and print 'Debug ', _callers_caller(), " getting from $url\n";
1420	$resp = $ua->get( $url );
1421    }
1422    $debug
1423	and print 'Debug - request: ', $resp->request()->as_string(), "\n";
1424
1425    $resp->is_success()
1426	and return $resp;
1427
1428    my $rq = $resp->request()
1429	or croak $resp->status_line();
1430    my $u = $rq->uri();
1431    croak "$u: ", $resp->status_line();
1432}
1433
14341;
1435
1436__END__
1437
1438=back
1439
1440=head2 Attributes
1441
1442The Astro::SIMBAD::Client attributes are documented below. The type of
1443the attribute is given after the attribute name, in parentheses. The
1444types are:
1445
1446 boolean - a true/false value (in the Perl sense);
1447 hash - a reference to one or more key/value pairs;
1448 integer - an integer;
1449 string - any characters.
1450
1451Hash values may be specified either as hash references or as strings.
1452When a hash value is set, the given value updates the hash rather than
1453replacing it. For example, specifying
1454
1455 $simbad->set (format => {txt => '%MAIN_ID\n'});
1456
1457does not affect the value of the vo format. If a key is set to the
1458null value, it deletes the key. All keys in the hash can be deleted
1459by setting key 'clear' to any true value.
1460
1461When specifying a string for a hash-valued attribute, it must be of
1462the form 'key=value'. For example,
1463
1464 $simbad->set (format => 'txt=%MAIN_ID\n');
1465
1466does the same thing as the previous example. Specifying the key name
1467without an = sign deletes the key (e.g. set (format => 'txt')).
1468
1469The Astro::SIMBAD::Client class has the following attributes:
1470
1471=over
1472
1473=item autoload
1474
1475This Boolean attribute determines whether setting the parser should
1476attempt to autoload its package.
1477
1478The default is 1 (i.e. true).
1479
1480=item debug
1481
1482This integer attribute turns on debug output. It is unsupported in the
1483sense that the author makes no claim what will happen if it is non-zero.
1484
1485The default value is 0.
1486
1487=item delay
1488
1489This numeric attribute sets the minimum delay in seconds between
1490requests, so as not to overload the SIMBAD server. If
1491L<Time::HiRes|Time::HiRes> can be loaded, you can set delays in
1492fractions of a second; otherwise the delays will be rounded to the
1493nearest second.
1494
1495Delays are from the time of the last request to the server, no matter
1496which object issued the request. The delay can be set to 0, but not to a
1497negative number.
1498
1499The default is 3.
1500
1501=item emulate_soap_queries
1502
1503If this Boolean attribute is true, the methods that would normally use
1504the SOAP interface (that is, C<query()> and friends) use the script
1505interface instead.
1506
1507The purpose of this attribute is to give the user a way to manage the
1508deprecation and ultimate removal of the SOAP interface from the SIMBAD
1509servers. It may go away once that interface disappears, but it will be
1510put through a deprecation cycle.
1511
1512The default is false, but will become true once the University of
1513Strasbourg shuts down its SOAP server.
1514
1515=item format
1516
1517This attribute holds the default format for a given query()
1518output type. It is specified as a reference to a hash. See
1519L<http://simbad.u-strasbg.fr/guide/sim-fscript.htx> for how to specify
1520formats for each output type. Output type 'script' is used to specify a
1521format for the script() method.
1522
1523The format can be specified either literally, or as a subroutine name or
1524code reference. A string is assumed to be a subroutine name if it looks
1525like one (i.e. matches (\w+::)*\w+), and if the given subroutine is
1526actually defined. If no namespace is specified, all namespaces in the
1527call tree are checked. If a code reference or subroutine name is
1528specified, that code is executed, and the result becomes the format.
1529
1530The following formats are defined in this module:
1531
1532 FORMAT_TXT_SIMPLE_BASIC -
1533   a simple-to-parse text format providing basic information;
1534 FORMAT_TXT_YAML_BASIC -
1535   pseudo-YAML (parsable by YAML::Load) providing basic info;
1536 FORMAT_VO_BASIC -
1537   VOTable field names providing basic information.
1538
1539The FORMAT_TXT_YAML_BASIC format attempts to provide data structured
1540similarly to the output of L<Astro::SIMBAD>, though
1541Astro::SIMBAD::Client does not bless the output into any class.
1542
1543A simple way to examine these formats is (e.g.)
1544
1545 use Astro::SIMBAD::Client;
1546 print Astro::SIMBAD::Client->FORMAT_TXT_YAML_BASIC;
1547
1548Before a format is actually used it is preprocessed in a manner
1549depending on its intended output type. For 'vo' formats, leading and
1550trailing whitespace are stripped. For 'txt' and 'script' formats, line
1551breaks are stripped.
1552
1553The default specifies formats for output types 'txt' and 'vo'. The
1554'txt' default is FORMAT_TXT_YAML_BASIC; the 'vo' default is
1555FORMAT_VO_BASIC.
1556
1557There is no way to specify a default format for the 'script_file'
1558method.
1559
1560=item parser
1561
1562This attribute specifies the parser for a given output type. The actual
1563value is a hash reference; the keys are valid output types, and the
1564values are as described below.
1565
1566Parsers may be specified by either a code reference, or by the
1567text name of a subroutine. If specified as text and the name
1568is not qualified by a package name, the calling package is assumed.
1569The parser must be defined, and must take as its lone argument
1570the text to be parsed.
1571
1572If the parser for a given output type is defined, query results of that
1573type will be passed to the parser, and the result returned. Otherwise
1574the query results will be returned verbatim.
1575
1576The output types are anything legal for the query() method (i.e. 'txt'
1577and 'vo' at the moment), plus 'script' for a script parser. All default
1578to '', meaning no parser is used.
1579
1580=item post
1581
1582This Boolean attribute specifies that url_query() data should be
1583acquired using a POST request. If false, a GET request is used.
1584
1585The default is 1 (i.e. true).
1586
1587=item scheme
1588
1589This string attribute specifies the server's URI scheme to be used. As
1590of January 27 2017, either C<'http'> or C<'https'> is valid.
1591
1592The default is the value of environment variable
1593C<ASTRO_SIMBAD_CLIENT_SCHEME>, or C<'http'> if the environment variable
1594is not set, or if it contains a value other than C<'http'> or
1595C<'https'>, case-insensitive.
1596
1597=item server
1598
1599This string attribute specifies the server to be used. As of March 10
16002010, either C<'simbad.u-strasbg.fr'> or C<'simbad.cfa.harvard.edu'> is
1601valid.
1602
1603The default is the value of environment variable
1604ASTRO_SIMBAD_CLIENT_SERVER, or C<'simbad.u-strasbg.fr'> if the
1605environment variable is not set.
1606
1607=item type
1608
1609This string attribute specifies the default output type. Note that
1610although SIMBAD only defined types 'txt' and 'vo', we do not validate
1611this, since the SIMBAD web site hints at more types to come. SIMBAD
1612appears to treat an unrecognized type as C<'txt'>.
1613
1614The default is C<'txt'>.
1615
1616=item url_args
1617
1618This attribute specifies default arguments for url_query method as a
1619reference to a hash of argument name/value pairs. These will be applied
1620only if not specified in the method call. Any argument given in the
1621SIMBAD documentation may be specified. For example:
1622
1623 $simbad->set( url_args => { coodisp1 => 'd' } );
1624
1625causes the query to return coordinates in degrees and decimals rather
1626than in sexagesimal (degrees, minutes, and seconds or hours, minutes,
1627and seconds, as the case may be.) Note, however, that VOTable output
1628does not seem to be affected by this.
1629
1630The initial default for this attribute is an empty hash; that is, no
1631arguments are defaulted by this mechanism.
1632
1633=item verbatim
1634
1635This Boolean attribute specifies whether C<script()> and
1636C<script_file()> are to strip the front matter from the script output.
1637If false, everything up to and including the '::data:::::' line is
1638removed before passing the output to the parser or returning it to the
1639user. If true, the script output is passed to the parser or returned to
1640the user unmodified.
1641
1642The default is C<0> (i.e. false).
1643
1644=back
1645
1646=head1 ENVIRONMENT
1647
1648=head2 ASTRO_SIMBAD_CLIENT_SCHEME
1649
1650If assigned a true value, this environment variable specifies the
1651default for the C<'scheme'> attribute. It is read when the module is
1652loaded. If you want to change the default after the module has been
1653loaded, make a static call to C<set()>.
1654
1655=head2 ASTRO_SIMBAD_CLIENT_SERVER
1656
1657If assigned a true value, this environment variable specifies the
1658default for the C<'server'> attribute. It is read when the module is
1659loaded. If you want to change the default after the module has been
1660loaded, make a static call to C<set()>.
1661
1662=head2 ASTRO_SIMBAD_CLIENT_USE_SOAP
1663
1664The Boolean inverse of this environment variable specifies the default
1665for the C<'emulate_soap_queries'> attribute. It is read when the module
1666is loaded. If you want to change the default after the module has been
1667loaded, make a static call to C<set()>.
1668
1669=head2 L<LWP::UserAgent|LWP::UserAgent>
1670
1671The following environment variables control use of a proxy server. They
1672are implemented by L<LWP::UserAgent|LWP::UserAgent>, but are documented
1673fairly obscurely, so I have chosen to say a few words about them here:
1674
1675=head3 PERL_LWP_ENV_PROXY
1676
1677If this environment variable is set to a true value,
1678L<LWP::UserAgent|LWP::UserAgent> will take proxy settings for each URL
1679scheme from environment variables named C<xxxx_proxy> (yes, lower-case),
1680where the C<'xxxx'> is the scheme name. The content of each
1681scheme-specific environment variables is the URL (scheme, host, and
1682port) of the proxy. The following are relevant to users of this module:
1683
1684=head3 http_proxy
1685
1686This environment variable is set to the URL of the C<http:> proxy
1687server.
1688
1689=head2 https_proxy
1690
1691This environment variable is set to the URL of the C<http:> proxy
1692server.
1693
1694=head1 SUPPORT
1695
1696Support is by the author. Please file bug reports at
1697L<https://rt.cpan.org/Public/Dist/Display.html?Name=Astro-SIMBAD-Client>,
1698L<https://github.com/trwyant/perl-Astro-SIMBAD-Client/issues>, or in
1699electronic mail to the author.
1700
1701=head1 AUTHOR
1702
1703Thomas R. Wyant, III (F<wyant at cpan dot org>)
1704
1705=head1 COPYRIGHT AND LICENSE
1706
1707Copyright (C) 2005-2021 by Thomas R. Wyant, III
1708
1709This program is free software; you can redistribute it and/or modify it
1710under the same terms as Perl 5.10.0. For more details, see the full text
1711of the licenses in the directory LICENSES.
1712
1713This program is distributed in the hope that it will be useful, but
1714without any warranty; without even the implied warranty of
1715merchantability or fitness for a particular purpose.
1716
1717=cut
1718
1719# ex: set textwidth=72 :
1720