Metacat

#!/usr/bin/perl

#

# Basic LSID resolution client for quick and dirty testing

# Matt Jones  07 December 2005

#

# '$Id$'

use strict;

use SOAP::Lite;

use SOAP::MIME;

use MIME::Entity;

# Default LSID to resolve

my $lsid = "urn:lsid:joneseckert.org:jones-test:1:1";

#my $lsid = "urn:lsid:limnology.wisc.edu:dataset:ntlfi02";

# I have hardcoded the endpoint proxy for this service, but in fact it

# should be first determined using a DNS SRV record lookup on the authority,

# and then parsed out of the WSDL from the getAvailableServices() call

my $endpoint = "http://snow.joneseckert.org:8080/authority/";

#my $endpoint = "http://lsid.limnology.wisc.edu:8080/authority/services/AuthorityWebService";

&parseArgs;

print "\nResolving LSID: $lsid\n";

print "Using Endpoint: $endpoint\n\n";

# Namespace constants

my $AUTH_SERVICE_NS="http://www.omg.org/LSID/2003/AuthorityServiceSOAPBindings";

my $DATA_SERVICE_NS="http://www.omg.org/LSID/2003/DataServiceSOAPBindings";

# First get the WSDL for available services for this LSID

callLsidOperation($AUTH_SERVICE_NS, $endpoint, $lsid, 'getAvailableServices');

# Second call the getMetadata operation for this LSID

callLsidOperation($DATA_SERVICE_NS, $endpoint . 'metadata/', $lsid, 

        'getMetadata');

# Third call the getData operation for this LSID

callLsidOperation($DATA_SERVICE_NS, $endpoint . 'data/', $lsid, 'getData');

#

# Subroutine to make the SOAP call to the LSID resolver

#    TODO: Assumes parameters passed in are valid, need to check

#

sub callLsidOperation {

    my $namespace = shift;

    my $endpoint = shift;

    my $lsid = shift;

    my $method = shift;

    my $service = SOAP::Lite

        -> uri($DATA_SERVICE_NS)

        -> proxy($endpoint);

    my $response = $service->call($method => SOAP::Data->name(lsid => "$lsid"));

    if ($response->fault) { 

        print "DETAIL: ", $response->faultdetail, "\n";

        print "  CODE: ", $response->faultcode, "\n";

        print "STRING: ", $response->faultstring, "\n"; 

        print " ACTOR: ", $response->faultactor, "\n";

    } else {

        print "\n";

        print "************************************************************\n";

        print "*   Results of $method\n";

        print "************************************************************\n";

        print "SOAP Body says type is: ", $response->result, "\n";

        foreach my $part (@{$response->parts}) {

            my $type = $$part->mime_type;

            print "MIME Envelope says type is: ", $type, "\n";

            print "Attachment payload is: ", "\n";

            if (my $io = $$part->open("r")) {

                while (defined($_ = $io->getline)) { 

                    print $_;

                }

                $io->close;

            }

            print "\n\n";

        }

    }

}

# check the commandline for LSIDs to be resolved and the endpoint

# if no arguments are found, the deault lsid is used

sub parseArgs {

    foreach my $arg (@ARGV) {

        if ($arg =~ /^urn:lsid:/i) {

            $lsid = $arg;

        } else {

            $endpoint = $arg;

        }

    }

}