# Connector::Proxy::SOAP::Lite
#
# Proxy class for accessing SOAP servers
#
# Written by Martin Bartosch for the OpenXPKI project 2012
#
package Connector::Proxy::SOAP::Lite;

use strict;
use warnings;
use English;
use SOAP::Lite;
use Try::Tiny;
use Data::Dumper;

use Moose;
extends 'Connector::Proxy';

has uri => (
    is => 'rw',
    isa => 'Str',
    required => 1,
    );

has method => (
    is => 'rw',
    isa => 'Str',
    required => 1,
    );

has do_not_use_charset => (
    is => 'ro',
    isa => 'Bool',
    default => 0,
    );

has use_microsoft_dot_net_compatible_separator => (
    is => 'rw',
    isa => 'Bool',
    default => 0,
    );

# By default the SOAP call uses positional parameters. If this flag is set,
# the argument list to the call is interpreted as a Hash
has use_named_parameters => (
    is => 'rw',
    # FIXME
    # isa => 'Bool',
    isa => 'Str',
    default => 0,
    );

has certificate_file => (
    is => 'rw',
    isa => 'Str',
    );

has certificate_key_file => (
    is => 'rw',
    isa => 'Str',
    );

has certificate_p12_file => (
    is => 'rw',
    isa => 'Str',
    );

has certificate_p12_password => (
    is => 'rw',
    isa => 'Str',
    );


has ca_certificate_path => (
    is => 'rw',
    isa => 'Str',
    );

sub BUILD {
    my $self = shift;
    if ($self->do_not_use_charset) {
	$SOAP::Constants::DO_NOT_USE_CHARSET = 1;
    }
}

sub _build_config {
    my $self = shift;
}


sub _soap_call {
    my $self = shift;

#    my $arg = shift;

    my $proxy = $self->LOCATION();

    my %ENV_BACKUP = %ENV;

    if ($self->certificate_file) {
	if ($self->certificate_p12_file) {
	    die "Options certificate_file and certificate_p12_file are mutually exclusive";
	}
	$ENV{HTTPS_CERT_FILE} = $self->certificate_file;
    }

    if ($self->certificate_key_file) {
	$ENV{HTTPS_KEY_FILE}  = $self->certificate_key_file;
    }

    if ($self->certificate_p12_file) {
	$ENV{HTTPS_PKCS12_FILE}  = $self->certificate_p12_file;
    }
    if ($self->certificate_p12_password) {
	$ENV{HTTPS_PKCS12_PASSWORD}  = $self->certificate_p12_password;
    }

    if ($self->ca_certificate_path) {
	$ENV{HTTPS_CA_DIR}    = $self->ca_certificate_path;
    }

    my $client = SOAP::Lite
	-> uri($self->uri)
	-> proxy($proxy);

    if ($self->use_microsoft_dot_net_compatible_separator) {
	$client->on_action( sub { join('/', @_) } );
    }

    $self->log()->debug('Performing SOAP call to method ' . $self->method . ' on service ' . $self->uri . ' via ' . $proxy);
    my @params;
    if ($self->use_named_parameters) {
	# names parameters
	# FIXME: this is what we really want:
# 	my %args = @_;

	# FIXME: only support one single named parameter, named in
	# "use_named_parameters" for now
	my %args = (
		    $self->use_named_parameters => shift,
		    );

 	foreach my $key (keys %args) {
 	    push @params, SOAP::Data->new(name => $key, value => $args{$key});
	    $self->log()->debug('Named parameter: ' . $key . ' => ' . $args{$key});
 	}
    } else {
	@params = @_;
	$self->log()->debug('Parameters: ' . join(', ', @params));
    }


    my $som;
    eval {
        $som = $client->call($self->method,
			    @params);
    };
    if ($@) {
	$self->log()->error('SOAP call died: ' . $@);
	die 'Fatal SOAP Error: ' . $@ . " [method=" . $self->method . ", params=(" . join(', ', @params) . ")]";
    }


    # restore environment
    %ENV = %ENV_BACKUP;

    if ($som->fault) {
	$self->log()->error('SOAP call returned error: ' . $som->fault->{faultstring});
	die $som->fault->{faultstring};
    }

    return $som->result;
}


sub get {
    my $self = shift;

    my $result = $self->_soap_call(@_);
    return if (! defined $result);

    if (ref $result ne '') {
	die "SOAP call result is not a scalar";
    }
    return $result;
}

sub get_size {
    my $self = shift;

    my $result = $self->get_list(@_);
    return scalar @{$result};
}

sub get_list {
    my $self = shift;

    my $result = $self->_soap_call(@_);

    return if (! defined $result);

    if (ref $result ne 'ARRAY' ) {
        die "SOAP call result is not a list";
    }

    return @{$result};
}

sub get_keys {
    my $self = shift;

    my $result = $self->get_hash(@_);
    return keys %{$result};
}

sub get_hash {
    my $self = shift;

    my $result = $self->_soap_call(@_);

    return if (! defined $result);

    if (ref $result ne 'HASH' ) {
        die "SOAP call result is not a hash";
    }

    return $result;
}

sub get_meta {
    my $self = shift;
    # FIXME
    die "Sorry that is not supported, yet";
}

sub exists {

    my $self = shift;

    # FIXME
    die "Sorry that is not supported, yet";

}
no Moose;
__PACKAGE__->meta->make_immutable;

1;
__END__

=head 1 NAME

Connector::Proxy::SOAP::Lite

=head 1 DESCRIPTION