UDDI - UDDI client interface

UDDI documentation Contained in the UDDI distribution.

Index

Code Index:

NAME

Top

UDDI - UDDI client interface

SYNOPSIS

Top

 use UDDI;

 my $list = UDDI::find_business(name => "a");
 my $bis = $list->businessInfos;
 for my $b ($bis->businessInfo) {
     print $b->name, "\n";
 }

DESCRIPTION

Top

This module provide functions to interact with UDDI registry servers. UDDI (Universal Description, Discovery and Integration) is the name of a group of web-based registries that expose information about businesses and their technical interfaces (APIs). Learn more about UDDI at www.uddi.org.

The interface exposed comply with the "UDDI Programmer's API Specification". Currently only the UDDI inquiry interface is provided.

FUNCTIONS

Top

The following functions are provided. None of them are exported by default. A successful invocation will return some UDDI object. On error undef is returned and the global variable %UDDI::err is set.

All the find_xxx() functions take key/value pairs as arguments. All they get_xxx() functions simply take one or more keys as argument.

find_binding( serviceKey => $key, ... )

This function will find binding details for a specific service. On success a UDDI::bindingDetails object is returned. Optional arguments are maxRows, findQualifiers and tModelBag.

find_business( ... )

This function will return businesses that fullfil the search criteria given. On success a UDDI::businessList object is returned. The returned businessList might be empty. Arguments are maxRows, findQualifiers, name, identiferBag, categoryBag, tModelBag are discoveryURLs.

find_service( businessKey => $key, ... )

This function will find services for a specific business. On success a UDDI::serviceList object is returned. Optional arguments are maxRows, findQualifiers, name, categoryBag and tModelBag.

find_tModel( ... )

This function will return tModels that fullfil the search criteria given. On success a UDDI::tModelList object is returned. The returned tModelList might be empty. Arguments are maxRows, findQualifiers, name, identiferBag and categoryBag.

get_bindingDetail( $bindingKey, ... )

This function will return a UDDI::bindingDetail object containing a UDDI::bindingTemplate for each binding key given as argument.

get_businessDetail( $businessKey, ... )

This function will return a UDDI::businessDetail object containing a UDDI::businessEntity for each business key given as argument.

get_businessDetailExt( $businessKey, ... )

This function will return a UDDI::businessDetailExt object containing a UDDI::businessEntityExt for each business key given as argument.

get_serviceDetail( $serviceKey, ... )

This function will return a UDDI::serviceDetail object containing a UDDI::businessService for each service key given as argument.

get_tModelDetail( $tModelKey, ... )

This function will return a UDDI::tModelDetail object containing a UDDI::tModel for each tModel key given as argument.

GLOBALS

Top

%UDDI::err

In case of errors the functions above will return undef and the %UDDI::err hash will be filled with the following values:

type

A short string giving the overall type of the failure. It can be either "HTTP" or "SOAP".

code

Error code. For HTTP it is a 3 digit number. For UDDI failures it is some string prefixed with "E_". For general SOAP failures it is a short string like "VersionMismatch", "MustUnderstand", "Client", "Server" (defined in section 4.4.1 in the SOAP spec.)

message

A short human readable (English) message describing the error.

detail

A reference to the corresponing error object.

The hash will be empty after a successful function call.

$UDDI::registry

The $UDDI::registry variable contains the URL to the registry server to use for the calls. Currently it defaults to Microsoft's test server.

$UDDI::TRACE

For debugging you might assign a file handle to the $UDDI::TRACE variable. Trace logs of the SOAP messages are then written to this file.

SEE ALSO

Top

http://www.uddi.org, SOAP, SOAP::Lite

AUTHOR

Top

Gisle Aas <gisle@ActiveState.com>

Copyright 2000 ActiveState Tool Corp.

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

UDDI documentation Contained in the UDDI distribution. 
package UDDI;

# Copyright 2000 ActiveState Tool Corp.

use strict;

our $VERSION = "0.03";

our $registry ||= "http://test.uddi.microsoft.com/inquire";
#our $registry = "http://uddi.microsoft.com/inquire";
our $TRACE;
our %err;

require Exporter;
our @EXPORT_OK = qw(find_binding find_business find_service find_tModel
		    get_bindingDetail get_businessDetail get_businessDetailExt
		    get_serviceDetail get_tModelDetail
                   );

my %findQualifier = map {$_ => 1}
   qw(exactNameMatch caseSensitiveMatch
      sortByNameAsc sortByNameDesc
      sortByDateAsc sortByDateDesc
     );

sub _esc_q {
    for (@_) {
	s/&/&amp;/g;
	s/\"/&quot;/g;
	s/</&lt;/g;
    }
}

sub _esc {
    for (@_) {
	s/&/&amp;/g;
	s/</&lt;/g;
    }
}

sub _rows_and_fq
{
    my $arg = shift;
    my $msg = "";
    if (defined(my $maxRows = delete $arg->{maxRows})) {
	$msg .= qq( maxRows="$maxRows");
    }
    $msg .= qq( xmlns="urn:uddi-org:api">);
    if (my $findQ = delete $arg->{findQualifiers}) {
	unless (ref($findQ)) {
	    $findQ = [split(' ', $findQ)];
	}
	if ($^W) {
	    for (@$findQ) {
		warn "Unknown findQualifier '$_'\n" unless $findQualifier{$_};
	    }
	}
	$msg .= "<findQualifiers>" .
                   join("", map "<findQualifier>$_</findQualifier>", @$findQ) .
                "</findQualifiers>";
    }
    return $msg;
}

sub _tbag
{
    my $arg = shift;
    my $msg = "";
    if (my $tBag = delete $arg->{tModelBag}) {
	unless (ref($tBag)) {
	    $tBag = [split(' ', $tBag)];
	}
	$msg .= "<tModelBag>" .
                   join("", map "<tModelKey>$_</tModelKey>", @$tBag) .
                "</tModelBag>";
    }
    return $msg;
}

sub _key_ref
{
    my($arg, $bag) = @_;
    my $msg = "";
    if (my $refs = delete $arg->{$bag}) {
	# XXX using a hash to implement a keyedReference bag is problematic
	# because there is no obvous place to put tModelKey if wanted...
	if (ref($refs) eq "HASH") {
	    my @kref;
	    for my $k (sort keys %$refs) {
		my $v = $refs->{$k};
		for ($k, $v) {
		    _esc_q($_);
		}
		push(@kref, qq(<keyedReference keyName="$k" keyValue="$v"/>));
	    }
	    $msg = "<$bag>" . join("", @kref) . "</$bag>";
	}
	else {
	    die "Unknown $bag argument type(must be hash)";
	}
    }
    $msg;
}

sub find_binding
{
    my %arg = @_;
    my $serviceKey = delete $arg{serviceKey};
    die "Missing serviceKey" unless $serviceKey;
    my $msg = qq(<find_binding serviceKey="$serviceKey" generic="1.0");
    $msg .= _rows_and_fq(\%arg);
    $msg .= _tbag(\%arg);
    $msg .= qq(</find_binding>);
    if (%arg) {
	my $a = join(", ", keys %arg);
	warn "Unrecongized parameters: $a";
    }

    return _request($msg);
}

sub find_business
{
    my %arg = @_;
    my $msg = qq(<find_business generic="1.0");
    $msg .= _rows_and_fq(\%arg);

    if (my $n = delete $arg{name}) {
	_esc($n);
	$msg .= qq(<name>$n</name>);
    }
    $msg .= _key_ref(\%arg, "identifierBag");
    $msg .= _key_ref(\%arg, "categoryBag");
    $msg .= _tbag(\%arg);

    if (my $discU = delete $arg{discoveryURLs}) {
	unless (ref($discU)) {
	    $discU = [split(' ', $discU)];
	}
	$msg .= "<discoveryURLs>" .
                   join("", map "<discoveryURL>$_</discoveryURL>", @$discU) .
                "</discoveryURLs>";
    }

    $msg .= qq(</find_business>);
    if (%arg) {
	my $a = join(", ", keys %arg);
	warn "Unrecongized parameters: $a";
    }

    return _request($msg);
}

sub find_service
{
    my %arg = @_;
    my $businessKey = delete $arg{businessKey};
    die "Missing businessKey" unless $businessKey;
    my $msg = qq(<find_service businessKey="$businessKey" generic="1.0");
    $msg .= _rows_and_fq(\%arg);
    if (my $n = delete $arg{name}) {
	_esc($n);
	$msg .= qq(<name>$n</name>);
    }
    $msg .= _key_ref(\%arg, "categoryBag");
    $msg .= _tbag(\%arg);
    $msg .= qq(</find_binding>);
    if (%arg) {
	my $a = join(", ", keys %arg);
	warn "Unrecongized parameters: $a";
    }

    return _request($msg);
}

sub find_tModel
{
    my %arg = @_;
    my $msg = qq(<find_tModel generic="1.0");
    $msg .= _rows_and_fq(\%arg);
    if (my $n = delete $arg{name}) {
	_esc($n);
	$msg .= qq(<name>$n</name>);
    }
    $msg .= _key_ref(\%arg, "identifierBag");
    $msg .= _key_ref(\%arg, "categoryBag");
    $msg .= _tbag(\%arg);
    $msg .= qq(</find_tModel>);
    if (%arg) {
	my $a = join(", ", keys %arg);
	warn "Unrecongized parameters: $a";
    }

    return _request($msg);
}

sub get_bindingDetail
{
    my $msg = qq(<get_bindingDetail generic="1.0" xmlns="urn:uddi-org:api">);
    for (@_) {
	$msg .= "<bindingKey>$_</bindingKey>";
    }
    $msg .= "</get_bindingDetail>";

    return _request($msg);
}

sub _get_businessDetail
{
    my $ext = (shift) ? "Ext" : "";
    my $msg = qq(<get_businessDetail$ext generic="1.0" xmlns="urn:uddi-org:api">);
    for (@_) {
	$msg .= "<businessKey>$_</businessKey>";
    }
    $msg .= "</get_businessDetail$ext>";

    return _request($msg);
}

sub get_businessDetail
{
    unshift(@_, 0);
    goto &_get_businessDetail;
}

sub get_businessDetailExt
{
    unshift(@_, 1);
    goto &_get_businessDetail;
}

sub get_serviceDetail
{
    my $msg = qq(<get_serviceDetail generic="1.0" xmlns="urn:uddi-org:api">);
    for (@_) {
	$msg .= "<serviceKey>$_</serviceKey>";
    }
    $msg .= "</get_serviceDetail>";

    return _request($msg);
}

sub get_tModelDetail
{
    my $msg = qq(<get_tModelDetail generic="1.0" xmlns="urn:uddi-org:api">);
    for (@_) {
	$msg .= "<tModelKey>$_</tModelKey>";
    }
    $msg .= "</get_tModelDetail>";

    return _request($msg);
}



# ----------------------------------

my $ua;

sub _request {
    my $msg = shift;

    if (!$ua) {
	require LWP::UserAgent;
	$ua = LWP::UserAgent->new;
	$ua->agent("UDDI.pm/$VERSION " . $ua->agent);
	$ua->env_proxy;
    }

    undef(%UDDI::err);

    my $req = HTTP::Request->new(POST => $registry);
    $req->date(time) if $TRACE;
    $req->header("SOAPAction", '""');
    $req->content_type("text/xml");
    $req->content(qq(<?xml version="1.0" encoding="UTF-8"?><Envelope xmlns="http://schemas.xmlsoap.org/soap/envelope/"><Body>$msg</Body></Envelope>\n));

    print $TRACE "\n\n", ("=" x 50), "\n", $req->as_string if $TRACE;

    my $res = $ua->request($req);

    print $TRACE $res->as_string if $TRACE;

    if ($res->content_type eq "text/xml" && $res->header("SOAPAction")) {
	#warn $res->content;

	require UDDI::SOAP;
	my $envelope = UDDI::SOAP::parse($res->content);
	if ($envelope->must_understand_headers) {
	    %UDDI::err = ( type => "SOAP",
			   code => "MustUnderstand",
			   message => "UDDI response contained SOAP headers that ".
			              "the client libarary did not understand",
			   detail => $envelope,
			 );
	    return undef;
	}

	my $obj = $envelope->body_content;

	if (ref($obj) eq "UDDI::SOAP::Fault") {
	    %UDDI::err = ( type    => "SOAP",
			   code    => $obj->code,
			   message => $obj->message,
			   detail  => $obj,
			 );
	    return undef;
	}

	return $obj;
    }

    %UDDI::err = (
		  type    => "HTTP",
		  code    => $res->code,
		  message => $res->status_line,
		  detail  => $res,
		 );
    return undef;
}

# The following table is auto-generated from:
# "UDDI API schema.  Version 1.0, revision 0.  Last change 2000-09-06"

# urn:uddi-org:api elements

sub TEXT_CONTENT () { 0x01 }
sub ELEM_CONTENT () { 0x02 }

our %elementContent = (
    'UDDI::addressLine'           => 0x01,
    'UDDI::bindingKey'            => 0x01,
    'UDDI::businessKey'           => 0x01,
    'UDDI::description'           => 0x01,
    'UDDI::keyValue'              => 0x01,
    'UDDI::name'                  => 0x01,
    'UDDI::overviewURL'           => 0x01,
    'UDDI::personName'            => 0x01,
    'UDDI::serviceKey'            => 0x01,
    'UDDI::tModelKey'             => 0x01,
    'UDDI::uploadRegister'        => 0x01,
    'UDDI::address'               => 0x02,
    'UDDI::contacts'              => 0x02,
    'UDDI::contact'               => 0x02,
    'UDDI::discoveryURL'          => 0x01,
    'UDDI::discoveryURLs'         => 0x02,
    'UDDI::phone'                 => 0x01,
    'UDDI::email'                 => 0x01,
    'UDDI::businessEntity'        => 0x02,
    'UDDI::businessServices'      => 0x02,
    'UDDI::businessService'       => 0x02,
    'UDDI::bindingTemplates'      => 0x02,
    'UDDI::identifierBag'         => 0x02,
    'UDDI::keyedReference'        => 0000,
    'UDDI::categoryBag'           => 0x02,
    'UDDI::bindingTemplate'       => 0x02,
    'UDDI::accessPoint'           => 0x01,
    'UDDI::hostingRedirector'     => 0000,
    'UDDI::tModelInstanceDetails' => 0x02,
    'UDDI::tModelInstanceInfo'    => 0x02,
    'UDDI::instanceDetails'       => 0x02,
    'UDDI::instanceParms'         => 0x01,
    'UDDI::tModel'                => 0x02,
    'UDDI::tModelBag'             => 0x02,
    'UDDI::overviewDoc'           => 0x02,
    'UDDI::authInfo'              => 0x01,
    'UDDI::get_authToken'         => 0000,
    'UDDI::authToken'             => 0x02,
    'UDDI::discard_authToken'     => 0x02,
    'UDDI::save_tModel'           => 0x02,
    'UDDI::delete_tModel'         => 0x02,
    'UDDI::save_business'         => 0x02,
    'UDDI::delete_business'       => 0x02,
    'UDDI::save_service'          => 0x02,
    'UDDI::delete_service'        => 0x02,
    'UDDI::save_binding'          => 0x02,
    'UDDI::delete_binding'        => 0x02,
    'UDDI::dispositionReport'     => 0x02,
    'UDDI::result'                => 0x02,
    'UDDI::errInfo'               => 0x01,
    'UDDI::findQualifiers'        => 0x02,
    'UDDI::findQualifier'         => 0x01,
    'UDDI::find_tModel'           => 0x02,
    'UDDI::find_business'         => 0x02,
    'UDDI::find_binding'          => 0x02,
    'UDDI::find_service'          => 0x02,
    'UDDI::serviceList'           => 0x02,
    'UDDI::businessList'          => 0x02,
    'UDDI::tModelList'            => 0x02,
    'UDDI::businessInfo'          => 0x02,
    'UDDI::businessInfos'         => 0x02,
    'UDDI::serviceInfo'           => 0x02,
    'UDDI::serviceInfos'          => 0x02,
    'UDDI::get_businessDetail'    => 0x02,
    'UDDI::businessDetail'        => 0x02,
    'UDDI::get_serviceDetail'     => 0x02,
    'UDDI::serviceDetail'         => 0x02,
    'UDDI::get_registeredInfo'    => 0x02,
    'UDDI::registeredInfo'        => 0x02,
    'UDDI::tModelInfo'            => 0x02,
    'UDDI::tModelInfos'           => 0x02,
    'UDDI::get_tModelDetail'      => 0x02,
    'UDDI::tModelDetail'          => 0x02,
    'UDDI::businessEntityExt'     => 0x02,
    'UDDI::get_businessDetailExt' => 0x02,
    'UDDI::businessDetailExt'     => 0x02,
    'UDDI::get_bindingDetail'     => 0x02,
    'UDDI::bindingDetail'         => 0x02,
    'UDDI::validate_categorization' => 0x02,
);


package UDDI::Object;

use overload '""' => \&as_string;

our $AUTOLOAD;

sub AUTOLOAD
{
    my $self = shift;
    my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
    return if $method eq "DESTROY";

    my $k = "urn:uddi-org:api\0$method";
    if (exists $self->[0]{$k}) {
	return $self->[0]{$k};
    }

    my @res = grep ref($_) eq "UDDI::$method", @$self;
    return wantarray ? @res : $res[0];
}

sub xml_lang
{
    my $self = shift;
    return $self->[0]{"xml\0lang"};
}

sub as_string
{
    my($self, $elem) = @_;
    my $class = ref($self);

    unless ($class) {
	# plain string
	UDDI::_esc($self) if $elem;
	return $self;
    }

    return $self->[1]
	if $UDDI::elementContent{$class} == UDDI::TEXT_CONTENT && !$elem;

    (my $tag = $class) =~ s/^UDDI:://;

    my @e = @$self;
    my $attr = shift @e;
    if (%$attr) {
	my @attr;
	for my $k (sort keys %$attr) {
	    my $v = $attr->{$k};
	    $k =~ s/^[^\0]*\0//; # kill namespace qualifier
	    UDDI::_esc_q($v);
	    @attr = qq($k="$v");
	}
	$attr = join(" ", "", @attr);
    }
    else {
	$attr = "";
    }

    return "<$tag$attr/>" unless @e;

    return join("", "<$tag$attr>", (map as_string($_, 1), @e), "</$tag>");
}

1;

__END__