view release on metacpan or  search on metacpan

lib/Amazon/S3/Util.pm  view on Meta::CPAN

package Amazon::S3::Util;

use strict;
use warnings;

use Amazon::S3::Constants qw(:all);
use Data::Dumper;
use Digest::MD5       qw(md5 md5_hex);
use Digest::MD5::File qw(file_md5 file_md5_hex);
use English           qw(-no_match_vars);
use MIME::Base64;
use Scalar::Util qw(reftype);
use URI::Escape  qw(uri_escape_utf8);
use XML::Simple;

use parent qw(Exporter);

our @EXPORT_OK = qw(
  create_query_string
  create_grant_header
  create_xml_request
  create_api_uri
  set_md5_header
  urlencode
  get_parameters
);

our %EXPORT_TAGS;

$EXPORT_TAGS{all} = [@EXPORT_OK];

########################################################################
sub urlencode {
########################################################################
  my (@args) = @_;

  my $unencoded = ref $args[0] ? $args[1] : $args[0];

  ## no critic (RequireInterpolation)
  return uri_escape_utf8( $unencoded, '^A-Za-z0-9\-\._~\x2f' );
}

# hashref or list of key/value pairs
########################################################################
sub create_query_string {
########################################################################
  my (@args) = @_;

  my $parameters = get_parameters(@args);

  return $EMPTY
    if !$parameters || !keys %{$parameters};

  return join $AMPERSAND,
    map { sprintf '%s=%s', $_, urlencode( $parameters->{$_} ) }
    keys %{$parameters};
}

########################################################################
sub create_api_uri {
########################################################################
  my (@args) = @_;

  my $parameters = get_parameters(@args);

  my $path = delete $parameters->{path};
  $path //= $EMPTY;

  if ( $path !~ /\/$/xsm ) {
    $path = "$path/";
  }

  my $api = delete $parameters->{api};
  $api //= $EMPTY;

  my $query_string = create_query_string($parameters);

  return sprintf '%s?%s%s', $path, $api, $query_string;
}

########################################################################
sub create_xml_request {
########################################################################
  my ( $request, $content_key ) = @_;

  if ( !$content_key ) {
    ($content_key) = keys %{$request};
  }

  $request->{$content_key}->{xmlns} = $S3_XMLNS;

  return XMLout(
    $request,
    NSExpand   => $TRUE,
    KeyAttr    => [],
    KeepRoot   => $TRUE,
    ContentKey => $content_key,
    NoAttr     => $TRUE,
    XMLDecl    => $XMLDECL,
  );