view release on metacpan or  search on metacpan

bin/create-queue.pl  view on Meta::CPAN

########################################################################
sub command_delete_message {
########################################################################
  my ( $client, $options ) = @_;

  die "--queue is a required argument\n"
    if !$options->{queue};

  my $queue_url = get_queue_url( $client, $options );

  my $receipt_handle = shift @ARGV;

  die "no receipt handle\n"
    if !$receipt_handle;

  $client->deleteMessage(
    { QueueUrl      => $queue_url,
      ReceiptHandle => $receipt_handle,
    }
  );

  return 0;
}

########################################################################
sub command_list {
########################################################################
  my ( $client, $options ) = @_;

  my $queues = list_queues( $client, $options );

  print {*STDOUT} JSON->new->pretty->encode($queues);

  return 0;
}

########################################################################
sub command_attributes {
########################################################################
  my ( $client, $options ) = @_;

  die "--queue is a required argument\n"
    if !$options->{queue};

  my $queue_url  = get_queue_url( $client, $options );
  my $attributes = get_queue_attributes( $client, $queue_url );

  print {*STDOUT} JSON->new->pretty->encode( { map { $_->getName, $_->getValue } @{$attributes} } );

  return 0;
}

########################################################################
sub init_client {
########################################################################
  my ($options) = @_;

  my $client_options = {
    ServiceURL => $options->{'endpoint-url'},
    $options->{debug} ? ( loglevel => 'debug' ) : ( loglevel => 'info' ),
  };

  my @credentials = ( $ENV{AWS_ACCESS_KEY_ID}, $ENV{AWS_SECRET_ACCESS_KEY} );

  return Amazon::SQS::Client->new( @credentials, $client_options );
}

########################################################################
sub main {
########################################################################
  my @option_specs = qw(
    debug|d
    dlq!
    delay-seconds|D=i
    endpoint-url|e=s
    help|h
    max-receive-count|c=i
    maximum-message-size|S=i
    message-retention-period|p=i
    queue|q=s
    receive-message-wait-time-seconds|w=i
    visibility-timeout|v=i
  );

  my %options = (
    dlq                                 => 1,
    'delay-seconds'                     => $DEFAULT_DELAY_SECONDS,
    'endpoint-url'                      => $DEFAULT_ENDPOINT_URL,
    'max-receive-count'                 => $DEFAULT_MAX_RECEIVE_COUNT,
    'endpoint-url'                      => $DEFAULT_ENDPOINT_URL,
    'maximum-message-size'              => $DEFAULT_MAXIMUM_MESSAGE_SIZE,
    'message-retention-period'          => $DEFAULT_MESSAGE_RETENTION_PERIOD,
    'receive-message-wait-time-seconds' => $DEFAULT_RECEIVE_MESSAGE_WAIT_TIME_SECONDS,
  );

  my %dispatch = (
    attributes        => \&command_attributes,
    create            => \&command_create,
    'send-message'    => \&command_send_message,
    'receive-message' => \&command_receive_message,
    delete            => \&command_delete,
    'delete-message'  => \&command_delete_message,
    list              => \&command_list,
  );

  my $retval = GetOptions( \%options, @option_specs );

  if ( !$retval || $options{help} ) {
    pod2usage(1);
  }

  my $client = init_client( \%options );

  my $command = shift @ARGV;
  $command //= q{};

  if ( !$command || !$dispatch{$command} ) {
    warn "invalid command [$command]\n"
      if $command;

    pod2usage(1);
  }

  return $dispatch{$command}->( $client, \%options );
}

exit main();

1;

## no critic