lib/MOBY/Client/Service.pm

   1 #$Id: Service.pm,v 1.24 2006/01/31 22:19:02 fgibbons Exp $
   2
   3 =head1 NAME
   4
   5 MOBY::Client::Service - an object for communicating with MOBY Services
   6
   7 =head1 SYNOPSIS
   8
   9  use MOBY::Client::Service;
  10
  11  my $Service = MOBY::Client::Service->new(service => $WSDL);
  12  my $result = $Service->execute(@args);
  13
  14 =head1 DESCRIPTION
  15
  16 Deals with all SOAPy rubbish required to communicate with a MOBY Service.
  17 The object is created using the WSDL file returned from a
  18 MOBY::Client::Central->retrieveService() call.  The only useful method call
  19 in this module is "execute", which executes the service.
  20
  21 =head1 AUTHORS
  22
  23 Mark Wilkinson (markw@illuminae.com)
  24
  25 BioMOBY Project:  http://www.biomoby.org
  26
  27 =head1 METHODS
  28
  29 =head2 new
  30
  31  Usage     :    $Service = MOBY::Client::Service->new(@args)
  32  Function  :    create a service connection
  33  Returns   :    MOBY::Client::Service object, undef if no wsdl.
  34  Args      :    service : string ; required
  35                           a WSDL file defining a MOBY service
  36                 uri     : string ; optional ; default NULL
  37                           if the URI of the soap call needs to be personalized
  38                           this should almost never happen...
  39
  40 =cut
  41
  42 package MOBY::Client::Service;
  43 use SOAP::Lite;
  44
  45 #use SOAP::Lite + 'trace';
  46 use strict;
  47 use Carp;
  48 use Cwd;
  49 use URI::Escape;
  50 use vars qw($AUTOLOAD @ISA);
  51 my $debug = 0;
  52 if ( $debug ) {
  53         open( OUT, ">/tmp/ServiceCallLogOut.txt" ) || die "cant open logfile\n";
  54         close OUT;
  55 }
  56
  57 sub BEGIN {
  58 }
  59 {
  60
  61         #Encapsulated class data
  62         #___________________________________________________________
  63         #ATTRIBUTES
  64         my %_attr_data =    #                                   DEFAULT         ACCESSIBILITY
  65           (
  66                 service      => [ undef, 'read/write' ],
  67                 uri          => [ undef, 'read/write' ],
  68                 serviceName  => [ undef, 'read/write' ],
  69                 _soapService => [ undef, 'read/write' ],
  70                 smessageVersion => ['0.87', 'read'      ],
  71           );
  72
  73         #_____________________________________________________________
  74         # METHODS, to operate on encapsulated class data
  75         # Is a specified object attribute accessible in a given mode
  76         sub _accessible {
  77                 my ( $self, $attr, $mode ) = @_;
  78                 $_attr_data{$attr}[1] =~ /$mode/;
  79         }
  80
  81         # Classwide default value for a specified object attribute
  82         sub _default_for {
  83                 my ( $self, $attr ) = @_;
  84                 $_attr_data{$attr}[0];
  85         }
  86
  87         # List of names of all specified object attributes
  88         sub _standard_keys {
  89                 keys %_attr_data;
  90         }
  91         my $queryID = 0;
  92
  93         sub _nextQueryID {
  94                 return ++$queryID;
  95         }
  96 }
  97
  98 sub new {
  99         my ( $caller, %args ) = @_;
 100         my $caller_is_obj = ref( $caller );
 101         my $class         = $caller_is_obj || $caller;
 102         my $self          = bless {}, $class;
 103         foreach my $attrname ( $self->_standard_keys ) {
 104                 if ( exists $args{$attrname} ) {
 105                         $self->{$attrname} = $args{$attrname};
 106                 } elsif ( $caller_is_obj ) {
 107                         $self->{$attrname} = $caller->{$attrname};
 108                 } else {
 109                         $self->{$attrname} = $self->_default_for( $attrname );
 110                 }
 111         }
 112
 113         #my $dir = cwd;
 114         # seems to be a bug in SOAP::Lite that the WSDL document
 115         # fails a parse if it is passed as a scalar rather than a file
 116         # this section can be removed when this bug is fixed
 117         #open (OUT, ">$dir/Service.wsdl") || die "cant open dump of wsdl file";
 118         #print OUT $self->service;
 119         #close OUT;
 120         # ________________________________________
 121         my $wsdl =
 122           URI::Escape::uri_escape( $self->service );    # this seems to fix the bug
 123         return undef unless $wsdl;
 124         my $soap = SOAP::Lite->service( "data:,$wsdl" );
 125         if ( $self->uri ) { $soap->uri( $self->uri ) }
 126         $self->serviceName( &_getServiceName( $soap ) );
 127         $self->_soapService( $soap );
 128         return $self;
 129 }
 130
 131 =head2 execute
 132
 133  Usage     :    $result = $Service->execute(%args)
 134  Function  :    execute the MOBY service
 135  Returns   :    whatever the Service provides as output
 136  Args      :    XMLinputlist => \@data
 137  Comment   :    @data is a list of single invocation inputs; the XML goes between the
 138                 <queryInput> tags of a servce invocation XML.
 139 Each element of @data is itself a listref of [articleName, $XML].
 140                 articleName may be undef if it isn't required.
 141                 $XML is the actual XML of the Input object
 142
 143 =head3 Examples
 144
 145 There are several ways in which you can execute a service. You may
 146 wish to invoke the service on several objects, and get the response
 147 back in a single message. You may wish to pass in a collection of
 148 objects, which should be treated as a single entity. Or you may wish
 149 to pass in parameters, along with data. In each case, you're passing in
 150
 151    XMLinputlist => [ ARGS ]
 152
 153 The structure of @ARGS helps MOBY to figure out what you want.
 154
 155 =over 4
 156
 157 =item Iterate over multiple Simples
 158
 159 To have the service iterate over multiple equivalent objects, and
 160 return all the results in a single message, use this syntax (ARGS =
 161 ([...], [...], ...):
 162
 163   $Service->execute(XMLinputlist => [
 164                         ['object1', '<Object namespace="blah" id="123"/>'],
 165                         ['object2', '<Object namespace="blah" id="234"/>']
 166                             ]);
 167
 168 This would invoke the service twice (in a single message) the first
 169 time with an object "123" and the second time with object "234".
 170
 171 =item Process a Collection
 172
 173 To pass in a Collection, you need this syntax (ARGS = [ '', [..., ..., ...] ]):
 174
 175   $Service->execute(XMLinputlist => [
 176                  ['', [
 177                      '<Object namespace="blah" id="123"/>',
 178                      '<Object namespace="blah" id="234"/>']
 179               ]);
 180
 181 This would invoke the service once with a collection of inputs that
 182 are not required to be named ('').
 183
 184 =item Process multiple Simple inputs
 185
 186 To pass in multiple inputs, to be considered neither a Collection nor sequentially evaluated, use this syntax (ARGS = [..., ..., ...])
 187
 188   $Service->execute(XMLinputlist => [
 189             [
 190              'input1', '<Object namespace="blah" id="123"/>',
 191              'input2', '<Object namespace="blah" id="234"/>',
 192             ]
 193                      ]);
 194
 195 This would cause a single invocation of a service requiring two input
 196 parameters named "input1" and "input2"
 197
 198 =item Parameters
 199
 200 Finally, MOBY will recognize parameters by virtue of their having been
 201 declared when the service was registered. You need to specify the name
 202 correctly.
 203
 204   $Service->execute(XMLinputlist => [
 205                  [
 206              'input1', '<Object namespace="blah" id="123"/>',
 207              'input2', '<Object namespace="blah" id="234"/>',
 208              'param1', '<Value>0.001</Value>',
 209              ]
 210               ]);
 211
 212 This would cause a single invocation of a service requiring two input
 213 parameters named "input1" and "input2", and a parameter named 'param1'
 214 with a value of 0.001
 215
 216 =back
 217
 218 =cut
 219
 220 sub execute {
 221   # The biggest unanswered question for this subroutine is how it should respond in the event
 222   # that there is a problem with the service.
 223   # It should probably die() rather than just return strings as error messages.
 224   my ( $self, %args ) = @_;
 225   die "ERROR:  expected listref for XMLinputlist"
 226     unless ( ref( $args{XMLinputlist} ) eq 'ARRAY' );
 227   my @inputs = @{ $args{XMLinputlist} };
 228   my $data;
 229   foreach ( @inputs ) {
 230     die "ERROR:  expected listref [articleName, XML] for data element"
 231       unless ( ref( $_ ) eq 'ARRAY' );
 232     my $qID = $self->_nextQueryID;
 233     $data .= "<moby:mobyData queryID='$qID'>";
 234     while ( my ( $articleName, $XML ) = splice( @{$_}, 0, 2 ) ) {
 235       $articleName ||= "";
 236       if (  ref( $XML ) ne 'ARRAY' ) {
 237         $XML         ||= "";
 238         if ( $XML =~ /\<(moby\:|)Value\>/ )
 239           {
 240             $data .=
 241               "<moby:Parameter moby:articleName='$articleName'>$XML</moby:Parameter>";
 242           } else {
 243             $data .=
 244               "<moby:Simple moby:articleName='$articleName'>\n$XML\n</moby:Simple>\n";
 245           }
 246
 247         # need to do this for collections also!!!!!!
 248       } elsif ( ref( $XML ) eq 'ARRAY' ) {
 249         my @objs = @{$XML};
 250         $data .= "<moby:Collection moby:articleName='$articleName'>\n";
 251         foreach ( @objs ) {
 252           $data .= "<moby:Simple>$_</moby:Simple>\n";
 253         }
 254         $data .= "</moby:Collection>\n";
 255       }
 256     }
 257     $data .= "</moby:mobyData>\n";
 258   }
 259   ###################
 260   #  this was added on January 19th, 2005 and may not work!
 261   ###################
 262   ###################
 263   my $version = $self->smessageVersion();
 264   $data = "<?xml version='1.0' encoding='UTF-8'?>
 265         <moby:MOBY xmlns:moby='http://www.biomoby.org/moby-s' moby:smessageVersion='$version'>
 266               <moby:mobyContent>
 267                   $data
 268               </moby:mobyContent>
 269         </moby:MOBY>";
 270   $data =~ s"&"&amp;"g;  # encode content in case it has CDATA
 271   $data =~ s"\<"&lt;"g;
 272   $data =~ s"\]\]\>"\]\]&gt;"g;
 273
 274   ####################
 275   ####################
 276   ### BEFORE IT WAS JUST THIS
 277
 278   #$data = "<![CDATA[<?xml version='1.0' encoding='UTF-8'?>
 279   #<moby:MOBY xmlns:moby='http://www.biomoby.org/moby-s'>
 280   #      <moby:mobyContent>
 281   #          $data
 282   #      </moby:mobyContent>
 283   #</moby:MOBY>]]>";
 284   my $METHOD = $self->serviceName;
 285   &_LOG( %args, $METHOD );
 286   my $response;
 287   eval { ( $response ) = $self->_soapService->$METHOD( $data ) };
 288   if ($@) { die "Service execution failed: $@"}
 289   else {return $response;} # the service execution failed then pass back ""
 290 }
 291
 292 =head2 serviceName
 293
 294  Usage     :    $name = $Service->serviceName()
 295  Function  :    get the name of the service
 296  Returns   :    string
 297  Args      :    none
 298
 299 =cut
 300
 301 =head2 _getServiceName
 302
 303  Usage     :    $name = $Service->_getServiceName()
 304  Function  :    Internal method to retrieve the name of the service from the SOAP object
 305  Returns   :    string
 306  Args      :    none
 307
 308 =cut
 309
 310 sub _getServiceName {
 311         my ( $service ) = @_;
 312         no strict;
 313         my ( $method ) = @{ join '::', ref $service, 'EXPORT_OK' };
 314         return $method;
 315 }
 316
 317 sub AUTOLOAD {
 318         no strict "refs";
 319         my ( $self, $newval ) = @_;
 320         $AUTOLOAD =~ /.*::(\w+)/;
 321         my $attr = $1;
 322         if ( $self->_accessible( $attr, 'write' ) ) {
 323                 *{$AUTOLOAD} = sub {
 324                         if ( defined $_[1] ) { $_[0]->{$attr} = $_[1] }
 325                         return $_[0]->{$attr};
 326                 };    ### end of created subroutine
 327 ###  this is called first time only
 328                 if ( defined $newval ) {
 329                         $self->{$attr} = $newval;
 330                 }
 331                 return $self->{$attr};
 332         } elsif ( $self->_accessible( $attr, 'read' ) ) {
 333                 *{$AUTOLOAD} = sub {
 334                         return $_[0]->{$attr};
 335                 };    ### end of created subroutine
 336                 return $self->{$attr};
 337         }
 338
 339         # Must have been a mistake then...
 340         croak "No such method: $AUTOLOAD";
 341 }
 342 sub DESTROY { }
 343
 344 sub SOAP::Transport::HTTP::Client::get_basic_credentials {
 345         my ( $username, $password );
 346         print "ENTER USERNAME: ";
 347         $username = <STDIN>;
 348         chomp $username;
 349         print "ENTER PASSWORD: ";
 350         $password = <STDIN>;
 351         chomp $password;
 352         return $username => $password;
 353 }
 354
 355 sub _LOG {
 356         return unless $debug;
 357         open LOG, ">>/tmp/ServiceCallLogOut.txt" or die "can't open logfile $!\n";
 358         print LOG join "\n", @_;
 359         print LOG "\n---\n";
 360         close LOG;
 361 }
 362
 363 #
 364 #
 365 # --------------------------------------------------------------------------------------------------------
 366 #
 367 ##
 368 ##
 369 1;