?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
fixed recursive_children cvterm function, and added tests for parents and children
[cxgn-corelibs.git] / lib / MOBY / Central.pm
blob9587502083632e07759a581ba5be3613764a511b
1 #$Id: Central.pm,v 1.224 2005/12/09 16:49:54 mwilkinson Exp $
2
3 =head1 NAME
4
5 MOBY::Central.pm - API for communicating with the MOBY Central registry
6
7 =cut
8
9 package MOBY::Central;
10 use strict;
11 use Carp;
12 use vars qw($AUTOLOAD $WSDL_TEMPLATE);
13 use XML::LibXML;
14 use MOBY::OntologyServer;
15 use MOBY::service_type;
16 use MOBY::authority;
17 use MOBY::service_instance;
18 use MOBY::simple_input;
19 use MOBY::simple_output;
20 use MOBY::collection_input;
21 use MOBY::collection_output;
22 use MOBY::secondary_input;
23 use MOBY::central_db_connection;
24 use MOBY::Config;
25 use MOBY::CommonSubs;
26
27 #use MOBY::RDF::ServiceInstanceRDF;
28 #use RDF::Core;
29 #use RDF::Core::Model;
30 #use RDF::Core::Literal;
31 #use RDF::Core::Statement;
32 #use RDF::Core::Model::Serializer;
33 #use RDF::Core::Storage::Memory;
34 #use RDF::Core::Constants qw(:xml :rdf :rdfs);
35 use MOBY::MobyXMLConstants;
36 my $debug = 0;
37
38 if ($debug) {
39 open( OUT, ">/tmp/CentralRegistryLogOut.txt" ) || die "cant open logfile\n";
40 print OUT "created logfile\n";
41 close OUT;
42 }
43
44 =head1 SYNOPSIS
45
46 REQUIRES MYSQL 3.23 or later!!!!
47
48 If you are a Perl user, you should be using the
49 MOBY::Client:Central module to talk to MOBY-Central
50
51 If you need to connect directly, here is how it
52 is done in perl 5.6 and 5.6.1. It wont work
53 in Perl 5.8... sorry. Look how MOBY::Client::Cent
54 does it if you want to use Perl 5.8
55
56
57 --------------------------------------
58 SERVER-SIDE
59
60 use SOAP::Transport::HTTP;
61
62 my $x = new SOAP::Transport::HTTP::CGI;
63 # fill in your server path below...
64 $x->dispatch_to('WWW_SERVER_PATH', 'MOBY::Central');
65 $x->handle;
66
67
68 ---------------------------------------
69
70 CLIENT-SIDE
71
72 use SOAP::Lite +autodispatch =>
73 proxy => 'http://mobycentral.icapture.ubc.ca/cgi-bin/MOBY05/mobycentral.pl',
74 on_fault => sub {
75 my($soap, $res) = @_;
76 die ref $res ? $res->faultstring : $soap->transport->status, "\n";
77 };
78
79 my $NAMES_XML = MOBY::Central->retrieveObjectNames;
80 print $NAMES_XML;
81 # ... do something with the XML
82
83 ----------------------------------------
84
85
86 =head1 DESCRIPTION
87
88 Used to do various transactions with MOBY-Central registry, including registering
89 new Object and Service types, querying for these types, registering new
90 Servers/Services, or queryiong for available services given certain input/output
91 or service type constraints.
92
93 =cut
94
95 =head1 CONFIGURATION
96
97 This depends on a config file to get its database connection information. At a minimum
98 this config file must have the following clause:
99
100 [mobycentral]
101 url = some.url
102 username = foo
103 password = bar
104 port = portnumber
105 dbname = mobycentral
106
107
108 The space before and after the '=' is critical.
109
110 The end of a clause is indicated by a blank line.
111
112 Additional identically formatted clauses may be added for each of:
113
114 [mobyobject]
115 [mobynamespace]
116 [mobyservice]
117 [mobyrelationship]
118
119 if these ontologies are being served from a local database (via the
120 OntologyServer module). These clauses will be read by the OntologyServer
121 module if they are present, otherwise default connections will be made
122 to the MOBY Central ontology server.
123
124 The config file must be readable by the webserver, and the webserver
125 environment should include the following ENV variable:
126
127 $ENV{MOBY_CENTRAL_CONFIG} = /path/to/config/file.name
128
129
130 =head1 AUTHORS
131
132 Mark Wilkinson (markw@illuminae.com)
133
134 BioMOBY Project: http://www.biomoby.org
135
136 =cut
137
138 =head1 Registration XML Object
139
140 This is sent back to you for all registration and
141 deregistration calls
142
143 <MOBYRegistration>
144 <success>$success</success>
145 <id>$id</id>
146 <message><![CDATA[$message]]></message>
147 </MOBYRegistration>
148
149
150 success is a boolean indicating a
151 successful or a failed registration
152
153 id is the deregistration ID of your registered
154 object or service to use in a deregister call.
155
156 message will contain any additional information
157 such as the reason for failure.
158
159
160 =cut
161
162 sub Registration {
163 my ($details) = @_;
164 my $id = $details->{id};
165 my $success = $details->{success};
166 my $message = $details->{message};
167 my $RDF = "";
168 $RDF = $details->{RDF};
169
170 # return "<MOBYRegistration>
171 # <id>$id</id>
172 # <success>$success</success>
173 # <message><![CDATA[$message]]></message>
174 # <RDF><![CDATA[$RDF]]></RDF>
175 # </MOBYRegistration>";
176 return "<MOBYRegistration>
177 <id>$id</id>
178 <success>$success</success>
179 <message><![CDATA[$message]]></message>
180 <RDF>$RDF</RDF>
181 </MOBYRegistration>";
182 }
183 =cut
184
185
186
187
188
189
190
191 =head1 METHODS
192
193
194
195 =head2 new
196
197 Title : new
198 Usage : deprecated
199
200 =cut
201
202 sub new {
203 my ( $caller, %args ) = @_;
204 print STDERR "\nuse of MOBY::Central->new is deprecated\n";
205 return 0;
206 }
207
208 =head2 registerObjectClass
209
210 The registerObjectClass call is:
211
212 =over 3
213
214 =item * used to register a new object Class into the Class ontology
215
216 =item * can envision this as simply registering a new node into the Class ontology graph, and creating the primary connections from that node.
217
218 =item * MOBY, by default, supports three types of Class Relationships: ISA, HAS, and HASA (these are the relationship ontology terms)
219
220 =over 3
221
222 =item * Foo ISA bar is a straight inheritence, where all attributes of bar are guaranteed to be present in foo.
223
224 =item * foo HAS bar is a container type, where bar is an object inside of foo in one or more copies.
225
226 =item * foo HASA bar is a container type, where bar is an object inside of foo in one copy only
227
228 =back
229
230 =item * notice that, in a HAS and HASA relationships, it is necessary to indicate an article name for each contained object type. Thus, for example, you could have a sequence object that contained a String object with name "nucleotideSequence" and an Integer object with the name "sequenceLength".
231
232 =back
233
234 Input XML :
235
236 <registerObjectClass>
237 <objectType>NewObjectType</objectType>
238 <Description><![CDATA[
239 human readable description
240 of data type]]>
241 </Description>
242 <Relationship relationshipType="RelationshipOntologyTerm">
243 <objectType articleName="SomeName">ExistingObjectType</objectType>
244 ...
245 ...
246 </Relationship>
247 ...
248 ...
249 <authURI>Your.URI.here</authURI>
250 <contactEmail>You@your.address.com</contactEmail>
251 </registerObjectClass>
252
253
254 Output XML :
255
256 ...Registration Object...
257
258
259 =cut
260
261 sub registerObjectClass {
262
263 # this contacts the ontology server to register
264 # the ontology and writes the resulting URI into
265 # the MOBY Central database
266 my ( $pkg, $payload ) = @_;
267 my ( $success, $message );
268 my $OntologyServer = &_getOntologyServer( ontology => 'object' );
269 my $RelOntologyServer = &_getOntologyServer( ontology => 'relationship' );
270 my ( $term, $desc, $relationships, $email, $auth, $clobber ) =
271 &_registerObjectPayload($payload);
272
273 unless ( defined $term && defined $desc && defined $auth && defined $email )
274 {
275 if ( $term =~ /FAILED/ ) { return &_error( "Malformed XML;", "" ); }
276 return &_error("Malformed XML; may be missing required parameters objectType, Description, authURI or contactEmail",
277 ""
278 );
279 }
280 return &_error( "Malformed authURI - must not have an http:// prefix", "" )
281 if $auth =~ '[/:]';
282 return &_error( "Malformed authURI - must take the form NNN.NNN.NNN", "" )
283 unless $auth =~ /\./;
284 return &_error("Malformed email - must be a valid email address of the form name\@organization.foo",
285 ""
286 )
287 unless $email =~ /\S\@\S+\.\S+/;
288 return &_error("Object name may not contain spaces or other characters invalid in a URN",
289 ""
290 )
291 if $term =~ /\s\"\&\<\>\[\]\^\`\{\|\}\~/;
292 if ( $term =~ m"^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))?" )
293 { # matches a URI
294 return &_error( "Object name may not be an URN or URI", "" ) if $1;
295 }
296 my $ISAs;
297
298 # validate that the final ontology will be valid by testing against existing relationships and such
299 while ( my ( $reltype, $obj ) = each %{$relationships} ) {
300 my ( $success, $message, $URI ) =
301 $RelOntologyServer->relationshipExists(
302 term => $reltype,
303 ontology => 'object'
304 ); # success = 1 if it does
305 ($success == 0) && return &_error( $message, $URI );
306 foreach ( @{$obj} ) {
307 ++$ISAs if ( $URI =~ /isa$/i );
308 my ( $objectType, $articleName ) = @{$_};
309 my ( $success, $message, $URI ) =
310 $OntologyServer->objectExists( term => $objectType )
311 ; # success = 1 if it does
312 ($success == 0) && return &_error( $message, $URI );
313 }
314 }
315 return &_error(
316 "Object must have exactly one ISA parent in the MOBY Object ontology")
317 unless $ISAs == 1;
318 $clobber = defined($clobber) ? $clobber : 0;
319 $clobber = 0
320 unless ( $clobber eq 0 || $clobber eq 1 || $clobber eq 2 ); # safety!
321 my ( $exists, $exists_message, $URI ) =
322 $OntologyServer->objectExists( term => $term ); # success = 1 if it does
323 ( ( $exists == 1 && !$clobber )
324 && return &_error( "Object $term already exists", $URI ) );
325 $clobber = 0
326 unless ($exists)
327 ; # it makes no sense to clobber something that doesnt' exist
328 if ($exists) {
329
330 if ( $clobber == 1 ) {
331 my ( $success, $message ) =
332 $OntologyServer->deprecateObject( term => $term );
333 ($success == 0) && return &_error( $message, $URI );
334 }
335 elsif ( $clobber == 2 ) {
336 my ( $success, $message ) =
337 $OntologyServer->deleteObject( term => $term );
338 ($success == 0) && return &_error( $message, $URI );
339 }
340 }
341
342 # now test if the object inherits from primitives... if so, abort
343 if ( keys %{$relationships} ) {
344 while ( my ( $reltype, $obj ) = each %{$relationships} ) {
345 next unless ($reltype =~ /isa/i); # we are only testing isa relationships here.
346 foreach ( @{$obj} ) {
347 my ( $objectType, $articleName ) = @{$_};
348 if (&_testObjectTypeAgainstPrimitives($objectType)){
349 return &_error( "Inheritance from Primitive data-types is now deprecated. You shold construct your object using a HASA relationship. for example, text-plain HASA string (as opposed to ISA string)", "" );
350 }
351 }
352 }
353 }
354
355 # should be good to go now...
356
357
358 ( $success, $message, $URI ) = $OntologyServer->createObject(
359 node => $term,
360 description => $desc,
361 authority => $auth,
362 contact_email => $email
363 );
364 ($success == 0) && return &_error( $message, $URI );
365 my @failures;
366 my $messages = "";
367 if ( keys %{$relationships} ) { # need to pull them out with ISA's first
368 foreach my $reltype(qw{ISA HASA HAS}){
369 my ( $obj ) = $relationships->{$reltype};
370 foreach ( @{$obj} ) {
371 my ( $objectType, $articleName ) = @{$_};
372 my ( $success, $message ) =
373 $OntologyServer->addObjectRelationship(
374 subject_node => $term,
375 relationship => $reltype,
376 object_node => $objectType,
377 articleName => $articleName,
378 authority => $auth,
379 contact_email => $email
380 );
381 unless ($success){
382 push @failures, $objectType;
383 $messages .= $message."; ";
384 }
385 }
386 }
387 }
388 if ( scalar(@failures) ) {
389 my ( $success, $message, $deleteURI ) =
390 $OntologyServer->deleteObject( term => $term )
391 ; # hopefully this situation will never happen!
392 ($success == 0) && return &_error(
393 "object failed ISA and/or HASA connections,
394 and subsequently failed deletion. This is a critical error,
395 and may indicate corruption of the MOBY Central registry.", $deleteURI
396 );
397 return &_error("object failed to register due to failure during registration of ISA/HASA relationships. Message returned was $messages"
398 . ( join ",", (@failures) ) . "\n",
399 ""
400 );
401 }
402 return &_success( "Object $term registered successfully.", $URI );
403 }
404
405 #Eddie - converted
406 sub _registerObjectPayload {
407 my ($payload) = @_; #EDDIE - assuming that payload is a string
408 my $Parser = XML::LibXML->new();
409 my $doc = $Parser->parse_string($payload);
410 my $Object = $doc->documentElement();
411 my $obj = $Object->nodeName;
412 return undef unless ( $obj eq 'registerObjectClass' );
413 my $term = &_nodeTextContent( $Object, "objectType" );
414 my $desc = &_nodeCDATAContent( $Object, "Description" );
415 my $authURI = &_nodeTextContent( $Object, "authURI" );
416 my $email = &_nodeTextContent( $Object, "contactEmail" );
417 my $clobber = &_nodeTextContent( $Object, "Clobber" );
418
419 #my @ISA = &_nodeArrayContent($Object, "ISA");
420 #my @HASA = &_nodeArrayExtraContent($Object, "HASA","articleName");
421 my %att_value;
422 my %relationships;
423 my $x = $doc->getElementsByTagName("Relationship");
424 my $no_relationships = $x->size;
425 for ( my $n = 1 ; $n <= $no_relationships ; ++$n ) {
426 my $relationshipType =
427 $x->get_node($n)->getAttributeNode('relationshipType')
428 ; # may or may not have a name
429 if ($relationshipType) {
430 $relationshipType = $relationshipType->getValue();
431 }
432 else {
433 return
434 "FAILED! must include a relationshipType in every relationship\n";
435 }
436 my @child = $x->get_node($n)->childNodes;
437 foreach (@child) {
438 next unless $_->nodeType == ELEMENT_NODE;
439 my $article =
440 $_->getAttributeNode('articleName'); # may or may not have a name
441 if ($article) { $article = $article->getValue() }
442 my @child2 = $_->childNodes;
443 foreach (@child2) {
444
445 #print getNodeTypeName($_), "\t", $_->toString,"\n";
446 next unless $_->nodeType == TEXT_NODE;
447 push @{ $relationships{$relationshipType} },
448 [ $_->toString, $article ];
449 }
450 }
451 }
452 return ( $term, $desc, \%relationships, $email, $authURI, $clobber );
453 }
454
455 sub _testObjectTypeAgainstPrimitives{
456 # THIS SUBROUTINE NEEDS TO BE REMOVED AND PLACED INTO THE ONTOLOGY SERVER
457 # one day when MOBY Central and the ontologies are separated properly
458 my ($type) = @_;
459 my $OS = MOBY::OntologyServer->new(ontology => 'object');
460 # get the inputlsid
461 my ($success, $desc, $inputlsid) = $OS->objectExists(term => $type);
462
463 my $CONF = MOBY::Config->new;
464 my @primitives = @{$CONF->primitive_datatypes}; # get the list of known primitive datatypes
465 my $x = 0; # set flag down
466 # convert everything to an LSID first
467
468 my @primitive_lsids = map{my ($s, $d, $l) = $OS->objectExists(term => $_); $l} @primitives;
469
470 map {($x=1) if ($inputlsid eq $_)} @primitive_lsids; # test primitives against this one
471
472 my $OSrel = MOBY::OntologyServer->new(ontology => 'relationship');
473 my ($exists1, $desc2, $isalsid) = $OSrel->relationshipExists(term => 'isa', ontology => 'object');
474
475 my $relationships = $OS->Relationships(
476 ontology => 'object',
477 term => $type,
478 relationship => $isalsid,
479 direction => 'root',
480 expand => 1);
481 #relationships{relationship} = [[lsid1,articleNmae], [lsid2, articleName], [lsid3, articleName]]
482 my ($isa) = keys(%$relationships); # can only be one key returned, and must be isa in this case
483 my @ISAlist;
484 (@ISAlist = @{$relationships->{$isa}}) if ($relationships->{$isa}) ;
485 # for each of the inherited parents, check their articleNames
486 foreach my $ISA(@ISAlist){ # $ISA = [lsid, articleName] (but articleName shuld be null anyway in this case)
487 my $what_it_is = $ISA->{lsid};
488 # my $articleName = $ISA->{articleName}
489 map {($x=1) if ($what_it_is eq $_)} @primitive_lsids; # test primitives against this one
490 }
491 return $x; # return flag state
492 }
493
494
495
496 =head2 deregisterObjectClass
497
498 =over 3
499
500 =item * used to remove an Object Class from the Class ontology
501
502 =item * this will not be successful until you respond positively to an email sent to the address that you provided when registering that object.
503
504 =item * you may only deregister Classes that you yourself registered!
505
506 =item * you may not deregister Object Classes that are being used as input or output by ANY service
507
508 =item * you may not deregister Object Classes that are in a ISA or HASA relationship to any other Object Class.
509
510 =back
511
512
513 Input XML :
514
515 <deregisterObjectClass>
516 <objectType>ObjectOntologyTerm</objectType>
517 </deregisterObjectClass>
518
519 Ouptut XML :
520
521 ...Registration Object...
522
523 =cut
524
525 sub deregisterObjectClass {
526 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
527 my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
528
529 my ( $pkg, $payload ) = @_;
530 my $OntologyServer = &_getOntologyServer( ontology => 'object' );
531 return &_error( "Message Format Incorrect", "" ) unless ($payload);
532 my ($class) = &_deregisterObjectPayload($payload);
533 $debug && &_LOG("deregister object type $class\n");
534 return &_error( "Must include class of object to deregister", "" )
535 unless ($class);
536 my ( $success, $message, $existingURI ) =
537 $OntologyServer->objectExists( term => $class );
538 return &_error( "Object class $class does not exist", "" )
539 unless ($existingURI);
540
541 my $errormsg = $adaptor->check_object_usage(type => $existingURI);
542 return &_error(
543 "Object class $class is used by a service and may not be deregistered",
544 ""
545 )
546 if ($errormsg);
547
548 my ( $success2, $message2, $URI ) =
549 $OntologyServer->deleteObject( term => $class );
550 ($success2 == 0) && return &_error( $message2, $URI );
551 return &_success( $message2, $URI );
552 }
553
554 #Eddie - converted
555 sub _deregisterObjectPayload {
556 my ($payload) = @_;
557 my $Parser = XML::LibXML->new();
558 my $doc = $Parser->parse_string($payload);
559 my $Object = $doc->getDocumentElement();
560 my $obj = $Object->nodeName;
561 return undef unless ( $obj eq 'deregisterObjectClass' );
562 return &_nodeTextContent( $Object, "objectType" );
563 }
564
565 =head2 registerServiceType
566
567 =over 3
568
569
570 =item * used to register a new node in the Service Ontology
571
572 =item * the ISA ontology terms must exist or this registration will fail.
573
574 =item * all parameters are required.
575
576 =item * email must be valid for later deregistration or updates
577
578 =back
579
580
581 Input XML :
582
583 <registerServiceType>
584 <serviceType>NewServiceType</serviceType>
585 <contactEmail>your_name@contact.address.com</contactEmail>
586 <authURI>Your.URI.here</authURI>
587 <Description>
588 <![CDATA[ human description of service type here]]>
589 </Description>
590 <Relationship relationshipType="RelationshipOntologyTerm">
591 <serviceType>ExistingServiceType</serviceType>
592 <serviceType>ExistingServiceType</serviceType>
593 </Relationship>
594 <Relationship relationshipType="AnotherRelationship">
595 ....
596 </Relationship>
597 </registerServiceType>
598
599
600 Output XML :
601
602 ...Registration Object...
603
604 =cut
605
606 sub registerServiceType {
607
608 # this contacts the ontology server to register
609 # the ontology and writes the resulting URI into
610 # the MOBY Central database
611 my ( $pkg, $payload ) = @_;
612 my ( $success, $message, $URI );
613 my $OntologyServer = &_getOntologyServer( ontology => 'service' );
614 $debug
615 && &_LOG(
616 "\n\npayload\n**********************\n$payload\n***********************\n\n"
617 );
618 my ( $term, $desc, $relationships, $email, $auth ) =
619 &_registerServiceTypePayload($payload);
620 $debug
621 && &_LOG(
622 "\n\nterm $term\ndesc $desc\nrel $relationships\nemail $email\nauth $auth"
623 );
624 unless ( defined $term && defined $desc && defined $auth && defined $email )
625 {
626
627 if ( $term =~ /FAILED/ ) {
628 return &_error( "Malformed XML\n $term", "" );
629 }
630 return &_error(
631 "Malformed XML\n may be missing required parameters serviceType, Description, authURI or contactEmail",
632 ""
633 );
634 }
635 return &_error( "Malformed authURI - must not have an http:// prefix", "" )
636 if $auth =~ '[/:]';
637 return &_error( "Malformed authURI - must take the form NNN.NNN.NNN", "" )
638 unless $auth =~ /\./;
639 return &_error(
640 "Malformed email - must be a valid email address of the form name\@organization.foo",
641 ""
642 )
643 unless $email =~ /\S\@\S+\.\S+/;
644
645 # validate that the final ontology will be valid
646 my ( $exists, $exists_message, $existingURI ) =
647 $OntologyServer->serviceExists( term => $term ); # success = 1 if it does
648 ( ( $exists == 1 )
649 && return &_error( "Service type $term already exists", $existingURI )
650 );
651
652 # is the relationship valid?
653 my $OSrel = MOBY::OntologyServer->new( ontology => 'relationship' );
654 if ( keys %{$relationships} ) {
655 while ( my ( $reltype, $obj ) = each %{$relationships} ) {
656 my ( $success, $desc, $URI ) = $OSrel->relationshipExists(
657 term => $reltype,
658 ontology => 'service'
659 );
660 ( !$success ) && return &_error(
661 "Relationship type $reltype does not exist in the relationship ontology",
662 ""
663 );
664 }
665 }
666
667 # are the predicate service types valid?
668 my $OSsrv = MOBY::OntologyServer->new( ontology => 'service' );
669 if ( keys %{$relationships} ) {
670 while ( my ( $srvtype, $svcs ) = each %{$relationships} ) {
671 foreach my $svc ( @{$svcs} ) {
672 my ( $success, $desc, $URI ) =
673 $OSsrv->serviceExists( term => $svc );
674 ( !$success ) && return &_error(
675 "Service type $srvtype does not exist in the service ontology",
676 ""
677 );
678 }
679 }
680 }
681
682 # hunky dorey. Now register!
683 ( $success, $message, $URI ) = $OntologyServer->createServiceType(
684 node => $term,
685 description => $desc,
686 authority => $auth,
687 contact_email => $email
688 );
689 ($success == 0) && return &_error( $message, $URI );
690 my @failures;
691 if ( keys %{$relationships} ) {
692 while ( my ( $reltype, $obj ) = each %{$relationships} ) {
693 foreach my $serviceType ( @{$obj} ) {
694 my ( $success, $message ) =
695 $OntologyServer->addServiceRelationship(
696 subject_node => $term,
697 relationship => $reltype,
698 object_node => $serviceType,
699 authority => $auth,
700 contact_email => $email
701 );
702 ($success == 0) && push @failures, $serviceType;
703 }
704 }
705 }
706 if ( scalar(@failures) ) {
707 my ( $success, $message, $deleteURI ) =
708 $OntologyServer->deleteServiceType( term => $term )
709 ; # hopefully this situation will never happen!
710 ($success == 0) && return &_error(
711 "Service registration failed ISA connections,
712 and subsequently failed deletion. This is a critical error,
713 and may indicate corruption of the MOBY Central registry", $deleteURI
714 );
715 return &_error(
716 "Service failed to register due to failure during registration of relationships"
717 . ( join ",", (@failures) ) . "\n",
718 ""
719 );
720 }
721 return &_success( "Service type $term registered successfully.", $URI );
722 }
723
724 #Eddie - converted
725 sub _registerServiceTypePayload {
726 my ($payload) = @_;
727 $debug && &_LOG("_registerServiceTypePayload payload=$payload\n");
728 my $Parser = XML::LibXML->new();
729 my $doc = $Parser->parse_string($payload);
730 my $Object = $doc->getDocumentElement();
731 my $obj = $Object->nodeName;
732 return undef unless ( $obj eq 'registerServiceType' );
733 my $type = &_nodeTextContent( $Object, "serviceType" );
734 my $email = &_nodeTextContent( $Object, "contactEmail" );
735 my $auth = &_nodeTextContent( $Object, "authURI" );
736 my $desc = &_nodeCDATAContent( $Object, "Description" );
737 my %relationships;
738 my $x = $doc->getElementsByTagName("Relationship");
739 my $no_relationships = $x->size();
740
741 for ( my $n = 1 ; $n <= $no_relationships ; ++$n ) {
742 my $relationshipType =
743 $x->get_node($n)->getAttributeNode('relationshipType')
744 ; # may or may not have a name
745 if ($relationshipType) {
746 $relationshipType = $relationshipType->getValue();
747 }
748 else {
749 return
750 "FAILED! must include a relationshipType in every relationship\n";
751 }
752 my @child = $x->get_node($n)->childNodes;
753 foreach (@child) {
754 next unless $_->nodeType == ELEMENT_NODE;
755 my @child2 = $_->childNodes;
756 foreach (@child2) {
757
758 #print getNodeTypeName($_), "\t", $_->toString,"\n";
759 next unless $_->nodeType == TEXT_NODE;
760 push @{ $relationships{$relationshipType} }, $_->toString;
761 }
762 }
763 }
764 $debug
765 && &_LOG(
766 "got $type, $desc, \%relationships, $email, $auth from registerServiceTypePayload\n"
767 );
768 return ( $type, $desc, \%relationships, $email, $auth );
769 }
770
771 =head2 deregisterServiceType
772
773 =over 3
774
775 =item * used to deregister a Service term from the Service ontology
776
777 =item * will fail if any services are instances of that Service Type
778
779 =item * will fail if any Service Types inherit from that Service Type.
780
781 =back
782
783
784 Input XML :
785
786 <deregisterServiceType>
787 <serviceType>ServiceOntologyTerm</serviceType>
788 </deregisterServiceType>
789
790 Ouptut XML :
791
792 ...Registration Object...
793
794 =cut
795
796 sub deregisterServiceType {
797 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
798 my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
799
800 my ( $pkg, $payload ) = @_;
801 my $OntologyServer = &_getOntologyServer( ontology => 'service' );
802 return &_error( "Message Format Incorrect", "" ) unless ($payload);
803 my ($term) = &_deregisterServiceTypePayload($payload);
804 $debug && &_LOG("deregister serviceType accession $term\n");
805 return &_error(
806 "Must include an accession number to deregister a serviceType", "" )
807 unless ($term);
808 my ( $success, $message, $existingURI ) = $OntologyServer->serviceExists( term => $term ); # hopefully this situation will never happen!
809 return &_error( "Service Type $term does not exist in the ontology", "" )
810 unless ($existingURI);
811
812 my $result = $adaptor->query_service_instance(service_type_uri => $existingURI);
813 my $row = shift(@$result);
814 my $lsid = $row->{lsid};
815
816 return &_error( "A registered service depends on this service type", "" )
817 if ($lsid);
818 my ( $success2, $message2, $deleteURI ) =
819 $OntologyServer->deleteServiceType( term => $term )
820 ; # hopefully this situation will never happen!
821 (($success2 == 0)) && return &_error( $message2, $deleteURI );
822 return &_success( "Service type $term deleted.", $deleteURI );
823 }
824
825 #Eddie - converted
826 sub _deregisterServiceTypePayload {
827 my ($payload) = @_;
828 my $Parser = XML::LibXML->new();
829 my $doc = $Parser->parse_string($payload);
830 my $Object = $doc->getDocumentElement();
831 my $obj = $Object->nodeName; #Eddie- unsure
832 return undef unless ( $obj eq 'deregisterServiceType' );
833 return &_nodeTextContent( $Object, "serviceType" );
834 }
835
836 =head2 registerNamespace
837
838 =over 3
839
840
841 =item * used to register a new Namespace in the Namespace controlled vocabulary
842
843 =item * must provide a valid email address
844
845 =item * all parameters are required.
846
847 =back
848
849
850 Input XML :
851
852 <registerNamespace>
853 <namespaceType>NewNamespaceHere</namespaceType>
854 <contactEmail>your_name@contact.address.com</contactEmail>
855 <authURI>Your.URI.here</authURI>
856 <Description>
857 <![CDATA[human readable description]]>
858 </Description>
859 </registerNamespace>
860
861 Output XML :
862
863 ...Registration Object...
864
865
866 =cut
867
868 sub registerNamespace {
869
870 # this contacts the ontology server to register
871 # the ontology and writes the resulting URI into
872 # the MOBY Central database
873 my ( $pkg, $payload ) = @_;
874 my ( $success, $message );
875 my $OntologyServer = &_getOntologyServer( ontology => 'namespace' );
876 $debug
877 && &_LOG(
878 "\n\npayload\n**********************\n$payload\n***********************\n\n"
879 );
880 my ( $term, $auth, $desc, $email ) = &_registerNamespacePayload($payload);
881 $debug && &_LOG("\n\nterm $term\ndesc $desc\nemail $email\nauth $auth");
882 unless ( defined $term && defined $desc && defined $auth && defined $email )
883 {
884 return &_error(
885 "Malformed XML; may be missing required parameters namespaceType, Description, authURI or contactEmail",
886 ""
887 );
888 }
889 return &_error( "Malformed authURI - must not have an http:// prefix", "" )
890 if $auth =~ '[/:]';
891 return &_error( "Malformed authURI - must take the form NNN.NNN.NNN", "" )
892 unless $auth =~ /\./;
893 return &_error(
894 "Malformed email - must be a valid email address of the form name\@organization.foo",
895 ""
896 )
897 unless $email =~ /\S\@\S+\.\S+/;
898 my ( $exists, $exists_message, $URI ) =
899 $OntologyServer->namespaceExists( term => $term )
900 ; # success = 1 if it does
901 ( ( $exists == 1 )
902 && return &_error( "Namespace $term already exists", $URI ) );
903 ( $success, $message, $URI ) = $OntologyServer->createNamespace(
904 node => $term,
905 description => $desc,
906 authority => $auth,
907 contact_email => $email
908 );
909 ($success == 0) && return &_error( $message, $URI );
910 return &_success( "Namespace type $term registered successfully.", $URI );
911 }
912
913 #Eddie - converted
914 sub _registerNamespacePayload {
915 my ($payload) = @_;
916 my $Parser = XML::LibXML->new();
917 my $doc = $Parser->parse_string($payload);
918 my $Object = $doc->getDocumentElement();
919 my $obj = $Object->nodeName;
920 return undef unless ( $obj eq 'registerNamespace' );
921 my $type = &_nodeTextContent( $Object, "namespaceType" );
922 my $authURI = &_nodeTextContent( $Object, "authURI" );
923 my $desc = &_nodeCDATAContent( $Object, "Description" );
924 my $contact = &_nodeTextContent( $Object, "contactEmail" );
925 return ( $type, $authURI, $desc, $contact );
926 }
927
928 =head2 deregisterNamespace
929
930 =over
931
932 =item * used to remove a Namespace from the controlled vocabulary
933
934 =item * will fail if that namespace is being used by any services
935
936 =item * you will recieve an email for confirmation of the deregistration
937
938 =back
939
940
941 Input XML :
942
943 <deregisterNamespace>
944 <namespaceType>MyNamespace</namespaceType>
945 </deregisterNamespace>
946
947 Ouptut XML :
948
949 ...Registration Object...
950
951
952 =cut
953
954 sub deregisterNamespace {
955 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
956 my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
957
958 my ( $pkg, $payload ) = @_;
959 my $OntologyServer = &_getOntologyServer( ontology => 'namespace' );
960 return &_error( "Message Format Incorrect", "" ) unless ($payload);
961 my ($term) = &_deregisterNamespacePayload($payload);
962 $debug && &_LOG("deregister namespaceType accession $term\n");
963 return &_error( "Must include a Namespace type to deregister.", "" )
964 unless ($term);
965 my ( $success, $message, $existingURI ) =
966 $OntologyServer->namespaceExists( term => $term );
967 return &_error( "Namespace Type $term does not exist", "" )
968 unless ($existingURI);
969 my ($err, $errstr) = $adaptor->check_namespace_usage(namespace_type_uris => $existingURI,
970 type => $term);
971 return &_error( $errstr, "")
972 if ($err);
973
974 my ( $success2, $message2, $URI ) =
975 $OntologyServer->deleteNamespace( term => $term );
976 ($success2 == 0) && return &_error( $message2, $URI );
977 return &_success( "Namespace type $term deregistered successfully.", $URI );
978 }
979
980 #Eddie - converted
981 sub _deregisterNamespacePayload {
982 my ($payload) = @_;
983 my $Parser = XML::LibXML->new();
984 my $doc = $Parser->parse_string($payload);
985 my $Object = $doc->getDocumentElement();
986 my $obj = $Object->nodeName;
987 return undef unless ( $obj eq 'deregisterNamespace' );
988 return &_nodeTextContent( $Object, "namespaceType" );
989 }
990
991 =head2 registerService
992
993 =over 3
994
995 =item * all elements are required
996
997 =item * a service must have at least one Input OR Output Object Class. Either Input or Output may be blank to represent "PUT" or "GET" services respectively
998
999 =item * the contactEmail address must be valid, as it is used to authorize deregistrations and changes to the service you registered.
1000
1001 =item * the "authoritativeService" tag is used to indicate whether or not the registered service is "authoritative" for that transformation. i.e. if anyone else were to perform the same transformation they would have to have obtained the information to do so from you. This is similar to, but not necessarily identical to, mirroring someone elses data, since the data in question may not exist prior to service invocation.
1002
1003 =item * only Input Secondary articles are defined during registration; Output Secondary objects are entirely optional and may or may not be interpreted Client-side using their articleName tags.
1004
1005 =item * Service Categories:
1006
1007 =over 3
1008
1009 =item * moby - for services that use the MOBY SOAP messaging format and object structure (i.e. the objects used in service transaction inherit from the root 'Object' Class in the MOBY Class ontology).
1010
1011 =over 2
1012
1013 =item * authURI - a URI representing your organization (e.g. yourdomain.com); no http-prefix, and no trailing path information is allowed.
1014
1015 =item * serviceName - an arbitrary, but unique, name for your service within your authURI namespace
1016
1017 =item * URL - the URL to a SOAP CGI server that can invoke a method as described by your serviceName
1018
1019 =back
1020
1021 =item * wsdl - for other SOAP services that do not use the MOBY messaging format. The other elements in the registration should be interpreted as follows:
1022
1023 =over 2
1024
1025 =item * authURI - a URI representing your organization (e.g. yourdomain.com); no http-prefix, and no trailing path information is allowed.
1026
1027 =item * serviceName - an arbitrary, but unique, name for your service within your authURI namespace
1028
1029 =item * URL - the URL from which a WSDL document describing your service can be retrieved by an HTTP GET call.
1030
1031 =back
1032
1033 =item * Comments about Input and Output for MOBY and non-MOBY services
1034
1035 =over 2
1036
1037 =item * in "moby" services, the input and output messaging structure is defined by the BioMOBY API, and the services use data Objects that are defined in the Class ontology as inheriting from the root "Object" Class.
1038
1039 =item * For "wsdl" services, there is additional flexibility:
1040
1041 =over 2
1042
1043 =item * Similar to a "moby" service, your "wsdl" service must consume/produce named data types. These are represented as LSID's
1044
1045 =item * YOU DO NOT NEED TO REGISTER THESE DATA TYPES in MOBY Central; it is up to you what your LSID's represent, and MOBY Central WILL NOT try to resolve them!
1046
1047 =item * You may mix ontologies when describing your service - i.e. you may freely use any MOBY Object as your input or (XOR) your output and use a non-MOBY object (LSID) for the alternate so long as you follow the MOBY message structure for the parameter that uses the MOBY Object
1048
1049 =over 2
1050
1051 =item * You may register, for example, a service that consumes a non-MOBY data Class and outputs a MOBY data class, so long as you follow the MOBY Messaging format for the output data
1052
1053 =item * You may register, for example, a service that consumes a MOBY data Class and outputs a non-MOBY data class, so long as you follow the MOBY Messaging format for the input data
1054
1055 =item * NOTE: Nether of the cases above are considered MOBY services, and are therefore described in the category of "soap" service
1056
1057 =back
1058
1059 =back
1060
1061 =item * secondaryArticles - not applicable; should be left out of message.
1062
1063 =back
1064
1065 =back
1066
1067 =back
1068
1069
1070 Input XML :
1071
1072 <registerService>
1073 <Category>moby</Category> <!-- one of 'moby', 'cgi', 'wsdl' ; currently only 'moby' and 'wsdl' services are fully supported -->
1074 <serviceName>YourServiceNameHere</serviceName>
1075 <serviceType>TypeOntologyTerm</serviceType>
1076 <authURI>your.URI.here</authURI>
1077 <URL>http://URL.to.your/Service.script</URL>;
1078 <contactEmail>your_name@contact.address.com</contactEmail>
1079 <authoritativeService>1 | 0 </authoritativeService>
1080 <Description><![CDATA[
1081 human readable COMPREHENSIVE description of your service]]>
1082 </Description>
1083 <Input>
1084 <!-- zero or more Primary (Simple and/or Collection) articles -->
1085 </Input>
1086 <secondaryArticles>
1087 <!-- zero or more INPUT Secondary articles -->
1088 </secondaryArticles>
1089 <Output>
1090 <!-- zero or more Primary (Simple and/or Collection) articles -->
1091 </Output>
1092 </registerService>
1093
1094 Output XML :
1095
1096 ...Registration Object...
1097
1098 There are two forms of Primary articles:
1099
1100 =over 3
1101
1102 =item * Simple - the article consists of a single MOBY Object
1103
1104 =item * Collection - the article consists of a collection ("bag") of MOBY Objects (not necessarily the same object type).
1105
1106 =over 3
1107
1108 =item * Their number/order is not relevant, nor predictable
1109
1110 =item * If order is important to the service provider, then a collection should not be used, rather the collection should be broken into named Simple parameters. This may impose limitations on the the types of services that can be registered in MOBY Central. If it becomes a serious problem, a new Primary article type will be added in a future revision.
1111
1112 =item * The use of more than one Class in a collection is difficult to interpret, though it is equally difficult to envision a service that would require this. It is purposely left losely defined since any given Service Instance can tighten up this definition during the registration process.
1113
1114 =item * A collection may contain zero or more Objects of each of the Classes defined in the XML during Service Instance registration.
1115
1116 =over 3
1117
1118 =item * Each distinct Object Class only needs to be included once in the XML. Additional entries of that Class within the same Collection definition must be ignored.
1119
1120 =back
1121
1122 =back
1123
1124 =back
1125
1126 An example of the use of each of these might be another BLAST service, where you provide the sequences that make up the Blast database as well as the sequence to Blast against it. The sequences used to construct the database might be passed as a Collection input article containing multiple Sequence Objects, while the sequence to Blast against it would be a Simple input article consisting of a single Sequence Object.
1127
1128 There is currently only one form of Secondary article:
1129
1130 =over 3
1131
1132 =item * Secondary - the article may or may not be specifically configured by the client as Input, and may or may not be returned by the Service as output.
1133
1134 =over 3
1135
1136 =item * In the case of inputs, they are generally user-configurable immediately prior to service invocation.
1137
1138 =item * During service invocation a Client must send all Secondary articles defined in the Service Instance, even if no value has been provided either as default, or Client-side.
1139
1140 =item * Secondary articles that are considered "required" by the Service should be registered with a default value.
1141
1142 =item * The Service may fail if an unacceptable value is passed for any Secondary Article.
1143
1144 =back
1145
1146 =back
1147
1148
1149 Articles are, optionally, named using the articleName attribute. This might be used if, for example, the service requires named inputs. The order of non-named articles in a single Input or Output set MUST not be meaningful.
1150
1151 The XML structure of these articles is as follows:
1152
1153 =over 3
1154
1155 =item * Simple (note that the lsid attribute of the objectType and Namespace element need only be present in the article when it is present in a response document from MOBY Central such as the result of a findService call. These attributes are ignored by MOBY Central when they appear in input messages such as registerService)
1156
1157 <Simple articleName="NameOfArticle">
1158 <objectType lsid='urn:lsid:...'>ObjectOntologyTerm</objectType>
1159 <Namespace lsid='urn:lsid:...'>NamespaceTerm</Namespace>
1160 <Namespace lsid='urn:lsid:...'>...</Namespace><!-- one or more... -->
1161 </Simple>
1162
1163 =item * Collection note that articleName of the contained Simple objects is not required, and is ignored.
1164
1165
1166 <Collection articleName="NameOfArticle">
1167 <Simple>......</Simple> <!-- Simple parameter type structure -->
1168 <Simple>......</Simple> <!-- DIFFERENT Simple parameter type (used only when multiple Object Classes appear in a collection) -->
1169 </Collection>
1170
1171 =item * Secondary
1172
1173
1174 <Parameter articleName="NameOfArticle">
1175 <datatype>Integer|Float|String|DateTime</datatype>
1176 <default>...</default> <!-- any/all of these -->
1177 <max>...</max> <!-- ... -->
1178 <min>...</min> <!-- ... -->
1179 <enum>...<enum> <!-- ... -->
1180 <enum>...<enum> <!-- ... -->
1181 </Parameter>
1182
1183 =back
1184
1185
1186 =cut
1187
1188 # inputXML (FOR CGI GET SERVICES):
1189 # <registerService>
1190 # <Category>cgi</Category>
1191 # <serviceName>YourServiceNameHere</serviceName>
1192 # <serviceType>YourServiceTypeHere</serviceType>
1193 # <authURI>your.URI.here</authURI>
1194 # <contactEmail>blah@blow.com</contactEmail>
1195 # <URL>http://URL.to.your/CGI.pl</URL>
1196 # <authoritativeService>your.URI.here</authoritativeService>
1197 # <Input>
1198 # <!-- zero or more pimary (simple or collection) articles -->
1199 # </Input>
1200 # <Output>
1201 # <!-- zero or more pimary (simple or collection) articles -->
1202 # </Output>
1203 # <secondaryArticles>
1204 # </secondaryArticles>
1205 # <Description><![CDATA[
1206 # human readable description of your service]]>
1207 # </Description>
1208 # </registerService>
1209
1210 sub registerService {
1211 my ( $pkg, $payload ) = @_;
1212 my (
1213 $serviceName, $serviceType, $AuthURI,
1214 $contactEmail, $URL, $authoritativeService,
1215 $desc, $Category, $INPUTS,
1216 $OUTPUTS, $SECONDARY, $signatureURL
1217 )
1218 = &_registerServicePayload($payload);
1219
1220 #--------RDFagent call----------------------------------------
1221
1222 if ( defined $signatureURL ) {
1223 my $ch = 0;
1224 my $i;
1225 foreach $i ( $serviceName, $serviceType, $AuthURI, $contactEmail, $URL,
1226 $desc, $Category )
1227 {
1228 if ( defined $i ) {
1229 $ch = 1;
1230 }
1231 }
1232
1233 if ( $ch == 0 ) {
1234
1235 my $conf = MOBY::Config->new();
1236 my $path = $conf->{mobycentral}->{rdfagent};
1237 my $rez = system( $path. " " . $signatureURL );
1238 return &_success( "The RDFagent call was successful. Report will send to you by E-mail",
1239 ""
1240 )
1241 if ( $rez == 0 );
1242 return &_error(
1243 "Some problem with a connection or RDF model building", "" )
1244 if ( $rez != 0 );
1245 }
1246 }
1247
1248 #---------------------------------------------------------------
1249 $authoritativeService = defined($authoritativeService) ? 1 : 0;
1250 my $error;
1251 $error .= "missing serviceName \n" unless defined $serviceName;
1252 $error .= "missing serviceType \n" unless defined $serviceType;
1253 $error .= "invalid character string for serviceName. Must start with a letter followed by [A-Za-z0-9_]\n" if ($serviceName =~ /^[^A-Za-z]/);
1254 $error .= "invalid character string for serviceName. Must start with a letter followed by [A-Za-z0-9_]\n" if ($serviceName =~ /^.+?[^A-Za-z0-9_]/);
1255
1256 # $error .="missing signatureURL \n" unless defined $signatureURL;
1257 $error .= "missing authURI \n" unless defined $AuthURI;
1258 $error .= "missing contactEmail \n" unless defined $contactEmail;
1259 return &_error( "Malformed authURI - must not have an http:// prefix", "" )
1260 if $AuthURI =~ '[/:]';
1261 return &_error( "Malformed authURI - must take the form NNN.NNN.NNN", "" )
1262 unless $AuthURI =~ /\./;
1263 return &_error("Malformed email - must be a valid email address of the form name\@organization.foo","")
1264 unless $contactEmail =~ /\S\@\S+\.\S+/;
1265 $error .= "missing URL \n" unless defined $URL;
1266 $error .= "missing description \n" unless defined $desc;
1267 $error .= "missing Category \n" unless defined $Category;
1268 return &_error( "malformed payload $error\n\n", "" ) if ($error);
1269 return &_error(
1270 "Category may take the (case sensitive) values 'moby', 'cgi', 'soap'\n",
1271 ""
1272 )
1273 unless (
1274 ( $Category eq "wsdl" )
1275
1276 # || ($Category eq "cgi")
1277 || ( $Category eq "moby" )
1278 );
1279 $debug && &_LOG("Entering switch with $Category method\n");
1280 return &_error("Service categories other than 'moby' and 'wsdl' are not yet implemented","")
1281 unless ( ( $Category eq "moby" ) || ( $Category eq "wsdl" ) );
1282
1283 #test the existence of the service
1284 return &_error( "This service already exists", "" ) if (MOBY::service_instance->new(
1285 servicename => $serviceName,
1286 authority_uri => $AuthURI,
1287 test => 1));
1288
1289
1290 my @IN = @{$INPUTS};
1291 my @OUT = @{$OUTPUTS};
1292 my @SECS = @{$SECONDARY};
1293 return &_error(
1294 "must include at least one input and/or one output object type", "" )
1295 unless ( scalar @IN || scalar @OUT );
1296 my %objects_to_be_validated;
1297 foreach ( @IN, @OUT ) {
1298
1299 foreach my $objectName ( &_extractObjectTypes($_) ) {
1300 $objects_to_be_validated{$objectName} = 1;
1301 }
1302 }
1303 my $OS = MOBY::OntologyServer->new( ontology => 'object' );
1304 foreach ( keys %objects_to_be_validated ) {
1305 my ( $valid, $message, $URI ) = $OS->objectExists( term => $_ );
1306 return &_error( "$message", "$URI" )
1307 unless ( $valid
1308 || ( ( $_ =~ /urn:lsid/i ) && !( $_ =~ /urn:lsid:biomoby.org/i ) )
1309 ); # either valid, or a non-moby LSID
1310 }
1311 $debug
1312 && &_LOG(
1313 "\n\n\aall objects okay - either valid MOBY objects, or LSID's\n");
1314 $OS = MOBY::OntologyServer->new( ontology => 'service' );
1315 my ( $valid, $message, $URI ) = $OS->serviceExists( term => $serviceType );
1316
1317 #print STDERR "\n\nChecking $URI\n\n";
1318 return &_error( "$message", "$URI" )
1319 unless (
1320 $valid
1321 || ( ( $serviceType =~ /urn:lsid/i )
1322 && !( $serviceType =~ /urn:lsid:biomoby.org/i ) )
1323 ); # either valid, or a non-MOBY LSID
1324 #print STDERR "\n\nChecking $URI OK!!\n\n";
1325 # right, registration should be successful now!
1326 my $SVC = MOBY::service_instance->new(
1327 category => $Category,
1328 servicename => $serviceName,
1329 service_type => $serviceType,
1330 authority_uri => $AuthURI,
1331 url => $URL,
1332 contact_email => $contactEmail,
1333 authoritative => $authoritativeService,
1334 description => $desc,
1335 signatureURL => $signatureURL,
1336 );
1337 return &_error( "Service registration failed for unknown reasons", "" ) if ( !defined $SVC );
1338
1339 $debug && &_LOG("new service instance created\n");
1340
1341 foreach my $IN (@IN) {
1342 my ( $success, $msg ) = &_registerArticles( $SVC, "input", $IN, undef );
1343 unless ( $success == 1 ){
1344 $SVC->DELETE_THYSELF;
1345 return &_error("Registration Failed During INPUT Article Registration: $msg", "" )
1346 }
1347 }
1348 foreach my $OUT (@OUT) {
1349 my ( $success, $msg ) = &_registerArticles( $SVC, "output", $OUT, undef );
1350 unless ( $success == 1 ){
1351 $SVC->DELETE_THYSELF;
1352 return &_error("Registration Failed During OUTPUT Article Registration: $msg", "" )
1353 }
1354 }
1355 foreach my $SEC (@SECS) {
1356 my ( $success, $msg ) = &_registerArticles( $SVC, "secondary", $SEC, undef );
1357 unless ( $success == 1 ){
1358 $SVC->DELETE_THYSELF;
1359 return &_error("Registration Failed During SECONDARY Article Registration: $msg", "" )
1360 }
1361 }
1362
1363 # we're going to do a findService here to find the service that we just created
1364 # and use the resulting XML to create a MOBY::Client::ServiceInstance object
1365 # that we can then use to retrieve the RDF for that service signature.
1366 # this is roundabout, I agree, but it is the most re-usable way to go at
1367 # the moment.
1368 my ( $si, $reg ) = &findService(
1369 '', "<findService>
1370 <authURI>$AuthURI</authURI>;
1371 <serviceName>$serviceName</serviceName>;
1372 </findService>"
1373 );
1374 unless ($si) {
1375 $SVC->DELETE_THYSELF;
1376 return &_error("Registration Failed - newly registered service could not be discovered","");
1377 }
1378 #my $services = MOBY::Client::Central::_parseServices( '', '', $si );
1379 #my $service_instance = shift @{$services};
1380
1381 # my $storage = new RDF::Core::Storage::Memory;
1382 # my $model = new RDF::Core::Model( Storage => $storage );
1383 # my $RDF_MODEL = MOBY::RDF::ServiceInstanceRDF->new(
1384 #model => $model,
1385 #service_instance => $service_instance );
1386 # my $RDF_XML = $RDF_MODEL->serialize;
1387 #my $LSID = $service_instance->LSID;
1388
1389 # my $RDF = _getServiceInstanceRDF($LSID);
1390 my $RDF = "<RDF/>";
1391 unless ($RDF) {
1392 return &_success( "Registration successful but LSID resolution error",
1393 $SVC->service_instance_id, "" );
1394 }
1395 unless ( $RDF =~ /RDF/ ) {
1396 return &_success(
1397 "Registration successful but LSID resolution error $RDF",
1398 $SVC->service_instance_id, "" );
1399 }
1400 return &_success( "Registration successful", $SVC->service_instance_id,
1401 $RDF );
1402 }
1403
1404 sub _getServiceInstanceRDF {
1405 my ( $self, $LSID ) = @_;
1406 #my $lsid = LS::ID->new($LSID);
1407 my $RDF_XML = "";
1408 my $lsid_error = "";
1409 my $lsid_good = 1;
1410
1411 #use LS::ID;
1412 #use LS::Authority::WSDL::Constants;
1413 #use LS::Client::BasicResolver;
1414 #use LS::Locator;
1415
1416 #my $resolver = LS::Client::BasicResolver->new();
1417 #my $authority = $resolver->resolve( lsid => $lsid );
1418 #unless ($authority) {
1419 # $lsid_error .= "The authority for $LSID could not be located";
1420
1421 #}
1422 #return $lsid_error unless $authority;
1423 #$authority->clean_cache();
1424
1425 # my $resource = $authority->getResource($lsid);
1426 # unless ($resource) {
1427 # $lsid_error .= $authority->error_string . " ";
1428 # return $lsid_error;
1429 # }
1430
1431 # my $response = $resource->get_metadata;
1432 # unless ( ref($response) =~ /LS::Service::Response/ ) {
1433
1434 #TODO raise an error
1435 # $lsid_error .= "Metadata response didn't come back";
1436 # return $lsid_error;
1437 # }
1438
1439 # my $rsp = $response->response;
1440 # unless ( ref($rsp) =~ /IO::File/ ) {
1441
1442 #TODO raise an error
1443 # $lsid_error .= "metadata response was not a filehandle";
1444 # }
1445 # while (<$rsp>) {
1446 # $RDF_XML .= $_;
1447 # }
1448 return $RDF_XML
1449
1450 }
1451
1452 #Eddie - Converted
1453 sub _registerArticles {
1454 my ( $SVC, $inout, $node, $collid ) = @_
1455 ; # node is a node of the XML dom representing an article to be registered
1456 return ( -1, 'Bad node' ) unless $node->nodeType == ELEMENT_NODE;
1457
1458 # this is a Simple, Collection, or Parameter object
1459 my $simp_coll = $node->nodeName;
1460 $debug && &_LOG("TAGNAME in $inout _registerArticle is $simp_coll");
1461 my $article = $node->getAttributeNode("articleName");
1462
1463 if ($article) { $article = $article->getValue() }
1464 $debug && &_LOG("ARTICLENAME in _registerArticle is $article");
1465 if (lc($inout) eq "input"){
1466 return (-1, "Input Simples and collections are required to have an articleName as of API version 0.86") if (!$article && !$collid);
1467 }
1468
1469 my ( $object_type, @namespaces );
1470 if ( $simp_coll eq "Collection" ) {
1471 $debug && &_LOG("Collection!\n");
1472 my $collection_id;
1473 if ( $inout eq 'input' ) {
1474 $collection_id =
1475 $SVC->add_collection_input( article_name => $article );
1476 }
1477 elsif ( $inout eq 'output' ) {
1478 $collection_id =
1479 $SVC->add_collection_output( article_name => $article );
1480 }
1481 else {
1482 $SVC->DELETE_THYSELF;
1483 return ( -1, "found article that was neither input nor output" );
1484 }
1485
1486 my $Simples = $node->getElementsByTagName('Simple');
1487 my $length = $Simples->size();
1488 unless ( $length > 0 ) {
1489 return ( -1,"Your collection must be a collection of one Simple type"
1490 );
1491 }
1492 unless ( $length == 1 ) {
1493 return ( -1,"As of API v0.86, Collections must not be of more than one Simple type"
1494 );
1495 }
1496 for ( my $x = 1 ; $x <= $length ; ++$x ) {
1497 my ( $success, $message ) = &_registerArticles( $SVC, $inout, $Simples->get_node($x), $collection_id );
1498 unless ( $success == 1 ) { return ( -1, $message ); }
1499 }
1500 } elsif ( $simp_coll eq "Simple" ) {
1501 my $article = $node->getAttributeNode("articleName");
1502 $article = $article->getValue() if $article;
1503
1504 # get object type and its URI from the ontoogy server
1505 my $types = $node->getElementsByTagName('objectType');
1506 my $OE = MOBY::OntologyServer->new( ontology => "object" );
1507 foreach ( $types->get_node(1)->childNodes ) { # should only ever be one!
1508 ( $_->nodeType == TEXT_NODE ) && ( $object_type = $_->toString );
1509 }
1510 my ( $success, $message, $typeURI ) =
1511 $OE->objectExists( term => $object_type );
1512 if ( ( !($success) && ( $object_type =~ /urn:lsid:biomoby.org/i ) )
1513 || ( !($success) && !( $object_type =~ /urn:lsid/i ) ) )
1514 { # if the object doesn't exist, and it isn't an LSID
1515 $SVC->DELETE_THYSELF;
1516 return ( -1,
1517 "object: $object_type does not exist, and is not an LSID" );
1518 } # kill it all unless this was successful!
1519 my $namespace_string;
1520 my $namespaces = $node->getElementsByTagName('Namespace');
1521 my $num_ns = $namespaces->size();
1522 $OE = MOBY::OntologyServer->new( ontology => "namespace" );
1523 for ( my $n = 1 ; $n <= $num_ns ; ++$n ) {
1524 foreach my $name ( $namespaces->get_node($n)->childNodes ) {
1525 if ( $name->nodeType == TEXT_NODE ) {
1526 my $term = $name->toString;
1527 my ( $success, $message, $URI ) =
1528 $OE->namespaceExists( term => $term );
1529 if ( ( !($success) && ( $term =~ /urn:lsid:biomoby.org/i ) )
1530 || ( !($success) && !( $term =~ /urn:lsid/i ) ) )
1531 { # if the object doesn't exist, and it isn't an LSID
1532 $SVC->DELETE_THYSELF;
1533 return ( -1,
1534 "namespace: $term doesn't exist and is not an LSID"
1535 );
1536 }
1537 $namespace_string .= $URI . ",";
1538 }
1539 }
1540 }
1541 chop($namespace_string); # remove trailing comma
1542
1543 my $service_instance_id;
1544 unless ($collid)
1545 { # this SIMPLE is either alone, or is part of a COLLECTION ($collid > 0)
1546 # therefore we want either its service instance ID, or its Collection ID.
1547 $service_instance_id = $SVC->service_instance_id;
1548 } # one or the other, but not both
1549 if ( $inout eq 'input' ) {
1550 my $sinput = $SVC->add_simple_input(
1551 object_type_uri => $typeURI,
1552 namespace_type_uris => $namespace_string,
1553 article_name => $article,
1554 collection_input_id => $collid,
1555 );
1556 unless ($sinput) {
1557 $SVC->DELETE_THYSELF;
1558 return ( -1, "registration failed during registration of input object $typeURI. Unknown reasons.");
1559 }
1560 }
1561 elsif ( $inout eq 'output' ) {
1562 my $soutput = $SVC->add_simple_output(
1563 object_type_uri => $typeURI,
1564 namespace_type_uris => $namespace_string,
1565 article_name => $article,
1566 collection_output_id => $collid,
1567 );
1568 unless ($soutput) {
1569 $SVC->DELETE_THYSELF;
1570 return ( -1,"registration failed during registration of output object $typeURI. Unknown reasons."
1571 );
1572 }
1573 }
1574 }
1575 elsif ( $simp_coll eq "Parameter" ) {
1576 my $parameter = $node;
1577 my $article = $parameter->getAttributeNode("articleName");
1578 $article = $article->getValue() if $article;
1579 my ( $datatype, $def, $max, $min, @enums );
1580 my $types = $parameter->getElementsByTagName('datatype');
1581 if ( $types->get_node(1) ) {
1582 foreach ( $types->get_node(1)->childNodes )
1583 { # should only ever be one!
1584 ( $_->nodeType == TEXT_NODE ) && ( $datatype .= $_->nodeValue );
1585 }
1586 }
1587
1588 #ensure that thet type is correct (Integer | String | Float | DateTime)
1589 $datatype =~ s/\s//g;
1590 my $secondaries = $CONFIG->{valid_secondary_datatypes};
1591 my $valid;
1592 map { $valid = 1 if $datatype eq $_ } @{$secondaries};
1593 unless ($valid) {
1594 $SVC->DELETE_THYSELF;
1595 return ( -1,"Registration failed. $datatype must be one of type Integer, String, DateTime, or Float."
1596 );
1597 }
1598
1599 my $defs = $parameter->getElementsByTagName('default');
1600 if ( $defs->get_node(1) ) {
1601 foreach ( $defs->get_node(1)->childNodes )
1602 { # should only ever be one!
1603 ( $_->nodeType == TEXT_NODE ) && ( $def .= $_->nodeValue );
1604 }
1605 }
1606 my $maxs = $parameter->getElementsByTagName('max');
1607 if ( $maxs->get_node(1) ) {
1608 foreach ( $maxs->get_node(1)->childNodes )
1609 { # should only ever be one!
1610 ( $_->nodeType == TEXT_NODE ) && ( $max .= $_->nodeValue );
1611 }
1612 }
1613 my $mins = $parameter->getElementsByTagName('min');
1614 if ( $mins->get_node(1) ) {
1615 foreach ( $mins->get_node(1)->childNodes )
1616 { # should only ever be one!
1617 ( $_->nodeType == TEXT_NODE ) && ( $min .= $_->nodeValue );
1618 }
1619 }
1620 my $enums = $parameter->getElementsByTagName('enum');
1621 my $numenums = $enums->size();
1622 for ( my $n = 1 ; $n <= $numenums ; ++$n ) {
1623 foreach ( $enums->get_node($n)->childNodes )
1624 { # should only ever be one!
1625 ( $_->nodeType == TEXT_NODE )
1626 && ( push @enums, $_->nodeValue );
1627 }
1628 }
1629 my $enum_string = join "", ( map { $_ . "," } @enums );
1630 chop $enum_string; # get rid of trailing comma
1631 $datatype =~ s/^\s+//;
1632 $datatype =~ s/\s+$//;
1633 $def =~ s/^\s+//;
1634 $def =~ s/\s+$//;
1635 $max =~ s/^\s+//;
1636 $max =~ s/\s+$//;
1637 $min =~ s/^\s+//;
1638 $min =~ s/\s+$//;
1639 my $sec = $SVC->add_secondary_input(
1640 default_value => $def,
1641 maximum_value => $max,
1642 minimum_value => $min,
1643 enum_value => $enum_string,
1644 datatype => $datatype,
1645 article_name => $article,
1646 );
1647
1648 unless ($sec) {
1649 $SVC->DELETE_THYSELF;
1650 return ( -1,
1651 "registration failed during registration of parameter $article. Must be of type Integer, String, DateTime, or Float."
1652 );
1653 }
1654 }
1655 return 1;
1656 }
1657
1658 #Eddie - converted
1659 sub _registerServicePayload {
1660 my ($payload) = @_;
1661 my $Parser = XML::LibXML->new();
1662 my $doc = $Parser->parse_string($payload);
1663 my $Object = $doc->getDocumentElement();
1664 my $obj = $Object->nodeName;
1665 return undef unless ( $obj eq 'registerService' );
1666 my $serviceName = &_nodeTextContent( $Object, "serviceName" );
1667 my $Category = &_nodeTextContent( $Object, "Category" );
1668 my $serviceType = &_nodeTextContent( $Object, "serviceType" );
1669 my $AuthURI = &_nodeTextContent( $Object, "authURI" );
1670 my $contactEmail = &_nodeTextContent( $Object, "contactEmail" );
1671 my $authoritativeService =
1672 &_nodeTextContent( $Object, "authoritativeService" );
1673 my $URL = &_nodeTextContent( $Object, "URL" );
1674 my $signatureURL = &_nodeTextContent( $Object, "signatureURL" );
1675 my $desc = &_nodeCDATAContent( $Object, "Description" );
1676 my $INPUTS = &_nodeRawContent( $Object, "Input" ); # returns array ref
1677 my $OUTPUTS = &_nodeRawContent( $Object, "Output" ); # returns array ref
1678 my $SECONDARIES =
1679 &_nodeRawContent( $Object, "secondaryArticles" ); # returns array ref
1680 return (
1681 $serviceName, $serviceType, $AuthURI,
1682 $contactEmail, $URL, $authoritativeService,
1683 $desc, $Category, $INPUTS,
1684 $OUTPUTS, $SECONDARIES, $signatureURL
1685 );
1686 }
1687
1688 #Eddie - converted
1689 sub _extractObjectTypes {
1690 my ($DOM) = @_; # DOM is either a <Simple/> or a <Collection/> article
1691 $debug && &_LOG("\n\n\nExtracting object types from \n$DOM \n\n");
1692 unless ( ref($DOM) =~ /^XML/ ) {
1693 my $Parser = XML::LibXML->new();
1694 my $doc = $Parser->parse_string($DOM);
1695 $DOM = $doc->getDocumentElement();
1696 }
1697 my $x = $DOM->getElementsByTagName("objectType");
1698 my @objectnames;
1699 my $l = $x->size(); # might be a Collection object with multiple simples...
1700 for ( my $n = 1 ; $n <= $l ; ++$n ) {
1701 my @child = $x->get_node($n)->childNodes;
1702 foreach (@child) {
1703 $debug
1704 && &_LOG( getNodeTypeName($_), "\t", $_->toString, "\n" )
1705 ; #hopefully uses MobyXMLConstants.pm
1706 next unless ( $_->nodeType == TEXT_NODE );
1707 my $name = $_->toString;
1708 chomp $name;
1709 push @objectnames, $name;
1710 }
1711 }
1712 return (@objectnames);
1713 }
1714
1715 =head2 registerServiceWSDL
1716
1717 Title : NOT YET IMPLEMENTED
1718 Usage :
1719
1720
1721 =cut
1722
1723 sub registerServiceWSDL {
1724 my ( $pkg, $serviceType, $wsdl ) = @_;
1725 return &_error( "not yet implemented", "" );
1726 }
1727
1728 =head2 deregisterService
1729
1730 Title : deregisterService
1731 Usage : $REG = $MOBY->deregisterService($inputXML)
1732 Function : deregister a Service
1733 Returns : $REG object
1734 inputXML :
1735 <deregisterService>
1736 <authURI>biomoby.org</authURI>
1737 <serviceName>MyFirstService</serviceName>
1738 </deregisterService>
1739
1740 ouptutXML : see Registration XML object
1741
1742
1743 =cut
1744
1745 sub deregisterService {
1746 my ( $pkg, $payload ) = @_;
1747 $debug && &_LOG("\nstarting deregistration\n");
1748 my ( $authURI, $serviceName ) = &_deregisterServicePayload($payload);
1749 return &_error( "must provide an authority and a service name\n", "" )
1750 unless ( $authURI && $serviceName );
1751 return &_error("The service specified by authority=$authURI servicename=$serviceName does not exist in the registry","")
1752 unless (
1753 MOBY::service_instance->new(
1754 servicename => $serviceName,
1755 authority_uri => $authURI,
1756 test => 1
1757 ));
1758 my $SERVICE = MOBY::service_instance->new(
1759 servicename => $serviceName,
1760 authority_uri => $authURI
1761 );
1762 return &_error("service lookup failed for unknown reasons","") unless ($SERVICE);
1763
1764 if ( $SERVICE->signatureURL ) {
1765 return &_error(
1766 "it is illegal to deregister a service that has a signatureURL. Such services must be deregistered by deleting the RDF at the location identified by the signatureURL",
1767 ""
1768 );
1769 }
1770
1771 my $result = $SERVICE->DELETE_THYSELF;
1772 if ($result) {
1773 return &_success( "Service Deregistered Successfully", "" );
1774 }
1775 else {
1776 return &_error( "Service deletion failed for unknown reasons", "" );
1777 }
1778 }
1779
1780 #Eddie - converted
1781 sub _deregisterServicePayload {
1782 my ($payload) = @_;
1783 $debug && &_LOG( "deregisterService payload: ", ($payload), "\n" );
1784 my $Parser = XML::LibXML->new();
1785 my $doc = $Parser->parse_string($payload);
1786 my $Object = $doc->getDocumentElement();
1787 my $obj = $Object->nodeName; #Eddie - unsure
1788 return undef unless ( $obj eq 'deregisterService' );
1789 my $authURI = &_nodeTextContent( $Object, "authURI" );
1790 my $name = &_nodeTextContent( $Object, "serviceName" );
1791 return ( $authURI, $name );
1792 }
1793
1794 =head2 findService
1795
1796 inputXML:
1797 <findService>
1798 <!-- Service Query Object -->
1799 </findService>
1800
1801 ServiceQueryObject XML:
1802
1803 To query MOBY Central, you fill out the relevant elements of a Query Ojbect. These include the input and/or output data Classes (by name from the Class ontology), the Service-type (by name from the Service-type ontology), the authority (service provider URI), or any number of keywords that must appear in the service description.
1804
1805 =over 3
1806
1807 =item * MOBY Central finds all services which match the contents of the Query Object.
1808
1809 =item * All elements are optional, however at least one must be present.
1810
1811 =item * All elements present are considered as increasingly limiting on the search (i.e. "AND").
1812
1813 =item * keywords are:
1814
1815 =over 3
1816
1817 =item * comma-delimited
1818
1819 =item * sentence-fragments are enclosed in double-quotes
1820
1821 =item * wildcard "*" is allowed in combination with keyword fragments and or sentence fragments (lone "*" is meaningless and ignored)
1822
1823 =item * multiple keywords are considered joined by "AND".
1824
1825 =back
1826
1827 =back
1828
1829 In addition to the search parameters, there are two "flags" that can be set in the Query object:
1830
1831 =over 3
1832
1833 =item * expandServices: this flag will cause MOBY Central to traverse the Service ontology and discover services that are child types (more specific) than the Service-type you requested
1834
1835 e.g. you might request "alignment", and it would discover services such as "Blast", "Smith Waterman", "Needleman Wunsch"
1836
1837 =item * expandObjects: this flag will cause MOBY Central to traverse the Class ontology to find services that operate not only on the Object Class you are querying, but also any parent types or sub-objects of that Object Class.
1838
1839 e.g. if you request services that work on AnnotatedSequence Objects this flag will also return services that work on Sequence objects, since AnnotatedSequence objects inherit from Sequence objects
1840
1841 =back
1842
1843 The Query object structure is as follows:
1844
1845 <inputObjects>
1846 <Input>
1847 <!-- one or more Simple or Collection Primary articles -->
1848 </Input>
1849 </inputObjects>
1850 <outputObjects>
1851 <Output>
1852 <!-- one or more Simple or Collection Primary articles -->
1853 </Output>
1854 </outputObjects>
1855 <authoritative>1</authoritative>
1856 <Category>moby</Category>
1857 <serviceType>ServiceTypeTerm</serviceType>
1858 <serviceName>ServiceName</serviceName>
1859 <authURI>http://desired.service.provider</authURI>;
1860 <expandObjects>1|0</expandObjects>
1861 <expandServices>1|0</expandServices>
1862 <keywords>
1863 <keyword>something</keyword>
1864 ....
1865 ....
1866 </keywords>
1867
1868
1869 outputXML
1870
1871 <Services>
1872 <Service authURI="authority.URI.here" serviceName="MyService" lsid="urn:lsid:authority.uri:serviceinstance:id">
1873 <serviceType lsid='urn:...'>Service_Ontology_Term</serviceType>
1874 <Protocol>moby</Protocol> <!-- or 'cgi' or 'soap' -->
1875 <authoritative>1</authoritative>
1876 <contactEmail>your@email.address</contactEmail>
1877 <URL>http://endpoint.of.service</URL>
1878 <Input>
1879 <!-- one or more Simple and/or Collection Primary articles -->
1880 </Input>
1881 <Output>
1882 <!-- one or more Simple and/or Collection Primary articles -->
1883 </Output>
1884 <secondaryArticles>
1885 <!-- one or more Secondary articles -->
1886 </secondaryArticles>
1887 <Description><![CDATA[free text description here]]></Description>
1888 </Service>
1889 ... <!-- one or more Service blocks may be returned -->
1890 ...
1891 ...
1892 </Services>
1893
1894
1895 =cut
1896
1897 sub findService {
1898 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
1899 my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
1900
1901 my ( $pkg, $payload ) = @_;
1902 $debug && &_LOG("\nLOOKING FOR SERVICES\n");
1903 my %findme = &_findServicePayload($payload);
1904 $debug && &_LOG(
1905 "'serviceType' => $findme{serviceType},
1906 'authURI' => $findme{AuthURI},
1907 'servicename' => $findme{servicename},
1908 'expandObjects' => $findme{expandObjects},
1909 'expandServices' => $findme{expandServices},
1910 'authoritative' => $findme{authoritative},
1911 'category' => $findme{Category},
1912 'keywords' => $findme{keywords},
1913 "
1914 );
1915 my %valid_service_ids;
1916 my $criterion_count = 0;
1917
1918 # we want to avoid joins, since they slow things down, so...
1919 # the logic is that we keep a hash of valid id's
1920 # and the number of times they are discovered
1921 # we also count the number of criterion
1922 # we only want the service_id's that appear as many times as the criterion we have
1923 # since they will have matched every criterion.
1924
1925 if ( $findme{authoritative} ) {
1926 ++$criterion_count;
1927 $debug
1928 && _LOG(
1929 "authoritative added; criterion count is now $criterion_count\n");
1930 my $ids = _extract_ids($adaptor->query_service_instance(authoritative => $findme{authoritative}));
1931
1932
1933
1934 ### MARK - we need to extract ids at each step...
1935
1936
1937
1938 unless ( scalar @{$ids} ) {
1939 return &_serviceListResponse(undef );
1940 }
1941 $debug
1942 && _LOG( "services " . ( join ',', @{$ids} ) . " incrememted\n" );
1943 foreach ( @{$ids} ) {
1944 $debug && &_LOG("found service_instance_id $_\n");
1945 ++$valid_service_ids{$_}; # increment that particular id's count by one
1946 }
1947 }
1948 if ( $findme{serviceType} ) { # must have something more than empty content
1949 my $OS = MOBY::OntologyServer->new( ontology => 'service' );
1950 $findme{serviceType} =~ s/^moby\://;
1951 my ( $exists, $message, $URI ) =
1952 $OS->serviceExists( term => $findme{serviceType} );
1953 unless ($exists) {
1954 return &_serviceListResponse(undef );
1955 }
1956 ++$criterion_count;
1957 $debug
1958 && _LOG(
1959 "serviceType added; criterion count is now $criterion_count\n");
1960 my $children_string = "'$URI',";
1961 if ( $findme{'expandServices'} ) {
1962 $debug && _LOG("Expanding Services\n");
1963 my $OS = MOBY::OntologyServer->new( ontology => 'service' );
1964 my %relationships = %{ $OS->traverseDAG( $URI, "leaves" ) };
1965 my (@children) =
1966 @{ $relationships{'urn:lsid:biomoby.org:servicerelation:isa'} };
1967 $children_string .= ( join ',', map { "\'$_\'" } @children );
1968 #*******FIX this isn't very perlish... sending a comma-delimited string to a subroutine instead of an array
1969 # need to change that one day soon!
1970 }
1971 $children_string =~ s/\,$//;
1972 my $ids = _extract_ids($adaptor->match_service_type_uri(service_type_uri => $children_string));
1973
1974 $debug
1975 && _LOG( "services " . ( join ',', @{$ids} ) . " incrememted\n" );
1976 foreach ( @{$ids} ) {
1977 $debug && &_LOG("found service_instance_id $_\n");
1978 ++$valid_service_ids{$_}; # increment that particular id's count by one
1979 }
1980 }
1981 if ( $findme{authURI} ) {
1982 ++$criterion_count;
1983 $debug
1984 && _LOG("authURI added; criterion count is now $criterion_count\n");
1985 my $ids = _extract_ids($adaptor->query_service_instance(authority_uri => $findme{'authURI'}));
1986
1987 unless ( scalar @{$ids} ) {
1988 return &_serviceListResponse(undef );
1989 }
1990 $debug
1991 && _LOG( "services " . ( join ',', @{$ids} ) . " incrememted\n" );
1992 foreach ( @{$ids} ) {
1993 $debug && &_LOG("found service_instance_id $_\n");
1994 ++$valid_service_ids{$_}; # increment that particular id's count by one
1995 }
1996 }
1997 if ( $findme{servicename} ) {
1998 ++$criterion_count;
1999 $debug
2000 && _LOG(
2001 "servicename added; criterion count is now $criterion_count\n");
2002
2003 my $ids = _extract_ids($adaptor->query_service_instance(servicename => $findme{servicename}));
2004
2005 unless ( scalar @{$ids} ) {
2006 return &_serviceListResponse( undef );
2007 }
2008 $debug
2009 && _LOG( "services " . ( join ',', @{$ids} ) . " incrememted\n" );
2010 foreach ( @{$ids} ) {
2011 $debug && &_LOG("found service_instance_id $_\n");
2012 ++$valid_service_ids{$_}; # increment that particular id's count by one
2013 }
2014 }
2015 $findme{category} = 'moby' unless $findme{category};
2016 if ( $findme{category} ) {
2017 ++$criterion_count;
2018 $debug
2019 && _LOG("category added; criterion count is now $criterion_count\n");
2020
2021 my $ids = _extract_ids($adaptor->query_service_instance(category => lc( $findme{category}) ));
2022
2023 unless ( scalar @{$ids} ) {
2024 return &_serviceListResponse( undef );
2025 }
2026 $debug
2027 && _LOG( "services " . ( join ',', @{$ids} ) . " incrememted\n" );
2028 foreach ( @{$ids} ) {
2029 $debug && &_LOG("found service_instance_id $_\n");
2030 ++$valid_service_ids{$_}; # increment that particular id's count by one
2031 }
2032 }
2033 if ( $findme{keywords} && ( scalar @{ $findme{keywords} } ) ) {
2034 ++$criterion_count;
2035 $debug
2036 && _LOG("Keywords added; criterion count is now $criterion_count\n");
2037
2038 my ($ids) = $adaptor->check_keywords(keywords => \@{$findme{keywords}});
2039 $ids = _extract_ids($ids); # this is the hash-list that comes back from do_query
2040
2041 unless ( scalar @{$ids} ) {
2042 return &_serviceListResponse( undef );
2043 }
2044 $debug
2045 && _LOG( "services " . ( join ',', @{$ids} ) . " incrememted\n" );
2046 foreach ( @{$ids} ) {
2047 $debug && &_LOG("found service_instance_id $_\n");
2048 ++$valid_service_ids{$_}; # increment that particular id's count by one
2049 }
2050 }
2051 if ( $findme{inputObjects} && ( scalar @{ $findme{inputObjects} } ) ) {
2052 ++$criterion_count;
2053 $debug
2054 && _LOG(
2055 "inputObject added; criterion count is now $criterion_count\n");
2056 my $obj = ( shift @{ $findme{inputObjects} } );
2057 my @si_ids;
2058 @si_ids =
2059 &_searchForServicesWithArticle( "input", $obj,$findme{'expandObjects'}, '' )
2060 if defined $obj;
2061 $debug
2062 && _LOG("Initial Search For Services with INPUT Article found @si_ids\n");
2063 my %instances;
2064
2065 # we need to do a join, without doing a join...
2066 if ( scalar @si_ids ) {
2067 map { $instances{$_} = 1 }
2068 @si_ids; # get an id of the good services from the first object
2069 while ( my $obj = shift( @{ $findme{inputObjects} } ) )
2070 { # iterate through the rest of the objects
2071 next unless $obj;
2072 $debug
2073 && _LOG( "FIRST: ", "input", $obj,
2074 $findme{'expandObjects'}, '' );
2075 my @new_ids =
2076 &_searchForServicesWithArticle("input", $obj,$findme{'expandObjects'}, '' ); # get their service ids
2077 $debug
2078 && _LOG("Subsequent Search For Services with INPUT Article found @new_ids\n");
2079 my @good_ids;
2080 my %good_ids;
2081 foreach my $id (@new_ids)
2082 { # check the new id set against the set we know is already valid
2083 next unless defined $id;
2084 if ( $instances{$id} ) {
2085 push @good_ids, $id;
2086 } # if they are in common, then that id is still good
2087 }
2088 map { $good_ids{$_} = 1 }
2089 @good_ids; # make a hash of the new good id's
2090 %instances = %good_ids
2091 ; # and replace the original list with this more limited one
2092 }
2093 }
2094
2095 # now %instances contains only valid ID numbers
2096 $debug
2097 && _LOG( "Final results incremented of search for INPUT: "
2098 . ( join ',', ( keys %instances ) )
2099 . "\n" );
2100 foreach ( keys %instances ) {
2101 $debug && &_LOG("found id $_\n");
2102 ++$valid_service_ids{$_};
2103 }
2104 }
2105 if ( $findme{outputObjects} && ( scalar @{ $findme{outputObjects} } ) ) {
2106 ++$criterion_count;
2107 $debug
2108 && _LOG(
2109 "outputObject added; criterion count is now $criterion_count\n");
2110 my $obj = ( shift @{ $findme{outputObjects} } );
2111 my @si_ids;
2112 @si_ids = &_searchForServicesWithArticle("output", $obj, '' )if defined $obj;
2113 $debug
2114 && _LOG(
2115 "Initial Search For Services with OUTPUT Article found @si_ids\n");
2116 my %instances;
2117
2118 # we need to do a join, without doing a join...
2119 if ( scalar @si_ids ) {
2120 map { $instances{$_} = 1 }
2121 @si_ids; # get an id of the good services from the first object
2122 while ( my $obj = shift( @{ $findme{outputObjects} } ) )
2123 { # iterate through the rest of the objects
2124 next unless $obj;
2125 my @new_ids =
2126 &_searchForServicesWithArticle("output", $obj, '' )
2127 ; # get their service ids
2128 $debug
2129 && _LOG("Subsequent Search For Services with OUTPUT Article found @new_ids\n"
2130 );
2131 my @good_ids;
2132 my %good_ids;
2133 foreach my $id (@new_ids)
2134 { # check the new id set against the set we know is already valid
2135 next unless defined $id;
2136 if ( $instances{$id} ) {
2137 push @good_ids, $id;
2138 } # if they are in common, then that id is still good
2139 }
2140 map { $good_ids{$_} = 1 }
2141 @good_ids; # make a hash of the new good id's
2142 %instances = %good_ids
2143 ; # and replace the original list with this more limited one
2144 }
2145 }
2146
2147 # now %instances contains only valid ID numbers
2148 $debug
2149 && _LOG( "Final results incremented of search for OUTPUT: "
2150 . ( join ',', ( keys %instances ) )
2151 . "\n" );
2152 foreach ( keys %instances ) {
2153 $debug && &_LOG("found id $_\n");
2154 ++$valid_service_ids{$_};
2155 }
2156 }
2157 my @final;
2158 while ( my ( $id, $freq ) = each %valid_service_ids ) {
2159 $debug
2160 && _LOG(
2161 "TALLY IS ID: $id FREQ:$freq\n CRITERION COUNT $criterion_count\n"
2162 );
2163 next
2164 unless $freq ==
2165 $criterion_count; # has to have matched every criterion
2166 push @final, $id;
2167 }
2168 return &_serviceListResponse(@final );
2169 }
2170
2171 sub _extract_ids {
2172 my ($linehash) = @_;
2173 # ths data comes from the do_query of the mysql call
2174 # --> [{...}]
2175 my @lines = @$linehash;
2176 return [] unless scalar(@lines);
2177 my @ids;
2178 foreach (@lines){
2179 my $id = $_->{service_instance_id};
2180 push @ids, $id;
2181 }
2182 return \@ids
2183 }
2184
2185 #Eddie - converted
2186 sub _searchForServicesWithArticle {
2187 my ($inout, $node, $expand, $coll ) = @_;
2188 return ()
2189 unless $node->nodeType ==
2190 ELEMENT_NODE; # this will erase all current successful service instances!
2191 $debug
2192 && _LOG( "searchServWthArticle ", $inout, $node, $expand, $coll );
2193
2194 # this element node may be a Simple or a Collection object
2195 my $simp_coll = $node->nodeName;
2196 $debug && &_LOG("TAGNAME in _searchForArticle is $simp_coll");
2197 my @valid_ids;
2198 if ( $simp_coll eq "Collection" ) {
2199 @valid_ids = &_searchForCollection( $node, $expand, $inout );
2200 }
2201 elsif ( $simp_coll eq "Simple" ) {
2202 @valid_ids = &_searchForSimple( $node, $expand, $inout );
2203 }
2204 return @valid_ids;
2205 }
2206
2207 sub _searchForSimple {
2208 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
2209 my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
2210
2211 # returns list of service_instance ID's
2212 # that match this simple
2213 my ( $node, $expand, $inout ) = @_;
2214 $debug && _LOG( $node, $expand, $inout );
2215 my ( $objectURI, $namespaceURIs ) =
2216 &_extractObjectTypesAndNamespaces($node); # (objectType, [ns1, ns2, ns3])
2217 unless ($objectURI) { return () }
2218 my $ancestor_string = "'$objectURI',";
2219 if ($expand) {
2220 $debug && _LOG("Expanding Objects\n");
2221 my $OS = MOBY::OntologyServer->new( ontology => 'object' );
2222 my %relationships = %{ $OS->traverseDAG( $objectURI, "root" ) };
2223 my (@ancestors) =
2224 @{ $relationships{'urn:lsid:biomoby.org:objectrelation:isa'} };
2225 $ancestor_string .= ( join ',', map { "\'$_\'" } @ancestors );
2226 }
2227 $ancestor_string =~ s/\,$//;
2228
2229 my $result = $adaptor->find_by_simple(inout => $inout,
2230 ancestor_string => $ancestor_string,
2231 namespaceURIs => $namespaceURIs);
2232
2233 my @valid_services;
2234
2235 foreach my $row (@$result)
2236 {
2237 # get the service instance ID and the namespaces that matched
2238 my $id = $row->{service_instance_id};
2239 my $nss = $row->{namespace_type_uris};
2240 if ( $nss && scalar @{$namespaceURIs} )
2241 { # if this service cares about namespaces at all,
2242 # and if namespaces were specified in the query,
2243 # then validate the discovered service against this list
2244 my @ns = split ",", $nss
2245 ; # because of the database structure we have to re-test for *identity*, not just like%% similarity
2246 my %nshash = map { ( $_, 1 ) } @ns, @{ $namespaceURIs
2247 }; #we're going to test identity by building a hash of namespaces as keys
2248 if (
2249 scalar( keys %nshash ) <
2250 scalar(@ns) + scalar( @{$namespaceURIs} ) )
2251 { # if the number of keys is less than the sum of the number of keys goign into the hash, then one of them was identical
2252 push @valid_services,
2253 $id; # and therefore it really is a match, and is valid
2254 }
2255 }
2256 else { # if no namespace was specified, then all of them are valid
2257 push @valid_services, $id;
2258 }
2259 }
2260 $debug
2261 && _LOG( "Resulting IDs were " . ( join ',', @valid_services ) . "\n" );
2262 return @valid_services;
2263 }
2264
2265 #Eddie - converted
2266 sub _searchForCollection {
2267 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
2268 my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
2269
2270 my ( $node, $expand, $inout ) =
2271 @_; # $node in this case is a Collection object
2272
2273 # luckily, we can return a redundant list of service id's and
2274 # this will be cleaned up in the caller
2275 my @validservices;
2276 foreach my $simple ( $node->childNodes() ) {
2277 next unless ( $simple->nodeType == ELEMENT_NODE );
2278 next unless ( $simple->nodeName =~ /simple/i );
2279 my ( $objectURI, $namespaceURIs ) =
2280 &_extractObjectTypesAndNamespaces($simple);
2281
2282 my $result = $adaptor->find_by_collection(inout => $inout,
2283 objectURI => $objectURI,
2284 namespaceURIs => $namespaceURIs);
2285
2286 foreach my $row (@$result )
2287 { # get the service instance ID and the namespaces that matched
2288 my $id = $row->{service_instance_id};
2289 my $nss = $row->{namespace_type_uris};
2290 if ( $nss && scalar @{$namespaceURIs} )
2291 { # if this service cares about namespaces at all,
2292 # and if namespaces were specified in the query,
2293 # then validate the discovered service against this list
2294 my @ns = split ",", $nss
2295 ; # because of the database structure we have to re-test for *identity*, not just like%% similarity
2296 my %nshash = map { ( $_, 1 ) } @ns, @{ $namespaceURIs
2297 }; #we're going to test identity by building a hash of namespaces as keys
2298 if (
2299 scalar( keys %nshash ) <
2300 scalar(@ns) + scalar( @{$namespaceURIs} ) )
2301 { # if the number of keys is less than the sum of the number of keys goign into the hash, then one of them was identical
2302 push @validservices,
2303 $id; # and therefore it really is a match, and is valid
2304 }
2305 }
2306 else { # if no namespace was specified, then all of them are valid
2307 push @validservices, $id;
2308 }
2309 }
2310 }
2311 return @validservices;
2312 }
2313
2314 #Eddie - converted
2315 sub _findServicePayload {
2316 my ($payload) = @_;
2317 my $Parser = XML::LibXML->new();
2318 my $doc = $Parser->parse_string($payload);
2319 my $Object = $doc->getDocumentElement();
2320 my $obj = $Object->nodeName;
2321 return undef unless ( $obj eq 'findService' );
2322 my $serviceType = &_nodeTextContent( $Object, "serviceType" );
2323 $serviceType && ( $serviceType =~ s/\s+//g );
2324 my $servicename = &_nodeTextContent( $Object, "serviceName" );
2325 $servicename && ( $servicename =~ s/\s+//g );
2326 my $authoritative = &_nodeTextContent( $Object, "authoritative" );
2327 $authoritative && ( $authoritative =~ s/\s+//g );
2328 my $Category = &_nodeTextContent( $Object, "Category" );
2329 $Category && ( $Category =~ s/\s+//g );
2330 my $AuthURI = &_nodeTextContent( $Object, "authURI" );
2331 $AuthURI && ( $AuthURI =~ s/\s+//g );
2332 my $expandObjects = &_nodeTextContent( $Object, "expandObjects" );
2333 $expandObjects && ( $expandObjects =~ s/\s+//g );
2334 my $expandServices = &_nodeTextContent( $Object, "expandServices" );
2335 $expandServices && ( $expandServices =~ s/\s+//g );
2336 my @kw = &_nodeArrayContent( $Object, "keywords" );
2337 my $INPUTS = &_nodeRawContent( $Object, "Input" ); # returns array ref
2338 my $OUTPUTS = &_nodeRawContent( $Object, "Output" ); # returns array ref
2339 return (
2340 'serviceType' => $serviceType,
2341 'authURI' => $AuthURI,
2342 'servicename' => $servicename,
2343 'expandObjects' => $expandObjects,
2344 'expandServices' => $expandServices,
2345 'authoritative' => $authoritative,
2346 'Category' => $Category,
2347 'inputObjects' => $INPUTS,
2348 'outputObjects' => $OUTPUTS,
2349 'keywords' => \@kw
2350 );
2351 }
2352
2353 #Eddie - converted
2354 sub _extractObjectTypesAndNamespaces {
2355
2356 # takes a SINGLE simple article and return regular list ($objectURI, [nsURI1, nsURI2, nsURI3])
2357 my ($DOM) = @_;
2358 $debug
2359 && &_LOG(
2360 "\n\n_extractObjectTypesAndNamespaces\nExtracting object types from \n$DOM \n\n"
2361 );
2362 unless ( ref($DOM) =~ /^XML/ ) {
2363 my $Parser = XML::LibXML->new();
2364 my $doc = $Parser->parse_string($DOM);
2365 $DOM = $doc->getDocumentElement();
2366 }
2367 my $x = $DOM->getElementsByTagName("objectType");
2368 my $objectname;
2369 my @child = $x->get_node(1)->childNodes;
2370 foreach (@child) {
2371 $debug && &_LOG( getNodeTypeName($_), "\t", $_->toString, "\n" );
2372 next unless ( $_->nodeType == TEXT_NODE );
2373 my $name = $_->toString;
2374 chomp $name;
2375 $objectname = $name;
2376 }
2377 $objectname =~ s/^moby\://
2378 ; # damn XML DOM can't deal with namespaces... so get rid of it if it exists, though this is going to limit us to only MOBY objects again :-(
2379 my $OS = MOBY::OntologyServer->new( ontology => 'object' );
2380 my ( $exists, $message, $objectURI ) =
2381 $OS->objectExists( term => $objectname );
2382 return ( undef, [] ) unless $objectURI;
2383 my $ns = $DOM->getElementsByTagName("Namespace");
2384 my @namespaces;
2385 my $nonamespaces = $ns->size();
2386 $OS = MOBY::OntologyServer->new( ontology => 'namespace' );
2387
2388 for ( my $n = 1 ; $n <= $nonamespaces ; ++$n ) {
2389 my @child = $ns->get_node($n)->childNodes;
2390 foreach (@child) {
2391 $debug && &_LOG( getNodeTypeName($_), "\t", $_->toString, "\n" );
2392 next unless ( $_->nodeType == TEXT_NODE );
2393 my $name = $_->toString;
2394 chomp $name;
2395 my ( $success, $message, $URI ) =
2396 $OS->namespaceExists( term => $name );
2397 $URI
2398 ? ( push @namespaces, $URI )
2399 : ( push @namespaces, "__MOBY__INVALID__NAMESPACE__" );
2400 }
2401 }
2402 return ( $objectURI, \@namespaces );
2403 }
2404
2405 =head2 retrieveService
2406
2407 Title : retrieveService
2408 Usage : $WSDL = $MOBY->locateService($inputXML)
2409 Function : get the WSDL descriptions for services with this service name
2410 Returns : XML (see below)
2411 Comment : the WSDL that you get back is invalid w.r.t. the object structure
2412 It will always be so.
2413 It should be used only to create stubs for the connection to the service.
2414 inputXML :
2415 <retrieveService>
2416 <Service authURI="authority.uri.here" serviceName="myServ"/>
2417 <retrieveService>
2418
2419 outputXML (by category):
2420
2421 moby: <Service lsid='urn:lsid:...'><![CDATA[WSDL document here]]</Service>
2422
2423
2424 =cut
2425
2426 sub retrieveService {
2427 my ( $pkg, $payload ) = @_;
2428 my ( $AuthURI, $serviceName, $InputXML, $OutputXML, $SecondaryXML ) =
2429 &_retrieveServicePayload($payload);
2430 unless ( $AuthURI && $serviceName ) { return "<Services/>" }
2431 my $SI = MOBY::service_instance->new(
2432 authority_uri => $AuthURI,
2433 servicename => $serviceName
2434 );
2435 my $servlsid = $SI->lsid;
2436 my $wsdls;
2437 return "<Services/>" unless ($SI);
2438 if ( $SI->category eq 'moby' ) {
2439 my $wsdl =
2440 &_getServiceWSDL( $SI, $InputXML, $OutputXML, $SecondaryXML );
2441 if ($wsdl) {
2442 if ( $wsdl =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
2443 $wsdl = $1;
2444 }
2445 $wsdls .= "<Service lsid='$servlsid'><![CDATA[$wsdl]]></Service>\n";
2446 }
2447
2448 #$debug && &_LOG("WSDL_________________$wsdls\n____________________");
2449 return $wsdls;
2450 }
2451 }
2452
2453 #Eddie - converted
2454 sub _retrieveServicePayload {
2455 my ($payload) = @_;
2456 my $Parser = XML::LibXML->new();
2457 my $doc = $Parser->parse_string($payload);
2458 my $x = $doc->getElementsByTagName("Service");
2459 my $authURI = "";
2460 my $serviceName = "";
2461 my $l = $x->size(); # might be a Collection object with multiple simples...
2462 for ( my $n = 1 ; $n <= $l ; ++$n ) {
2463 $authURI =
2464 $x->get_node($n)->getAttributeNode("authURI")
2465 ; # may or may not have a name
2466 if ($authURI) { $authURI = $authURI->getValue() }
2467 $serviceName =
2468 $x->get_node($n)->getAttributeNode("serviceName")
2469 ; # may or may not have a name
2470 if ($serviceName) { $serviceName = $serviceName->getValue() }
2471 }
2472 my $INPUT = $doc->getElementsByTagName("Input");
2473 my $InputXML = "";
2474 if ( $INPUT->get_node(1) ) {
2475 $InputXML = $INPUT->get_node(1)->toString;
2476 }
2477 my $OUTPUT = $doc->getElementsByTagName("Output");
2478 my $OutputXML = "";
2479 if ( $OUTPUT->get_node(1) ) {
2480 $OutputXML = $OUTPUT->get_node(1)->toString;
2481 }
2482 my $SECONDARY = $doc->getElementsByTagName("Output");
2483 my $SecondaryXML = "";
2484 if ( $SECONDARY->get_node(1) ) {
2485 $SecondaryXML = $SECONDARY->get_node(1)->toString;
2486 }
2487 return ( $authURI, $serviceName, $InputXML, $OutputXML, $SecondaryXML );
2488 }
2489
2490 =head2 retrieveResourceURLs
2491
2492 Title : retrieveResourceURLs
2493 Usage : $urls = $MOBY->retrieveResourceURLs
2494 Function : to retrieve the location(s) of the RDF versions of the various
2495 MOBY-S Ontologies
2496 Args : none
2497 Returns : XML (see below). The "name" attribute indicates which ontology
2498 is described by the URL (Service, Object, Namespace, ServiceInstance, Full),
2499 and the "url" attribute provides a URL that, when called with an
2500 HTTP GET, will return RDF-XML describing that ontology.
2501 XML :
2502 <resourceURLs>
2503 <Resource name="Service" url="http://mobycentral.org/RESOURCES/MOBY-S/Services/>
2504 <Resource name="Object" url="..."/>
2505 <Resource name="Namespace" url="...X..."/>
2506 <Resource name="Namespace" url="...Y..."/>
2507 </resourceURLs>
2508
2509 =cut
2510
2511 sub retrieveResourceURLs {
2512
2513 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
2514 my $central = $CONFIG->{mobycentral}->{resourceURL};
2515 my $service = $CONFIG->{mobyservice}->{resourceURL};
2516 my $namespace = $CONFIG->{mobynamespace}->{resourceURL};
2517 my $object = $CONFIG->{mobyobject}->{resourceURL};
2518 my $all = $CONFIG->{mobycentral}->{allResources};
2519
2520 my $message ="<resourceURLs>";
2521 $message .="<Resource name='ServiceInstance' url='$central'/>" if $central;
2522 $message .="<Resource name='Object' url='$object'/>" if $object;
2523 $message .="<Resource name='Service' url='$service'/>" if $service;
2524 $message .="<Resource name='Namespace' url='$namespace'/>" if $namespace;
2525 $message .="<Resource name='Full' url='$all'/>" if $all;
2526 $message .="</resourceURLs>";
2527 return $message;
2528 }
2529
2530
2531 =head2 retrieveServiceProviders
2532
2533 Title : retrieveServiceProviders
2534 Usage : $uris = $MOBY->retrieveServiceProviders()
2535 Function : get the list of all provider's AuthURI's
2536 Returns : XML (see below)
2537 Args : none
2538 XML :
2539 <serviceProviders>
2540 <serviceProvider name="authority.info.here"/>
2541 ...
2542 ...
2543 </serviceProviders>
2544
2545 =cut
2546
2547 sub retrieveServiceProviders {
2548 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
2549 my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
2550
2551 my ($pkg) = @_;
2552
2553 my $result = $adaptor->get_all_authorities();
2554
2555 my $providers = "<serviceProviders>\n";
2556 foreach my $prov (@$result) {
2557 $providers .= "<serviceProvider name='".($prov->{authority_uri})."'/>\n";
2558 }
2559 $providers .= "</serviceProviders>\n";
2560 return $providers;
2561 }
2562
2563 =head2 retrieveServiceNames
2564
2565 Title : retrieveServiceNames
2566 Usage : $names = $MOBY->retrieveServiceNames()
2567 Function : get a (redundant) list of all registered service names
2568 (N.B. NOT service types!)
2569 Returns : XML (see below)
2570 Args : none
2571 XML :
2572 <serviceNames>
2573 <serviceName name="serviceName" authURI='authority.info.here' lsid = 'urn:lsid...'/>
2574 ...
2575 ...
2576 </serviceNames>
2577
2578 =cut
2579
2580 sub retrieveServiceNames {
2581 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
2582 my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
2583
2584 my ($pkg) = shift;
2585
2586 my $result = $adaptor->get_service_names();
2587 my $names = "<serviceNames>\n";
2588 foreach my $row (@$result) {
2589 my $name = $row->{servicename};
2590 my $auth = $row->{authority_uri};
2591 my $lsid = $row->{lsid};
2592 $names .= "<serviceName name='$name' authURI='$auth' lsid='$lsid'/>\n";
2593 }
2594 $names .= "</serviceNames>\n";
2595 return $names;
2596 }
2597
2598 =head2 retrieveServiceTypes
2599
2600 Title : retrieveServiceTypes
2601 Usage : $types = $MOBY->retrieveServiceTypes()
2602 Function : get the list of all registered service types
2603 Returns : XML (see below)
2604 Args : none
2605 XML :
2606 <serviceTypes>
2607 <serviceType name="serviceName" lsid="urn:lsid...">
2608 <Description><![CDATA[free text description here]]></Description>
2609 <contactEmail>your@email.here</contactEmail>
2610 <authURI>authority.uri.here</authURI>
2611 </serviceType>
2612 ...
2613 ...
2614 </serviceNames>
2615
2616 =cut
2617
2618 sub retrieveServiceTypes {
2619 my ($pkg) = @_;
2620 my $OS = MOBY::OntologyServer->new( ontology => 'service' );
2621 my %types = %{ $OS->retrieveAllServiceTypes() };
2622 my $types = "<serviceTypes>\n";
2623 while ( my ( $serv, $descr ) = each %types ) { #UNCOMMENT
2624 my ($desc, $lsid, $contact, $auth) = @$descr;
2625 if ( $desc =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
2626 $desc = $1;
2627 }
2628 $types .="<serviceType name='$serv' lsid='$lsid'>\n<Description><![CDATA[$desc]]></Description>\n<contactEmail>$contact</contactEmail>\n<authURI>$auth</authURI>\n</serviceType>\n"; #UNCOMMENT
2629 }
2630 $types .= "</serviceTypes>\n";
2631 return $types;
2632 }
2633
2634 =head2 retrieveRelationshipTypes
2635
2636 Title : retrieveRelationshipTypes
2637 Usage : $types = $MOBY->retrieveRelationshipTypes($xml)
2638 Function : get the list of all registered relationship types in the given ontology
2639 Returns : XML (see below)
2640 Args : input XML (ontologies are 'object', 'service', 'namespace', 'relationship')
2641
2642 Input XML : <Ontology>OntologyName</Ontology>
2643 Output XML:
2644 <relationshipTypes>
2645 <relationshipType relationship="ontologyterm" authority="biomoby.org">
2646 <Description><![CDATA[free text description here]]></Description>
2647 </relationshipType>
2648 ...
2649 ...
2650 </relationshipTypes>
2651
2652 =cut
2653
2654 #Eddie - converted
2655 sub retrieveRelationshipTypes {
2656 my ( $pkg, $payload ) = @_;
2657 my $Parser = XML::LibXML->new();
2658 my $doc = $Parser->parse_string($payload);
2659 my $ontology = &_nodeTextContent( $doc, "Ontology" );
2660 my $OS = MOBY::OntologyServer->new( ontology => 'relationship' );
2661 my %types = %{ $OS->getRelationshipTypes( ontology => $ontology ) };
2662 my $types = "<relationshipTypes>\n";
2663 while ( my ( $lsid, $authdesc ) = each %types ) {
2664 my $name = $authdesc->[0];
2665 my $auth = $authdesc->[1];
2666 my $desc = $authdesc->[2];
2667 if ( $desc =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
2668 $desc = $1;
2669 }
2670 $types .="<relationshipType relationship='$name' authority='$auth' lsid='$lsid'>\n<Description><![CDATA[$desc]]></Description>\n</relationshipType>\n";
2671 }
2672 $types .= "</relationshipTypes>\n";
2673 return $types;
2674 }
2675
2676 =head2 retrieveObjectNames
2677
2678 Title : retrieveObjectNames
2679 Usage : $names = $MOBY->retrieveObjectNames()
2680 Function : get the list of all registered Object types
2681 Returns : XML (see below)
2682 Args : none
2683 XML :
2684 <objectNames>
2685 <Object name="objectName" lsid="urn:lsid:...">
2686 <Description><![CDATA[free text description here]]></Description>
2687 </Object>
2688 ...
2689 ...
2690 </objectNames>
2691
2692 =cut
2693
2694 sub retrieveObjectNames {
2695 my ($pkg) = @_;
2696 my $OS = MOBY::OntologyServer->new( ontology => 'object' );
2697 my %types = %{ $OS->retrieveAllObjectTypes() };
2698 my $obj = "<objectNames>\n";
2699 while ( my ( $name, $descr ) = each %types ) {
2700 my ($desc, $lsid) = @$descr;
2701 if ( $desc =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
2702 $desc = $1;
2703 }
2704 $obj .="<Object name='$name' lsid='$lsid'>\n<Description><![CDATA[$desc]]></Description>\n</Object>\n";
2705 }
2706 $obj .= "</objectNames>\n";
2707 return $obj;
2708 }
2709
2710 =head2 retrieveObjectDefinition
2711
2712 Title : retrieveObjectDefinition
2713 Usage : $registerObjectXML = $MOBY->retrieveObjectDefinition($inputXML)
2714 Function : get the full description of an object, as registered
2715 Returns : see input XML for registerObjectClass
2716 Input XML :
2717 <retrieveObjectDefinition>
2718 <obqjectType>ExistingObjectClassname</objectType>
2719 </retrieveObjectDefinition>
2720
2721 Ouptut XML :
2722 <retrieveObjectDefinition>
2723 <objectType lsid="urn:lsid:...">NewObjectType</objectType>
2724 <Description><![CDATA[
2725 human readable description
2726 of data type]]>
2727 </Description>
2728 <Relationship relationshipType="urn:lsid...">
2729 <objectType articleName="SomeName" lsid="urn:lsid...">ExistingObjectType</objectType>
2730 </Relationship>
2731 ...
2732 ...
2733 <authURI>owner.URI.here</authURI>
2734 <contactEmail>owner@their.address.com</contactEmail>
2735 </retrieveObjectDefinition>
2736
2737
2738 =cut
2739
2740 #Eddie - converted
2741 sub retrieveObjectDefinition {
2742 my ( $pkg, $payload ) = @_;
2743 my $Parser = XML::LibXML->new();
2744 my $doc = $Parser->parse_string($payload);
2745 my $term = &_nodeTextContent( $doc, "objectType" );
2746 return "<retrieveObjectDefinition/>" unless $term;
2747 my $OS = MOBY::OntologyServer->new( ontology => 'object' );
2748 my $def =
2749 $OS->retrieveObject( node => $term )
2750 ; # will return undef if this term does not exist, and does not look like an LSID
2751 return "<retrieveObjectDefinition/>" unless $def;
2752 my %def = %{ $OS->retrieveObject( type => $term ) };
2753
2754 if ( $def{description} =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
2755 $def{description} = $1;
2756 }
2757 my $response;
2758 $response = "<retrieveObjectDefinition>
2759 <objectType lsid='$def{objectLSID}'>$def{objectType}</objectType>
2760 <Description><![CDATA[$def{description}]]></Description>
2761 <authURI>$def{authURI}</authURI>
2762 <contactEmail>$def{contactEmail}</contactEmail>\n";
2763 my %relationships = %{ $def{Relationships} };
2764
2765 while ( my ( $rel, $objdefs ) = each %relationships ) {
2766 $response .= "<Relationship relationshipType='$rel'>\n";
2767 foreach my $def ( @{$objdefs} ) {
2768 my ( $lsid, $articlename,$type, $def, $auth, $contac ) = @{$def};
2769 $articlename = "" unless defined $articlename;
2770 $response .=
2771 "<objectType articleName='$articlename' lsid='$lsid'>$type</objectType>\n";
2772 }
2773 $response .= "</Relationship>\n";
2774 }
2775 $response .= "</retrieveObjectDefinition>\n";
2776 return $response;
2777 }
2778
2779 =head2 retrieveNamespaces
2780
2781 Title : retrieveNamespaces
2782 Usage : $ns = $MOBY->retrieveNamespaces()
2783 Function : get the list of all registered Object types
2784 Returns : XML (see below)
2785 Args : none
2786 XML :
2787 <Namespaces>
2788 <Namespace name="namespace" lsid="urn:lsid:...">
2789 <Description><![CDATA[free text description here]]></Description>
2790 <contactEmail>email@address.here</contactEmail>
2791 <authURI>authority.uri.here</authURI>
2792 </Namespace>
2793 ...
2794 ...
2795 </Namespaces>
2796
2797 =cut
2798
2799 sub retrieveNamespaces {
2800 my ($pkg) = @_;
2801 my $OS = MOBY::OntologyServer->new( ontology => 'namespace' );
2802 my %types = %{ $OS->retrieveAllNamespaceTypes() };
2803 my $ns = "<Namespaces>\n";
2804 while ( my ( $namespace, $descr ) = each %types ) {
2805 my ($desc, $lsid, $auth, $contact) = @$descr;
2806 if ( $desc =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
2807 $desc = $1;
2808 }
2809 # $ns .= "<Namespace name='$namespace' lsid='$lsid'>\n<Description><![CDATA[$desc]]></Description>\n</Namespace>\n"; #COMMENT/REMOVE
2810 $ns .= "<Namespace name='$namespace' lsid='$lsid'>\n<Description><![CDATA[$desc]]></Description>\n<contactEmail>$contact</contactEmail>\n<authURI>$auth</authURI>\n</Namespace>\n";#UNCOMMENT
2811 }
2812 $ns .= "</Namespaces>";
2813 return $ns;
2814 }
2815
2816 =head2 retrieveObject
2817
2818 NOT YET IMPLEMENTED
2819 Title : retrieveObject
2820 Usage : $objects = $MOBY->retrieveObject($inputXML)
2821 Function : get the object xsd
2822 Returns : XML (see below)
2823 Args : $name - object name (from ontology) or "all" to get all objects
2824
2825 inputXML :
2826 <retrieveObject>
2827 <objectType>ObjectType | all</objectType>
2828 </retrieveObject>
2829
2830 outputXML :
2831 <Objects>
2832 <Object name="namespace">
2833 <Schema><XSD schema fragment here></Schema>
2834 </Object>
2835 ...
2836 ...
2837 </Objects>
2838
2839 =cut
2840
2841 sub retrieveObject {
2842 my ( $pkg, $payload ) = @_;
2843 my $response = "<Objects>\n";
2844 $response .= "<NOT_YET_IMPLEMENTED/>\n";
2845 $response .= "</Objects>\n";
2846 return $response;
2847 }
2848
2849 #Eddie - converted
2850 sub _retrieveObjectPayload {
2851 my ($payload) = @_;
2852 my $Parser = XML::LibXML->new();
2853 my $doc = $Parser->parse_string($payload);
2854 my $Object = $doc->getDocumentElement();
2855 my $obj = $Object->nodeName;
2856 return undef unless ( $obj eq 'retrieveObject' );
2857 my $type = &_nodeTextContent( $Object, "objectType" );
2858 return ($type);
2859 }
2860
2861 =head2 Relationships
2862
2863 Title : Relationships
2864 Usage : $ns = $MOBY->Relationships()
2865 Function : get the fist level of relationships for the given term
2866 Returns : output XML (see below)
2867 Args : Input XML (see below). relationshipTypes are optional.
2868 If included, it will limit the response to only those
2869 relationship types, otherwise you get all by default.
2870
2871 NOTE: the expandRelationships flag in the official API is not yet implemented.
2872 NOTE: THIS CURRENTLY ONLY FUNCTIONS PROPERLY FOR ISA RELATIONSHIPS since the
2873 expected behaviour with HAS and HASA relationships isn't yet defined.
2874
2875 input XML :
2876 <Relationships>
2877 <objectType>$term</objectType>
2878 <expandRelationship>1|0</expandRelationship>
2879 <relationshipType>$relationship_term</relationshipType>
2880 ... more relationship types
2881 ...
2882 </Relationships>
2883 OR
2884 <Relationships>
2885 <serviceType>$term</serviceType>
2886 <expandRelationship>1|0</expandRelationship>
2887 <relationshipType>$relationship_term</relationshipType>
2888 ... more relationship types
2889 ...
2890 </Relationships>
2891
2892
2893 outputXML :
2894 <Relationships>
2895 <Relationship relationshipType="RelationshipOntologyTerm">
2896 <objectType lsid='urn:lsid...'>ExistingObjectType</objectType>
2897 <objectType lsid='urn:lsid...'>ExistingObjectType</objectType>
2898 </Relationship>
2899 <Relationship relationshipType="AnotherRelationshipTerm">
2900 ....
2901 </Relationship>
2902 </Relationships>
2903
2904 OR
2905
2906 <Relationships>
2907 <Relationship relationshipType="RelationshipOntologyTerm">
2908 <serviceType lsid='urn:lsid...'>ExistingServiceType</serviceType>
2909 <serviceType lsid='urn:lsid...'>ExistingServiceType</serviceType>
2910 </Relationship>
2911 <Relationship relationshipType="AnotherRelationshipTerm">
2912 ....
2913 </Relationship>
2914 </Relationships>
2915
2916
2917 =cut
2918
2919 sub Relationships {
2920 my ( $pkg, $payload ) = @_;
2921 my $ontology;
2922 my $Parser = XML::LibXML->new();
2923 my $doc = $Parser->parse_string($payload);
2924 my $x = $doc->getElementsByTagName("relationshipType"); # this is ignored - it is always ISA
2925 my $l = $x->size();
2926 my $exp = $doc->getElementsByTagName("expandRelationship");
2927 my $expl = $exp->size();
2928 my $expand_relationship = &_nodeTextContent( $doc, 'expandRelationship' );
2929 $expand_relationship =~ s/\s//g;
2930 $expand_relationship ||= 0;
2931 my %reltypes;
2932 my $relationship;
2933
2934 for ( my $n = 1 ; $n <= $l ; ++$n ) {
2935 my @child = $x->get_node($n)->childNodes;
2936 foreach (@child) {
2937 next unless ( $_->nodeType == TEXT_NODE );
2938 my $name .= $_->toString;
2939 $name =~ s/\s//g;
2940 $reltypes{$name} = 1;
2941 $relationship = $name; # THIS WILL ALWYAS BE ISA
2942 }
2943 }
2944 my $term = &_nodeTextContent( $doc, "objectType" );
2945 $ontology = "object"
2946 if $term; # pick up the ontology "object" that we used here if we got an object term
2947 $term ||=
2948 &_nodeTextContent( $doc, "serviceType" ); # if we didn't get anything using objectType try serviceType
2949 return undef unless $term; # and bail out if we didn't succeed
2950 $ontology ||= "service"; # if we have now succeeded and haven't already taken the ontology then it must be the service ontology
2951 $debug && &_LOG("Ontology was $ontology; Term was $term\n");
2952 my $OS = MOBY::OntologyServer->new( ontology => $ontology );
2953
2954 # WE WOULD PREFER TO LOOP OVER EACH KEY IN %RELTYPE HERE, BUT HARD CODED TO JUST ISA
2955 $relationship ||='isa';
2956 my %rels = %{ $OS->Relationships(
2957 term => $term,
2958 expand => $expand_relationship,
2959 relationship => $relationship, # ISA always
2960 direction => 'root'
2961 )}; # %rels = $rels{relationship} = [lsid, lsid,lsid]
2962 my $response = "<Relationships>\n";
2963 my $OSrel = MOBY::OntologyServer->new( ontology => 'relationship' );
2964
2965 # this routine is kinda stupid now...
2966 foreach ( keys %reltypes ) { # for each of our desired types
2967 my $rellsid = $OSrel->getRelationshipURI( $ontology, $_ ); # get the LSID
2968 delete $reltypes{$_}; # remove the non-LSID version from the hash
2969 $reltypes{$rellsid} = 1; # set the LSID as valid
2970 }
2971
2972 # now for each of the relationship types that we were returned
2973 foreach ( keys %rels ) {
2974 my $rellsid = $OSrel->getRelationshipURI( $ontology, $_ );
2975 next unless $rellsid;
2976 if ( keys %reltypes ) {
2977 next unless $reltypes{ $rellsid}; # next unless it is one ofthe relationship types we requested
2978 }
2979 next unless $rels{$rellsid};
2980 my @lsids_articles = @{$rels{$rellsid}};
2981 next unless scalar @lsids_articles;
2982
2983 # THE ISA RELATIONSHIP IS NOW HARD!
2984
2985 $response .= "<Relationship relationshipType='$relationship' lsid='$rellsid'>\n";
2986 foreach my $lsid_article ( @lsids_articles ) {
2987 my $lsid = $lsid_article->{lsid};
2988 my $term = $lsid_article->{term};
2989 my $articleName = $lsid_article->{articleName};
2990 $response .= "<${ontology}Type lsid='$lsid' ";
2991 $response .= "articleName='$articleName'" if $articleName;
2992 $response .= ">$term</${ontology}Type>\n";
2993 }
2994 $response .= "</Relationship>\n";
2995 }
2996 $response .= "</Relationships>\n";
2997 return $response;
2998 }
2999
3000 =head2 DUMP_MySQL
3001
3002 Title : DUMP_MySQL
3003 Usage : $SQL = $MOBY->DUMP_MySQL; ($central,$object,$service,$namespace,$relat) = @{$SQL};
3004 Function : return a mysql dump of each of the current MOBY Central databases
3005 Returns : an array of SQL strings that can be used to recreate the database locally
3006 Args : none
3007
3008 =cut
3009
3010 sub DUMP_MySQL {
3011 my ($pkg) = @_;
3012 my $config = MOBY::Config->new();
3013 my @dbsections = (
3014 'mobycentral', 'mobyobject',
3015 'mobyservice', 'mobynamespace',
3016 'mobyrelationship'
3017 );
3018 my @response;
3019 foreach my $dbsection (@dbsections) {
3020 my $dbname = ${ ${$config}{$dbsection} }{'dbname'};
3021 my $username = ${ ${$config}{$dbsection} }{'username'};
3022 my $password = ${ ${$config}{$dbsection} }{'password'};
3023 my $host = ${ ${$config}{$dbsection} }{'url'};
3024 my $port = ${ ${$config}{$dbsection} }{'port'};
3025 open( IN,
3026 "mysqldump -h $host -P $port -u $username --password=$password $dbname|"
3027 )
3028 || die "can't open $dbname for dumping";
3029 my @dbdump;
3030 while (<IN>) {
3031 push @dbdump, $_;
3032 }
3033 my $dbdump = ( join "", @dbdump );
3034 push @response, $dbdump;
3035 }
3036 return [@response];
3037 }
3038 *DUMP = \&DUMP_MySQL; # alias it for backward compatibility
3039 *DUMP = \&DUMP_MySQL; # alias it for backward compatibility
3040
3041 #sub _flatten {
3042 # $CONFIG ||= MOBY::Config->new; # exported by Config.pm
3043 # my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
3044 #
3045 # # from a given term, traverse the ontology
3046 # # and flatten it into a list of parent terms
3047 # my ( $dbh, $type, $term, $seen ) = @_;
3048 #
3049 # my $result = $adaptor->get_parent_terms(relationship_type_id => $type,
3050 # term => $term);
3051 #
3052 # foreach my $row (@$result) {
3053 # my $term = $row->{term};
3054 # next if ${$seen}{$term};
3055 # &_flatten( $dbh, $type, $term, $seen );
3056 # ${$seen}{$term} = 1;
3057 # }
3058 #}
3059
3060 #Eddie - Converted
3061 sub _ISAPayload {
3062 my ($payload) = @_;
3063 my $Parser = XML::LibXML->new();
3064 my $doc = $Parser->parse_string($payload);
3065 my $Object = $doc->getDocumentElement();
3066 my $obj = $Object->nodeName;
3067 return undef unless ( $obj eq 'ISA' );
3068 my $type = &_nodeTextContent( $Object, "objectType" );
3069 return ($type);
3070 }
3071 =cut
3072
3073
3074
3075
3076
3077
3078
3079
3080 =head1 Internal Object Methods
3081
3082
3083 =cut
3084
3085 =head2 _getValidServices
3086
3087 Title : _getValidServices
3088 Usage : %valid = $MOBY->_getValidServices($sth_hash, $query, $max_return)
3089 Function : execute the query in $query to return a non-redundant list of matching services
3090 Returns : XML
3091 Args : none
3092
3093 =cut
3094
3095 #sub _getValidServices {
3096 # my ($sth_hash, $query, $max_return ) = @_;
3097 # my %sth = %{$sth_hash};
3098 # $debug && &_LOG("QUERY: \n$query\n\n");
3099 # my $this_query = $dbh->prepare($query);
3100 # $this_query->execute;
3101 # my $response;
3102 # my %seen;
3103 # $response = "<Services>\n";
3104 #
3105 # while ( my ( $serviceName, $objectOUT, $AuthURI, $desc, $type, $cat ) =
3106 # $this_query->fetchrow_array() )
3107 # {
3108 # $debug
3109 # && &_LOG("$serviceName, $objectOUT, $AuthURI,$desc, $type, $cat\n");
3110 # next
3111 # if $seen{ "$AuthURI" . "||"
3112 # . "$serviceName" }; # non-redundant list please
3113 # $seen{ "$AuthURI" . "||" . "$serviceName" } = 1;
3114 # $response .=
3115 # "<Service authURI='$AuthURI' serviceName='$serviceName'>\n";
3116 # $response .= "<Category>$cat</Category>\n";
3117 # $response .= "<serviceType>$type</serviceType>\n";
3118 # $response .= "<outputObject>$objectOUT</outputObject>\n";
3119 # if ( $desc =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
3120 # $desc = $1;
3121 # }
3122 # $response .= "<Description><![CDATA[$desc]]></Description>\n";
3123 # $response .= "</Service>\n";
3124 # if ($max_return) { --$max_return; last unless $max_return }
3125 # }
3126 # $response .= "</Services>\n";
3127 # $debug && &_LOG("\nFINAL RESPONSE IS \n$response\n\n");
3128 # return $response;
3129 #}
3130
3131 =head2 _getServiceWSDL
3132
3133 Title : _getServiceWSDL
3134 Usage : @valid = $MOBY->_getValidServices($dbh, $sth_hash, $query)
3135 Function : execute the query in $query to return a non-redundant list of matching services
3136 Returns : list of response strings in wsdl
3137 Args : none
3138
3139 =cut
3140
3141 sub _getServiceWSDL {
3142 my ( $SI, $InputXML, $OutputXML, $SecondaryXML ) = @_;
3143
3144 # the lines below causes no end of grief. It is now in a variable.
3145 #open (WSDL, "./MOBY/Central_WSDL_SandR.wsdl") || die "can't open WSDL file for search and replace\n";
3146 #my $wsdl = join "", (<WSDL>);
3147 my $wsdl = $WSDL_TEMPLATE;
3148 $wsdl =~ s/^\n//gs;
3149
3150 #close WSDL;
3151 # do substitutions
3152 my $serviceName = $SI->servicename;
3153 my $AuthURI = $SI->authority_uri;
3154 my $desc = $SI->description;
3155 if ( $desc =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
3156 $desc = $1;
3157 }
3158 my $URL = $SI->url;
3159 my $IN = "NOT_YET_DEFINED_INPUTS";
3160 my $OUT = "NOT_YET_DEFINED_OUTPUTS";
3161 my $INxsd = &_getInputXSD( $InputXML, $SecondaryXML );
3162 my $OUTxsd = &_getOutputXSD($OutputXML);
3163 $INxsd ||= "<NOT_YET_IMPLEMENTED_INPUT_XSD/>";
3164 $OUTxsd ||= "<NOT_YET_IMPLEMENTED_OUTPUT_XSD/>";
3165 $wsdl =~ s/MOBY__SERVICE__NAME__/$serviceName/g; # replace all of the goofy portbindingpottype crap
3166 $wsdl =~s/\<\!\-\-\s*MOBY__SERVICE__DESCRIPTION\s*\-\-\>/Authority: $AuthURI - $desc/g; # add a sensible description
3167 $wsdl =~ s/MOBY__SERVICE__URL/$URL/g; # the URL to the service
3168 #if (scalar @in){my ($IN, $INxsd) = @{shift @in}};
3169 #if (scalar @out){my ($OUT, $OUTxsd) = @{shift @out}};
3170 # $wsdl =~ s/MOBY__INPUT__OBJECT__NAME/$IN/g; # SINGLE input object (for now)
3171 # $wsdl =~ s/MOBY__OUTPUT__OBJECT__NAME/$OUT/g; # SINGLE output object (for now)
3172 # $wsdl =~ s/\<\!\-\-\s*MOBY__INPUT__OBJECT__XSD\s*\-\-\>/$INxsd/g; # XSD stright from the database
3173 # $wsdl =~ s/\<\!\-\-\s*MOBY__OUTPUT__OBJECT__XSD\s*\-\-\>/$OUTxsd/g; # XSD straight from the database
3174 $wsdl =~ s/MOBY__SERVICE__NAME/$serviceName/g; # finally replace the actual subroutine call
3175 return $wsdl;
3176 }
3177
3178 #sub _getCGIService {
3179 # my ( $dbh, $sth_hash, $id, $serviceName, $AuthURI, $URL, $desc, $category )
3180 # = @_;
3181 # my %sth = %{$sth_hash};
3182 #
3183 # # "Select OE.term, O.xsd, SP.type
3184 # # from Object as O, OntologyEntry as OE, ServiceParameter as SP, Service as S
3185 # # where O.ontologyentry_id = OE.id
3186 # # AND SP.ontologyentry_id = OE.id
3187 # # and SP.service_id = ?
3188 # my $sth = $dbh->prepare( $sth{get_server_parameters} );
3189 # $sth->execute($id);
3190 # my ( $Object, $sprintf, $in ) = $sth->fetchrow_array();
3191 # if ( $sprintf =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
3192 # $sprintf = $1;
3193 # }
3194 # return "<GETstring><![CDATA[$sprintf]]></GETstring>";
3195 #}
3196
3197
3198 #Eddie - converted
3199 sub _nodeTextContent {
3200
3201 # will get text of **all** child $node from the given $DOM
3202 # regardless of their depth!!
3203 my ( $DOM, $node ) = @_;
3204 $debug && &_LOG( "_nodeTextContent received DOM: ",
3205 $DOM->toString, "\nsearching for node $node\n" );
3206 my $x = $DOM->getElementsByTagName($node);
3207 return undef unless $x->get_node(1);
3208 my @child = $x->get_node(1)->childNodes;
3209 my $content;
3210 foreach (@child) {
3211 $debug
3212 && &_LOG( $_->nodeType, "\t", $_->toString, "\n" );
3213
3214 #next unless $_->nodeType == TEXT_NODE;
3215 $content .= $_->textContent;
3216 }
3217 return $content;
3218 }
3219
3220 sub _nodeCDATAContent {
3221
3222 # will get text of **all** child $node from the given $DOM
3223 # regardless of their depth!!
3224 my ( $DOM, $node ) = @_;
3225 $debug && &_LOG( "_nodeTextContent received DOM: ",
3226 $DOM->toString, "\nsearching for node $node\n" );
3227 my $x = $DOM->getElementsByTagName($node);
3228 return undef unless $x->get_node(1);
3229 my @child = $x->get_node(1)->childNodes;
3230 my $content;
3231 foreach (@child) {
3232 $debug
3233 && &_LOG( $_->nodeType, "\t", $_->toString, "\n" );
3234
3235 #next unless $_->nodeType == TEXT_NODE;
3236 if ( $_->toString =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
3237 $content .= $1;
3238 }
3239 else {
3240 $content .= $_->textContent;
3241 }
3242 }
3243 return $content;
3244 }
3245
3246 #Eddie - converted
3247 sub _nodeRawContent {
3248
3249 # will get raw child nodes of $node from the given $DOM
3250 my ( $DOM, $nodename ) = @_;
3251 my @content;
3252 $debug && &_LOG( "_nodeRawContent received DOM: ",
3253 $DOM->toString, "\nsearching for node $nodename\n" );
3254 my $x = $DOM->getElementsByTagName($nodename);
3255 my $node = $x->get_node(1);
3256 return [] unless $node;
3257 foreach my $child ( $node->childNodes ) {
3258 next unless $child->nodeType == ELEMENT_NODE;
3259 push @content, $child;
3260 }
3261 return \@content;
3262 }
3263
3264 #Eddie - converted
3265 sub _nodeArrayContent {
3266
3267 # will get array content of all child $node from given $DOM
3268 # regardless of depth!
3269 # e.g. the following XML:
3270 #<ISA>
3271 # <objectType>first</objectType>
3272 # <objectType>second</objectType>
3273 #</ISA>
3274 #will return the list "first", "second"
3275 my ( $DOM, $node ) = @_;
3276 $debug && &_LOG( "_nodeArrayContext received DOM: ",
3277 $DOM->toString, "\nsearching for node $node\n" );
3278 my @result;
3279 my $x = $DOM->getElementsByTagName($node);
3280 return @result unless $x->get_node(1);
3281 my @child = $x->get_node(1)->childNodes;
3282 foreach (@child) {
3283 next unless $_->nodeType == ELEMENT_NODE;
3284 my @child2 = $_->childNodes;
3285 foreach (@child2) {
3286
3287 #print getNodeTypeName($_), "\t", $_->toString,"\n";
3288 next unless $_->nodeType == TEXT_NODE;
3289 next unless ( length( $_->toString ) > 0 );
3290 push @result, $_->toString;
3291 }
3292 }
3293 $debug && _LOG("_nodeArrayContent resulted in @result\n");
3294 return @result;
3295 }
3296
3297 #Eddie - converted
3298 sub _nodeArrayExtraContent {
3299
3300 # will get array content of all child $node from given $DOM
3301 # regardless of depth!
3302 # e.g. the following XML:
3303 #<ISA>
3304 # <objectType articleName="thisone">first</objectType>
3305 # <objectType articleName="otherone">second</objectType>
3306 #</ISA>
3307 #will return the list
3308 # ['first',{'articleName' => 'thisone'}],
3309 # ['second',{'articleName' => 'otherone'},...
3310 my ( $DOM, $node, @attrs ) = @_;
3311 $debug && &_LOG( "_nodeArrayExtraContext received DOM: ",
3312 $DOM->toString, "\nsearching for node $node\n" );
3313 my @result;
3314 my %att_value;
3315 my $x = $DOM->getElementsByTagName($node);
3316 my @child = $x->get_node(1)->childNodes;
3317 foreach (@child) {
3318 next unless $_->nodeType == ELEMENT_NODE;
3319 foreach my $attr (@attrs) {
3320 $debug && &_LOG( "_nodeArrayExtraContext received DOM: ",
3321 $DOM->toString, "\nsearching for attributre $attr\n" );
3322 my $article =
3323 $_->getAttributeNode($attr); # may or may not have a name
3324 if ($article) { $article = $article->getValue() }
3325 $att_value{$attr} = $article;
3326 }
3327 my @child2 = $_->childNodes;
3328 foreach (@child2) {
3329
3330 #print getNodeTypeName($_), "\t", $_->toString,"\n";
3331 next unless $_->nodeType == TEXT_NODE;
3332 push @result, [ $_->toString, \%att_value ];
3333 }
3334 }
3335 $debug && &_LOG(@result);
3336 return @result;
3337 }
3338
3339 sub _serviceListResponse {
3340
3341
3342 # *********FIX
3343 # this routine is using service instances by their database ID, rather than their LSID
3344 # this is BAD BAD BAD
3345 $CONFIG ||= MOBY::Config->new; # exported by Config.pm
3346 my $adaptor = $CONFIG->getDataAdaptor( datasource => 'mobycentral' );
3347
3348 my (@ids ) = @_;
3349 my $output = "";
3350 my $OSobj = MOBY::OntologyServer->new( ontology => 'object' );
3351 my $OSns = MOBY::OntologyServer->new( ontology => 'namespace' );
3352 my $OSserv = MOBY::OntologyServer->new( ontology => 'service' );
3353
3354 # *********FIX
3355 # this routine is using service instances by their database ID, rather than their LSID
3356 # this is BAD BAD BAD
3357
3358 foreach (@ids) {
3359 my $result = $adaptor->query_service_instance(service_instance_id => $_);
3360 my $row = shift(@$result);
3361 my $category = $row->{category};
3362 my $url = $row->{url};
3363 my $servicename = $row->{servicename};
3364 my $service_type_uri = $row->{service_type_uri};
3365 my $authority_uri = $row->{authority_uri};
3366 my $desc = $row->{description};
3367 my $authoritative = $row->{authoritative};
3368 my $email = $row->{contact_email};
3369 my $signatureURL = $row->{signatureURL};
3370 my $lsid = $row->{lsid};
3371
3372 if ( $desc =~ /<!\[CDATA\[((?>[^\]]+))\]\]>/ ) {
3373 $desc = $1;
3374 }
3375
3376 $signatureURL ||= "";
3377 next unless ( $servicename && $authority_uri );
3378 my $service_type = $OSserv->getServiceCommonName($service_type_uri);
3379
3380 $output .= "\t<Service authURI='$authority_uri' serviceName='$servicename' lsid='$lsid'>\n";
3381 $output .= "\t<serviceType>$service_type</serviceType>\n";
3382 $output .= "\t<authoritative>$authoritative</authoritative>\n";
3383 $output .= "\t<Category>$category</Category>\n";
3384 $output .= "\t<Description><![CDATA[$desc]]></Description>\n";
3385 $output .= "\t<contactEmail>$email</contactEmail>\n";
3386 $output .= "\t<signatureURL>$signatureURL</signatureURL>\n";
3387 $output .= "\t<URL>$url</URL>\n";
3388 $output .= "\t<Input>\n";
3389
3390 $result = $adaptor->query_simple_input(service_instance_lsid => $lsid);
3391
3392 foreach my $row (@$result)
3393 {
3394 my $objURI = $row->{object_type_uri};
3395 my $nsURI = $row->{namespace_type_uris};
3396 my $article = $row->{article_name};
3397
3398 my $objName = $OSobj->getObjectCommonName($objURI);
3399 $nsURI ||= "";
3400 my @nsURIs = split ",", $nsURI;
3401 $article ||= "";
3402 $output .= "\t\t<Simple articleName='$article'>\n";
3403 $output .= "\t\t\t<objectType lsid='$objURI'>$objName</objectType>\n";
3404 foreach my $ns (@nsURIs) {
3405 my $NSname = $OSns->getNamespaceCommonName($ns);
3406 $output .= "\t\t\t<Namespace lsid='$ns'>$NSname</Namespace>\n" if $NSname;
3407 }
3408 $output .= "\t\t</Simple>\n";
3409 }
3410 $result = $adaptor->query_collection_input(service_instance_lsid => $lsid);
3411
3412 foreach my $row (@$result)
3413 {
3414 my $collid = $row->{collection_input_id};
3415 my $articlename = $row->{article_name};
3416
3417 $output .= "\t\t<Collection articleName='$articlename'>\n";
3418
3419 my $result2 = $adaptor->query_simple_input(service_instance_lsid => undef, collection_input_id => $collid);
3420 foreach my $row2 (@$result2)
3421 {
3422 my $objURI = $row2->{object_type_uri};
3423 my $nsURI = $row2->{namespace_type_uris};
3424 my $article = $row2->{article_name};
3425
3426 my $objName = $OSobj->getObjectCommonName($objURI);
3427 $nsURI ||= "";
3428 my @nsURIs = split ",", $nsURI;
3429 $article ||= "";
3430 $output .= "\t\t\t<Simple articleName='$article'>\n";
3431 $output .= "\t\t\t\t<objectType lsid='$objURI'>$objName</objectType>\n";
3432 foreach my $ns (@nsURIs) {
3433 my $NSname = $OSns->getNamespaceCommonName($ns);
3434 $output .= "\t\t\t\t<Namespace lsid='$ns'>$NSname</Namespace>\n"
3435 if $NSname;
3436 }
3437 $output .= "\t\t\t</Simple>\n";
3438 }
3439 $output .= "\t\t</Collection>\n";
3440 }
3441 $output .= "\t</Input>\n";
3442 $output .= "\t<Output>\n";
3443
3444 $result = $adaptor->query_simple_output(service_instance_lsid => $lsid, collection_output_id => undef);
3445
3446 foreach my $row (@$result)
3447 {
3448 my $objURI = $row->{object_type_uri};
3449 my $nsURI = $row->{namespace_type_uris};
3450 my $article = $row->{article_name};
3451
3452 my $objName = $OSobj->getObjectCommonName($objURI);
3453 $nsURI ||= "";
3454 my @nsURIs = split ",", $nsURI;
3455 $article ||= "";
3456 $output .= "\t\t<Simple articleName='$article'>\n";
3457 $output .= "\t\t\t<objectType lsid='$objURI'>$objName</objectType>\n";
3458 foreach my $ns (@nsURIs) {
3459 my $NSname = $OSns->getNamespaceCommonName($ns);
3460 $output .= "\t\t\t<Namespace lsid='$ns'>$NSname</Namespace>\n" if $NSname;
3461 }
3462 $output .= "\t\t</Simple>\n";
3463 }
3464
3465 $result = $adaptor->query_collection_output(service_instance_lsid => $lsid);
3466 foreach my $row (@$result)
3467 {
3468 my $collid = $row->{collection_output_id};
3469 my $articlename = $row->{article_name};
3470 $output .= "\t\t<Collection articleName='$articlename'>\n";
3471
3472 my $result2 = $adaptor->query_simple_output(service_instance_lsid => undef, collection_output_id => $collid);
3473 foreach my $row2 (@$result2 )
3474 {
3475 my $objURI = $row2->{object_type_uri};
3476 my $nsURI = $row2->{namespace_type_uris};
3477 my $article = $row2->{article_name};
3478 my $objName = $OSobj->getObjectCommonName($objURI);
3479 $nsURI ||= "";
3480 my @nsURIs = split ",", $nsURI;
3481 $article ||= "";
3482 $output .= "\t\t\t<Simple articleName='$article'>\n";
3483 $output .= "\t\t\t\t<objectType lsid='$objURI'>$objName</objectType>\n";
3484 foreach my $ns (@nsURIs) {
3485 my $NSname = $OSns->getNamespaceCommonName($ns);
3486 $output .= "\t\t\t\t<Namespace lsid='$ns'>$NSname</Namespace>\n"
3487 if $NSname;
3488 }
3489 $output .= "\t\t\t</Simple>\n";
3490 }
3491 $output .= "\t\t</Collection>\n";
3492 }
3493 $output .= "\t</Output>\n";
3494 $output .= "\t<secondaryArticles>\n";
3495 $result = $adaptor->query_secondary_input(service_instance_lsid => $lsid);
3496 foreach my $row (@$result)
3497 { my($default_value, $maximum_value, $minimum_value, $enum_value, $datatype, $article_name) = ("","","","","","");
3498 $default_value = $row->{default_value};
3499 $maximum_value = $row->{maximum_value};
3500 $minimum_value = $row->{minimum_value};
3501 $enum_value = $row->{enum_value};
3502 $datatype = $row->{datatype};
3503 $article_name = $row->{article_name};
3504
3505 $output .= "\t\t\t<Parameter articleName='$article_name'>\n";
3506 $output .= "\t\t\t\t<datatype>$datatype</datatype>\n";
3507 $output .= "\t\t\t\t<default>$default_value</default>\n";
3508 $output .= "\t\t\t\t<max>$maximum_value</max>\n";
3509 $output .= "\t\t\t\t<min>$minimum_value</min>\n";
3510 my @enums = split ",", $enum_value;
3511
3512 if ( scalar(@enums) ) {
3513 foreach my $enum (@enums) {
3514 $output .= "\t\t\t\t<enum>$enum</enum>\n";
3515 }
3516 }
3517 else {
3518 $output .= "\t\t\t\t<enum></enum>\n";
3519 }
3520 $output .= "\t\t\t</Parameter>\n";
3521 }
3522 $output .= "\t\t</secondaryArticles>\n";
3523 $output .= "\t</Service>\n";
3524 }
3525 return "<Services>\n$output\n</Services>\n";
3526 }
3527
3528 sub _error {
3529 my ( $message, $id ) = @_;
3530 $id ||="";
3531 $message ||="";
3532
3533 my $reg = &Registration(
3534 {
3535 success => 0,
3536 message => "$message",
3537 id => "$id",
3538 }
3539 );
3540 return $reg;
3541 }
3542
3543 sub _success {
3544 my ( $message, $id, $RDF ) = @_;
3545 my $reg = &Registration(
3546 {
3547 success => 1,
3548 message => "$message",
3549 id => "$id",
3550 RDF => $RDF,
3551 }
3552 );
3553 return $reg;
3554 }
3555
3556 sub _getOntologyServer { # may want to make this more complex
3557 my (%args) = @_;
3558 my $OS = MOBY::OntologyServer->new(%args);
3559 return $OS;
3560 }
3561 sub DESTROY { }
3562
3563 sub _LOG {
3564
3565 return unless $debug;
3566 #print join "\n", @_;
3567 #print "\n---\n";
3568 #return;
3569 open LOG, ">>/tmp/CentralRegistryLogOut.txt"
3570 or die "can't open mobycentral error logfile $!\n";
3571 print LOG join "\n", @_;
3572 print LOG "\n---\n";
3573 close LOG;
3574 }
3575
3576 #
3577 #
3578 # --------------------------------------------------------------------------------------------------------
3579 #
3580 ##
3581 ##
3582
3583
3584 $WSDL_TEMPLATE = <<END;
3585 <?xml version="1.0"?>
3586 <wsdl:definitions name="MOBY_Central_Generated_WSDL"
3587 targetNamespace="http://biomoby.org/Central.wsdl"
3588 xmlns:tns="http://biomoby.org/Central.wsdl"
3589 xmlns:xsd1="http://biomoby.org/CentralXSDs.xsd"
3590 xmlns:soap="http://schemas.xmlsoap.org/wsdl/soap/"
3591 xmlns:xsd="http://www.w3.org/1999/XMLSchema"
3592 xmlns="http://schemas.xmlsoap.org/wsdl/"
3593 xmlns:wsdl="http://schemas.xmlsoap.org/wsdl/">
3594
3595
3596 <wsdl:message name="MOBY__SERVICE__NAME__Input">
3597 <wsdl:part name="data" type="xsd:string"/>
3598 </wsdl:message>
3599
3600 <wsdl:message name="MOBY__SERVICE__NAME__Output">
3601 <wsdl:part name="body" type="xsd:string"/>
3602 </wsdl:message>
3603
3604 <wsdl:portType name="MOBY__SERVICE__NAME__PortType">
3605 <wsdl:operation name="MOBY__SERVICE__NAME">
3606 <wsdl:input message="tns:MOBY__SERVICE__NAME__Input"/>
3607 <wsdl:output message="tns:MOBY__SERVICE__NAME__Output"/>
3608 </wsdl:operation>
3609 </wsdl:portType>
3610
3611 <wsdl:binding name="MOBY__SERVICE__NAME__Binding" type="tns:MOBY__SERVICE__NAME__PortType">
3612 <soap:binding style="rpc" transport="http://schemas.xmlsoap.org/soap/http"/>
3613 <wsdl:operation name="MOBY__SERVICE__NAME"><!-- in essense, this is the name of the subroutine that is called -->
3614 <soap:operation soapAction='http://biomoby.org/#MOBY__SERVICE__NAME' style='rpc'/>
3615 <wsdl:input>
3616 <soap:body use="encoded" namespace="http://biomoby.org/" encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"/>
3617 </wsdl:input>
3618 <wsdl:output>
3619 <soap:body use="encoded"/>
3620 </wsdl:output>
3621 </wsdl:operation>
3622 </wsdl:binding>
3623
3624 <wsdl:service name="MOBY__SERVICE__NAME__Service">
3625 <wsdl:documentation><!-- MOBY__SERVICE__DESCRIPTION --></wsdl:documentation> <!-- service description goes here -->
3626 <wsdl:port name="MOBY__SERVICE__NAME__Port" binding="tns:MOBY__SERVICE__NAME__Binding">
3627 <soap:address location="MOBY__SERVICE__URL"/> <!-- URL to service scriptname -->
3628 </wsdl:port>
3629 </wsdl:service>
3630
3631 </wsdl:definitions>
3632
3633
3634 END
3635
3636 =head2 _getInputXSD
3637
3638 name : _getInputXSD($InputXML, $SecondaryXML)
3639 function: to get an XSD describing the input to a MOBY Service,
3640 e.g. to use in a WSDL document
3641 args : (see _serviceListResponse code above for full details of XML)
3642 $InputXML - the <Input>...</Input> block of a findService
3643 response message
3644
3645 $SecondaryXML - the <secondaryArticles>...<sescondaryArticles>
3646 fragment of a findService response message
3647
3648 returns : XSD fragment of XML (should not return an XML header!)
3649 notes : the structure of an Input block is as follows:
3650 <Input>
3651 <!-- one or more Simple or Collection articles -->
3652 </Input>
3653
3654 the structure of a secondaryArticle block is as follows:
3655 <sescondaryArticles>
3656 <!-- one or more Parameter blocks -->
3657 </secondaryArticles>
3658
3659
3660 =over
3661
3662 =item * Simple
3663
3664 <Simple articleName="NameOfArticle">
3665 <objectType>ObjectOntologyTerm</objectType>
3666 <Namespace>NamespaceTerm</Namespace>
3667 <Namespace>...</Namespace><!-- one or more... -->
3668 </Simple>
3669
3670 =item * Collection note that articleName of the contained Simple objects is not required, and is ignored.
3671
3672
3673 <Collection articleName="NameOfArticle">
3674 <Simple>......</Simple> <!-- Simple parameter type structure -->
3675 <Simple>......</Simple> <!-- DIFFERENT Simple parameter type
3676 (used only when multiple Object Classes
3677 appear in a collection) -->
3678 </Collection>
3679
3680 =item * Secondary
3681
3682
3683 <Parameter articleName="NameOfArticle">
3684 <datatype>INT|FLOAT|STRING</datatype>
3685 <default>...</default> <!-- any/all of these -->
3686 <max>...</max> <!-- ... -->
3687 <min>...</min> <!-- ... -->
3688 <enum>...<enum> <!-- ... -->
3689 <enum>...<enum> <!-- ... -->
3690 </Parameter>
3691
3692 =back
3693
3694 =cut
3695
3696 sub _getInputXSD {
3697 my ( $Input, $Secondary ) = @_;
3698 my $XSD;
3699 return $XSD;
3700 }
3701
3702 =head2 _getOuputXSD
3703
3704 name : _getOutputXSD($OutputXML)
3705 function: to get an XSD describing the output from a MOBY Service
3706 e.g. to use in a WSDL document
3707 args : (see _serviceListResponse code above for full details)
3708 $InputXML - the <Input>...</Input> block of a findService
3709 response message
3710
3711 $SecondaryXML - the <secondaryArticles>...<sescondaryArticles>
3712 fragment of a findService response message
3713
3714 returns : XSD fragment of XML (should not return an XML header!)
3715 notes : the structure of an Output block is as follows:
3716 <Input>
3717 <!-- one or more Simple or Collection articles -->
3718 </Input>
3719
3720 =over
3721
3722 =item * Simple
3723
3724 <Simple articleName="NameOfArticle">
3725 <objectType>ObjectOntologyTerm</objectType>
3726 <Namespace>NamespaceTerm</Namespace>
3727 <Namespace>...</Namespace><!-- one or more... -->
3728 </Simple>
3729
3730 =item * Collection note that articleName of the contained Simple objects is not required, and is ignored.
3731
3732
3733 <Collection articleName="NameOfArticle">
3734 <Simple>......</Simple> <!-- Simple parameter type structure -->
3735 <Simple>......</Simple> <!-- DIFFERENT Simple parameter type
3736 (used only when multiple Object Classes
3737 appear in a collection) -->
3738 </Collection>
3739
3740 =back
3741
3742 =cut
3743
3744 sub _getOutputXSD {
3745 my ($Output) = @_;
3746 my $XSD;
3747 return $XSD;
3748 }
3749
3750 1;
3751
Various Modules relating to SGN