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.10 =cut our $VERSION = '0.10'; =head1 SYNOPSIS WebService::Gravatar provides an interface to Gravatar XML-RPC API. use WebService::Gravatar; # Create a new instance of WebService::Gravatar my $grav = WebService::Gravatar->new(email => 'your@email.address', 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 => $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 => 'your@email.address', 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 = { 'some@email.address' => { 'rating' => '0', 'userimage' => '8bfc8da2562a53ddd7e630a68badf00d', 'userimage_url' => 'http://en.gravatar.com/userimage/123456/8bfc8da2562a53ddd7e630a68badf00d.jpg' }, 'another@email.address' => { '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 => ['some@email.address', 'another@email.address']); 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 => ['some@email.address', 'another@email.address']) 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 = { 'some@email.address' => 1, 'another@email.address' => 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