lib/MOBY/myScript.pl

   1 #!/usr/bin/perl -w -Wall
   2 use strict;
   3 use diagnostics;
   4 use lib "C:/Perl/site/lib/MOBY";
   5 use MOBY::Client::Central;
   6 my $v = 1 if ($ARGV[0] && ($ARGV[0] eq "verbose"));
   7
   8 sub TEST {  # test of Registration object
   9     my ($reg, $test, $expect) = @_;
  10     die "\a\a\aREG OBJECT MALFORMED" unless $reg;
  11     if ($reg->success == $expect){
  12         print "test $test\t\t[PASS] ", ($v?($reg->message):""),"\n";
  13     } else {
  14         print "test $test\t\t[FAIL] ",$reg->message,"\n\n";
  15     }
  16 }
  17 sub TEST2 {  # test of ServiceInstance object listref
  18   my  ($SI, $REG, $test, $expect) = @_;
  19     die "\a\a\aServiceInstance Response MALFORMED" if ($SI && !(ref($SI) =~ /array/i));
  20     if (defined($REG) && $expect){
  21         print "test $test\t\t[FAIL]\n", $REG->message,"\n";
  22     } elsif (($SI->[0] && $expect) || (!$SI->[0] && !$expect)) {
  23         print "test $test\t\t[PASS]\n";
  24     } else {
  25                 print "test $test\t\t[FAIL]\nExpected to find service; didn't find service\n";
  26         }
  27
  28 }
  29 my $URL = $ENV{MOBY_SERVER}?$ENV{MOBY_SERVER}:'http://mobycentral.cbr.nrc.ca:8080/cgi-bin/MOBY05/testmobycentral.pl';
  30 my $URI = $ENV{MOBY_URI}?$ENV{MOBY_URI}:'http://mobycentral.cbr.nrc.ca:8080/MOBY/Central';
  31 my $PROXY = $ENV{MOBY_PROXY}?$ENV{MOBY_PROXY}:'No Proxy Server';
  32
  33 my $C = MOBY::Client::Central->new(
  34 Registries => {
  35   mobycentral => {URL => $URL,
  36                                   URI => $URI}
  37                                                 }
  38 );
  39
  40 print "TESTING MOBY CLIENT with\n\tURL:  $URL\n\tURI: $URI\n\tProxy: $PROXY\n\n";
  41
  42
  43 #register with two ISA's -> should fail
  44 TEST($C->registerObjectClass(objectType => "HypotheticalObject1",
  45                 description => "a human-readable description of the object",
  46                 contactEmail => 'your@email.address',
  47                 authURI => "blah.blah.blah",
  48                             Relationships => {
  49                                         ISA => [
  50                                                 ['Object', 'article1'],
  51                                                 ['Object', 'articleName2']],
  52                                         HASA => [
  53                                                 ['Object', 'articleName3']]}
  54                        ), '1a', 0);
  55
  56 #register with no ISA's -> should fail
  57 TEST($C->registerObjectClass(objectType => "HypotheticalObject1",
  58                 description => "a human-readable description of the object",
  59                 contactEmail => 'your@email.address',
  60                 authURI => "blah.blah.blah",
  61                             Relationships => {
  62                                         HASA => [
  63                                                 ['Object', 'articleName3']]}
  64                        ), '1b', 0);
  65
  66 #reg first object class with a single ISA -> should pass
  67 TEST($C->registerObjectClass(objectType => "HypotheticalObject1",
  68                 description => "a human-readable description of the object",
  69                 contactEmail => 'your@email.address',
  70                 authURI => "blah.blah.blah",
  71                             Relationships => {
  72                                         ISA => [
  73                                                 ['Object', 'articleName2']],
  74                                         HASA => [
  75                                                 ['Object', 'articleName3']]}
  76                        ), 1, 1);
  77
  78 #reg duplicate object class
  79 TEST($C->registerObjectClass(objectType => "HypotheticalObject1",
  80                 description => "a human-readable description of the object",
  81                                 contactEmail => 'your@email.address',
  82                 authURI => "blah.blah.blah",
  83                             Relationships => {
  84                                         ISA => [
  85                                                 ['Object', 'article1']
  86                                                 ],
  87                                         HASA => [
  88                                                 ['Object', 'articleName3']]}
  89                        ), 2, 0);
  90
  91 #reg second object class
  92 TEST($C->registerObjectClass(objectType => "HypotheticalObject2",
  93                 description => "a human-readable description of the object",
  94                                 contactEmail => 'your@email.address',
  95                 authURI => "blah.blah.blah",
  96                             Relationships => {
  97                                         ISA => [
  98                                                 ['Object', 'articleName2']],
  99                                         HASA => [
 100                                                 ['Object', 'articleName3']]}
 101                        ), 3, 1);
 102
 103 TEST($C->registerServiceType(serviceType => "HypotheticalService1",
 104                 description => "a human-readable description of the service",
 105                                 contactEmail => 'your@email.address',
 106                 authURI => "blah.blah.blah",
 107                             Relationships => {
 108                                         ISA => ['Retrieval','Analysis']}
 109                        ), 4, 1);
 110
 111 TEST($C->registerServiceType(serviceType => "HypotheticalService1",
 112                 description => "a human-readable description of the service",
 113                                 contactEmail => 'your@email.address',
 114                 authURI => "blah.blah.blah",
 115                             Relationships => {
 116                                         ISA => ['Retrieval','Analysis']}
 117                        ), 5, 0);
 118
 119 TEST($C->deregisterObjectClass(objectType => "HypotheticalObject1"), 6, 1);
 120 TEST($C->deregisterObjectClass(objectType => "HypotheticalObject1"), 7, 0);
 121 TEST($C->deregisterObjectClass(objectType => "HypotheticalObject2"), 8, 1);
 122 TEST($C->deregisterServiceType(serviceType => "HypotheticalService1"), 9, 1);
 123 TEST($C->deregisterServiceType(serviceType => "HypotheticalService1"), 10, 0);
 124 TEST($C->registerNamespace(
 125     namespaceType =>'HypotheticalNamespace1',
 126     authURI => 'your.authority.URI',
 127     description => "human readable description of namespace",
 128     contactEmail => 'your@address.here'), 11, 1);
 129 TEST($C->registerNamespace(
 130     namespaceType =>'HypotheticalNamespace1',
 131     authURI => 'your.authority.URI',
 132     description => "human readable description of namespace",
 133     contactEmail => 'your@address.here'), 12, 0);
 134 TEST($C->deregisterNamespace(namespaceType =>'HypotheticalNamespace1'), 13, 1);
 135
 136
 137 #reg first object class
 138 TEST($C->registerObjectClass(objectType => "HypotheticalObject1",
 139                 description => "a human-readable description of the object",
 140                 contactEmail => 'your@email.address',
 141                 authURI => "blah.blah.blah",
 142                             Relationships => {
 143                                         ISA => [
 144                                                 ['Object', 'article1']]}
 145                        ), 14, 1);
 146
 147 #reg duplicate object class
 148 TEST($C->registerObjectClass(objectType => "HypotheticalObject2",
 149                 description => "a human-readable description of the object",
 150                                 contactEmail => 'your@email.address',
 151                 authURI => "blah.blah.blah",
 152                             Relationships => {
 153                                         ISA => [
 154                                                 ['HypotheticalObject1', 'article1']]}
 155                        ), 15, 1);
 156
 157 TEST($C->deregisterObjectClass(objectType => "HypotheticalObject1"), 16, 0);
 158
 159 TEST($C->registerNamespace(
 160     namespaceType =>'HypotheticalNamespace1',
 161     authURI => 'your.authority.URI',
 162     description => "human readable description of namespace",
 163     contactEmail => 'your@address.here'), 17, 1);
 164
 165 TEST($C->registerService(
 166     serviceName  => "myfirstservice",
 167     serviceType  => "Retrieval",
 168     authURI      => "www.illuminae.com",
 169     contactEmail => 'your@mail.address',
 170     description => "this is my first service",
 171     category  =>  "moby",
 172     URL    =>  "http://illuminae/cgi-bin/service.pl",
 173         input =>[
 174         ['articleName1', [Object => ['HypotheticalNamespace1']]], # Simple
 175                 ],
 176         output =>[
 177         ['articleName2', [String => ['HypotheticalNamespace1']]], # Simple
 178                  ],
 179         secondary => {
 180         parametername1 => {
 181             datatype => 'Integer',
 182                 default => 0,
 183                         max => 10,
 184                         min => -10,
 185                         enum => [-10, 10, 0]}}), 18, 1);
 186
 187 TEST($C->registerService(
 188     serviceName  => "myfirstservice",
 189     serviceType  => "Retrieval",
 190     authURI      => "www.illuminae.com",
 191     contactEmail => 'your@mail.address',
 192     description => "this is my first service",
 193     category  =>  "moby",
 194     URL    =>  "http://illuminae/cgi-bin/service.pl",
 195         input =>[
 196         ['articleName1', [Object => ['HypotheticalNamespace1']]], # Simple
 197                 ],
 198         output =>[
 199         ['articleName2', [String => ['HypotheticalNamespace1']]], # Simple
 200                  ],
 201         ), 19, 0);
 202
 203 TEST($C->registerService(
 204     serviceName  => "myfirstservice2",
 205     serviceType  => "Retrieval",
 206     authURI      => "www.illuminae.com",
 207     contactEmail => 'your@mail.address',
 208     description => "this is my first service",
 209     category  =>  "moby",
 210     URL    =>  "http://illuminae/cgi-bin/service.pl",
 211         input =>[
 212 #        ['articleName1', [[Object => ['HypotheticalNamespace1']]]], # Collection
 213                 ['articleName1', [Object => ['HypotheticalNamespace1']]], # Simple
 214                 ],
 215         output =>[
 216         ['articleName2', [String => ['HypotheticalNamespace1']]], # Simple
 217                  ],
 218         ), 20, 1);
 219
 220
 221 TEST2($C->findService(
 222      serviceName  => "myfirstservice2",
 223      serviceType  => "Retrieval",
 224      authURI      => "www.illuminae.com",
 225      authoritative => 0,
 226      category  =>  "moby",
 227          expandObjects => 1,
 228      input =>[
 229               ["Object"], # Simple
 230               ]), 21, 1);
 231
 232 TEST2($C->findService(
 233      serviceName  => "myfirstservice2",
 234         ), 22, 1);
 235
 236 TEST2($C->findService(
 237      input =>[
 238               ["BlahObject"], # Simple
 239               ]), 23, 0);
 240
 241 TEST2($C->findService(
 242      input =>[
 243               ["Object", ['HypotheticalNamespace1']], # Simple
 244               ]), 24, 1);
 245
 246 my ($si, $reg) = $C->findService(
 247      serviceName => "myfirstservice2"
 248 );
 249
 250 $si = $si->[0];
 251 my $wsdl = $C->retrieveService($si);
 252 print $wsdl;
 253 if ($wsdl && ($wsdl =~ /\<definitions/)){
 254         print "test 25\t\t[PASS]\n";
 255 } else {
 256         print "test 25\t\t[FAIL]\tWSDL was not retrieved\n\n";
 257 }
 258
 259
 260
 261 TEST($C->deregisterService(
 262     serviceName  => "myfirstservice2",
 263     authURI      => "www.illuminae.com",
 264     ), 26, 1);
 265 TEST($C->deregisterService(
 266     serviceName  => "myfirstservice2",
 267     authURI      => "www.illuminae.com",
 268     ), 27, 0);
 269 TEST($C->deregisterService(
 270     serviceName  => "myfirstservice",
 271     authURI      => "www.illuminae.com",
 272     ), 28, 1);
 273 #TEST($C->deregisterService(
 274 #    serviceName  => "getDragonSimpleAnnotatedImages",
 275 #    authURI      => "www.illuminae.com",
 276 #    ), 29, 0);  # cant deregister a service with a signatureURL
 277
 278 TEST($C->deregisterObjectClass(objectType => "HypotheticalObject2"), 30, 1);
 279 TEST($C->deregisterObjectClass(objectType => "HypotheticalObject1"), 31, 1);
 280 TEST($C->deregisterNamespace(namespaceType =>'HypotheticalNamespace1'), 32, 1);
 281
 282 exit 0;
 283