view release on metacpan or  search on metacpan

t/03-lock.t  view on Meta::CPAN

#!/usr/bin/env perl

use strict;
use warnings;

use English qw(-no_match_vars);
use JSON qw(encode_json decode_json);
use Test::More;

use Amazon::S3::Lite::Lock;

########################################################################
# Test doubles
########################################################################
{
  package Local::Logger;

  sub new { return bless {}, shift }
  sub trace { return }
  sub debug { return }
  sub info  { return }
  sub warn  { return }
  sub error { return }
}

{
  package Local::S3;

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

    return bless {
      last_status => q{},
      logger      => Local::Logger->new,
      puts        => [],
      deletes     => [],
      put_queue   => $args{put_queue}  || [],
      head_queue  => $args{head_queue} || [],
      get_queue   => $args{get_queue}  || [],
    }, $class;
  }

  sub logger      { return $_[0]->{logger} }
  sub last_status { return $_[0]->{last_status} }
  sub puts        { return $_[0]->{puts} }
  sub deletes     { return $_[0]->{deletes} }

  sub put_object {
    my ( $self, $bucket, $key, $body, %options ) = @_;

    push @{ $self->{puts} }, {
      bucket  => $bucket,
      key     => $key,
      body    => $body,
      options => { %options },
    };

    my $response = shift @{ $self->{put_queue} };
    die "unexpected put_object call\n"
      if !$response;

    $self->{last_status} = $response->{status};

    die( $response->{error} // "put_object failed\n" )
      if $response->{status} !~ /\A2/;

    return $response->{etag};
  }

  sub head_object {
    my ( $self, $bucket, $key ) = @_;

    my $response = shift @{ $self->{head_queue} };
    die "unexpected head_object call\n"
      if !$response;

    $self->{last_status} = $response->{status};

    die( $response->{error} // "head_object failed\n" )
      if $response->{status} !~ /\A2/ && $response->{status} != 404;