Amazon-SQS-Simple-2.03/000755 000766 000024 00000000000 12211045462 016403 5ustar00mikewhitakerstaff000000 000000 Amazon-SQS-Simple-2.03/bin/000755 000766 000024 00000000000 12211045462 017153 5ustar00mikewhitakerstaff000000 000000 Amazon-SQS-Simple-2.03/Changes000644 000766 000024 00000004514 12211045441 017677 0ustar00mikewhitakerstaff000000 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.03 1 Sep 2013 Retry 500 errors (on advice from AWS support) Handle ARN-style endpoints (https://sqs..amazonaws.com//) Amazon-SQS-Simple-2.03/lib/000755 000766 000024 00000000000 12211045462 017151 5ustar00mikewhitakerstaff000000 000000 Amazon-SQS-Simple-2.03/LICENSE000644 000766 000024 00000000247 12135504217 017416 0ustar00mikewhitakerstaff000000 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.03/Makefile.PL000644 000766 000024 00000001364 12147156156 020374 0ustar00mikewhitakerstaff000000 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 => { 'Test::More' => 0, 'Digest::HMAC_SHA1' => 0, 'Digest::SHA' => 0, 'LWP::UserAgent' => 0, 'MIME::Base64' => 0, 'URI::Escape' => 0, 'XML::Simple' => 0, }, dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, clean => { FILES => 'Amazon-SQS-Simple-*' }, ); Amazon-SQS-Simple-2.03/MANIFEST000644 000766 000024 00000000545 12211045462 017540 0ustar00mikewhitakerstaff000000 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 META.json Module JSON meta-data (added by MakeMaker) Amazon-SQS-Simple-2.03/MANIFEST.SKIP000644 000766 000024 00000000006 12135504217 020300 0ustar00mikewhitakerstaff000000 000000 \.svn Amazon-SQS-Simple-2.03/META.json000644 000766 000024 00000002124 12211045462 020023 0ustar00mikewhitakerstaff000000 000000 { "abstract" : "OO API for accessing the Amazon Simple Queue ", "author" : [ "Simon Whitaker " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921", "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" : { "Digest::HMAC_SHA1" : "0", "Digest::SHA" : "0", "LWP::UserAgent" : "0", "MIME::Base64" : "0", "Test::More" : "0", "URI::Escape" : "0", "XML::Simple" : "0" } } }, "release_status" : "stable", "version" : "2.03" } Amazon-SQS-Simple-2.03/META.yml000644 000766 000024 00000001162 12211045462 017654 0ustar00mikewhitakerstaff000000 000000 --- abstract: 'OO API for accessing the Amazon Simple Queue ' author: - 'Simon Whitaker ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.62, CPAN::Meta::Converter version 2.120921' 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: Digest::HMAC_SHA1: 0 Digest::SHA: 0 LWP::UserAgent: 0 MIME::Base64: 0 Test::More: 0 URI::Escape: 0 XML::Simple: 0 version: 2.03 Amazon-SQS-Simple-2.03/README000644 000766 000024 00000001507 12135504217 017271 0ustar00mikewhitakerstaff000000 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.03/t/000755 000766 000024 00000000000 12211045462 016646 5ustar00mikewhitakerstaff000000 000000 Amazon-SQS-Simple-2.03/t/00-load.t000644 000766 000024 00000000247 12135504217 020175 0ustar00mikewhitakerstaff000000 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.03/lib/Amazon/000755 000766 000024 00000000000 12211045462 020376 5ustar00mikewhitakerstaff000000 000000 Amazon-SQS-Simple-2.03/lib/Amazon/SQS/000755 000766 000024 00000000000 12211045462 021044 5ustar00mikewhitakerstaff000000 000000 Amazon-SQS-Simple-2.03/lib/Amazon/SQS/Simple/000755 000766 000024 00000000000 12211045462 022275 5ustar00mikewhitakerstaff000000 000000 Amazon-SQS-Simple-2.03/lib/Amazon/SQS/Simple.pm000644 000766 000024 00000014135 12211042114 022626 0ustar00mikewhitakerstaff000000 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.03'; 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 new Amazon::SQS::Simple::Queue( %$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, 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 { new Amazon::SQS::Simple::Queue( %$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($access_key, $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(); =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 =head1 AUTHOR Copyright 2007-2008 Simon Whitaker Eswhitaker@cpan.orgE Copyright 2013 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.03/lib/Amazon/SQS/Simple/Base.pm000755 000766 000024 00000026372 12211044376 023525 0ustar00mikewhitakerstaff000000 000000 package Amazon::SQS::Simple::Base; use strict; use warnings; use Carp qw( croak carp ); use Digest::HMAC_SHA1; use Digest::SHA qw(hmac_sha256 sha256); use LWP::UserAgent; use MIME::Base64; use URI::Escape; use XML::Simple; use Encode qw(encode); use base qw(Exporter); use constant { SQS_VERSION_2012_11_05 => '2012-11-05', SQS_VERSION_2009_02_01 => '2009-02-01', SQS_VERSION_2008_01_01 => '2008-01-01', BASE_ENDPOINT => 'http://queue.amazonaws.com', DEF_MAX_GET_MSG_SIZE => 4096, # Messages larger than this size will use a POST request. }; our $DEFAULT_SQS_VERSION = SQS_VERSION_2012_11_05; our @EXPORT = qw(SQS_VERSION_2012_11_05 SQS_VERSION_2009_02_01 SQS_VERSION_2008_01_01); our $URI_SAFE_CHARACTERS = '^A-Za-z0-9-_.~'; # defined by AWS, same as URI::Escape defaults sub new { my $class = shift; my $access_key = shift; my $secret_key = shift; my $self = { AWSAccessKeyId => $access_key, SecretKey => $secret_key, Endpoint => +BASE_ENDPOINT, SignatureVersion => 2, Version => $DEFAULT_SQS_VERSION, @_, }; if (!$self->{AWSAccessKeyId} || !$self->{SecretKey}) { croak "Missing AWSAccessKey or SecretKey"; } # validate the Version, warn if it's not one we recognise my @valid_versions = ( SQS_VERSION_2012_11_05, SQS_VERSION_2008_01_01, SQS_VERSION_2009_02_01 ); if (!grep {$self->{Version} eq $_} @valid_versions) { carp "Warning: " . $self->{Version} . " might not be a valid version. Recognised versions are " . join(', ', @valid_versions); } $self = bless($self, $class); $self->_debug_log("Version is set to $self->{Version}"); return $self; } sub _api_version { my $self = shift; return $self->{Version}; } sub _dispatch { my $self = shift; my $params = shift || {}; my $force_array = shift || []; my $ua = LWP::UserAgent->new(); my $url = $self->{Endpoint}; my $response; my $post_body; my $post_request = 0; if ($self->{Timeout}) { $ua->timeout($self->{Timeout}); } $ua->env_proxy; $params = { AWSAccessKeyId => $self->{AWSAccessKeyId}, Version => $self->{Version}, %$params }; if (!$params->{Timestamp} && !$params->{Expires}) { $params->{Timestamp} = _timestamp(); } if ($params->{MessageBody} && length($params->{MessageBody}) > $self->_max_get_msg_size) { $post_request = 1; } my ($query, @auth_headers) = $self->_get_signed_query($params, $post_request); $self->_debug_log($query); my $try; foreach $try (1..3) { if ($post_request) { $response = $ua->post( $url, 'Content-Type' => 'application/x-www-form-urlencoded;charset=utf-8', 'Content' => $query, @auth_headers, ); } else { $response = $ua->get("$url/?$query", "Content-Type" => "text/plain;charset=utf-8", @auth_headers); } # $response isa HTTP::Response if ($response->is_success) { $self->_debug_log($response->content); my $href = XMLin($response->content, ForceArray => $force_array, KeyAttr => {}); return $href; } # advice from internal AWS support - most client libraries try 3 times in the face # of 500 errors, so ours should too next if ($response->code == 500); } # 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 [try $try]: On calling $params->{Action}: " . $response->status_line; $error .= " ($msg)" if $msg; croak $error; } sub _get_or_post { my ($self, $params) = @_; my $msg_size = 0; # a single message if ($params->{MessageBody}) { $msg_size = length($params->{MessageBody}); } # a batch message elsif ($params->{"SendMessageBatchRequestEntry.1.MessageBody"}) { foreach my $i (1..10){ last unless $msg_size += length($params->{"SendMessageBatchRequestEntry.$i.MessageBody"}); } } return $msg_size > $self->_max_get_msg_size ? 1 : 0; } sub _debug_log { my ($self, $msg) = @_; return unless $self->{_Debug}; chomp($msg); print {$self->{_Debug}} $msg . "\n\n"; } sub _get_signed_query { my ($self, $params, $post_request) = @_; my $version = $params->{SignatureVersion}; $version = $self->{SignatureVersion} unless defined $version; my @auth_headers; if ($version == 0 and defined $version) { $params = $self->_sign_query_v0($params); } elsif ($version == 1) { $params = $self->_sign_query_v1($params); } elsif ($version == 2) { $params = $self->_sign_query_v2($params, $post_request); } elsif ($version == 3) { ($params, @auth_headers) = $self->_sign_query_v3($params, $post_request); } else { croak "unrecognized SignatureVersion: $version"; } $params = $self->_escape_params($params); my $query = join('&', map { $_ . '=' . $params->{$_} } keys %$params); return ($query, @auth_headers); } sub _sign_query_v0 { my ($self, $params) = @_; carp "Signature version 0 is deprecated"; my $to_sign = $params->{Action} . $params->{Timestamp}; $params->{SignatureVersion} = 0; my $hmac = Digest::HMAC_SHA1->new($self->{SecretKey})->add($to_sign); $params->{Signature} = encode_base64($hmac->digest, ''); return $params; } sub _sign_query_v1 { my ($self, $params) = @_; my $to_sign = ''; $params->{SignatureVersion} = 1; for my $key( sort { uc $a cmp uc $b } keys %$params ) { if (defined $params->{$key}) { $to_sign = $to_sign . $key . $params->{$key}; } } my $hmac = Digest::HMAC_SHA1->new($self->{SecretKey})->add($to_sign); $params->{Signature} = encode_base64($hmac->digest, ''); return $params; } sub _sign_query_v2 { my ($self, $params, $post_request) = @_; $params->{SignatureVersion} = 2; $params->{SignatureMethod} = 'HmacSHA256'; my $to_sign; for my $key( sort keys %$params ) { $to_sign .= '&' if $to_sign; my $key_octets = encode('utf-8-strict', $key); my $value_octets = encode('utf-8-strict', $params->{$key}); $to_sign .= uri_escape($key_octets, $URI_SAFE_CHARACTERS) . '=' . uri_escape($value_octets, $URI_SAFE_CHARACTERS); } my $verb = "GET"; $verb = "POST" if $post_request; my $host = lc URI->new($self->{Endpoint})->host; my $path = '/'; if ($self->{Endpoint} =~ m{^https?://[^/]*(/.*)$}) { $path = "$1"; $path .= '/' unless $post_request; # why is this not in the spec? } $to_sign = "$verb\n$host\n$path\n$to_sign"; $params->{Signature} = encode_base64(hmac_sha256($to_sign, $self->{SecretKey}),''); return $params; } sub _sign_query_v3 { croak "Signature version 3 is not yet supported"; # this is an untested draft based on V3 signatures in SES # SQS apparently does not yet support this # my ($self, $params, $post_request) = @_; # # my @auth_headers; # require Date::Format; # my $date = Date::Format::time2str('%a, %d %b %Y %X %z', time() + 5); # or must this be GM time? # # if ($self->{Endpoint} =~ m{^https://}) { # my $to_sign = $date; # my $signature = encode_base64(hmac_sha256($to_sign, $self->{SecretKey}),''); # @auth_headers = ('Date', $date, # 'X-Amzn-Authorization', "AWS3-HTTPS AWSAccessKeyId=$self->{AWSAccessKeyId},Algorithm=HmacSHA256,Signature=$signature"); # } else { # my $query; # for my $key ( sort keys %$params ) { # $query .= '&' if $query; # my $key_octets = encode('utf-8-strict', $key); # my $value_octets = encode('utf-8-strict', $params->{$key}); # $query .= uri_escape($key_octets, $URI_SAFE_CHARACTERS) . '=' . uri_escape($value_octets, $URI_SAFE_CHARACTERS); # } # my $verb = "GET"; # $verb = "POST" if $post_request; # my $host = lc URI->new($self->{Endpoint})->host; # my $path = '/'; # if ($self->{Endpoint} =~ m{^https?://[^/]*(/.*)$}) { # $path = "$1"; # $path .= '/' unless $post_request; # why is this not in the spec? # } # my $to_sign = "$verb\n$path\n$query\nhost:$host\ndate:$date\n"; # my $signature = encode_base64(hmac_sha256(sha256($to_sign), $self->{SecretKey}),''); # yes, it hashes twice in the reference code # @auth_headers = ('Date', $date, # 'Host', $host, # 'X-Amzn-Authorization', "AWS3 AWSAccessKeyId=$self->{AWSAccessKeyId},Algorithm=HmacSHA256,Signature=$signature,SignedHeaders=Date;Host'"); # } # # return $params, @auth_headers; } sub _escape_params { my ($self, $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/; next unless exists $params->{$key}; my $octets = encode('utf-8-strict', $params->{$key}); $params->{$key} = uri_escape($octets, $URI_SAFE_CHARACTERS); } return $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 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime($t); return sprintf("%4i-%02i-%02iT%02i:%02i:%02iZ", ($year + 1900), ($mon + 1), $mday, $hour, $min, $sec ); } 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 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.03/lib/Amazon/SQS/Simple/Message.pm000644 000766 000024 00000002743 12147147601 024233 0ustar00mikewhitakerstaff000000 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 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.03/lib/Amazon/SQS/Simple/Queue.pm000755 000766 000024 00000030211 12164253000 023713 0ustar00mikewhitakerstaff000000 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 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 ($self->_api_version eq SQS_VERSION_2008_01_01) { carp "ChangeMessageVisibility not supported in this API version"; } else { 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) = @_; if ($self->_api_version eq SQS_VERSION_2008_01_01) { carp "AddPermission not supported in this API version"; } else { $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) = @_; if ($self->_api_version eq SQS_VERSION_2008_01_01) { carp "RemovePermission not supported in this API version"; } else { $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 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 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.03/lib/Amazon/SQS/Simple/SendResponse.pm000755 000766 000024 00000002773 12147147572 025274 0ustar00mikewhitakerstaff000000 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 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.03/bin/sqs-toolkit000755 000766 000024 00000006374 12135504217 021407 0ustar00mikewhitakerstaff000000 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}; } }