Amazon-SQS-Simple-2.07/000755 000765 000024 00000000000 13356474404 014664 5ustar00mikestaff000000 000000 Amazon-SQS-Simple-2.07/bin/000755 000765 000024 00000000000 13356474403 015433 5ustar00mikestaff000000 000000 Amazon-SQS-Simple-2.07/Changes000644 000765 000024 00000005320 13356473217 016160 0ustar00mikestaff000000 000000 Revision history for Amazon-SQS-Simple 0.1 26 June 2007 First version, running against SQS version 2007-05-01 0.2 29 June 2007 Added full POD docs 0.3 17 July 2007 Added Amazon::SQS::Simple::Base, Amazon::SQS::Simple::Message 0.4 17 July 2007 Mended POD docs in Base and Message classes 0.5 06 August 2007 Fixed bug in Queue.pm where RetrieveMessage could attempt to bless a null reference. 0.6 06 February 2008 Updated to be compatible with the latest version of SQS (2008-01-01). NOTE: This version introduces non-backwards compatible changes! See this URL for details of the API change: http://developer.amazonwebservices.com/connect/entry.jspa?externalID=1148 0.7 14 Feb 2008 Documentation fixes 0.8 31 Jul 2008 Documentation fixes 0.9 25 Sep 2008 Added ability to call old API versions 1.00 28 Oct 2008 Fixed bug rt.cpan.org#34120 (http://rt.cpan.org/Public/Bug/Display.html?id=34120) 1.01 1 Nov 2008 Improved error reporting when using old API versions 1.02 21 Nov 2008 Fixed bug where interpolating an Amazon::SQS::Simple object in string context threw an error. 1.03 21 Nov 2008 Fixed ReceiveMessages when called with MaxNumberOfMessages > 1 1.04 23 May 2009 Added support for API version 2009-02-01 Removed support for API version 2007-05-01 1.05 14 Nov 2009 Minor tweak to improve the lives of folks using strict and mod_perl (Thanks to Stephen Sayre) 1.06 31 Mar 2010 Added Timeout constructor arg 2.00 22 May 2013 New Maintainer (PENFOLD) ReceiveMessage now always returns the first message in scalar context, irrespective of how many there are. (previously if there were more than one, it would return a count) Updated to support and default to SignatureVersion 2, stub SignatureVersion 3 (Roland Walker) Proxy Support (James Neal) Added SendMessageBatch, ReceiveMessageBatch (Chris Jones) 2.01 1 Jul 2013 Fix bug with SendMessageBatch and single messages :D 2.02 1 Jul 2013 As above with updated Changes file :D 2.04 1 Sep 2013 Retry 500 errors (on advice from AWS support) Handle ARN-style endpoints (https://sqs..amazonaws.com//) 2.05 16 Jan 2017 Add v4 signature support (rustyconover) Better tracking of retries (cjhamil) Retry 503s as well (Chris Jones) 2.06 20 Mar 2017 Fix 500/503 retry code so it actually works 2.07 18 Sep 2018 Added missing module import (Sachin Sebastian) Fixed double encode on retry (Clint Seales) Change to Digest::SHA1 Amazon-SQS-Simple-2.07/lib/000755 000765 000024 00000000000 13356474403 015431 5ustar00mikestaff000000 000000 Amazon-SQS-Simple-2.07/LICENSE000644 000765 000024 00000000247 13350242447 015666 0ustar00mikestaff000000 000000 COPYRIGHT AND LICENCE Copyright (C) 2007 Simon Whitaker This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Amazon-SQS-Simple-2.07/Makefile.PL000644 000765 000024 00000001503 13350244240 016620 0ustar00mikestaff000000 000000 use strict; use warnings; use ExtUtils::MakeMaker; use 5.0073; # for Encode/utf8 WriteMakefile( NAME => 'Amazon::SQS::Simple', AUTHOR => 'Simon Whitaker ', VERSION_FROM => 'lib/Amazon/SQS/Simple.pm', ABSTRACT_FROM => 'lib/Amazon/SQS/Simple.pm', PL_FILES => {}, PREREQ_PM => { 'AWS::Signature4' => 0, 'Test::More' => 0, 'Digest::SHA' => 0, 'LWP::UserAgent' => 0, 'MIME::Base64' => 0, 'Time::HiRes' => 0, 'URI::Escape' => 0, 'XML::Simple' => 0, 'VM::EC2::Security::CredentialCache' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Amazon-SQS-Simple-*' }, ); Amazon-SQS-Simple-2.07/MANIFEST000644 000765 000024 00000000566 13356474404 016024 0ustar00mikestaff000000 000000 bin/sqs-toolkit Changes lib/Amazon/SQS/Simple.pm lib/Amazon/SQS/Simple/Base.pm lib/Amazon/SQS/Simple/Message.pm lib/Amazon/SQS/Simple/Queue.pm lib/Amazon/SQS/Simple/SendResponse.pm LICENSE Makefile.PL MANIFEST This list of files MANIFEST.SKIP META.yml README t/00-load.t t/01-construct.t META.json Module JSON meta-data (added by MakeMaker) Amazon-SQS-Simple-2.07/MANIFEST.SKIP000644 000765 000024 00000000006 13350242447 016550 0ustar00mikestaff000000 000000 \.svn Amazon-SQS-Simple-2.07/META.json000644 000765 000024 00000002361 13356474404 016307 0ustar00mikestaff000000 000000 { "abstract" : "OO API for accessing the Amazon Simple Queue Service", "author" : [ "Simon Whitaker " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Amazon-SQS-Simple", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "AWS::Signature4" : "0", "Digest::SHA" : "0", "LWP::UserAgent" : "0", "MIME::Base64" : "0", "Test::More" : "0", "Time::HiRes" : "0", "URI::Escape" : "0", "VM::EC2::Security::CredentialCache" : "0", "XML::Simple" : "0" } } }, "release_status" : "stable", "version" : "2.07", "x_serialization_backend" : "JSON::PP version 2.27400_02" } Amazon-SQS-Simple-2.07/META.yml000644 000765 000024 00000001405 13356474404 016135 0ustar00mikestaff000000 000000 --- abstract: 'OO API for accessing the Amazon Simple Queue Service' author: - 'Simon Whitaker ' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.24, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Amazon-SQS-Simple no_index: directory: - t - inc requires: AWS::Signature4: '0' Digest::SHA: '0' LWP::UserAgent: '0' MIME::Base64: '0' Test::More: '0' Time::HiRes: '0' URI::Escape: '0' VM::EC2::Security::CredentialCache: '0' XML::Simple: '0' version: '2.07' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Amazon-SQS-Simple-2.07/README000644 000765 000024 00000001507 13350242447 015541 0ustar00mikestaff000000 000000 Amazon-SQS-Simple INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Amazon::SQS::Simple You can also look for information at: Search CPAN http://search.cpan.org/dist/Amazon-SQS-Simple CPAN Request Tracker: http://rt.cpan.org/NoAuth/Bugs.html?Dist=Amazon-SQS-Simple AnnoCPAN, annotated CPAN documentation: http://annocpan.org/dist/Amazon-SQS-Simple CPAN Ratings: http://cpanratings.perl.org/d/Amazon-SQS-Simple COPYRIGHT AND LICENCE Copyright (C) 2007 Simon Whitaker This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Amazon-SQS-Simple-2.07/t/000755 000765 000024 00000000000 13356474403 015126 5ustar00mikestaff000000 000000 Amazon-SQS-Simple-2.07/t/00-load.t000644 000765 000024 00000000247 13350242447 016445 0ustar00mikestaff000000 000000 #!perl -T use Test::More tests => 1; BEGIN { use_ok( 'Amazon::SQS::Simple' ); } diag( "Testing Amazon::SQS::Simple $Amazon::SQS::Simple::VERSION, Perl $], $^X" ); Amazon-SQS-Simple-2.07/t/01-construct.t000755 000765 000024 00000001404 13350242447 017552 0ustar00mikestaff000000 000000 #!perl -T use Test::More tests => 4; use Amazon::SQS::Simple; my $obj; eval { $obj = new Amazon::SQS::Simple(); }; ok($@, "should get a constructor exception when no AWS keys exist"); my $error = $@; chomp($error); like($error, qr/missing.*aws.*key/i, "should have a good error message (got: \"$error\")"); eval { $obj = new Amazon::SQS::Simple('fake access', 'fake secret', Version => "bogus version"); }; ok(!$@, "Giving an unrecognised version is OK"); eval { $obj = new Amazon::SQS::Simple('fake access', 'fake secret'); }; ok(!$@ && $obj->_api_version eq $Amazon::SQS::Simple::Base::DEFAULT_SQS_VERSION, "Constructor should default to the default API version if no version is given"); Amazon-SQS-Simple-2.07/lib/Amazon/000755 000765 000024 00000000000 13356474403 016656 5ustar00mikestaff000000 000000 Amazon-SQS-Simple-2.07/lib/Amazon/SQS/000755 000765 000024 00000000000 13356474403 017324 5ustar00mikestaff000000 000000 Amazon-SQS-Simple-2.07/lib/Amazon/SQS/Simple/000755 000765 000024 00000000000 13356474403 020555 5ustar00mikestaff000000 000000 Amazon-SQS-Simple-2.07/lib/Amazon/SQS/Simple.pm000644 000765 000024 00000015316 13350242513 021106 0ustar00mikestaff000000 000000 package Amazon::SQS::Simple; use strict; use warnings; use Carp qw( croak ); use Amazon::SQS::Simple::Base; # for constants use Amazon::SQS::Simple::Queue; use base qw(Exporter Amazon::SQS::Simple::Base); our $VERSION = '2.07'; our @EXPORT_OK = qw( timestamp ); sub GetQueue { my ($self, $queue_endpoint) = @_; if ($queue_endpoint =~ /^arn:aws:sqs/) { my ($host, $user, $queue); (undef, undef, undef, $host, $user, $queue) = split(/:/, $queue_endpoint); $queue_endpoint = "https://sqs.$host.amazonaws.com/$user/$queue"; } return Amazon::SQS::Simple::Queue->new( $self->{AWSAccessKeyId}, #AWSAccessKeyId and SecretKey are the first two arguments to Amazon::SQS::Simple::Base->new $self->{SecretKey}, %$self, Endpoint => $queue_endpoint, ); } sub CreateQueue { my ($self, $queue_name, %params) = @_; $params{Action} = 'CreateQueue'; $params{QueueName} = $queue_name; my $href = $self->_dispatch(\%params); if ($href->{CreateQueueResult}{QueueUrl}) { return Amazon::SQS::Simple::Queue->new( $self->{AWSAccessKeyId}, #AWSAccessKeyId and SecretKey are the first two arguments to Amazon::SQS::Simple::Base->new $self->{SecretKey}, %$self, Endpoint => $href->{CreateQueueResult}{QueueUrl}, ); } } sub ListQueues { my ($self, %params) = @_; $params{Action} = 'ListQueues'; my $href = $self->_dispatch(\%params, ['QueueUrl']); # default to the current version if ($href->{ListQueuesResult}{QueueUrl}) { my @result = map { Amazon::SQS::Simple::Queue->new( $self->{AWSAccessKeyId}, #AWSAccessKeyId and SecretKey are the first two arguments to Amazon::SQS::Simple::Base->new $self->{SecretKey}, %$self, Endpoint => $_, ) } @{$href->{ListQueuesResult}{QueueUrl}}; return \@result; } else { return undef; } } sub timestamp { return Amazon::SQS::Simple::Base::_timestamp(@_); } 1; __END__ =head1 NAME Amazon::SQS::Simple - OO API for accessing the Amazon Simple Queue Service =head1 SYNOPSIS use Amazon::SQS::Simple; my $access_key = 'foo'; # Your AWS Access Key ID my $secret_key = 'bar'; # Your AWS Secret Key # Create an SQS object my $sqs = new Amazon::SQS::Simple(AWSAccessKeyId => $access_key, SecretKey => $secret_key); # Create a new queue my $q = $sqs->CreateQueue('queue_name'); # Send a message my $response = $q->SendMessage('Hello world!'); # Send multiple messages my @responses = $q->SendMessageBatch(['Hello world', 'Farewell cruel world']); # Retrieve a message my $msg = $q->ReceiveMessage(); print $msg->MessageBody() # Hello world! # Delete the message $q->DeleteMessage($msg->ReceiptHandle()); # or $q->DeleteMessage($msg); # Delete the queue $q->Delete(); # Purge the queue $q->Purge(); =head1 INTRODUCTION Amazon::SQS::Simple is an OO API for the Amazon Simple Queue Service. =head1 IMPORTANT This version of Amazon::SQS::Simple defaults to work against version 2009-02-01 of the SQS API. Earlier API versions may or may not work. =head1 CONSTRUCTOR =over 2 =item new($access_key, $secret_key, [%opts]) Constructs a new Amazon::SQS::Simple object C<$access_key> is your Amazon Web Services access key. C<$secret_key> is your Amazon Web Services secret key. If you don't have either of these credentials, visit L. Options for new: =over 4 =item Timeout => SECONDS Set the HTTP user agent's timeout (default is 180 seconds) =item Version => VERSION_STRING Specifies the SQS API version you wish to use. E.g.: my $sqs = new Amazon::SQS::Simple($access_key, $secret_key, Version => '2008-01-01'); =back =back =head1 METHODS =over 2 =item GetQueue($queue_endpoint) Gets the queue with the given endpoint. Returns a C object. (See L for details.) =item CreateQueue($queue_name, [%opts]) Creates a new queue with the given name. Returns a C object. (See L for details.) Options for CreateQueue: =over 4 =item DefaultVisibilityTimeout => SECONDS Set the default visibility timeout for this queue =back =item ListQueues([%opts]) Gets a list of all your current queues. Returns an array of C objects. (See L for details.) Options for ListQueues: =over 4 =item QueueNamePrefix => STRING Only those queues whose name begins with the specified string are returned. =back =back =head1 FUNCTIONS No functions are exported by default; if you want to use them, export them in your use line: use Amazon::SQS::Simple qw( timestamp ); =over 2 =item timestamp($seconds) Takes a time in seconds since the epoch and returns a formatted timestamp suitable for using in a Timestamp or Expires optional method parameter. =back =head1 STANDARD OPTIONS The following options can be supplied with any of the listed methods. =over 2 =item AWSAccessKeyId => STRING The AWS Access Key Id to use with the method call. If not provided, Amazon::SQS::Simple uses the value passed to the constructor. =item SecretKey => STRING The Secret Key to use with the method call. If not provided, Amazon::SQS::Simple uses the value passed to the constructor. =item Timestamp => TIMESTAMP All methods are automatically given a timestamp of the time at which they are called, but you can override this value if you need to. The value for this key should be a timestamp as returned by the Amazon::SQS::Simple::timestamp() function. You generally do not need to supply this option. =item Expires => TIMESTAMP All methods are automatically given a timestamp of the time at which they are called. You can alternatively set an expiry time by providing an Expires option. The value for this key should be a timestamp as returned by the C function. You generally do not need to supply this option. =back =head1 ACKNOWLEDGEMENTS Bill Alford wrote the code to support basic functionality of older API versions in release 0.9. James Neal provided the proxy support code in release 2.0 Roland Walker provided support for the newer signature version in release 2.0 Chris Jones provied the batch message code in release 2.0 Rusty Conover provided the V4 signature support in release 2.05 =head1 AUTHOR Copyright 2007-2008 Simon Whitaker Eswhitaker@cpan.orgE Copyright 2013-2017 Mike (no relation) Whitaker Epenfold@cpan.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Amazon-SQS-Simple-2.07/lib/Amazon/SQS/Simple/Base.pm000755 000765 000024 00000016405 13350243707 021771 0ustar00mikestaff000000 000000 package Amazon::SQS::Simple::Base; use strict; use warnings; use Carp qw( croak carp ); use Digest::SHA qw(hmac_sha256 sha256); use LWP::UserAgent; use MIME::Base64; use URI::Escape; use XML::Simple; use HTTP::Date; use HTTP::Request::Common; use AWS::Signature4; use POSIX qw(strftime); use Encode qw(encode); use Data::Dumper; use Time::HiRes; use VM::EC2::Security::CredentialCache; use base qw(Exporter); use constant ({ SQS_VERSION_2012_11_05 => '2012-11-05', BASE_ENDPOINT => 'http://sqs.us-east-1.amazonaws.com', DEF_MAX_GET_MSG_SIZE => 4096, # Messages larger than this size will use a POST request. MAX_RETRIES => 4, }); our $DEFAULT_SQS_VERSION = SQS_VERSION_2012_11_05; our @EXPORT = qw(SQS_VERSION_2012_11_05); our $URI_SAFE_CHARACTERS = '^A-Za-z0-9-_.~'; # defined by AWS, same as URI::Escape defaults sub new { my $class = shift; my @args = @_; if (scalar(@args) >= 2 && $args[0] ne 'UseIAMRole') { my $access_key = shift @args; my $secret_key = shift @args; @args = (AWSAccessKeyId => $access_key, SecretKey => $secret_key, @args); } my $self = { Endpoint => +BASE_ENDPOINT, SignatureVersion => 4, Version => $DEFAULT_SQS_VERSION, @args }; if (!defined($self->{UserAgent})) { $self->{UserAgent} = LWP::UserAgent->new(keep_alive => 4); } if (defined($self->{Timeout})) { $self->{UserAgent}->timeout($self->{Timeout}); } if (!defined($self->{Region})) { $self->{Region} = 'us-east-1'; } $self->{UserAgent}->env_proxy; if (!$self->{UseIAMRole} && (!$self->{AWSAccessKeyId} || !$self->{SecretKey})) { croak "Missing AWSAccessKey or SecretKey"; } $self = bless($self, $class); return $self; } sub _api_version { my $self = shift; return $self->{Version}; } sub _dispatch { my $self = shift; my $params = shift || {}; my $force_array = shift || []; my $url = $self->{Endpoint}; my $response; my $post_body; my $post_request = 0; $params = { Version => $self->{Version}, %$params }; if (!$params->{Timestamp} && !$params->{Expires}) { $params->{Timestamp} = _timestamp(); } foreach my $try (1..MAX_RETRIES) { my $req = HTTP::Request->new(POST => $url); $req->header(host => URI->new($url)->host); my $now = time; my $http_date = strftime('%Y%m%dT%H%M%SZ', gmtime($now)); my $date = strftime('%Y%m%d', gmtime($now)); $req->protocol('HTTP/1.1'); $req->header('Date' => $http_date); $req->header('x-amz-target', 'AmazonSQSv20121105.' . $params->{Action}); $req->header('content-type' => 'application/x-www-form-urlencoded;charset=utf-8'); if ($self->{UseIAMRole}) { my $creds = VM::EC2::Security::CredentialCache->get(); defined($creds) || die("Unable to retrieve IAM role credentials"); $self->{AWSAccessKeyId} = $creds->accessKeyId; $self->{SecretKey} = $creds->secretAccessKey; $req->header('x-amz-security-token' => $creds->sessionToken); } $params->{AWSAccessKeyId} = $self->{AWSAccessKeyId}; my $escaped_params = $self->_escape_params($params); my $payload = join('&', map { $_ . '=' . $escaped_params->{$_} } keys %$escaped_params); $req->content($payload); $req->header('Content-Length', length($payload)); my $signer = AWS::Signature4->new(-access_key => $self->{AWSAccessKeyId}, -secret_key => $self->{SecretKey}); $signer->sign($req); $self->_debug_log($req->as_string()); $response = $self->{UserAgent}->request($req); if ($response->is_success) { # note, 500 and 503 are NOT success :D $self->_debug_log($response->content); my $href = XMLin($response->content, ForceArray => $force_array, KeyAttr => {}); return $href; } else { # advice from internal AWS support - most client libraries try 3 times in the face # of 500 errors, so ours should too # use exponential backoff. if ($response->code == 500 || $response->code == 503) { my $sleep_amount= 2 ** $try * 50 * 1000; $self->_debug_log("Doing sleep for: $sleep_amount"); Time::HiRes::usleep($sleep_amount); next; } die("Got an error: " . $response->as_string()); } } # if we fall out of the loop, then we have either a non-500 error or a persistent 500. my $msg; eval { my $href = XMLin($response->content); $msg = $href->{Error}{Message}; }; my $error = "ERROR: On calling $params->{Action}: " . $response->status_line; $error .= " ($msg)" if $msg; croak $error; } sub _debug_log { my ($self, $msg) = @_; return unless $self->{_Debug}; chomp($msg); print {$self->{_Debug}} $msg . "\n\n"; } sub _escape_params { my ($self, $params) = @_; my $escaped_params = {%$params}; # Need to escape + characters in signature # see http://docs.amazonwebservices.com/AWSSimpleQueueService/2006-04-01/Query_QueryAuth.html # Likewise, need to escape + characters in ReceiptHandle # Many characters are possible in MessageBody: # #x9 | #xA | #xD | [#x20-#xD7FF] | [#xE000-#xFFFD] | [#x10000-#x10FFFF] # probably should encode all keys and values for consistency and future-proofing my $to_escape = qr{^(?:Signature|MessageBody|ReceiptHandle)|\.\d+\.(?:MessageBody|ReceiptHandle)$}; foreach my $key (keys %$params) { next unless $key =~ m/$to_escape/; my $octets = encode('utf-8-strict', $params->{$key}); $escaped_params->{$key} = uri_escape($octets, $URI_SAFE_CHARACTERS); } return $escaped_params; } sub _escape_param { my $params = shift; my $single = shift; my $multi_n = shift; if ($params->{$single}) { $params->{$single} = uri_escape($params->{$single}); } else { foreach my $i (1..10) { my $multi = $multi_n; $multi =~ s/\.n\./\.$i\./; if ($params->{$multi}) { $params->{$multi} = uri_escape($params->{$multi}); } else { last; } } } } sub _max_get_msg_size { my $self = shift; # a user-defined cut-off if (defined $self->{MAX_GET_MSG_SIZE}) { return $self->{MAX_GET_MSG_SIZE}; } # the default cut-off else { return DEF_MAX_GET_MSG_SIZE; } } sub _timestamp { my $t = shift; if (!defined($t)) { $t = time; } my $formatted_time = HTTP::Date::time2isoz($t); $formatted_time =~ s/ /T/; return $formatted_time; } 1; __END__ =head1 NAME Amazon::SQS::Simple::Base - No user-serviceable parts included =head1 AUTHOR Copyright 2007-2008 Simon Whitaker Eswhitaker@cpan.orgE Copyright 2013-2017 Mike (no relation) Whitaker Epenfold@cpan.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Amazon-SQS-Simple-2.07/lib/Amazon/SQS/Simple/Message.pm000644 000765 000024 00000002750 13350242447 022476 0ustar00mikestaff000000 000000 package Amazon::SQS::Simple::Message; use strict; use warnings; use Amazon::SQS::Simple::Base; # for constants sub new { my $class = shift; my $msg = shift; my $version = shift || $Amazon::SQS::Simple::Base::DEFAULT_SQS_VERSION; $msg->{Version} = $version; return bless ($msg, $class); } sub MessageBody { my $self = shift; return $self->{Body}; } sub MD5OfBody { my $self = shift; return $self->{MD5OfBody}; } sub MessageId { my $self = shift; return $self->{MessageId}; } sub ReceiptHandle { my $self = shift; return $self->{ReceiptHandle}; } 1; __END__ =head1 NAME Amazon::SQS::Simple::Message - OO API for representing messages from the Amazon Simple Queue Service. =head1 INTRODUCTION Don't instantiate this class directly. Objects of this class are returned by various methods in C. See L for more details. =head1 METHODS =over 2 =item B Get the message body. =item B Get the message unique identifier =item B Get the MD5 checksum of the message body =item B Get the receipt handle for the message (used as an argument to DeleteMessage) =back =head1 AUTHOR Copyright 2007-2008 Simon Whitaker Eswhitaker@cpan.orgE Copyright 2013-2017 Mike (no relation) Whitaker Epenfold@cpan.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Amazon-SQS-Simple-2.07/lib/Amazon/SQS/Simple/Queue.pm000755 000765 000024 00000027405 13350244053 022200 0ustar00mikestaff000000 000000 package Amazon::SQS::Simple::Queue; use strict; use warnings; use Amazon::SQS::Simple::Message; use Amazon::SQS::Simple::SendResponse; use Carp qw( croak carp ); use base 'Amazon::SQS::Simple::Base'; use Amazon::SQS::Simple::Base; # for constants use overload '""' => \&_to_string; sub Endpoint { my $self = shift; return $self->{Endpoint}; } sub Delete { my $self = shift; my $params = { Action => 'DeleteQueue' }; my $href = $self->_dispatch($params); } sub Purge { my $self = shift; my $params = { Action => 'PurgeQueue' }; my $href = $self->_dispatch($params); } sub SendMessage { my ($self, $message, %params) = @_; $params{Action} = 'SendMessage'; $params{MessageBody} = $message; my $href = $self->_dispatch(\%params); # default to most recent version return new Amazon::SQS::Simple::SendResponse( $href->{SendMessageResult}, $message ); } sub SendMessageBatch { my ($self, $messages, %params) = @_; $params{Action} = 'SendMessageBatch'; if (ref($messages) eq 'ARRAY'){ my %messages; my @IDs = map { "msg_$_" } (1..scalar(@$messages)); @messages{@IDs} = @$messages; $messages = \%messages; } my $i=0; while (my ($id, $msg) = each %$messages){ if ($i==10){ warn "Batch messaging limited to 10 messages"; last; } $i++; $params{"SendMessageBatchRequestEntry.$i.Id"} = $id; $params{"SendMessageBatchRequestEntry.$i.MessageBody"} = $msg; } my $href = $self->_dispatch(\%params, [qw/SendMessageBatchResultEntry/]); my @responses = (); # default to most recent version for (@{$href->{SendMessageBatchResult}{SendMessageBatchResultEntry}}) { push @responses, new Amazon::SQS::Simple::SendResponse($_, $messages->{$_->{Id}}); } if (wantarray){ return @responses; } else { return \@responses; } } sub ReceiveMessage { my ($self, %params) = @_; $params{Action} = 'ReceiveMessage'; my $href = $self->_dispatch(\%params, [qw(Message)]); my @messages = (); # default to most recent version if (defined $href->{ReceiveMessageResult}{Message}) { foreach (@{$href->{ReceiveMessageResult}{Message}}) { push @messages, new Amazon::SQS::Simple::Message( $_, $self->_api_version() ); } } if (wantarray) { return @messages; } elsif (@messages) { return $messages[0]; } else { return undef; } } sub ReceiveMessageBatch { my ($self, %params) = @_; $params{MaxNumberOfMessages} = 10; $self->ReceiveMessage(%params); } sub DeleteMessage { my ($self, $message, %params) = @_; # to be consistent with DeleteMessageBatch, this will now accept a message object my $receipt_handle; if (ref($message) && $message->isa('Amazon::SQS::Simple::Message')){ $receipt_handle = $message->ReceiptHandle; } # for backward compatibility, we will still cope with a receipt handle else { $receipt_handle = $message; } $params{Action} = 'DeleteMessage'; $params{ReceiptHandle} = $receipt_handle; my $href = $self->_dispatch(\%params); } sub DeleteMessageBatch { my ($self, $messages, %params) = @_; return unless @$messages; $params{Action} = 'DeleteMessageBatch'; my $i=0; foreach my $msg (@$messages){ $i++; if ($i>10){ warn "Batch deletion limited to 10 messages"; last; } $params{"DeleteMessageBatchRequestEntry.$i.Id"} = $msg->MessageId; $params{"DeleteMessageBatchRequestEntry.$i.ReceiptHandle"} = $msg->ReceiptHandle; } my $href = $self->_dispatch(\%params); } sub ChangeMessageVisibility { my ($self, $receipt_handle, $timeout, %params) = @_; if (!defined($timeout) || $timeout =~ /\D/ || $timeout < 0 || $timeout > 43200) { croak "timeout must be specified and in range 0..43200"; } $params{Action} = 'ChangeMessageVisibility'; $params{ReceiptHandle} = $receipt_handle; $params{VisibilityTimeout} = $timeout; my $href = $self->_dispatch(\%params); } our %valid_permission_actions = map { $_ => 1 } qw(* SendMessage ReceiveMessage DeleteMessage ChangeMessageVisibility GetQueueAttributes); sub AddPermission { my ($self, $label, $account_actions, %params) = @_; $params{Action} = 'AddPermission'; $params{Label} = $label; my $i = 1; foreach my $account_id (keys %$account_actions) { $account_id =~ /^\d{12}$/ or croak "Account IDs passed to AddPermission should be 12 digit AWS account numbers, no hyphens"; my $actions = $account_actions->{$account_id}; my @actions; if (UNIVERSAL::isa($actions, 'ARRAY')) { @actions = @$actions; } else { @actions = ($actions); } foreach my $action (@actions) { exists $valid_permission_actions{$action} or croak "Action passed to AddPermission must be one of " . join(', ', sort keys %valid_permission_actions); $params{"AWSAccountId.$i"} = $account_id; $params{"ActionName.$i"} = $action; $i++; } } my $href = $self->_dispatch(\%params); } sub RemovePermission { my ($self, $label, %params) = @_; $params{Action} = 'RemovePermission'; $params{Label} = $label; my $href = $self->_dispatch(\%params); } sub GetAttributes { my ($self, %params) = @_; $params{Action} = 'GetQueueAttributes'; my %result; # default to the current version $params{AttributeName} ||= 'All'; my $href = $self->_dispatch(\%params, [ 'Attribute' ]); if ($href->{GetQueueAttributesResult}) { foreach my $attr (@{$href->{GetQueueAttributesResult}{Attribute}}) { $result{$attr->{Name}} = $attr->{Value}; } } return \%result; } sub SetAttribute { my ($self, $key, $value, %params) = @_; $params{Action} = 'SetQueueAttributes'; $params{'Attribute.Name'} = $key; $params{'Attribute.Value'} = $value; my $href = $self->_dispatch(\%params); } sub _to_string { my $self = shift; return $self->Endpoint(); } 1; __END__ =head1 NAME Amazon::SQS::Simple::Queue - OO API for representing queues from the Amazon Simple Queue Service. =head1 SYNOPSIS use Amazon::SQS::Simple; my $access_key = 'foo'; # Your AWS Access Key ID my $secret_key = 'bar'; # Your AWS Secret Key my $sqs = new Amazon::SQS::Simple($access_key, $secret_key); my $q = $sqs->CreateQueue('queue_name'); # Single messages my $response = $q->SendMessage('Hello world!'); my $msg = $q->ReceiveMessage; print $msg->MessageBody; # Hello world! $q->DeleteMessage($msg); # or, for backward compatibility $q->DeleteMessage($msg->ReceiptHandle); # Batch messaging of up to 10 messages per operation my @responses = $q->SendMessageBatch( [ 'Hello world!', 'Hello again!' ] ); # or with defined message IDs $q->SendMessageBatch( { msg1 => 'Hello world!', msg2 => 'Hello again!' } ); my @messages = $q->ReceiveMessageBatch; $q->DeleteMessageBatch( \@messages ); =head1 INTRODUCTION Don't instantiate this class directly. Objects of this class are returned by various methods in C. See L for more details. =head1 METHODS =over 2 =item B Get the endpoint for the queue. =item B Deletes the queue. Any messages contained in the queue will be lost. =item B Purges the queue. =item B Sends the message. The message can be up to 8KB in size and should be plain text. =item B Sends a batch of up to 10 messages, passed as an array-ref. Message IDs (of the style 'msg_1', 'msg_2', etc) are auto-generated for each message. Alternatively, if you need to specify the format of the message ID then you can pass a hash-ref {$id1 => $message1, etc} =item B Get the next message from the queue. Returns one or more C objects (depending on whether called in list or scalar context), or undef if no messages are retrieved. NOTE: This behaviour has changed slightly since v1.06. It now always returns the first message in scalar context, irrespective of how many there are. See L for more details. Options for ReceiveMessage: =over 4 =item * MaxNumberOfMessages => INTEGER Maximum number of messages to return (integer from 1 to 20). SQS never returns more messages than this value but might return fewer. Not necessarily all the messages in the queue are returned. Defaults to 1. =item * WaitTimeSeconds => INTEGER Long poll support (integer from 0 to 20). The duration (in seconds) that the I action call will wait until a message is in the queue to include in the response, as opposed to returning an empty response if a message is not yet available. If you do not specify I in the request, the queue attribute I is used to determine how long to wait. =item * VisibilityTimeout => INTEGER The duration in seconds (integer from 0 to 43200) that the received messages are hidden from subsequent retrieve requests after being retrieved by a I request. If you do not specify I in the request, the queue attribute I is used to determine how long to wait. =back =item B As ReceiveMessage(MaxNumberOfMessages => 10) =item B Pass this method either a message object or receipt handle to delete that message from the queue. For backward compatibility, can pass the message ReceiptHandle rather than the message. =item B Pass this method an array-ref containing up to 10 message objects to delete all of those messages from the queue =item B NOT SUPPORTED IN APIs EARLIER THAN 2009-01-01 Changes the visibility of the message with the specified receipt handle to C<$timeout> seconds. C<$timeout> must be in the range 0..43200. =item B NOT SUPPORTED IN APIs EARLIER THAN 2009-01-01 Sets a permissions policy with the specified label. C<$account_actions> is a reference to a hash mapping 12-digit AWS account numbers to the action(s) you want to permit for those account IDs. The hash value for each key can be a string (e.g. "ReceiveMessage") or a reference to an array of strings (e.g. ["ReceiveMessage", "DeleteMessage"]) =item B NOT SUPPORTED IN APIs EARLIER THAN 2009-01-01 Removes the permissions policy with the specified label. =item B Get the attributes for the queue. Returns a reference to a hash mapping attribute names to their values. Currently the following attribute names are returned: =over 4 =item * VisibilityTimeout =item * ApproximateNumberOfMessages =back =item B Sets the value for a queue attribute. Currently the only valid attribute name is C. =back =head1 ACKNOWLEDGEMENTS Chris Jones provied the batch message code in release 2.0 =head1 AUTHOR Copyright 2007-2008 Simon Whitaker Eswhitaker@cpan.orgE Copyright 2013-2017 Mike (no relation) Whitaker Epenfold@cpan.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Amazon-SQS-Simple-2.07/lib/Amazon/SQS/Simple/SendResponse.pm000755 000765 000024 00000003000 13350242447 023512 0ustar00mikestaff000000 000000 package Amazon::SQS::Simple::SendResponse; use strict; use warnings; use Digest::MD5 qw(md5_hex); sub new { my ($class, $msg, $body) = @_; $msg = bless($msg, $class); if ($body){ $msg->{MessageBody} = $body; } return $msg; } sub MessageId { my $self = shift; return $self->{MessageId}; } sub MD5OfMessageBody { my $self = shift; return $self->{MD5OfMessageBody}; } sub VerifyReceipt { my $self = shift; return $self->{MD5OfMessageBody} eq md5_hex($self->{MessageBody}) ? 1 : undef; } 1; __END__ =head1 NAME Amazon::SQS::Simple::SendResponse - OO API for representing responses to messages sent to the Amazon Simple Queue Service. =head1 INTRODUCTION Don't instantiate this class directly. Objects of this class are returned by SendMessage in C. See L for more details. =head1 METHODS =over 2 =item B Get the message unique identifier =item B Get the MD5 checksum of the message body you sent =item B Perform verification of message receipt. Compares the MD5 checksum returned by the response object with the expected checksum. Returns 1 if receipt is verified, undef otherwise. =back =head1 AUTHOR Copyright 2007-2008 Simon Whitaker Eswhitaker@cpan.orgE Copyright 2013-2017 Mike (no relation) Whitaker Epenfold@cpan.orgE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Amazon-SQS-Simple-2.07/bin/sqs-toolkit000755 000765 000024 00000006374 13350242447 017657 0ustar00mikestaff000000 000000 #!/usr/bin/perl -w use File::Basename; use Getopt::Long; use Amazon::SQS::Simple; my %opts; GetOptions( \%opts, 'flush', 'timeout=i', 'help', 'delete', 'create', 'info', 'access-key', 'secret-key', 'list-queues', 'verbose', ); my $scr = basename($0); my $queue_name = shift; my $AWSAccessKeyId = $opts{'access-key'} || $ENV{AWS_ACCESS_KEY}; my $SecretKey = $opts{'secret-key'} || $ENV{AWS_SECRET_KEY}; usage(0) if ($opts{help}); usage(1) if @ARGV; sub usage { my $status = shift || 0; print <ListQueues(); if ($queues) { foreach my $queue (@$queues) { (my $name = $queue->Endpoint()) =~ s|.*/||; printf ("%s (Endpoint: %s)\n", $name, $queue->Endpoint()); } } else { print "You don't have any queues (use --create to create one)" } exit(0); } usage(1) unless $queue_name; if ($opts{create}) { $q = q_create($queue_name); } else { $q = q_find($queue_name); } if ($opts{timeout}) { q_timeout($q, $opts{timeout}); } if ($opts{info}) { q_info($q); } if ($opts{flush}) { q_flush($q); } if ($opts{delete}) { q_delete($q); } sub q_find { my $name = shift; my $queues = $sqs->ListQueues(QueueNamePrefix => $name); if ($queues) { my @matches = grep { $_->Endpoint() =~ m|/$name$|} @$queues; if (@matches > 1) { warn "[WARNING] Multiple queues found with name $name\n"; } if (@matches) { return $matches[0]; } } die "No queue called $name found (try using --list-queues)\n"; } sub q_create { my $name = shift; $sqs->CreateQueue($name); } sub q_delete { my $queue = shift; my $href = $queue->Delete(); } sub q_info { my $queue = shift; print "Endpoint: $queue\nAttributes:\n"; my $attrs = $queue->GetAttributes(); for (keys %$attrs) { print "$_ => $attrs->{$_}\n"; } } sub q_flush { my $queue = shift; while (my $msg = $queue->ReceiveMessage) { if ($opts{verbose}) { print "Deleting " . $msg->MessageId . "\n"; } $queue->DeleteMessage($msg->ReceiptHandle); } } sub q_timeout { my $queue = shift; my $t = shift; if (defined $t) { $queue->SetAttribute('VisibilityTimeout', $t); } else { my $href = $queue->GetAttributes(); return $href->{VisibilityTimeout}; } }