Project

General

Profile

1 2820 jones
#!/usr/bin/perl
2
#
3
# Basic LSID resolution client for quick and dirty testing
4
# Matt Jones  07 December 2005
5
#
6
# '$Id$'
7
8
use strict;
9
use SOAP::Lite;
10
use SOAP::MIME;
11
use MIME::Entity;
12
13
# Default LSID to resolve
14
my $lsid = "urn:lsid:joneseckert.org:jones-test:1:1";
15
#my $lsid = "urn:lsid:limnology.wisc.edu:dataset:ntlfi02";
16
17
# I have hardcoded the endpoint proxy for this service, but in fact it
18
# should be first determined using a DNS SRV record lookup on the authority,
19
# and then parsed out of the WSDL from the getAvailableServices() call
20
my $endpoint = "http://snow.joneseckert.org:8080/authority/";
21
#my $endpoint = "http://lsid.limnology.wisc.edu:8080/authority/services/AuthorityWebService";
22
23
&parseArgs;
24
25
print "\nResolving LSID: $lsid\n";
26
print "Using Endpoint: $endpoint\n\n";
27
28
# Namespace constants
29
my $AUTH_SERVICE_NS="http://www.omg.org/LSID/2003/AuthorityServiceSOAPBindings";
30
my $DATA_SERVICE_NS="http://www.omg.org/LSID/2003/DataServiceSOAPBindings";
31
32
# First get the WSDL for available services for this LSID
33
callLsidOperation($AUTH_SERVICE_NS, $endpoint, $lsid, 'getAvailableServices');
34
35
# Second call the getMetadata operation for this LSID
36
callLsidOperation($DATA_SERVICE_NS, $endpoint . 'metadata/', $lsid,
37
        'getMetadata');
38
39
# Third call the getData operation for this LSID
40
callLsidOperation($DATA_SERVICE_NS, $endpoint . 'data/', $lsid, 'getData');
41
42
#
43
# Subroutine to make the SOAP call to the LSID resolver
44
#    TODO: Assumes parameters passed in are valid, need to check
45
#
46
sub callLsidOperation {
47
    my $namespace = shift;
48
    my $endpoint = shift;
49
    my $lsid = shift;
50
    my $method = shift;
51
52
    my $service = SOAP::Lite
53
        -> uri($DATA_SERVICE_NS)
54
        -> proxy($endpoint);
55
    my $response = $service->call($method => SOAP::Data->name(lsid => "$lsid"));
56
    if ($response->fault) {
57
        print "DETAIL: ", $response->faultdetail, "\n";
58
        print "  CODE: ", $response->faultcode, "\n";
59
        print "STRING: ", $response->faultstring, "\n";
60
        print " ACTOR: ", $response->faultactor, "\n";
61
    } else {
62
        print "\n";
63
        print "************************************************************\n";
64
        print "*   Results of $method\n";
65
        print "************************************************************\n";
66
        print "SOAP Body says type is: ", $response->result, "\n";
67
        foreach my $part (@{$response->parts}) {
68
            my $type = $$part->mime_type;
69
            print "MIME Envelope says type is: ", $type, "\n";
70
            print "Attachment payload is: ", "\n";
71
            if (my $io = $$part->open("r")) {
72
                while (defined($_ = $io->getline)) {
73
                    print $_;
74
                }
75
                $io->close;
76
            }
77
            print "\n\n";
78
        }
79
    }
80
}
81
82
# check the commandline for LSIDs to be resolved and the endpoint
83
# if no arguments are found, the deault lsid is used
84
sub parseArgs {
85
    foreach my $arg (@ARGV) {
86
        if ($arg =~ /^urn:lsid:/i) {
87
            $lsid = $arg;
88
        } else {
89
            $endpoint = $arg;
90
        }
91
    }
92
}