view release on metacpan or  search on metacpan

lib/Amazon/SQS/ProducerConsumer/Base.pm  view on Meta::CPAN

package Amazon::SQS::ProducerConsumer::Base;

use 5.006;
use strict;
use warnings;

use XML::Simple;
use LWP::UserAgent;
use Digest::HMAC_SHA1;
use URI::Escape qw(uri_escape_utf8);
use MIME::Base64 qw(encode_base64);


=head1 NAME

Amazon::SQS::ProducerConsumer::Base - Perl interface to the Amazon Simple Queue Service (SQS) environment

=head1 VERSION

Version 0.04

=cut

our $VERSION = '0.04';

=head1 SYNOPSIS

 use Amazon::SQS::ProducerConsumer::Base;

 my $sqs = new Amazon::SQS::ProducerConsumer::Base
	AWSAccessKeyId => 'PUBLIC_KEY_HERE',
	SecretAccessKey => 'SECRET_KEY_HERE';

 # Create a queue
 my $queueURL = $sqs->create_queue( QueueName => 'TestQueue' );

 # Send a message to that queue
 my $messageID = $sqs->send_message( Queue => $queueURL, MessageBody => 'Test message' );

 # Get a message from that queue
 my $message = $sqs->receive_message( Queue => $queueURL );
 print 'Message ID: ', $message->{MessageId}, "\n";
 print 'Message: ', $message->{MessageBody}, "\n";

 # Delete the message you got
 my $message = $sqs->delete_message( Queue => $queueURL, MessageId => $message->{MessageId} );

If an error occurs in communicating with SQS, the return value will be undef and $sqs->{error} will be populated with the message.

=cut

sub new {
	my ($class, %args) = @_;

	my $me = \%args;
	bless $me, $class;
	$me->initialize;
	return $me;
}

sub initialize {
	my $me = shift;
	$me->{signature_version} = 2;
	$me->{version} = '2009-02-01';
	$me->{host} ||= 'queue.amazonaws.com';
}

sub create_queue {
	my ($me, %args) = @_;

	my $xml = $me->sign_and_post( Action => 'CreateQueue', %args );
	return undef if $me->check_error( $xml );
	return $xml->{CreateQueueResult}{QueueUrl};
}

sub list_queues {
	my ($me, %args) = @_;

	my $xml = $me->sign_and_post( Action => 'ListQueues', %args );
	return undef if $me->check_error( $xml );

	my $result;
	$result = $xml->{ListQueuesResult}{QueueUrl};
	map { $_ = (split '/', $_)[-1] } @$result if ref $result eq 'ARRAY';
	return ref $result eq 'ARRAY' ? @$result : $result;
}

sub delete_queue {
	my ($me, %args) = @_;

	delete $args{ForceDeletion};
	my $xml = $me->sign_and_post( Action => 'DeleteQueue', %args );
	return undef if $me->check_error( $xml );

	return $xml->{ResponseMetadata}{RequestId};
}

sub send_message {
	my ($me, %args) = @_;

	my $xml = $me->sign_and_post( Action => 'SendMessage', %args );
	return undef if $me->check_error( $xml );

	return $xml->{SendMessageResult}{MessageId};
}

sub receive_message {
	my ($me, %args) = @_;

	delete $args{NumberOfMessages};
	my $xml = $me->sign_and_post( Action => 'ReceiveMessage', %args );
	return undef if $me->check_error( $xml );

	return $xml->{ReceiveMessageResult}{Message};
}