File Coverage

blib/lib/Amazon/S3/Thin/ResponseParser.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	5	6	83.3
condition			n/a
subroutine	9	9	100.0
pod	2	2	100.0
total	50	51	98.0

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

our $VERSION = "0.02";

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 list_objects {
    my ($self, $content) = @_;

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

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

    # 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'),
        encoding_type           => $xpc->findvalue('/s3:ListBucketResult/s3:EncodingType'),
        is_truncated            => _boolean($xpc->findvalue('/s3:ListBucketResult/s3:IsTruncated')),
        max_keys                => $xpc->findvalue('/s3:ListBucketResult/s3:MaxKeys'),
        name                    => $xpc->findvalue('/s3:ListBucketResult/s3:Name'),
        prefix                  => $xpc->findvalue('/s3:ListBucketResult/s3:Prefix'),
        # v1
        # https://docs.aws.amazon.com/AmazonS3/latest/API/RESTBucketGET.html
        marker                  => $xpc->findvalue('/s3:ListBucketResult/s3:Marker'),
        next_marker             => $xpc->findvalue('/s3:ListBucketResult/s3:NextMarker'),
        # v2
        continuation_token      => $xpc->findvalue('/s3:ListBucketResult/s3:ContinuationToken'),
        next_continuation_token => $xpc->findvalue('/s3:ListBucketResult/s3:NextContinuationToken'),
        key_count               => $xpc->findvalue('/s3:ListBucketResult/s3:KeyCount'),
        start_after             => $xpc->findvalue('/s3:ListBucketResult/s3:StartAfter'),
    };
    return ($result, undef);
}

sub _boolean {
    my $s = shift;
    return $s eq 'true' ? 1 : 0;
}

sub _remove_quote {
    my $s = shift;
    $s =~ s/^"|"$//g;
    return $s;
}

1;
__END__