The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Net::Z3950::UDDI::Database::soap;
our @ISA = qw(Net::Z3950::UDDI::Database);
use strict;
use warnings;

sub _on_fault_die {
    my($soap, $som) = @_;

    my $msg = ref $som ? $som->faultstring : $soap->transport->status;
    # We have no UDDI or Database object to invoke _throw() on, so we
    # have to use the fully-qualified function-call form.
    Net::Z3950::UDDI::_throw(100, "SOAP error: $msg");
}

sub _on_fault_warn {
    my($soap, $som) = @_;

    warn ref $som ? $som->faultstring : $soap->transport->status;
}

use SOAP::Lite on_fault => \&_on_fault_die;


sub rebless {
    my $class = shift();
    my($this) = @_;

    my $soap = new SOAP::Lite;
    foreach my $property (qw(service proxy uri)) {
	my $val = $this->config()->property("$property");
	$soap->$property($val) if defined $val;
    }

    my $params = $this->config()->{params};
    my $soap_fault = $params->property("soap-fault");
    if (defined $soap_fault) {
	#warn "soap_fault='$soap_fault'";
	if ($soap_fault eq "die") {
	    $soap->on_fault(\&_on_fault_die);
	} elsif ($soap_fault eq "warn") {
	    $soap->on_fault(\&_on_fault_warn);
	} elsif ($soap_fault eq "ignore") {
	    $soap->on_fault(undef);
	} else {
	    $this->_throw(1, "unrecognised soap-fault value " .
			  "'$soap_fault' [die|warn|ignore]");
	}
    }

    my $soap_debug = $params->property("soap-debug");
    if (defined $soap_debug) {
	#warn "soap_debug='$soap_debug'";
	SOAP::Lite->import(+trace => [ split /[,\s]+/, $soap_debug ]);
    }

    $this->{_soap} = $soap;
    bless $this, $class;
}


sub _soap { shift()->{_soap} }


sub search {
    my $this = shift();
    my($rpn) = @_;

    my $query = $rpn->{query};
    $this->_throw(6, "only single-term queries are supported for now")
	if ref $query ne "Net::Z3950::RPN::Term";

    ### Ignore attribute set for now
    ### Ignore all attributes apart from access point, for now
    my $attrs = $query->{attributes};
    my $ap = undef;
    foreach my $attr (@$attrs) {
	$ap = $attr->{attributeValue} if $attr->{attributeType} == 1;
    }
    $this->_throw(116) if !defined $ap;

    my $map = $this->config()->property("indexmap");
    my $bib1map = $map->{"bib-1"};
    my $method = $bib1map->{$ap};
    $this->_throw(114, $ap) if !defined $method;

    my $term = $query->{term};
    my $som = $this->_soap()->call($method, $term);
    return new Net::Z3950::UDDI::ResultSet::soap($this, $som);
}


package Net::Z3950::UDDI::ResultSet::soap;

use Net::Z3950::UDDI::ResultSet;
our @ISA = qw(Net::Z3950::UDDI::ResultSet);
use strict;
use warnings;

sub new {
    my $class = shift();
    my($db, $som) = @_;

    my $this = $class->SUPER::new($db);
    $this->{som} = $som;
    $this->{count} = undef;
    $this->{records} = [];
    bless $this, $class;

    ### Parse the SOM and extract count and records!

    return $this;
}

sub count {
    my $this = shift();

    return 12345; $this->{count};
}

sub record {
    my $this = shift();
    my($index0) = @_;

    return $this->{records}->[$index0];
}


1;