Amazon-S3-Lite
view release on metacpan or search on metacpan
- add reftype to imports
(_request)
- pass payload_hash
(put_object)
- calculate payload_hash for streaming calls
* lib/Amazon/S3/Lite/Lock.pm.in
($VERSION): new
(acquire)
- return disambiguating values instead of undef
(_try_create)
- add some debug output
(_try_steal_if_stale)
- add logging
- return disambiguating values instead of undef
- quote etag header
(_guard): require Amazon::S3::Lite::Lock::Guard
* lib/Amazon/S3/Lite/Lock/Guard.pm.in
(release)
- quote etag
- add logging
* t/01-s3-lite.t
(log_level): new
(_create_noitification_configuration)
- use new filters template
- set filter to q{} if no filter
(__DATA__): +:filters
* lib/Amazon/S3/Lite/Logger.pm.in
(new)
- accept log_level option
- refactored
(_log_level): new
(debug): actually implement log levels
(error): likewise
(info): likewise
(warn): likewise
(trace): liewise
* t/01-s3-lite.t: remove test for region required
Thu Jun 18 14:26:43 2026 Rob Lauer <rclauer@gmail.com>
[1.2.1]:
* release-notes/release-notes-1.2.1.md: new
[1.1.2]:
* release-notes/release-notes-1.1.2.md
* VERSION: bump
* lib/Amazon/S3/Lite.pm.in
(_request)
- remove use of postfix if
(put_bucket_notification_configuration)
- set query string variable with '=' for signing
(get_bucket_notification_configuration)
- likewise
- log parsed reponse at debug level
(_parse_notification_configuration)
- elements to capture are CloudFunctionConfiguration, CloudFunction, not Lambda*
Thu May 14 10:00:33 2026 Rob Lauer <rclauer@gmail.com>
[1.1.1]:
* release-notes/release-notes-1.1.1.md: new
* releaes-notes-*.md => release-notes/
* VERSION: bump
* cpanfile: likewise
lib/Amazon/S3/Lite.pm view on Meta::CPAN
# minimal STDERR logger
########################################################################
sub _init_logger {
########################################################################
my ($self) = @_;
my $logger = $self->{logger};
if ( $logger && blessed $logger ) {
# Validate it quacks like a logger
for my $method (qw(trace debug info warn error)) {
croak "logger object must implement '$method'"
if !$logger->can($method);
}
return;
}
my $log4perl = eval {
require Log::Log4perl;
1;
lib/Amazon/S3/Lite.pm view on Meta::CPAN
method => $method,
url => $url,
headers => $headers,
payload => $content_is_coderef ? q{} : $content,
payload_hash => $extra->{payload_hash},
);
# HTTP::Tiny sets Host itself — remove to avoid duplicate header error
delete $signed->{host};
$self->logger->debug("$method $url");
my $options = { headers => $signed };
if ( length $content || $content_is_coderef ) {
$options->{content} = $content;
}
if ( $extra->{data_callback} ) {
$options->{data_callback} = $extra->{data_callback};
}
my $response = $self->ua->request( $method, $url, $options );
$self->logger->debug( sprintf 'Response: %s %s', $response->{status}, $response->{reason} );
$self->{last_status} = $response->{status};
return $response;
}
########################################################################
# head_object( $bucket, $key )
#
# Fetches metadata for an object without retrieving the body.
lib/Amazon/S3/Lite.pm view on Meta::CPAN
if !defined $bucket || !length $bucket;
my $url = $self->_endpoint($bucket) . q{?notification=};
my $response = $self->_request( 'GET', $url );
$self->_croak_on_error( $response, 'get_bucket_notification_configuration' );
my $rsp = $self->_parse_notification_configuration( $response->{content} );
$self->logger->debug(
Dumper(
[ response => $response,
parsed_response => $rsp
]
)
);
return $rsp;
}
lib/Amazon/S3/Lite.pm view on Meta::CPAN
my $resolved_xml = $self->_resolve(
$xml,
id => $id,
lambda_arn => $options{lambda_arn},
queue_arn => $options{queue_arn},
events => "@event_xml",
filters => $filters,
);
$self->logger->debug( Dumper( [ resolved_xml => $resolved_xml ] ) );
return $resolved_xml;
}
########################################################################
sub _create_public_access_block {
########################################################################
my ( $self, $bucket, %permissions ) = @_;
croak 'ERROR: bucket is required'
lib/Amazon/S3/Lite.pm view on Meta::CPAN
foreach my $p (qw(block_public_acls ignore_public_acls block_public_policy restrict_public_buckets)) {
$permissions{$p} = defined $permissions{$p} ? $permissions{$p} ? 'true' : 'false' : 'true';
}
my $templates = $self->_fetch_templates();
my $xml = $self->_resolve( $templates->{'public_access_block'}, %permissions );
$xml = qq{<?xml version="1.0" encoding="UTF-8"?>\n} . $xml;
$self->logger->debug( Dumper( [ xml => $xml ] ) );
return $xml;
}
########################################################################
sub put_bucket_website {
########################################################################
my ( $self, $bucket, %options ) = @_;
my $xml = $self->_create_website_configuration( $bucket, %options );
lib/Amazon/S3/Lite.pm view on Meta::CPAN
Any object that satisfies this interface is accepted -
L<Amazon::Credentials>, L<Paws::Credential::*>, or your own. The
getters are called at request time, so objects that refresh expiring
credentials transparently are supported.
=item logger
An object providing the standard log methods:
$logger->trace(...)
$logger->debug(...)
$logger->info(...)
$logger->warn(...)
$logger->error(...)
If not supplied, the module looks for L<Log::Log4perl>. If available,
it calls C<Log::Log4perl::easy_init> with the configure log level (or
WARN) and logs to STDERR. If Log::Log4perl is not installed, a
minimal internal logger.
=item host
lib/Amazon/S3/Lite.pm view on Meta::CPAN
L</list_objects_v2> directly.
Returns a (possibly empty) list of object hashrefs, each with the same
fields as the elements of C<objects> in the C<list_objects_v2>
response.
=over 4
=item log_level
Log level for the internal logger. Accepted values: C<trace>, C<debug>,
C<info>, C<warn>, C<error>, C<fatal>. Default is C<warn>. Only consulted
when no C<logger> object is supplied and Log::Log4perl is not available
or not yet initialized.
=back
=head2 get_object
my $obj = $s3->get_object($bucket, $key);
my $obj = $s3->get_object($bucket, $key, %options);
lib/Amazon/S3/Lite/Lock.pm view on Meta::CPAN
}
########################################################################
sub _try_create {
########################################################################
my ($self) = @_;
my $body = encode_json( { owner => $self->{owner}, expires => time + $self->{ttl} } );
$self->{s3}
->logger->debug( sprintf 'lock acquire: bucket=%s key=%s owner=%s', $self->{bucket}, $self->{key}, $self->{owner}, );
my $etag = eval {
$self->{s3}->put_object(
$self->{bucket}, $self->{key}, $body,
content_type => 'application/json',
headers => { 'If-None-Match' => q{*} },
);
};
my $err = $EVAL_ERROR;
$self->{s3}->logger->debug(
sprintf 'lock create: status=%s etag=%s error=%s',
$self->{s3}->last_status // q{},
$etag // q{},
$err // q{},
);
return $etag
if $self->{s3}->last_status =~ /\A2/xsm; # acquired
return
lib/Amazon/S3/Lite/Lock.pm view on Meta::CPAN
die $err; # real error
}
########################################################################
sub _try_steal_if_stale {
########################################################################
my ($self) = @_;
my $meta = eval { $self->{s3}->head_object( $self->{bucket}, $self->{key} ) };
$self->{s3}->logger->debug(
Dumper(
[ error => $EVAL_ERROR,
meta => $meta
]
)
);
return ('vanished')
if !$meta;
my $current_etag = $meta->{etag};
# Fetch body to read the holder's expiry (head doesn't carry it).
my $obj = eval { $self->{s3}->get_object( $self->{bucket}, $self->{key} ) };
$self->{s3}->logger->debug( Dumper( [ error => $EVAL_ERROR, ] ) );
my $data = eval { decode_json( $obj->{content} // '{}' ) } // {};
$self->{s3}->logger->debug(
Dumper(
[ error => $EVAL_ERROR,
data => $data,
]
)
);
return ('held')
if ( $data->{expires} // 0 ) > time;
lib/Amazon/S3/Lite/Lock/Guard.pm view on Meta::CPAN
$self->{bucket}, $self->{key},
headers => { 'If-Match' => $etag }, # <-- needs delete_object to accept headers
);
return 1;
};
my $err = $EVAL_ERROR;
if ( !$ok ) {
$self->{s3}->logger->debug(
sprintf "lock release: bucket=%s key=%s etag=%s status=%s error=%s\n",
$self->{bucket}, $self->{key},
$self->{etag} // q{},
$self->{s3}->last_status // q{},
$err // q{},
);
}
return;
}
lib/Amazon/S3/Lite/Logger.pm view on Meta::CPAN
########################################################################
sub trace { # silent
########################################################################
my ( $self, $msg ) = @_;
return if $self->_log_level > $LEVELS->{TRACE};
return print {*STDERR} "TRACE - $msg\n";
}
########################################################################
sub debug {
########################################################################
my ( $self, $msg ) = @_;
return if $self->_log_level > $LEVELS->{DEBUG};
return print {*STDERR} "DEBUG - $msg\n";
}
########################################################################
sub level {
########################################################################
share/README.md view on Meta::CPAN
Any object that satisfies this interface is accepted -
[Amazon::Credentials](https://metacpan.org/pod/Amazon%3A%3ACredentials), [Paws::Credential::\*](https://metacpan.org/pod/Paws%3A%3ACredential%3A%3A%2A), or your own. The
getters are called at request time, so objects that refresh expiring
credentials transparently are supported.
- logger
An object providing the standard log methods:
$logger->trace(...)
$logger->debug(...)
$logger->info(...)
$logger->warn(...)
$logger->error(...)
If not supplied, the module looks for [Log::Log4perl](https://metacpan.org/pod/Log%3A%3ALog4perl). If available,
it calls `Log::Log4perl::easy_init` with the configure log level (or
WARN) and logs to STDERR. If Log::Log4perl is not installed, a
minimal internal logger.
- host
share/README.md view on Meta::CPAN
all matching keys. Hierarchical directory-style traversal using
`delimiter` is inherently page-by-page and should use
["list\_objects\_v2"](#list_objects_v2) directly.
Returns a (possibly empty) list of object hashrefs, each with the same
fields as the elements of `objects` in the `list_objects_v2`
response.
- log\_level
Log level for the internal logger. Accepted values: `trace`, `debug`,
`info`, `warn`, `error`, `fatal`. Default is `warn`. Only consulted
when no `logger` object is supplied and Log::Log4perl is not available
or not yet initialized.
## get\_object
my $obj = $s3->get_object($bucket, $key);
my $obj = $s3->get_object($bucket, $key, %options);
Fetches the object at `$key` in `$bucket`.
t/01-s3-lite.t view on Meta::CPAN
eval { Amazon::S3::Lite->new( { region => 'us-east-1', credentials => BadCreds->new } ) };
like $@, qr/must implement aws_secret_access_key/, 'bad creds object croaks';
}
# custom logger
{
my $warned = 0;
my $logger = bless {}, 'MyLogger';
{
no strict 'refs';
for my $m (qw(trace debug info error)) {
*{"MyLogger::$m"} = sub { };
}
*{"MyLogger::warn"} = sub { $warned++ };
}
my $s3l = new_s3( logger => $logger );
isa_ok $s3l->logger, 'MyLogger', 'custom logger accepted';
}
};
subtest '_endpoint' => sub {
t/03-lock.t view on Meta::CPAN
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 ) = @_;
( run in 1.956 second using v1.01-cache-2.11-cpan-062aa07a564 )