1# $Id$ 2# 3# BioPerl module Bio::Tools::Run::Analysis::soap.pm 4# 5# Please direct questions and support issues to <bioperl-l@bioperl.org> 6# 7# Cared for by Martin Senger <martin.senger@gmail.com> 8# For copyright and disclaimer see below. 9 10# POD documentation - main docs before the code 11 12=head1 NAME 13 14Bio::Tools::Run::Analysis::soap - A SOAP-based access to the analysis tools 15 16=head1 SYNOPSIS 17 18Do not use this object directly, it is recommended to access it and use 19it through the C<Bio::Tools::Run::Analysis> module: 20 21 use Bio::Tools::Run::Analysis; 22 my $tool = Bio::Tools::Run::Analysis->new(-access => 'soap', 23 -name => 'seqret'); 24 25=head1 DESCRIPTION 26 27This object allows to execute and to control a remote analysis tool 28(an application, a program) using the SOAP middleware, 29 30All its public methods are documented in the interface module 31C<Bio::AnalysisI> and explained in tutorial available in the 32C<analysis.pl> script. 33 34=head1 FEEDBACK 35 36=head2 Mailing Lists 37 38User feedback is an integral part of the evolution of this and other 39Bioperl modules. Send your comments and suggestions preferably to 40the Bioperl mailing list. Your participation is much appreciated. 41 42 bioperl-l@bioperl.org - General discussion 43 http://bioperl.org/wiki/Mailing_lists - About the mailing lists 44 45=head2 Support 46 47Please direct usage questions or support issues to the mailing list: 48 49I<bioperl-l@bioperl.org> 50 51rather than to the module maintainer directly. Many experienced and 52reponsive experts will be able look at the problem and quickly 53address it. Please include a thorough description of the problem 54with code and data examples if at all possible. 55 56=head2 Reporting Bugs 57 58Report bugs to the Bioperl bug tracking system to help us keep track 59of the bugs and their resolution. Bug reports can be submitted via the 60web: 61 62 http://redmine.open-bio.org/projects/bioperl/ 63 64=head1 AUTHOR 65 66Martin Senger (martin.senger@gmail.com) 67 68=head1 COPYRIGHT 69 70Copyright (c) 2003, Martin Senger and EMBL-EBI. 71All Rights Reserved. 72 73This module is free software; you can redistribute it and/or modify 74it under the same terms as Perl itself. 75 76=head1 DISCLAIMER 77 78This software is provided "as is" without warranty of any kind. 79 80=head1 SEE ALSO 81 82=over 4 83 84=item * 85 86http://www.ebi.ac.uk/soaplab/Perl_Client.html 87 88=back 89 90=head1 BUGS AND LIMITATIONS 91 92None known at the time of writing this. 93 94=head1 APPENDIX 95 96Here is the rest of the object methods. Internal methods are preceded 97with an underscore _. 98 99=cut 100 101 102# Let the code begin... 103 104 105package Bio::Tools::Run::Analysis::soap; 106use vars qw(@ISA $Revision $DEFAULT_LOCATION); 107use strict; 108 109use Bio::Tools::Run::Analysis; 110use SOAP::Lite 111 on_fault => sub { 112 my $soap = shift; 113 my $res = shift; 114 my $msg = 115 ref $res ? 116 "--- SOAP FAULT ---\n" . 117 'faultcode: ' . $res->faultcode . "\n" . 118 'faultstring: ' . Bio::Tools::Run::Analysis::soap::_clean_msg ($res->faultstring) 119 : "--- TRANSPORT ERROR ---\n" . $soap->transport->status . "\n$res\n"; 120 Bio::Tools::Run::Analysis::soap->throw ($msg); 121 } 122; 123 124@ISA = qw(Bio::Tools::Run::Analysis); 125 126BEGIN { 127 $Revision = q[$Id$]; 128 129 # where to go 130 $DEFAULT_LOCATION = 'http://www.ebi.ac.uk/soaplab/services'; 131} 132 133# ----------------------------------------------------------------------------- 134 135=head2 _initialize 136 137 Usage : my $tool = Bio::Tools::Run::Analysis->new(-access => 'soap', 138 -name => 'seqret', 139 ...); 140 (_initialize is internally called from the 'new()' method) 141 Returns : nothing interesting 142 Args : This module recognises and uses following arguments: 143 -location 144 -name 145 -httpproxy 146 -timeout 147 Additionally, the main module Bio::Tools::Run::Analysis 148 recognises also: 149 -access 150 151It populates calling object with the given arguments, and then - for 152some attributes and only if they are not yet populated - it assigns 153some default values. 154 155This is an actual new() method (except for the real object creation 156and its blessing which is done in the parent class Bio::Root::Root in 157method _create_object). 158 159Note that this method is called always as an I<object> method (never 160as a I<class> method) - and that the object who calls this method may 161already be partly initiated (from Bio::Tools::Run::Analysis::new method); 162so if you need to do some tricks with the 'class invocation' you need to 163change Bio::Analysis I<new> method, not this one. 164 165=over 4 166 167=item -location 168 169A URL (also called an I<endpoint>) defining where is located a Web Service 170representing this analysis tool. 171 172Default is C<http://www.ebi.ac.uk/soaplab/services> (services running 173at European Bioinformatics Institute on top of most of EMBOSS 174analyses, and few others). 175 176For example, if you run your own Web Service using Java(TM) Apache Axis 177toolkit, the location might be something like 178C<http://localhost:8080/axis/services>. 179 180=item -name 181 182A name of a Web Service (also called a I<urn> or a I<namespace>). 183There is no default value (which usually means that this parameter is 184mandatory unless your I<-location> parameter includes also a Web 185Service name). 186 187=item -destroy_on_exit =E<gt> '0' 188 189Default value is '1' which means that all Bio::Tools::Run::Analysis::Job 190objects - when being finalised - will send a request 191to the remote Web Service to forget the results of these jobs. 192 193If you change it to '0' make sure that you know the job identification 194- otherwise you will not be able to re-established connection with it 195(later, when you use your script again). This can be done by calling 196method C<id> on the job object (such object is returned by any of 197these methods: C<create_job>, C<run>, C<wait_for>). 198 199=item -httpproxy 200 201In addition to the I<location> parameter, you may need 202to specify also a location/URL of an HTTP proxy server 203(if your site requires one). The expected format is C<http://server:port>. 204There is no default value. 205 206=item -timeout 207 208For long(er) running jobs the HTTP connection may be time-outed. In 209order to avoid it (or, vice-versa, to call timeout sooner) you may 210specify C<timeout> with the number of seconds the connection will be 211kept alive. Zero means to keep it alive forever. The default value is 212two minutes. 213 214=back 215 216=cut 217 218sub _initialize { 219 my ($self, @args) = @_; 220 221 # make a hashtable from @args 222 my %param = @args; 223 @param { map { lc $_ } keys %param } = values %param; # lowercase keys 224 225 # copy all @args into this object (overwriting what may already be 226 # there) - changing '-key' into '_key' 227 my $new_key; 228 foreach my $key (keys %param) { 229 ($new_key = $key) =~ s/^-/_/; 230 $self->{ $new_key } = $param { $key }; 231 } 232 233 # finally add default values for those keys who have default value 234 # and who are not yet in the object 235 $self->{'_location'} = $DEFAULT_LOCATION unless $self->{'_location'}; 236 237 # create a SOAP::Lite object, the main worker 238 if (defined $self->{'_httpproxy'}) { 239 $self->{'_soap'} = SOAP::Lite 240 -> proxy ($self->{'_location'}, 241 timeout => (defined $self->{'_timeout'} ? $self->{'_timeout'} : 120), 242 proxy => ['http' => $self->{'_httpproxy'}]); 243 } else { 244 $self->{'_soap'} = SOAP::Lite 245 -> proxy ($self->{'_location'}, 246 timeout => (defined $self->{'_timeout'} ? $self->{'_timeout'} : 120), 247 ); 248 } 249 $self->{'_soap'}->uri ($self->{'_name'}) if $self->{'_name'}; 250 251 # forget cached things which should not be cloned into new 252 # instances (because they may represent a completely different 253 # analysis 254 delete $self->{'_analysis_spec'}; 255 delete $self->{'_input_spec'}; 256 delete $self->{'_result_spec'}; 257} 258 259# 260# Create a hash with named inputs, all extracted 261# from the given data. 262# 263# The main job is done in the SUPER class - here we do 264# only the SOAP-specific stuff. 265# 266sub _prepare_inputs { 267 my $self = shift; 268 my $rh_inputs = $self->SUPER::_prepare_inputs (@_); 269 270 foreach my $name (keys %{$rh_inputs}) { 271 my $value = $$rh_inputs{$name}; 272 273 # value of type ref ARRAY is send as byte[][] 274 if (ref $value eq 'ARRAY') { 275 my @bytes = 276 map { SOAP::Data->new (type => 'base64', 277 value => $_) } @$value; 278 $$rh_inputs{$name} = \@bytes; 279 next; 280 } 281 } 282 283 return $rh_inputs; 284} 285 286# --------------------------------------------------------------------- 287# 288# Here are the methods implementing Bio::AnalysisI interface 289# (documentation is in Bio::AnalysisI) 290# 291# --------------------------------------------------------------------- 292 293sub analysis_name { 294 my $self = shift; 295 ${ $self->analysis_spec }{'name'}; 296} 297 298# Map getAnalysisType() 299sub analysis_spec { 300 my ($self) = @_; 301 return $self->{'_analysis_spec'} if $self->{'_analysis_spec'}; 302 my $soap = $self->{'_soap'}; 303 $self->{'_analysis_spec'} = $soap->getAnalysisType->result; 304} 305 306# String describe() 307sub describe { 308 my ($self) = @_; 309 my $soap = $self->{'_soap'}; 310 $soap->describe->result; 311} 312 313# Map[] getInputSpec() 314sub input_spec { 315 my ($self) = @_; 316 return $self->{'_input_spec'} if $self->{'_input_spec'}; 317 my $soap = $self->{'_soap'}; 318 $self->{'_input_spec'} = $soap->getInputSpec->result; 319} 320 321# Map[] getResultSpec() 322sub result_spec { 323 my ($self) = @_; 324 return $self->{'_result_spec'} if $self->{'_result_spec'}; 325 my $soap = $self->{'_soap'}; 326 $self->{'_result_spec'} = $soap->getResultSpec->result; 327} 328 329# String createJob (Map inputs) 330# String createJob (String id) 331# String createJob () 332sub create_job { 333 my ($self, $params) = @_; 334 my $job_id; 335 my $force_to_live; 336 337 # if $params is a reference then it contains *all* input data 338 # (see details in '_prepare_inputs' how they can be coded) - 339 # send it to the server to get a unique job ID 340 if (ref $params) { 341 my $rh_inputs = $self->_prepare_inputs ($params); 342 my $soap = $self->{'_soap'}; 343 $job_id = $soap->createJob (SOAP::Data->type (map => $rh_inputs))->result; 344 345 # if $params is a defined scalar it represents a job ID obtained in 346 # some previous invocation - such job already exists on the server 347 # side, just re-create it here using the same job ID 348 # (in this case, such job will *not* be implicitly destroyed on exit) 349 } elsif (defined $params) { 350 $job_id = $params; 351 $force_to_live = 1; 352 353 # finally, if $params is undef, ask server to create an empty job 354 # (and give me its unique job ID), the input data may be added 355 # later using 'set_data' method(s) - see scripts/applmaker.pl 356 } else { 357 my $soap = $self->{'_soap'}; 358 $job_id = $soap->createEmptyJob->result; # this method may not exist on server (TBD) 359 } 360 361 if ($force_to_live) { 362 return new Bio::Tools::Run::Analysis::Job (-analysis => $self, 363 -id => $job_id, 364 -destroy_on_exit => 0, 365 ); 366 } elsif (defined $self->{'_destroy_on_exit'}) { 367 return new Bio::Tools::Run::Analysis::Job (-analysis => $self, 368 -id => $job_id, 369 -destroy_on_exit => $self->{'_destroy_on_exit'}, 370 ); 371 } else { 372 return new Bio::Tools::Run::Analysis::Job (-analysis => $self, 373 -id => $job_id, 374 ); 375 } 376} 377 378# String createAndRun (Map inputs) 379sub run { 380 my $self = shift; 381 return $self->create_job (@_)->run; 382} 383 384# Map runAndWaitFor (Map inputs) 385sub wait_for { 386 my $self = shift; 387 return $self->run (@_)->wait_for; 388} 389 390# --------------------------------------------------------------------- 391# 392# Here are internal methods fo Bio::Tools::Run::Analysis::soap... 393# 394# --------------------------------------------------------------------- 395 396# Do something (or nothing) with $rh_resuls (coming from the server) 397# depending on rules defined in $rh_rules. 398# 399# $rh_results: keys are result names, values are results themselves 400# (either scalars or array references - if one result is split into 401# more parts). 402# 403# $rh_rules: keys are result names, values say what to do with 404# results: undef ... do nothing, return unchanged result 405# - ... send it to STDOUT, return nothing 406# @[template] ... put it into file (invent its name, 407# perhaps based on template), return filename 408# ?[template] ... ask server for result type, then decide: 409# put a binary result into file (invent its name) 410# and return the filename, for other result type 411# do nothing and return result unchanged 412# Special cases: if $rh_rules is scalar '@[template]', do with ALL results 413# as described above for @[template], or 414# if $rh_rules is scalar '?[template]', do with ALL results 415# as described above for ?[template]. 416 417sub _process_results { 418 my ($self, $rh_results, $rh_rules) = @_; 419 420 my $default_rule = $rh_rules if defined $rh_rules && $rh_rules =~ /^[\?@]/; 421 foreach my $name (keys %$rh_results) { 422 my $rule = $default_rule ? $default_rule : $$rh_rules{$name}; 423 next unless $rule; 424 next if $rule =~ /^\?/ && ! $self->is_binary ($name); 425 426 my ($prefix, $template) = $rule =~ /^([\?@])(.*)/; 427 $template = $ENV{'RESULT_FILENAME_TEMPLATE'} unless $template; 428 my $filename = $rule unless $template || $prefix; 429 430 my $stdout = ($rule eq '-'); 431 432 if (ref $$rh_results{$name}) { 433 # --- result value is an array reference 434 my $seq = 1; 435 foreach my $part (@{ $$rh_results{$name} }) { 436 print STDOUT $part && next if $stdout; 437 $part = $self->_save_result (-value => $part, 438 -name => $name, 439 -filename => $filename, 440 -template => $template, 441 -seq => $seq++); 442 } 443 444 } else { 445 # --- result value is a scalar 446 print STDOUT $$rh_results{$name} && next if $stdout; 447 $$rh_results{$name} = 448 $self->_save_result (-value => $$rh_results{$name}, 449 -name => $name, 450 -filename => $filename, 451 -template => $template); 452 } 453 delete $$rh_results{$name} if $stdout; 454 } 455 $rh_results; 456} 457 458# --------------------------------------------------------------------- 459 460# 461# is the given result $name binary? 462# 463 464=head2 is_binary 465 466 Usage : if ($service->is_binary ('graph_result')) { ... } 467 Returns : 1 or 0 468 Args : $name is a result name we are interested in 469 470=cut 471 472sub is_binary { 473 my ($self, $name) = @_; 474 foreach my $result (@{ $self->result_spec }) { 475 if ($result->{'name'} eq $name) { 476 return ($result->{'type'} =~ /^byte\[/); 477 } 478 } 479 return 0; 480} 481 482# --------------------------------------------------------------------- 483# 484# Here are internal subroutines (NOT methods) 485# for Bio::Tools::Run::Analysis::soap 486# 487# --------------------------------------------------------------------- 488 489sub _clean_msg { 490 my ($msg) = @_; 491 $msg =~ s/^org\.embl\.ebi\.SoaplabShare\.SoaplabException\:\s*//; 492 $msg; 493} 494 495# --------------------------------------------------------------------- 496# 497# Here is the rest of Bio::Analysis::soap 498# 499# --------------------------------------------------------------------- 500 501=head2 VERSION and Revision 502 503 Usage : print $Bio::Tools::Run::Analysis::soap::VERSION; 504 print $Bio::Tools::Run::Analysis::soap::Revision; 505 506=cut 507 508=head2 Defaults 509 510 Usage : print $Bio::Tools::Run::Analysis::soap::DEFAULT_LOCATION; 511 512=cut 513 514 515# --------------------------------------------------------------------- 516# 517# Bio::Tools::Run::Analysis::Job::soap 518# ------------------------------------ 519# A module representing a job (an invocation, an execution) 520# of an analysis (the analysis itself is represented by 521# a Bio::Tools::Run::Analysis::soap object) 522# 523# Documentation is in Bio::AnalysisI::JobI. 524# 525# --------------------------------------------------------------------- 526 527package Bio::Tools::Run::Analysis::Job::soap; 528 529use vars qw(@ISA); 530use strict; 531 532@ISA = qw(Bio::Tools::Run::Analysis::Job); 533 534sub _initialize { 535 my ($self, @args) = @_; 536 537 # make a hashtable from @args 538 my %param = @args; 539 @param { map { lc $_ } keys %param } = values %param; # lowercase keys 540 541 # copy all @args into this object (overwriting what may already be 542 # there) - changing '-key' into '_key' 543 my $new_key; 544 foreach my $key (keys %param) { 545 ($new_key = $key) =~ s/^-/_/; 546 $self->{ $new_key } = $param { $key }; 547 } 548 549 # finally add default values for those keys who have default value 550 # and who are not yet in the object 551 $self->{'_destroy_on_exit'} = 1 unless defined $self->{'_destroy_on_exit'}; 552} 553 554# --------------------------------------------------------------------- 555# 556# Here are the methods implementing Bio::AnalysisI::JobI interface 557# (documentation is in Bio::AnalysisI) 558# 559# --------------------------------------------------------------------- 560 561# void run (String jobID) 562sub run { 563 my $self = shift; 564 my $soap = $self->{'_analysis'}->{'_soap'}; 565 $soap->run (SOAP::Data->type (string => $self->{'_id'})); 566 return $self; 567} 568 569# void waitFor (String jobID) 570sub wait_for { 571 my $self = shift; 572 my $soap = $self->{'_analysis'}->{'_soap'}; 573 $soap->waitFor (SOAP::Data->type (string => $self->{'_id'})); 574 return $self; 575} 576 577 578# void terminate (String jobID) 579sub terminate { 580 my $self = shift; 581 my $soap = $self->{'_analysis'}->{'_soap'}; 582 $soap->terminate (SOAP::Data->type (string => $self->{'_id'})); 583 return $self; 584} 585 586# String getLastEvent (String jobID) 587sub last_event { 588 my $self = shift; 589 my $soap = $self->{'_analysis'}->{'_soap'}; 590 $soap->getLastEvent (SOAP::Data->type (string => $self->{'_id'}))->result; 591} 592 593# String getStatus (String jobID) 594sub status { 595 my $self = shift; 596 my $soap = $self->{'_analysis'}->{'_soap'}; 597 $soap->getStatus (SOAP::Data->type (string => $self->{'_id'}))->result; 598} 599 600# long getCreated (String jobID) 601sub created { 602 my ($self, $formatted) = @_; 603 my $soap = $self->{'_analysis'}->{'_soap'}; 604 my $time = $soap->getCreated (SOAP::Data->type (string => $self->{'_id'}))->result; 605 $formatted ? Bio::Tools::Run::Analysis::Utils::format_time ($time) : $time; 606} 607 608# long getStarted (String jobID) 609sub started { 610 my ($self, $formatted) = @_; 611 my $soap = $self->{'_analysis'}->{'_soap'}; 612 my $time = $soap->getStarted (SOAP::Data->type (string => $self->{'_id'}))->result; 613 $formatted ? Bio::Tools::Run::Analysis::Utils::format_time ($time) : $time; 614} 615 616# long getEnded (String jobID) 617sub ended { 618 my ($self, $formatted) = @_; 619 my $soap = $self->{'_analysis'}->{'_soap'}; 620 my $time = $soap->getEnded (SOAP::Data->type (string => $self->{'_id'}))->result; 621 $formatted ? Bio::Tools::Run::Analysis::Utils::format_time ($time) : $time; 622} 623 624# long getElapsed (String jobID) 625sub elapsed { 626 my $self = shift; 627 my $soap = $self->{'_analysis'}->{'_soap'}; 628 $soap->getElapsed (SOAP::Data->type (string => $self->{'_id'}))->result; 629} 630 631# Map getCharacterictics (String jobID) 632sub times { 633 my ($self, $formatted) = @_; 634 my $soap = $self->{'_analysis'}->{'_soap'}; 635 my $rh_times = $soap->getCharacteristics (SOAP::Data->type (string => $self->{'_id'}))->result; 636 map { $_ = Bio::Tools::Run::Analysis::Utils::format_time ($_) } values %$rh_times 637 if $formatted; 638 return $rh_times; 639} 640 641# Map getResults (String jobID) 642# Map getResults (String jobID, String[] resultNames) 643 644# Retrieving NAMED results: 645# ------------------------- 646# results ('name1', ...) => return results as they are, no storing into files 647# 648# results ( { 'name1' => 'filename', ... } ) => store into 'filename', return 'filename' 649# results ( 'name1=filename', ...) => ditto 650# 651# results ( { 'name1' => '-', ... } ) => send result to the STDOUT, do not return anything 652# results ( 'name1=-', ...) => ditto 653# 654# results ( { 'name1' => '@', ... } ) => store into file whose name is invented by 655# this method, perhaps using RESULT_NAME_TEMPLATE env 656# results ( 'name1=@', ...) => ditto 657# 658# results ( { 'name1' => '?', ... } ) => find of what type is this result and then use 659# {'name1'=>'@' for binary files, and a regular 660# return for non-binary files 661# results ( 'name=?', ...) => ditto 662# 663# Retrieving ALL results: 664# ----------------------- 665# results() => return all results as they are, no storing into files 666# 667# results ('@') => return all results, as if each of them given 668# as {'name' => '@'} (see above) 669# 670# results ('?') => return all results, as if each of them given 671# as {'name' => '?'} (see above) 672# 673# Misc: 674# ----- 675# * results(...) equals to result(...) 676# * any result can be returned as a scalar value, or as an array reference 677# (the latter is used for results consisting of more parts, such images); 678# this applies regardless whether the returned result is the result itself 679# or a filename created for the result 680 681sub results { 682 my $self = shift; 683 my $rh_names = Bio::Tools::Run::Analysis::Utils::normalize_names (@_); 684 my $soap = $self->{'_analysis'}->{'_soap'}; 685 686 if (ref $rh_names) { 687 # retrieve only named results 688 return 689 $self->{'_analysis'}->_process_results 690 ($soap->getSomeResults (SOAP::Data->type (string => $self->{'_id'}), 691 [ keys %$rh_names ])->result, 692 $rh_names); 693 } else { 694 # no result names given: take all 695 return 696 $self->{'_analysis'}->_process_results 697 ($soap->getResults (SOAP::Data->type (string => $self->{'_id'}))->result, 698 $rh_names); 699 } 700} 701 702sub result { 703 my $self = shift; 704 my $rh_results = $self->results (@_); 705 (values %$rh_results)[0]; 706} 707 708sub remove { 709 shift->{'_destroy_on_exit'} = 1; 710} 711 712# 713# job objects are being destroyed if they have attribute 714# '_destroy_on_exit' set to true - which is a default value 715# (void destroy (String jobID) 716# 717sub DESTROY { 718 my $self = shift; 719 my $soap = $self->{'_analysis'}->{'_soap'}; 720 return unless $self->{'_destroy_on_exit'} && $self->{'_id'}; 721 722 # ignore all errors here 723 eval { 724 $soap->destroy (SOAP::Data->type (string => $self->{'_id'})); 725 } 726} 727 7281; 729__END__ 730