File Coverage

blib/lib/SeeAlso/Client.pm

Criterion	Covered	Total	%
statement	66	84	78.5
branch	14	28	50.0
condition	3	6	50.0
subroutine	14	16	87.5
pod	6	6	100.0
total	103	140	73.5

use strict;
use warnings;
package SeeAlso::Client;
{
  $SeeAlso::Client::VERSION = '0.71';
}
#ABSTRACT: SeeAlso Linkserver Protocol Client

use Carp qw(croak);
use JSON::XS '2.0' ;
use LWP::Simple qw(get);
use URI '1.35';
use Data::Validate::URI qw(is_web_uri);

use SeeAlso::Identifier;
use SeeAlso::Response;

use base qw( SeeAlso::Source );
our @EXPORT = qw( seealso_request );


sub new {
    my $class = shift;
    my (%description, $baseurl);

    if (@_ % 2) {
        ($baseurl, %description) = @_;
    } else {
        %description = @_;
        $baseurl = $description{BaseURL};
    }

    croak "Please specify a baseurl" unless defined $baseurl;

    my $self = bless {
        'is_simple' => 0 # unknown or no
    }, $class;

    $self->description( %description );
    $self->baseURL( $baseurl );

    return $self;
}


sub query {
    my ($self, $identifier) = @_;

    # TOOD: on failure catch/throw error(s)

    my $url = $self->queryURL( $identifier );
    my $json = get($url);

    if (defined $json) {
        return SeeAlso::Response->fromJSON( $json ); # may also croak
    } else {
        croak("Failed to query $url");
    }
}


sub baseURL {
    my ($self, $url) = @_;
    return $self->description("BaseURL") unless defined $url;

    $url = URI->new( $url ) unless UNIVERSAL::isa( $url, "URI" );
    croak("The specified URL is not valid")
        unless defined $url and is_web_uri($url->as_string());

    my %query = $url->query_form();
    croak("The specified URL must not contain id or callback parameter")
        if defined $query{'id'} or defined $query{'callback'};
    $self->{is_simple} = defined $query{'format'};
    $self->{baseurl} = $url;
    $url = $url->canonical()->as_string();
    $self->description("BaseURL",$url);

    return $url;
}


sub queryURL {
    my ($self, $identifier, $callback) = @_;
    $identifier = $identifier->normalized()
        if UNIVERSAL::isa($identifier,"SeeAlso::Identifier");
    $identifier = "" unless defined $identifier;

    my $url = URI->new( $self->{baseurl} );
    my %query = $url->query_form();

    $query{'format'} = "seealso" unless $self->{is_simple};
    $query{'id'} = $identifier;

    if (defined $callback) {
        $callback =~ /^[a-zA-Z0-9\._\[\]]+$/ or
            croak ( "Invalid callback name" );
        $query{callback} = $callback;
    }
    $url->query_form( %query );

    return $url->canonical();
}


sub getFormats {
    my ($self) = @_;
    return $self->{formats} if exists $self->{formats};

    my $formats = {};
    my $url = $self->baseURL();
    my $xml = get($url);
    if ($xml) {
        # dump parser (not really XML)
        my %matches = ( $xml =~ m/
        $formats = {
            map { $_, { type => $matches{$_} } } (keys %matches)
        };
    }
    $self->{formats} = $formats;
}


sub seealso_request {
    my ($baseurl, $identifier) = @_;
    my $response = eval { SeeAlso::Client->new($baseurl)->query($identifier); };
    return $response;
}


__END__