view release on metacpan or  search on metacpan

lib/Microsoft/AdCenter/Service.pm  view on Meta::CPAN

    $self->EndPoint((defined $args{EndPoint}) ? $args{EndPoint} : $self->_default_location);
    $self->RetrySettings($args{RetrySettings});

    my $request_headers = $self->_request_headers_expanded;
    foreach my $header_name (keys %$request_headers) {
        if (defined $args{$header_name}) {
            $self->$header_name($args{$header_name});
        }
    }

    my $namespace_uri = $self->_namespace_uri;
    my $namespace = $namespace_uri;
    $namespace =~ s/\/$//;
    $namespace =~ s/^.*\///;

    $self->{_soap} = SOAP::Lite
        ->proxy($self->EndPoint)
        ->ns($namespace_uri, $namespace);

    $self->{_namespaces} = {
        $namespace_uri => $namespace
    };

    $self->{_type_category} = {};
    $self->{_type_namespace} = {};
    $self->{_type_full_names} = {};

    return $self;
}

sub _invoke {
    my ($self, %args) = @_;

    my $soap_action = $args{soap_action};
    my $request_name = $args{request}->{name};
    my $request_headers = $self->_request_headers;
    my $request_parameters = $args{request}->{parameters};
    my $response_name = $args{response}->{name};
    my $response_headers = $self->_request_headers;
    my $response_headers_expanded = $self->_response_headers_expanded;
    my $parameter_values = $args{parameters};

    # Reset the response headers
    foreach my $header_name (keys %$response_headers_expanded) {
        $self->$header_name(undef);
    }

    # Setup the SOAP client
    my $soap = $self->{_soap};
    $soap->proxy($self->EndPoint);
    $soap->on_action(sub { $soap_action });

    # Create request headers
    my @soap_header;
    foreach my $header (@$request_headers) {
        my $header_ns = $header->{namespace};
        my $header_name = $header->{name};
        my $header_type = $header->{type};
        my $type_category = $self->_type_category($header_type);
        my $header_value = ($type_category eq 'COMPLEX') ? $self->_populate_complex_type($header_type) : $self->$header_name;
        push @soap_header, $self->_serialize_argument("SOAP::Header", $header_ns, $header_name, $header_value, $header_type, 0);
    }

    # Create request body
    my @soap_body;
    foreach my $request_parameter (@$request_parameters) {
        my $request_parameter_ns = $request_parameter->{namespace};
        my $request_parameter_name = $request_parameter->{name};
        my $request_parameter_type = $request_parameter->{type};
        my $parameter_value = $parameter_values->{$request_parameter_name};
        push @soap_body, $self->_serialize_argument("SOAP::Data", $request_parameter_ns, $request_parameter_name, $parameter_value, $request_parameter_type, 1);
    }

    my $retries = 0;
    while (1) {
        my $result;
        eval {
            # Call the actual web service
            my $som = $soap->call($request_name, @soap_header, @soap_body);

            # Check for HTTP 400's errors (which we can't recover from)
            if ($soap->transport->proxy->code =~ /^4[0-9]{2}$/) {
                die $soap->transport->proxy->status . " for " . $soap->transport->proxy->endpoint;
            }

            # Store the response header values in the service client
            $self->_store_response_headers($som, $response_headers, $response_headers_expanded);

            # If it fails, die with a SOAPFault object
            if ($som->fault) {
                my $fault = Microsoft::AdCenter::SOAPFault->new
                    ->faultcode($som->faultcode)
                    ->faultstring($som->faultstring);

                my $faultdetail = $som->faultdetail;
                if (defined $faultdetail) {
                    if (ref $faultdetail eq 'HASH') {
                        $faultdetail = $self->_deserialize_array($faultdetail);
                        if (scalar(@$faultdetail) == 1) {
                            $fault->detail($faultdetail->[0]);
                        }
                        elsif (scalar(@$faultdetail) > 1) {
                            $fault->detail($faultdetail);
                        }
                    }
                    else {
                        $fault->detail($faultdetail);
                    }
                }
                die $fault;
            }

            # Parse the response body
            my $response_body = $som->body;
            if (defined $response_body) {
                die "Type mismatch" unless (exists $response_body->{$response_name});
                $result = $self->_deserialize_complex_type($response_name, $response_body->{$response_name});
            }
        };
        if (my $e = $@) {
            die $e unless ((defined $self->RetrySettings) && ref($self->RetrySettings) eq 'ARRAY');