File Coverage

blib/lib/Amazon/API/Signature4.pm

Criterion	Covered	Total	%
statement	19	36	52.7
branch	3	6	50.0
condition	3	9	33.3
subroutine	4	7	57.1
pod	1	3	33.3
total	30	61	49.1

package Amazon::API::Signature4;

use strict;
use warnings;

use parent qw( Exporter AWS::Signature4 );

our $VERSION = '2.0.10';

our @EXPORT_OK = qw{ parse_service_url };

our @SERVICE_URL_REGEXP = (
  qr/(s3)[.]amazonaws[.]com\z/xsm,
  qr/(s3)[.]([^.]+)[.]amazonaws[.]com\z/xsm,
  qr/(s3)[.][^.]+[.]([^.]+)[.]amazonaws[.]com\z/xsm,
  qr/(s3)[-][^.]+.+[.]([^.]+)[.]amazonaws[.]com\z/xsm,
  qr/^([[:alpha:]-]+)[.]amazonaws[.]com\z/xsm,
  qr/^([[:alpha:]-]+)[.]([^.]*)[.]amazonaws[.]com/xsm,
);

########################################################################
sub new {
########################################################################
  my ( $class, @options ) = @_;
  $class = ref $class || $class;

  my %args = ref $options[0] ? $options[0] : @options;

  my $self = $class->SUPER::new(%args);

  my @extra = grep { !/access_key|secret_key|security_token/xsm } keys %args;

  @{$self}{@extra} = @args{@extra};

  return $self;
} ## end sub new

########################################################################
sub parse_service_url {
########################################################################
  my (%args) = @_;

  my ( $host,   $service )        = @args{qw{host service}};
  my ( $region, $default_region ) = @args{qw{region default_region}};

  if ( !$service || !$region ) {
    foreach my $regexp (@SERVICE_URL_REGEXP) {
      if ( $host =~ $regexp ) {
        #        print Dumper [ $host, $regexp ];

        $service = $1;
        $region  = $2 || $region || $default_region;
        last;
      } ## end if ( $host =~ $regexp )

    } ## end foreach my $regexp (@SERVICE_URL_REGEXP)
  } ## end if ( !$service || !$region)

  return ( $host, $service, $region );
} ## end sub parse_service_url

###############################################################
sub scope {
###############################################################
  goto &_scope;
}

###############################################################
sub _scope {
###############################################################
  my ( $self, $request, $region ) = @_;

  my $host     = $request->uri->host;
  my $datetime = $self->_datetime($request);
  my ($date)   = $datetime =~ /^(\d+)T/xsm;

  my $service = $self->{service};

  ( $host, $service, $region ) = parse_service_url(
    host           => $host,
    service        => $service,
    region         => $region,
    default_region => 'us-east-1'
  );

  return "$date/$region/$service/aws4_request";
} ## end sub _scope

1;

__END__