#!/usr/local/bin/perl

use strict;
use warnings;

use Astro::SIMBAD::Client;
use XML::Parser;
use Data::Dumper;
$Data::Dumper::Terse = 1;

use constant ARRAY_REF	=> ref [];

my $simbad = Astro::SIMBAD::Client->new (
    type => 'vo',
    parser => {vo => 'parse_vo_lite'},
);

foreach my $obj (@ARGV) {
    print Dumper ($simbad->url_query( id => Ident => $obj ) );
}

#	The following parser returns an XML parse tree. It could be used
#	for any piece of XML, but we're using it for a VOTable. The
#	document itself is returned as a list. Within the list, tags are
#	list references, with the tag name as element 0, the attributes
#	as a hash reference in element 1, and the contents as subsequent
#	elements. Text is returned with leading and trailing blanks
#	trimmed, and empty strings supressed. So
#
#	<?xml version="1.0"?>
#	<query>Hello
#	<object type="nautical">sailor</object>
#	</query
#
#	would parse as
#
#	[
#	  ['query', {}, 'Hello',
#	    ['object', {type => 'nautical'}, 'sailor'],
#	  ],
#	]
#
#	Note that the empty strings are stripped after the parse is
#	complete. The obvious thing to do was to strip them in the
#	Char handler, but that (and Start and End) get called by the
#	experimental ?{} regular expression handler, and I couldn't
#	figure out how to use regular expressions without blowing the
#	context of the originating regular expression.

sub parse_vo_lite {
    my $xml = shift;

    my $root;
    my @tree;

#	Arguments:
#	Init ($class)
#	Start ($class, $tag, $attr => $value ...)
#	Char ($class, $text)
#	End ($class, $tag)
#	Final ($class)

    my $psr = XML::Parser->new (
	Handlers => {
	    Init => sub {
		$root = [];
		@tree = ($root);
	    },
	    Start => sub {
		shift;
		my $tag = shift;
		my $item = [$tag, {@_}];
		push @{$tree[-1]}, $item;
		push @tree, $item;
	    },
	    Char => sub {
		push @{$tree[-1]}, $_[1];
	    },
	    End => sub {
		my $tag = $_[1];
		die <<eod unless @tree > 1;
Error - Unmatched end tag </$tag>
eod
		die <<eod unless $tag eq $tree[-1][0];
Error - End tag </$tag> does not match start tag <$tree[-1][0]>
eod
		pop @tree;
	    },
	    Final => sub {
		die <<eod if @tree > 1;
Error - Missing end tags.
eod
		_strip_empty ($root);
		$root;
	    },
	});
    return @{$psr->parse ($xml)};
}

#	_strip_empty (\@tree)
#
#	splices out anything in the tree that is not a reference and
#	does not match m/\S/.

sub _strip_empty {
    my $ref = shift;
    my $inx = @$ref;
    while (--$inx >= 0) {
	my $val = $ref->[$inx];
	my $typ = ref $val;
	if ( ARRAY_REF eq $typ ) {
	    _strip_empty ($val);
	} elsif (!$typ) {
	    splice @$ref, $inx, 1 unless $val =~ m/\S/ms;
	}
    }
    return;
}

#	$subtree = _find_first (\@tree, $tag, ...)
#
#	descends through the given parse tree, recursively finding the
#	given tags, and returning the subtree thus identified. It dies
#	if a tag cannot be found. You would, for example, call
#	$subtree = _find_first (\@tree, qw{VOTABLE RESOURCE TABLE})
#	to get the first table in a VOTABLE document.
#
#	As things stand, this is unused code. But since this is an
#	example, I left it in.

sub _find_first {	## no critic (ProhibitUnusedPrivateSubroutines)
    my ($tree, @want) = @_;
    TAG_LOOP:
    foreach my $tag (@want) {
	foreach my $branch (@$tree) {
	    next unless ARRAY_REF eq ref $branch && $branch->[0] eq $tag;
	    $tree = $branch;
	    next TAG_LOOP;
	}
	die "Error - Tag <$tag> not found.\n";
    }
    return $tree;
}
__END__

=head1 TITLE

votree - Download SIMBAD data and display C<votable> XML parse tree

=head1 SYNOPSIS

 votree Arcturus

=head1 OPTIONS

None.

=head1 DETAILS

This script takes as its arguments the names of objects to be looked up
in the SIMBAD database and returned in C<votable> format. The return is
parsed, and the XML parse tree displayed in L<Data::Dumper|Data::Dumper>
format.

=head1 AUTHOR

Thomas R. Wyant, III F<wyant at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2006, 2008, 2010-2025 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the files F<LICENSE-Artistic> and F<LICENSE-GNU>.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

# ex: set textwidth=72 :
