r58740 - in /branches/upstream/libamazon-sqs-simple-perl: ./ current/ current/bin/ current/lib/ current/lib/Amazon/ current/lib/Amazon/SQS/ current/lib/Amazon/SQS/Simple/ current/t/
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Wed Jun 2 10:01:23 UTC 2010
Author: angelabad-guest
Date: Wed Jun 2 09:57:02 2010
New Revision: 58740
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=58740
Log:
[svn-inject] Installing original source of libamazon-sqs-simple-perl (1.06)
Added:
branches/upstream/libamazon-sqs-simple-perl/
branches/upstream/libamazon-sqs-simple-perl/current/
branches/upstream/libamazon-sqs-simple-perl/current/Changes
branches/upstream/libamazon-sqs-simple-perl/current/LICENSE
branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST
branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST.SKIP
branches/upstream/libamazon-sqs-simple-perl/current/META.yml
branches/upstream/libamazon-sqs-simple-perl/current/Makefile.PL
branches/upstream/libamazon-sqs-simple-perl/current/README
branches/upstream/libamazon-sqs-simple-perl/current/bin/
branches/upstream/libamazon-sqs-simple-perl/current/bin/sqs-toolkit (with props)
branches/upstream/libamazon-sqs-simple-perl/current/lib/
branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/
branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/
branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/
branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple.pm
branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Base.pm
branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Message.pm
branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Queue.pm
branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/SendResponse.pm
branches/upstream/libamazon-sqs-simple-perl/current/t/
branches/upstream/libamazon-sqs-simple-perl/current/t/00-load.t
Added: branches/upstream/libamazon-sqs-simple-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/Changes?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/Changes (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/Changes Wed Jun 2 09:57:02 2010
@@ -1,0 +1,57 @@
+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
Added: branches/upstream/libamazon-sqs-simple-perl/current/LICENSE
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/LICENSE?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/LICENSE (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/LICENSE Wed Jun 2 09:57:02 2010
@@ -1,0 +1,6 @@
+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.
Added: branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST Wed Jun 2 09:57:02 2010
@@ -1,0 +1,14 @@
+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
Added: branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST.SKIP
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST.SKIP?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST.SKIP (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/MANIFEST.SKIP Wed Jun 2 09:57:02 2010
@@ -1,0 +1,1 @@
+\.svn
Added: branches/upstream/libamazon-sqs-simple-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/META.yml?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/META.yml (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/META.yml Wed Jun 2 09:57:02 2010
@@ -1,0 +1,27 @@
+--- #YAML:1.0
+name: Amazon-SQS-Simple
+version: 1.06
+abstract: OO API for accessing the Amazon Simple Queue
+author:
+ - Simon Whitaker <sw at netcetera.org>
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
+requires:
+ Digest::HMAC_SHA1: 0
+ LWP::UserAgent: 0
+ MIME::Base64: 0
+ Test::More: 0
+ URI::Escape: 0
+ XML::Simple: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.54
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
Added: branches/upstream/libamazon-sqs-simple-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/Makefile.PL?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/Makefile.PL (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/Makefile.PL Wed Jun 2 09:57:02 2010
@@ -1,0 +1,21 @@
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Amazon::SQS::Simple',
+ AUTHOR => 'Simon Whitaker <sw at netcetera.org>',
+ 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,
+ 'LWP::UserAgent' => 0,
+ 'MIME::Base64' => 0,
+ 'URI::Escape' => 0,
+ 'XML::Simple' => 0,
+ },
+ dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
+ clean => { FILES => 'Amazon-SQS-Simple-*' },
+);
Added: branches/upstream/libamazon-sqs-simple-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/README?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/README (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/README Wed Jun 2 09:57:02 2010
@@ -1,0 +1,38 @@
+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.
Added: branches/upstream/libamazon-sqs-simple-perl/current/bin/sqs-toolkit
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/bin/sqs-toolkit?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/bin/sqs-toolkit (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/bin/sqs-toolkit Wed Jun 2 09:57:02 2010
@@ -1,0 +1,171 @@
+#!/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 <<USAGE;
+Usage:
+ $scr --list-queues
+ $scr [OPTIONS] queue-name
+
+OPTIONS:
+ --flush
+ remove all visible messages from queue
+
+ --timeout=SECS
+ set the queue's default visibility timeout in seconds
+
+ --create
+ create a queue with the given name
+
+ --delete
+ delete the queue with the given name
+
+ --info
+ print info about the queue
+
+ --help
+ show this help documentation
+
+ --verbose
+ make output of some operations more verbose
+
+ --access-key=KEY
+ Your AWS access key (or set AWS_ACCESS_KEY env
+ variable)
+
+ --secret-key=KEY
+ Your AWS secret key (or set AWS_SECRET_KEY env
+ variable)
+USAGE
+
+ exit($status);
+}
+
+use strict;
+
+my $sqs = new Amazon::SQS::Simple($AWSAccessKeyId, $SecretKey);
+my $q;
+
+if ($opts{'list-queues'}) {
+ my $queues = $sqs->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};
+ }
+}
Propchange: branches/upstream/libamazon-sqs-simple-perl/current/bin/sqs-toolkit
------------------------------------------------------------------------------
svn:executable =
Added: branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple.pm?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple.pm (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple.pm Wed Jun 2 09:57:02 2010
@@ -1,0 +1,246 @@
+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 = '1.06';
+our @EXPORT_OK = qw( timestamp );
+
+sub GetQueue {
+ my ($self, $queue_endpoint) = @_;
+ 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
+ $q->SendMessage('Hello world!');
+
+ # Retrieve a message
+ my $msg = $q->ReceiveMessage();
+ print $msg->MessageBody() # Hello world!
+
+ # Delete the message
+ $q->DeleteMessage($msg->ReceiptHandle());
+
+ # 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<http://aws.amazon.com/>.
+
+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<Amazon::SQS::Simple::Queue> object. (See L<Amazon::SQS::Simple::Queue> for details.)
+
+=item CreateQueue($queue_name, [%opts])
+
+Creates a new queue with the given name. Returns a
+C<Amazon::SQS::Simple::Queue> object. (See L<Amazon::SQS::Simple::Queue> 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<Amazon::SQS::Simple::Queue> objects. (See L<Amazon::SQS::Simple::Queue> 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<Amazon::SQS::Simple::timestamp()>
+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.
+
+=head1 AUTHOR
+
+Copyright 2007-2008 Simon Whitaker E<lt>swhitaker at cpan.orgE<gt>
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
Added: branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Base.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Base.pm?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Base.pm (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Base.pm Wed Jun 2 09:57:02 2010
@@ -1,0 +1,190 @@
+package Amazon::SQS::Simple::Base;
+
+use strict;
+use warnings;
+use Carp qw( croak carp );
+use Digest::HMAC_SHA1;
+use LWP::UserAgent;
+use MIME::Base64;
+use URI::Escape;
+use XML::Simple;
+
+use base qw(Exporter);
+
+use constant SQS_VERSION_2009_02_01 => '2009-02-01';
+use constant SQS_VERSION_2008_01_01 => '2008-01-01';
+use constant BASE_ENDPOINT => 'http://queue.amazonaws.com';
+use constant MAX_GET_MSG_SIZE => 4096; # Messages larger than this size will be sent
+ # using a POST request.
+
+our $DEFAULT_SQS_VERSION = +SQS_VERSION_2009_02_01;
+our @EXPORT = qw(SQS_VERSION_2009_02_01 SQS_VERSION_2008_01_01);
+
+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 => 1,
+ 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_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 $post_request = 0;
+ my $ua = LWP::UserAgent->new();
+ my $url = $self->{Endpoint};
+ my $response;
+ my $post_body;
+
+ if ($self->{Timeout}) {
+ $ua->timeout($self->{Timeout});
+ }
+
+ $params = {
+ AWSAccessKeyId => $self->{AWSAccessKeyId},
+ Version => $self->{Version},
+ %$params
+ };
+
+ if (!$params->{Timestamp} && !$params->{Expires}) {
+ $params->{Timestamp} = _timestamp();
+ }
+
+ if ($params->{MessageBody} && length($params->{MessageBody}) > +MAX_GET_MSG_SIZE) {
+ $post_request = 1;
+ }
+
+ my $query = $self->_get_signed_query($params);
+
+ $self->_debug_log($query);
+
+ if ($post_request) {
+ $response = $ua->post(
+ $url,
+ 'Content-type' => 'application/x-www-form-urlencoded',
+ 'Content' => $query
+ );
+ }
+ else {
+ $response = $ua->get("$url/?$query");
+ }
+
+ if ($response->is_success) {
+ $self->_debug_log($response->content);
+ my $href = XMLin($response->content, ForceArray => $force_array, KeyAttr => {});
+ return $href;
+ }
+ else {
+ 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 _get_signed_query {
+ my ($self, $params) = @_;
+ my $sig = '';
+
+ if ($self->{SignatureVersion} == 1) {
+ $params->{SignatureVersion} = $self->{SignatureVersion};
+
+ for my $key( sort { uc $a cmp uc $b } keys %$params ) {
+ if (defined $params->{$key}) {
+ $sig = $sig . $key . $params->{$key};
+ }
+ }
+ } else {
+ $sig = $params->{Action} . $params->{Timestamp};
+ }
+
+ my $hmac = Digest::HMAC_SHA1->new($self->{SecretKey})->add($sig);
+
+ # Need to escape + characters in signature
+ # see http://docs.amazonwebservices.com/AWSSimpleQueueService/2006-04-01/Query_QueryAuth.html
+ $params->{Signature} = uri_escape(encode_base64($hmac->digest, ''));
+ $params->{MessageBody} = uri_escape($params->{MessageBody}) if $params->{MessageBody};
+
+ # Likewise, need to escape + characters in ReceiptHandle
+ $params->{ReceiptHandle} = uri_escape($params->{ReceiptHandle}) if $params->{ReceiptHandle};
+
+ my $query = join('&', map { $_ . '=' . $params->{$_} } keys %$params);
+ return $query;
+}
+
+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 E<lt>swhitaker at cpan.orgE<gt>
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
Added: branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Message.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Message.pm?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Message.pm (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Message.pm Wed Jun 2 09:57:02 2010
@@ -1,0 +1,80 @@
+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<Amazon::SQS::Simple::Queue>.
+See L<Amazon::SQS::Simple::Queue> for more details.
+
+=head1 METHODS
+
+=over 2
+
+=item B<MessageBody()>
+
+Get the message body.
+
+=item B<MessageId()>
+
+Get the message unique identifier
+
+=item B<MD5OfBody()>
+
+Get the MD5 checksum of the message body
+
+=item B<ReceiptHandle()>
+
+Get the receipt handle for the message (used as an argument to DeleteMessage)
+
+=back
+
+=head1 AUTHOR
+
+Copyright 2007-2008 Simon Whitaker E<lt>swhitaker at cpan.orgE<gt>
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Queue.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Queue.pm?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Queue.pm (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/Queue.pm Wed Jun 2 09:57:02 2010
@@ -1,0 +1,305 @@
+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}
+ );
+}
+
+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 (@messages > 1 || wantarray) {
+ return @messages;
+ } elsif (@messages) {
+ return $messages[0];
+ } else {
+ return undef;
+ }
+}
+
+sub DeleteMessage {
+ my ($self, $receipt_handle, %params) = @_;
+
+ $params{Action} = 'DeleteMessage';
+ $params{ReceiptHandle} = $receipt_handle;
+
+ 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');
+
+ $q->SendMessage('Hello world!');
+
+ my $msg = $q->ReceiveMessage();
+
+ print $msg->MessageBody() # Hello world!
+
+ $q->DeleteMessage($msg->MessageId());
+
+=head1 INTRODUCTION
+
+Don't instantiate this class directly. Objects of this class are returned
+by various methods in C<Amazon::SQS::Simple>. See L<Amazon::SQS::Simple> for
+more details.
+
+=head1 METHODS
+
+=over 2
+
+=item B<Endpoint()>
+
+Get the endpoint for the queue.
+
+=item B<Delete([%opts])>
+
+Deletes the queue. Any messages contained in the queue will be lost.
+
+=item B<SendMessage($message, [%opts])>
+
+Sends the message. The message can be up to 8KB in size and should be
+plain text.
+
+=item B<ReceiveMessage([%opts])>
+
+Get the next message from the queue.
+
+Returns an C<Amazon::SQS::Simple::Message> object. See
+L<Amazon::SQS::Simple::Message> for more details.
+
+If MaxNumberOfMessages is greater than 1, the method returns
+an array of C<Amazon::SQS::Simple::Message> objects.
+
+Options for ReceiveMessage:
+
+=over 4
+
+=item * MaxNumberOfMessages => NUMBER
+
+Maximum number of messages to return. Value should be an integer between 1
+and 10 inclusive. Default is 1.
+
+=back
+
+=item B<DeleteMessage($receipt_handle, [%opts])>
+
+Delete the message with the specified receipt handle from the queue
+
+=item B<ChangeMessageVisibility($receipt_handle, $timeout, [%opts])>
+
+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<AddPermission($label, $account_actions, [%opts])>
+
+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<RemovePermission($label, [%opts])>
+
+NOT SUPPORTED IN APIs EARLIER THAN 2009-01-01
+
+Removes the permissions policy with the specified label.
+
+=item B<GetAttributes([%opts])>
+
+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<SetAttribute($attribute_name, $attribute_value, [%opts])>
+
+Sets the value for a queue attribute. Currently the only valid
+attribute name is C<VisibilityTimeout>.
+
+=back
+
+=head1 AUTHOR
+
+Copyright 2007-2008 Simon Whitaker E<lt>swhitaker at cpan.orgE<gt>
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/SendResponse.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/SendResponse.pm?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/SendResponse.pm (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/lib/Amazon/SQS/Simple/SendResponse.pm Wed Jun 2 09:57:02 2010
@@ -1,0 +1,57 @@
+package Amazon::SQS::Simple::SendResponse;
+
+use strict;
+use warnings;
+
+sub new {
+ my ($class, $msg) = @_;
+ return bless ($msg, $class);
+}
+
+sub MessageId {
+ my $self = shift;
+ return $self->{MessageId};
+}
+
+sub MD5OfMessageBody {
+ my $self = shift;
+ return $self->{MD5OfMessageBody};
+}
+
+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<Amazon::SQS::Simple::Queue>.
+See L<Amazon::SQS::Simple::Queue> for more details.
+
+=head1 METHODS
+
+=over 2
+
+=item B<MessageId()>
+
+Get the message unique identifier
+
+=item B<MD5OfMessageBody()>
+
+Get the MD5 checksum of the message body you sent
+
+=back
+
+=head1 AUTHOR
+
+Copyright 2007-2008 Simon Whitaker E<lt>swhitaker at cpan.orgE<gt>
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
Added: branches/upstream/libamazon-sqs-simple-perl/current/t/00-load.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libamazon-sqs-simple-perl/current/t/00-load.t?rev=58740&op=file
==============================================================================
--- branches/upstream/libamazon-sqs-simple-perl/current/t/00-load.t (added)
+++ branches/upstream/libamazon-sqs-simple-perl/current/t/00-load.t Wed Jun 2 09:57:02 2010
@@ -1,0 +1,9 @@
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Amazon::SQS::Simple' );
+}
+
+diag( "Testing Amazon::SQS::Simple $Amazon::SQS::Simple::VERSION, Perl $], $^X" );
More information about the Pkg-perl-cvs-commits
mailing list