|
1
|
#!/usr/bin/perl
|
|
2
|
#
|
|
3
|
# Basic LSID resolution client for quick and dirty testing
|
|
4
|
# Matt Jones 07 December 2005
|
|
5
|
#
|
|
6
|
# '$Id: getlsid.pl 2820 2005-12-07 22:14:53Z jones $'
|
|
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
|
}
|