File Coverage

blib/lib/Net/PicApp.pm

Criterion	Covered	Total	%
statement	4	6	66.6
branch			n/a
condition			n/a
subroutine	2	2	100.0
pod			n/a
total	6	8	75.0

package Net::PicApp;

# use 'our' on v5.6.0
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS $DEBUG);
use XML::Simple;
use LWP::UserAgent;
use Net::PicApp::Response;
use URI::Escape;

$DEBUG   = 0;
$VERSION = '0.3';

use base qw(Class::Accessor);
Net::PicApp->mk_accessors(qw(apikey url cache));

# We are exporting functions
use base qw/Exporter/;

use constant {
    CONTRIB_CORBIS              => 466,
    CONTRIB_ENTERTAINMENT_PRESS => 16797,
    CONTRIB_GETTY               => 3,
    CONTRIB_IMAGE_SOURCE        => 4,
    CONTRIB_JUPITER             => 5,
    CONTRIB_NEWSCOM             => 7387,
    CONTRIB_PACIFIC_COAST       => 12342,
    CONTRIB_SPLASH              => 4572,
    CAT_EDITORIAL               => 2,
    CAT_CREATIVE                => 3,
    CAT_ENTERTAINMENT           => 4,
    CAT_NEWS                    => 5,
    CAT_SPORTS                  => 6,
    SORT_RELEVANT               => 1,
    SORT_RECENT                 => 2,
    SORT_RANDOM                 => 6
};

# Methods to support:
# * getimagedetails
# * login

# Export list - to allow fine tuning of export table
@EXPORT_OK = qw( search get_image_details publish login );

use strict;

sub DESTROY { }

$SIG{INT} = sub { die "Interrupted\n"; };

$| = 1;    # autoflush

sub new {
    my $class  = shift;
    my $params = shift;
    my $self   = {};
    foreach my $prop (qw/ apikey cache /) {
        if ( exists $params->{$prop} ) {
            $self->{$prop} = $params->{$prop};
        }

        #        else {
        #            confess "You need to provide the $prop parameter!";
        #        }
    }
    my $ua = LWP::UserAgent->new;
    $ua->agent("Net::PicApp/$VERSION");
    $self->{ua} = $ua;
    $self->{url} = 'http://api.picapp.com/API/ws.asmx' unless $self->{url};
    bless $self, $class;
    return $self;
}

sub flush_cache {
    my $self = shift;
    return unless $self->cache;
    $self->cache->clear;
}

sub search {
    my $self = shift;
    my ( $term, $options ) = @_;
    my $method;
    if ( $options->{'with_thumbnails'} ) {
        if ( $options->{'subcategory'} || $options->{'contributor'} ) {
            $method = 'SearchImagesWithThumbnailsContributorAndSubCategory';
        }
        else {
            $method = 'SearchImagesWithThumbnails';
        }
    }
    else {
        if ( $options->{'subcategory'} || $options->{'contributor'} ) {
            $method = 'SearchWithContributorAndSubCategory';
        }
        else {
            $method = 'Search';
        }
    }
    my $url = $self->url . "/" . $method . "?ApiKey=" . $self->apikey;
    $url .= '&term=' . uri_escape($term);
    my $keys = {
        'category'      => 'cats',
        'colors'        => 'clrs',
        'orientation'   => 'oris',
        'types'         => 'types',
        'match_phrase'  => 'mp',
        'post'          => 'post',
        'sort'          => 'sort',
        'page'          => 'Page',
        'total_records' => 'totalRecords',
    };
    foreach my $key ( keys %$keys ) {
        $url .= '&'
          . $keys->{$key} . '='
          . ( $options->{$key} ? $options->{$key} : '' );
    }
    if ( $method =~ /(contributor|category)/i ) {
        $keys = {
            'contributor' => 'contributorId',
            'subcategory' => 'subCategory'
        };
        foreach my $key ( keys %$keys ) {
            $url .= '&'
              . $keys->{$key} . '='
              . ( $options->{$key} ? $options->{$key} : '' );
        }
    }

    my $response;
    if (!$options->{no_cache} && $self->cache && $self->cache->exists($url)) {
        $response = $self->cache->thaw($url);
        bless $response, 'Net::PicApp::Response';
        return $response;
    }

    $response = Net::PicApp::Response->new;
    $response->url_queried($url);

    # Call PicApp
    my $req = HTTP::Request->new( GET => $url );
    my $res = $self->{ua}->request($req);

    # Check the outcome of the response
    if ( $res->is_success ) {
        my $content = $res->content;
        my $xml = eval { XMLin($content) };
        if ($@) {
            print STDERR "ERROR: $@\n";
            $response->error_message("Could not parse response: $@");
        }
        else {
            $response->init($xml);
        }
    }
    else {
        $response->error_message("Could not conduct query to: $url");
    }
    if (!$options->{no_cache} && $self->cache && $response->is_success && $response->total_records > 0) {
        $self->cache->freeze( $url, $response );
    }
    return $response;
}

sub get_image_details {
    my $self = shift;
    my ( $id, $options ) = @_;
    die "No image id specified" unless $id;

    $options ||= {};

    my $url = $self->url . "/GetImageDetails?ApiKey=" . $self->apikey;
    $url .= '&ImageId=' . uri_escape($id);

    my $response;
    if (!$options->{no_cache} && $self->cache) {
        $response = $self->cache->thaw($url);
        if ($response) {
            bless $response, 'Net::PicApp::Response';
            return $response;
        }
    }

    $response = Net::PicApp::Response->new;
    $response->url_queried($url);

    # Call PicApp
    my $req = HTTP::Request->new( GET => $url );
    my $res = $self->{ua}->request($req);

    # Check the outcome of the response
    if ( $res->is_success ) {
        my $content = $res->content;
        my $xml = eval { XMLin($content) };
        if ($@) {
            print STDERR "ERROR: $@\n";
            $response->error_message("Could not parse response: $@");
        }
        else {
            $response->init($xml);
        }
    }
    else {
        $response->error_message("Could not conduct query to: $url");
    }
    if (!$options->{no_cache} && $self->cache && $response->is_success) {
        $self->cache->freeze( $url, $response );
    }
    return $response;
}

sub publish {
    my $self = shift;
    my ( $id, $term, $email, $options ) = @_;
    die "No image id specified" unless $id;

    $options ||= {};

    my $url = $self->url . "/PublishImageWithSearchTerm?ApiKey=" . $self->apikey;
    $url .= '&ImageId=' . uri_escape($id);
    $url .= '&SearchTerm=' . uri_escape($term);
    $url .= '&Email=' . uri_escape($email);
    $url .= '&PicAboo=';
    $url .= '&Trigger=';
    $url .= '&username=&password=';
    my $keys = {
        'size'        => 'Size',
        'image_frame' => 'ImageFrame',
    };
    foreach my $key ( keys %$keys ) {
        $url .= '&'
          . $keys->{$key} . '='
          . ( $options->{$key} ? $options->{$key} : '' );
    }

    my $response;
    $response = Net::PicApp::Response->new;
    $response->url_queried($url);

    # Call PicApp
    my $req = HTTP::Request->new( GET => $url );
    my $res = $self->{ua}->request($req);

    # Check the outcome of the response
    if ( $res->is_success ) {
        my $content = $res->content;
        my $xml = eval { XMLin($content) };
        if ($@) {
            print STDERR "ERROR: $@\n";
            $response->error_message("Could not parse response: $@");
        }
        else {
            $response->init($xml);
        }
    }
    else {
        $response->error_message("Could not conduct query to: $url");
    }
    return $response;

}

1;
__END__