view release on metacpan or  search on metacpan

lib/Amazon/S3/Thin/ResponseParser.pm  view on Meta::CPAN

package Amazon::S3::Thin::ResponseParser;
use strict;
use warnings;
use XML::LibXML;
use XML::LibXML::XPathContext;

our $VERSION = "0.03";

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

    my $xml = exists $args{xml} ? $args{xml} : XML::LibXML->new();

    return bless {
        xml => $xml,
    }, $class;
}

sub _xpc {
    my ($self, $content) = @_;
    my $doc = $self->{xml}->parse_string($content);
    my $xpc = XML::LibXML::XPathContext->new($doc);
    $xpc->registerNs('s3' => 'http://s3.amazonaws.com/doc/2006-03-01/');
    return $xpc;
}

sub error {
    my ($self, $content) = @_;

    my $xpc = $self->_xpc($content);

    # https://docs.aws.amazon.com/AmazonS3/latest/API/ErrorResponses.html
    return {
        code       => $xpc->findvalue('/Error/Code'),
        message    => $xpc->findvalue('/Error/Message'),
        request_id => $xpc->findvalue('/Error/RequestId'),
        resource   => $xpc->findvalue('/Error/Resource'),
    };
}

sub list_objects {
    my ($self, $content) = @_;

    my $xpc = $self->_xpc($content);

    if ($xpc->findnodes('/Error')) {
        return (undef, $self->error($content));
    }

    # https://docs.aws.amazon.com/AmazonS3/latest/API/v2-RESTBucketGET.html
    my $result = {
        contents                => [ map {
            +{
                etag          => _remove_quote($xpc->findvalue('./s3:ETag', $_)),
                key           => $xpc->findvalue('./s3:Key', $_),
                last_modified => $xpc->findvalue('./s3:LastModified', $_),
                owner         => {
                    display_name => $xpc->findvalue('./s3:Owner/s3:DisplayName', $_),
                    id           => $xpc->findvalue('./s3:Owner/s3:ID', $_),
                },
                size          => $xpc->findvalue('./s3:Size', $_),
                storage_class => $xpc->findvalue('./s3:StorageClass', $_),
            }
        } $xpc->findnodes('/s3:ListBucketResult/s3:Contents') ],
        common_prefixes         => [ map {
            +{
                owner  => {
                    display_name => $xpc->findvalue('./s3:Owner/s3:DisplayName', $_),
                    id           => $xpc->findvalue('./s3:Owner/s3:ID', $_),
                },
                prefix => $xpc->findvalue('./s3:Prefix', $_),
            }
        } $xpc->findnodes('/s3:ListBucketResult/s3:CommonPrefixes') ],
        delimiter               => $xpc->findvalue('/s3:ListBucketResult/s3:Delimiter'),