File Coverage

blib/lib/Astro/NED/Query/Objects.pm

Criterion	Covered	Total	%
statement	28	41	68.2
branch	1	4	25.0
condition			n/a
subroutine	8	9	88.8
pod			n/a
total	37	54	68.5

# --8<--8<--8<--8<--
#
# Copyright (C) 2007 Smithsonian Astrophysical Observatory
#
# This file is part of Astro::NED::Query
#
# Astro::NED::Query is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
#
# 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.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see .
#
# -->8-->8-->8-->8--

package Astro::NED::Query::Objects;

use 5.006;
use strict;
use warnings;

our $VERSION = '0.30';

use autouse Carp => qw/ croak /;
use base qw/ Astro::NED::Query /;

use Astro::NED::Response::Objects;

sub _query
{
    my ( $self ) = @_;

    $self->Format( 'table' );
    $self->ListLimit( 1 );
    $self->ImageStamp( 'NO' );

    return;
}

sub _parse_query
{
  my $self = shift;

  # got something
  if ( $_[0] =~ /\d+ objects found/i )
  {
    my $res = Astro::NED::Response::Objects->new;
    $res->parseHTML( $_[0] );

    return $res;
  }

  # got nothing!
  elsif( $_[0] =~ /No object found/i )
  {
    my $res = Astro::NED::Response::Objects->new;
    return $res;
  }

  else
  {
    my $pfx = ref($self) . '->query: ';
    my @stuff;

#    push @stuff, "error in query:";
#    my @keyw = $self->form;
#    my ( $key, $value );
#    push @stuff, "$key = $value"
#      while ($key, $value) = splice(@keyw, 0, 2 );

    require HTML::Parser;
    my $p = HTML::Parser->new( text_h =>
			    [ sub { push @stuff,
				      grep { ! /NED\ Home
                                                |Search\ Results
                                                |(^NASA.*BASE$)
                                                |(^$)/x }
				      split( /\n+/, shift ) }, 'dtext' ] );
    $p->unbroken_text(1);
    $p->parse( $_[0] );
    $p->eof;

    croak( $pfx, join( "\n$pfx", @stuff ), "\n" );
  }

  return;
}

1;
__END__