view release on metacpan or  search on metacpan

lib/AWS/S3/ResponseParser.pm  view on Meta::CPAN

    isa      => 'XML::LibXML::Document',
    required => 0,
    lazy    => 1,
    clearer => '_clear_xml',
    default => sub {
        my $self = shift;

        my $src = $self->response->content;
        print STDERR ">>> AWS Response:\n", $src, "\n" if DEBUG;

        return unless $src =~ m/^[[:space:]]*</s;
        return $self->libxml->parse_string( $src );
    }
);

has 'xpc' => (
    is       => 'ro',
    isa      => 'XML::LibXML::XPathContext',
    required => 0,
    lazy    => 1,
    clearer => '_clear_xpc',
    default => sub {
        my $self = shift;
        my $doc = $self->xml;
        return unless $doc;

        my $xpc = XML::LibXML::XPathContext->new( $doc );
        $xpc->registerNs( 's3', 'http://s3.amazonaws.com/doc/2006-03-01/' );

        return $xpc;
    }
);

has 'friendly_error' => (
    is       => 'ro',
    isa      => 'Maybe[Str]',
    lazy     => 1,
    required => 0,
    default  => sub {
        my $s = shift;

        return unless $s->error_code || $s->error_message;
        $s->type . " call had errors: [" . $s->error_code . "] " . $s->error_message;
    }
);

sub _parse_errors {
    my $self = shift;

    my $src = $self->response->content;

    # Do not try to parse non-xml:
    unless ( $src =~ m/^[[:space:]]*</s ) {
        ( my $code = $src ) =~ s/^[[:space:]]*\([0-9]*\).*$/$1/s;
        $LOG->error('Error response from AWS', {code => $code, msg => $src});
        $self->error_code( $code );
        $self->error_message( $src );
        return 1;
    }    # end unless()

    ## Originally at this point the re-setting of xpc would happen
    ## Does not seem to be needed but it may be a problem area
    ## Feel free to delete - Evan Carroll 2012/06/14
    #### $s->_clear_xpc;

    if ( $self->xpc->findnodes( "//Error" ) ) {
        my $code = $self->xpc->findvalue( "//Error/Code" );
        my $msg = $self->xpc->findvalue( "//Error/Message" );
        $LOG->error('Error response from AWS', {code => $code, msg => $msg});
        $self->error_code( $code );
        $self->error_message( $msg );
        return 1;
    }

    return 0;
}

__PACKAGE__->meta->make_immutable;