File Coverage

blib/lib/WebService/Gravatar.pm

Criterion	Covered	Total	%
statement	13	15	86.6
branch			n/a
condition			n/a
subroutine	5	5	100.0
pod			n/a
total	18	20	90.0

package WebService::Gravatar;

use warnings;
use strict;

use Carp;
use Digest::MD5 qw/md5_hex/;
use RPC::XML::Client;

=head1 NAME

WebService::Gravatar - Perl interface to Gravatar API

=head1 VERSION

Version 0.11

=cut

our $VERSION = '0.11';


=head1 SYNOPSIS

WebService::Gravatar provides an interface to Gravatar XML-RPC API.

    use WebService::Gravatar;
    use MIME::Base64;

    # Create a new instance of WebService::Gravatar
    my $grav = WebService::Gravatar->new(email => '[e-mail]',
                                         apikey => 'your_API_key');

    # Get a list of addresses
    my $addresses = $grav->addresses;

    if (defined $addresses) {
        # Print the userimage URL for each e-mail address
        foreach my $email (keys %$addresses) {
            print $addresses->{$email}->{'userimage_url'} . "\n";
        }
    }
    else {
        # We have a problem
        print STDERR "Error: " . $grav->errstr . "\n";
    }

    # Read image file data
    my $data;
    {
        local $/ = undef;
        open(F, "< my_pretty_face.png");
        $data = ;
        close(F);
    }

    # Save the image as a new userimage
    $grav->save_data(data => encode_base64($data), rating => 0);

    ...

=head1 DESCRIPTION

WebService::Gravatar is a Perl interface to Gravatar API. It aims at providing a
close representation of the basic XML-RPC API, as documented on Gravatar
website: L. All the method names,
parameter names, and data structures are the same as in the API -- the only
exception is that in the API the methods are named with camelCase, while the
module uses lowercase_with_infix_underscores.

=head1 METHODS

All the instance methods return C on failure. More detailed error
information can be obtained by calling L<"err"> and L<"errstr">.

=head2 new

Creates a new instance of WebService::Gravatar.

    my $grav = WebService::Gravatar->new(email => '[e-mail]',
                                         apikey => 'your_API_key');

Parameters:

=over 4

=item * email

B<(Required)> E-mail address.

=item * apikey

B<(Required)> API key. Can be ommitted if C is defined.

=item * password

B<(Required)> Account password. Can be ommitted if C is defined.

=back

=cut

sub new {
    my $class = shift;
    my %args = @_;

    my $self = {};
    bless($self, $class);

    if (!defined $args{'email'}) {
        carp "Required parameter 'email' is not defined";
    }

    if (!defined $args{'apikey'} && !defined $args{'password'}) {
        carp "Either the 'apikey' or 'password' parameter must be defined";
    }

    $self->{'err'} = undef;
    $self->{'errstr'} = undef;

    $self->{'apikey'} = $args{'apikey'};
    $self->{'password'} = $args{'password'};

    (my $email = $args{'email'}) =~ s/^\s+|\s+$//g;

    $self->{'cli'} = RPC::XML::Client->new(
        'https://secure.gravatar.com/xmlrpc?user=' . md5_hex(lc $email));

    return $self;
}

sub _call {
	my $self = shift;
	my $method = shift;
	my %args = (
	    'apikey'   => $self->{'apikey'},
	    'password' => $self->{'password'},
	    @_
	);

    $self->{'err'} = undef;
    $self->{'errstr'} = undef;

    my $ret = $self->{'cli'}->send_request('grav.' . $method, \%args);

    if ($ret->is_fault) {
    	$self->{'err'} = $ret->{'faultCode'}->value;
    	$self->{'errstr'} = $ret->{'faultString'}->value;
    	return undef;
    }
    else {
    	return $ret->value;
    }
}

=head2 exists

Checks whether a hash has a gravatar.

    $result = $grav->exists(hashes => ['e52beb5a6966554a02a56072cafebabe',
        '62345cdd79773f62a87fcbc6abadbabe'])

Parameters:

=over 4

=item * hashes

B<(Required)> An array of email hashes to check.

=back

Returns: A reference to a hash that maps email hashes to statuses. Example:

    $result = {
        'e52beb5a6966554a02a56072cafebabe' => '1',
        '62345cdd79773f62a87fcbc6abadbabe' => '0'
    };

=cut

sub exists {
	my $self = shift;
	my %args = @_;

	if (!defined $args{'hashes'}) {
        carp "Required parameter 'hashes' is not defined";
	}

    return $self->_call('exists', %args);
}

=head2 addresses

Gets a list of addresses for this account.

    $addresses = $grav->addresses;

Returns: A reference to a hash that maps addresses to userimage data. Example:

    $addresses = {
        '[e-mail]' => {
            'rating' => '0',
            'userimage' => '8bfc8da2562a53ddd7e630a68badf00d',
            'userimage_url' => 'http://en.gravatar.com/userimage/123456/8bfc8da2562a53ddd7e630a68badf00d.jpg'
        },
        '[e-mail]' => {
            'rating' => '1',
            'userimage' => '90f269fe7b67d0ce49f96427deadbabe',
            'userimage_url' => 'http://en.gravatar.com/userimage/123456/90f269fe7b67d0ce49f96427deadbabe.jpg'
        }
    };

=cut

sub addresses {
	my $self = shift;

    return $self->_call('addresses');
}

=head2 userimages

Gets a list of userimages for this account.

    $userimages = $grav->userimages;

Returns: A reference to a hash that maps userimages to data. Example:

    $userimages = {
    	'8bfc8da2562a53ddd7e630a68badf00d' => [
            '0',
            'http://en.gravatar.com/userimage/123456/8bfc8da2562a53ddd7e630a68badf00d.jpg'
        ],
        '90f269fe7b67d0ce49f96427deadbabe' => [
            '1',
            'http://en.gravatar.com/userimage/123456/90f269fe7b67d0ce49f96427deadbabe.jpg'
        ]
    };

=cut

sub userimages {
	my $self = shift;

	return $self->_call('userimages');
}

=head2 save_data

Saves binary image data as a userimage for this account.

    $grav->save_data(data => $data, rating => 1);

Parameters:

=over 4

=item * data

B<(Required)> A base64 encoded image.

=item * rating

B<(Required)> Rating.

=back

Returns: Userimage string.

=cut

sub save_data {
	my $self = shift;
    my %args = @_;

    if (!defined $args{'data'}) {
        carp "Required parameter 'data' is not defined";
    }

	if (!defined $args{'rating'}) {
		carp "Required parameter 'rating' is not defined";
	}

	return $self->_call('saveData', %args);
}

=head2 save_url

Reads an image via its URL and saves that as a userimage for this account.

    $grav->save_url(url => 'http://some.domain.com/image.png', rating => 0);

Parameters:

=over 4

=item * url

B<(Required)> A full URL to an image.

=item * rating

B<(Required)> Rating.

=back

Returns: Userimage string.

=cut

sub save_url {
    my $self = shift;
    my %args = @_;

    if (!defined $args{'url'}) {
        carp "Required parameter 'url' is not defined";
    }

    if (!defined $args{'rating'}) {
        carp "Required parameter 'rating' is not defined";
    }

    return $self->_call('saveUrl', %args);
}

=head2 use_userimage

Uses the specified userimage as a gravatar for one or more addresses on this
account.

    $grav->use_userimage(userimage => '9116aa83a568563290a681df61c0ffee'.
        addresses => ['[e-mail]', '[e-mail]']);

Parameters:

=over 4

=item * userimage

B<(Required)> The userimage to be used.

=item * addresses

B<(Required)> An array of email addresses for which this userimage will be used.

=back

Returns: 1 on success, undef on failure.

=cut

sub use_userimage {
	my $self = shift;
	my %args = @_;

    if (!defined $args{'userimage'}) {
        carp "Required parameter 'userimage' is not defined";
    }

    if (!defined $args{'addresses'}) {
        carp "Required parameter 'addresses' is not defined";
    }

	return $self->_call('useUserimage', %args);
}

=head2 remove_image

Removes the userimage associated with one or more email addresses.

    $result = $grav->remove_image(addresses => ['[e-mail]',
        '[e-mail]'])

Parameters:

=over 4

=item * addresses

B<(Required)> An array of email addresses to remove userimages for.

=back

Returns: A reference to a hash that maps email addresses to statuses. Example:

    result = {
        '[e-mail]' => 1,
        '[e-mail]' => 0
    };

=cut

sub remove_image {
	my $self = shift;
	my %args = @_;

    if (!defined $args{'addresses'}) {
        carp "Required parameter 'addresses' is not defined";
    }

    return $self->_call('removeImage', %args);
}

=head2 delete_userimage

Removes a userimage from the account and any email addresses with which it is
associated.

    $grav->delete_userimage(userimage => '292ed56ce849657d47b04105deadbeef');

Parameters:

=over 4

=item * userimage

B<(Required)> The userimage to be removed from the account.

=back

Returns: 1 on success, undef on failure.

=cut

sub delete_userimage {
	my $self = shift;
	my %args = @_;

    if (!defined $args{'userimage'}) {
        carp "Required parameter 'userimage' is not defined";
    }

    return $self->_call('deleteUserimage', %args);
}

=head2 test

API test method.

    $result = $grav->test(param => 1);

Returns: A reference to a hash which represents the parameters passed to the
test method.

=head2 err

Returns the numeric code of last error.

    $err_code = $grav->err;

=cut

sub err {
	my $self = shift;

	return $self->{'err'};
}

=head2 errstr

Returns the human readable text for last error.

    $err_description = $grav->errstr;

=cut

sub errstr {
	my $self = shift;

    return $self->{'errstr'};
}

=head1 AUTHOR

Michal Wojciechowski, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to C, or through
the web interface at L.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.


=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc WebService::Gravatar


You can also look for information at:

=over 4

=item * RT: CPAN's request tracker

L

=item * AnnoCPAN: Annotated CPAN documentation

L

=item * CPAN Ratings

L

=item * Search CPAN

L

=back


=head1 COPYRIGHT & LICENSE

Copyright 2010 Michal Wojciechowski, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.


=head1 SEE ALSO

=over 4

=item * Gravatar XML-RPC API Documentation

L

=back

=cut

1; # End of WebService::Gravatar