File Coverage

blib/lib/WWW/Discogs.pm

Criterion	Covered	Total	%
statement	151	163	92.6
branch	52	70	74.2
condition	37	72	51.3
subroutine	23	23	100.0
pod	5	6	83.3
total	268	334	80.2

package WWW::Discogs;

use strict;
use warnings;

use LWP::UserAgent;
use URI;
use URI::Escape;
use Carp;
use JSON::XS;
use Data::Dumper;

use 5.008;
our $VERSION = '0.13';

our @namespaces = qw ( Artist Release Label Search Master );

my %query_params  = (
    artist  => { releases => 0, },
    release => { },
    label   => { releases => 0, },
    search  => { type => 'all', 'q' => '', page => '1', },
    master  => { },
    );

for (@namespaces) {
    my $pkg = __PACKAGE__."::$_";
    my $name = "\L$_";

    my $namespace = eval qq{
        use $pkg;

        sub $name {
            Carp::croak
                "Params for '$name' should be key/value pairs, not hash ref"
                if ref(\$_[1]) eq 'HASH';
            my (\$self, \%args) = \@_;
            my \$id = \$args{id} || \$args{name} || '';

            Carp::croak "Call to '$name' missing required arguments."
                if !\$id && '$name' =~ /artist|release|label|master/;
            Carp::croak "No search query specified"
                if '$name' eq 'search' && !exists \$args{q};
            Carp::croak "Incorrect search query"
                if '$name' eq 'search' && \$args{q} =~ /^\\s*\$/;
            Carp::croak "id value for '$name' not a number"
                if '$name' =~ /master|release/ && \$id !~ /^\\d+\$/;
            Carp::croak "name value incorrect for '$name'"
                if '$name' =~ /artist|label/ && \$id =~ /^\\s*\$/;

            my \$query_params = \$self->_get_query_params('$name', \%args);

            my \$res = \$self->_request(
                path     => (\$id =~ /^\\s*\$/) ? '$name' : '$name'."/\$id",
                query    => \$query_params,
                );

            my \$json = JSON::XS::decode_json( \$res->decoded_content );
            my \$class_data = \$json->{resp}->{'$name'};
            \$class_data->{_uri} = \$res->base;
            \$class_data->{_params} = \$query_params;

            if (\$json->{resp}->{status} == JSON::XS::true &&
                defined \$json->{resp}->{'$name'}) {
                return $pkg->new(\%{\$class_data});
            }

            return undef;
        }

        1;
    };

    Carp::croak "Cannot create namespace $name: $@\n" if not $namespace;
}

sub _get_query_params {
    my ($self, $name, %args) = @_;
    my %params = ();

    for (keys %args) {
        if (exists $query_params{$name}->{$_}) {
            $params{$_} = $args{$_};
        } else {
            delete $args{$_};
        }
    }

    %params = ( %{$query_params{$name}}, %params );

    return \%params;
}


sub new {
    my ($class, @args) = @_;
    my $self = {};
    bless $self, $class;
    $self->_init(@args);

    return $self;
}

sub _init {
    my ($self, %args) = @_;
    $self->{apiurl} = $args{apiurl} || 'http://api.discogs.com';
    $self->{ua} = LWP::UserAgent->new;
    $self->{ua}->agent("WWW-Discogs/$VERSION +perl");
    $self->{ua}->default_header(
        'Accept-Encoding' => 'gzip, deflate',
        );

    return $self;
}

sub _request {
    my ($self, %args) = @_;
    my $path  = $args{path};
    my $query = $args{query};

    my $uri = URI->new(
        $self->{'apiurl'},
        'http',
        );
    $uri->path($path);
    $uri->query_form($query) if keys %{$query};

    my $url = $uri->canonical->as_string;
    my $res = $self->{ua}->get($url);

    Carp::croak join(
        "\n",
        "Request to $url failed: ",
        $res->status_line, Dumper($res)
        ) unless $res->is_success;

    return $res;
}

1;
__END__