source: webservices/se.lu.thep.webservices/trunk/BaseWebService.pm @ 1430

Last change on this file since 1430 was 261, checked in by Jari Häkkinen, 16 years ago

Changed samples and code to refer to the demo server.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 14.5 KB
Line 
1######################################################################
2#
3# $Id: BaseWebService.pm 261 2007-04-20 16:36:47Z jari $
4#
5# Copyright (C) Authors contributing to this file.
6#
7# This file is part of BASE - BioArray Software Environment.
8# Available at http://base.thep.lu.se/
9#
10# BASE is free software; you can redistribute it and/or
11# modify it under the terms of the GNU General Public License
12# as published by the Free Software Foundation; either version 2
13# of the License, or (at your option) any later version.
14#
15# BASE is distributed in the hope that it will be useful,
16# but WITHOUT ANY WARRANTY; without even the implied warranty of
17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
18# GNU General Public License for more details.
19#
20# You should have received a copy of the GNU General Public License
21# along with this program; if not, write to the Free Software
22# Foundation, Inc., 59 Temple Place - Suite 330,
23# Boston, MA  02111-1307, USA.
24######################################################################
25package BaseWebService;
26
27use strict;
28#use SOAP::Lite +trace => qw (debug);
29#use SOAP::Lite +trace;
30use SOAP::Lite;
31use Data::Dumper;
32use LWP::Simple;
33
34
35#### General documentation ####
36=pod
37
38=head1 NAME
39
40    BaseWebService - A module to connect to BASE using webservices.
41
42
43=head1 SYNOPSIS
44
45    $obj->BaseWebService->new(baseUrl => 'http://localhost:8080/base2');
46    print "Session ID = ", $obj->{sessionID}, "\n";
47
48    # Login
49    $obj->login('test', 'hej');
50
51    # Get project
52    my $projs = $obj->getProjects();
53    print "List of Projects:\n";
54    foreach my $proj (@{$projs}) {
55       print "Id         : ", $proj->{id}, "\n";
56       print "Name       : ", $proj->{name}, "\n";
57       print "Description: ", $proj->{description}, "\n\n";
58    }   
59    # Make an array of all projects
60    my @projID = map { $_->{id} } @{$projs};
61
62    # Set active project
63    $obj->setActiveProject($projID[0]);
64
65=head1 DESCRIPTION
66
67    BaseWebService.pm is Perl module that can communucate with a BASE
68    server through its webservice interface. This module can at the moment
69    only handle simple requests, such as listing projects, experiments and
70    raw bioassays. It can however be used to download raw bioassays and design
71    files from Base.  See below for some examples of its use.
72
73=head1 CONSTRUCTOR   
74
75=head2 BaseWebService->new()
76
77    $obj = BaseWebservice->new(baseUrl => 'http://localhost:8080/base2');
78    $obj = BaseWebservice->new(baseUrl => 'http://localhost:8080/base2',
79                               sessionID => 'b1212121212121212');
80 
81    The new() class method constructs a new BaseWebService object. The
82    returned object can be used to connect to a BASE server using
83    webservices. new() accept the following parameters:
84
85=over 5
86
87=item baseUrl
88
89    The url for the BASE server. Default value is
90    'http://localhost:8080/base2'
91
92=item sessionID
93
94    The sessionID. Usually one does not need to set this, beacuse a new
95    sessionID is obtained from the BASE server for each new call to
96    new(). Sometimes it might however be usefull to reuse an old sessionID.
97
98=back
99
100=cut
101sub new {
102    # The constructor
103
104    my $class = shift;
105    my $self = {
106  baseUrl    => "http://localhost:8080/base2",
107  sessionID  => undef,
108  @_            # Override   
109    };
110
111    # Set the other urls
112    $self->{uri}             = "http://server.ws.basedb.sf.net/xsd";
113    $self->{sessionProxy}    = "$self->{baseUrl}/services/Session";
114    $self->{experimentProxy} = "$self->{baseUrl}/services/Experiment";
115    $self->{projectProxy}    = "$self->{baseUrl}/services/Project";
116
117    # If we got a sessionID use that otherwise get a new one
118    unless( $self->{sessionID} ) {
119  my $service = SOAP::Lite
120      ->uri($self->{uri})
121      ->proxy($self->{sessionProxy})
122      ->newSession();
123  $self->{sessionID} = $service->result;
124    }
125
126    bless($self, $class);
127    return $self;
128
129} # End of new
130
131##########################################################
132#
133# Session, login, logout etc
134#
135##########################################################
136
137=head1 METHODS   
138
139=head2 $obj->sessionID
140
141    Title   : sessionID
142    Usage   : $ID = $obj->sessionID();
143    Function: Returns the sesssion ID for webservice object
144   
145    Returns : A string containing the sessionID
146    Args    : None
147
148=cut
149
150sub sessionID {
151    # Get the sessionID
152
153    my $self = shift;
154    return $self->{sessionID};
155   
156} # End of sessionID
157
158=head2 $obj->login
159
160    Title   : login
161    Usage   : $obj->login('login', 'password');
162    Function: To login to a specific account on the BASE server.
163
164    Returns : None
165    Args    : The first argument is the login name and the second argument
166              is the password
167
168=cut
169sub login {
170    # Login
171
172    my $self = shift;
173   
174    unless( @_ == 2 ) {
175  die "User and password needed\n";
176    }
177    my ($user, $passwd) = @_;
178
179    unless( $self->{sessionID} ) {
180  die "No sessionID found\n";
181    }
182    my $service = SOAP::Lite
183  ->uri($self->{uri})
184  ->proxy($self->{sessionProxy})
185  ->login($self->{sessionID}, $user, $passwd, 'WebService', 0);
186   
187    if( $service ) {
188  print "login error: ", $service->faultstring, "\n";
189    }
190
191} # End of Login
192
193
194=head2 $obj->logout
195
196    Title   : logout
197    Usage   : $obj->logout();
198    Function: To logout of the BASE server
199
200    Returns : None
201    Args    : None
202
203=cut
204sub logout {
205    # Logout
206   
207    my $self = shift;
208   
209    unless( $self->{sessionID} ) {
210  die "No sessionID found\n";
211    }
212
213    my $service = SOAP::Lite
214  ->uri($self->{uri})
215  ->proxy($self->{sessionProxy})
216  ->logout($self->{sessionID});
217
218    if( $service ) {
219  print "logout error: ", $service->faultstring, "\n";
220    }
221   
222} # End of Logout
223
224##########################################################
225#
226# Project routines
227#
228##########################################################
229
230=head2 $obj->getProjects
231
232    Title   : getProjects
233    Usage   : $projs = $obj->getProjects();
234    Function: This function returns all projects associated with the current
235              user.
236
237    Returns : This function returns a reference to an array of hashes.
238              Each hash has the followoing keys: 'id', 'name' and
239              'description', corresponding to the id, name and description
240              of the projects for the current user. The value behind the
241              'id' key is used later to make a specific project active.
242              See the 'setActiveProject' method.
243             
244    Args    : None
245
246=cut
247sub getProjects {
248   
249    my $self = shift;
250
251    # Use the getProjects webservice function at BASE
252    my $service = SOAP::Lite
253  ->uri($self->{uri})
254  ->proxy($self->{projectProxy})
255  ->getProjects($self->{sessionID});
256
257    # Error check
258    if( $service->fault ) {
259  print "getProjects error: ", $service->faultstring, "\n";
260  return;
261    }
262   
263    my @projs;
264    push(@projs, $service->result);
265    push(@projs, $service->paramsout);
266
267    return(\@projs);
268   
269
270} # End of getProjects
271
272
273=head2 $obj->setActiveProject
274
275    Title   : setActiveProject
276    Usage   : $obj->setActiveProject($ID);
277    Function: This is used to make a specific project active. The project
278              is identified by its ID-number, returned by the getProjects
279              method.
280
281    Returns : None
282    Args    : ID number (integer)
283
284=cut
285sub setActiveProject {
286   
287    my ($self, $projID) = @_;
288
289    # Use the getExperiments webservice function at BASE
290    my $service = SOAP::Lite
291  ->uri($self->{uri})
292  ->proxy($self->{projectProxy})
293  ->setActiveProject($self->{sessionID}, $projID);
294   
295    if( $service ) {
296  print "setActiveProject error: ", $service->faultstring, "\n";
297    }
298   
299} # End of setActiveProject
300
301
302##########################################################
303#
304# Experiments and Raw bioassays
305#
306##########################################################
307
308=head2 $obj->getExperiments
309
310    Title   : getExperiments
311    Usage   : $exps = $obj->getExperiments();
312    Function: Lists all experiments for the current user.
313
314    Returns : This function returns a reference to an array of hashes.
315              Each hash has the followoing keys: 'id', 'name' and
316              'description', corresponding to the id, name and description
317              of the experiments for the current user. Note, that this method
318              currently lists all experiments for user, not only the ones
319              associated with the active project.
320    Args    : None
321
322=cut
323sub getExperiments {
324    # get all Experiments
325
326    my $self = shift;
327
328    # Use the getExperiments webservice function at BASE
329    my $service = SOAP::Lite
330  ->uri($self->{uri})
331  ->proxy($self->{experimentProxy})
332  ->getExperiments($self->{sessionID});
333
334    # Error check
335    if( $service->fault ) {
336  print "getExperiment error: ", $service->faultstring, "\n";
337  return;
338    }
339   
340    my @exps;
341    push(@exps, $service->result);
342    push(@exps, $service->paramsout);
343
344    return(\@exps);
345   
346} # End of listExperiments
347
348
349=head2 $obj->getRawBioAssays_by_expID
350
351    Title   : getRawBioAssays_by_expID
352    Usage   : $assays = $obj->getRawBioAssays_by_expID($ID);
353    Function: This function returns a list of all raw bio assays and
354              the corresponding design files for the specified experiment.
355
356    Returns : A reference to an array of hashes. Each hash has the following
357              keys: 'celFile', 'celFileUrl', 'cdfFile' and 'cdfFileUrl'. Each
358              raw bio assay ('celFile') has a corresponding design ('cdfFile').
359              The 'celFileUrl' and 'cdfFileUrl' are internal urls of these files
360              and are used for the 'downloadRasBioAssays' method.
361    Args    : The experiment ID (integer).
362
363=cut
364sub getRawBioAssays_by_expID {
365    # List raw bioassays given an array if experiment ID
366   
367    my ($self, $exp) = @_;
368
369    my @result;
370    my $service = SOAP::Lite
371  ->uri($self->{uri})
372  ->proxy($self->{experimentProxy})
373  ->getRawBioAssays($self->{sessionID}, $exp);
374   
375    if( $service->fault ) {
376  print "getRawBioAssays_by_expID error: ", $service->faultstring, "\n"; 
377    }
378   
379    my @files;
380    push(@files, $service->result);
381    push(@files, $service->paramsout);
382   
383    foreach my $ass (@files) {
384
385  # Report both the url and the filename
386  my $cdfFileUrl = $ass->{cdfFileUrl};
387  my $cdfFile = $cdfFileUrl;
388  $cdfFile =~ s/^.*\///g;
389  my $celFileUrl = $ass->{celFileUrl};
390  my $celFile = $celFileUrl;
391  $celFile =~ s/^.*\///g;
392 
393  # Store in the result array
394  push(@result, {
395      cdfFileUrl => $cdfFileUrl,
396      cdfFile    => $cdfFile,
397      celFileUrl => $celFileUrl,
398      celFile    => $celFile
399      });
400    }
401
402    return(\@result);
403
404} # End of getRawBioAssays_by_expID
405
406
407=head2 $obj->downloadRawBioAssays
408
409    Title   : downloadRawBioAssays
410    Usage   : $obj->downloadRawBioAssays($assys, $path);
411    Function: To download raw bioassays to a local directory.
412
413    Returns : None
414    Args    : The first is a reference to an array of hashes, describing the
415              raw bioassays. See the 'getRawBioAssays_by_expID' method. The second
416              argument is the path where to download the files.
417
418=cut
419sub downloadRawBioAssays {
420
421    my($self, $files, $path) = @_;
422   
423    # Make sure that the supplied path exists
424    unless( -d $path ) {
425  die "downloadRawBioAssays error: no such directory $path\n";
426    }
427   
428    # Loop over all files
429    my %design;
430    foreach my $assay (@{$files}) {
431  my $cel = $assay->{celFileUrl};
432  my $celName = $assay->{celFile};
433  my $cdf = $assay->{cdfFileUrl};
434  my $cdfFile = $assay->{cdfFile};
435  $design{$cdfFile} = $cdf;
436 
437  # Make the correct path
438  my $celUrl = "$self->{baseUrl}/$cel";
439  my $celLocal = "$path/$celName";
440
441  #print "Downloading $celLocal\n";
442  getstore($celUrl, $celLocal);
443    }
444
445    # Now download the designs (cdf files)
446    foreach my $cdfFile (keys %design) {
447  my $cdfUrl = "$self->{baseUrl}/$design{$cdfFile}";
448  my $cdfLocal = "$path/$cdfFile";
449
450  #print "Downloading $cdfLocal\n";
451  getstore($cdfUrl, $cdfLocal);
452    }
453
454} # End of downloadRawBioAssays
455
456
457=head2 $obj->downloadRawBioAssays_by_expID
458
459    Title   : downloadRawBioAssays_by_expID
460    Usage   : $obj->downloadRawBioAssays_by_expID($ID $path);
461    Function: To download raw bioassays to a local directory. This function
462              takes an experiment ID as argument and downloads all the files
463              to the given path. This function is a simple wrapper of
464              getRawBioAssays_by_expID and downloadRawBioAssays.
465
466    Returns : None
467    Args    : The first is the experiment ID (integer) and the second
468              argument is the path where to download the files.
469
470=cut
471sub downloadRawBioAssays_by_expID {
472
473    my($self, $ID, $path) = @_;
474
475    my $files = $self->getRawBioAssays_by_expID($ID);
476    $self->downloadRawBioAssays($files, $path);
477   
478} # End of downloadRawBioAssays_by_expID
479
480
481=head1 Examples
482
483 Here follows an example script with comments
484
485 use BaseWebService;
486 use strict;
487 use Data::Dumper;
488 
489 # Create the BaseWebService object
490 my $obj = BaseWebService->new(baseUrl => 'http://base2.thep.lu.se:8080/demo');
491 my $sessionID = $obj->sessionID();
492 print "Session ID = $sessionID \n";
493 
494 # Login, change to fit your account
495 $obj->login('base2', 'base2');
496 
497 # Get all the projects
498 my $projs = $obj->getProjects();
499 print "List of Projects:\n";
500 foreach my $proj (@{$projs}) {
501     print "Id         : ", $proj->{id}, "\n";
502     print "Name       : ", $proj->{name}, "\n";
503     print "Description: ",
504     ($proj->{description} ? '' : defined($proj->{description})), "\n\n";
505 }   
506 # Make an array of all project ID's
507 my @projID = map { $_->{id} } @{$projs};
508 
509 
510 # Set active project. This is an important step, since
511 # you have to have your project in an active state.
512 # Here I simply select the first project ID.
513 $obj->setActiveProject($projID[0]);
514 
515 # Get a listing of all experiments (At the moment you get a list of all
516 # experiments, unfortunately not only for the active project.
517 my $exps = $obj->getExperiments();
518 
519 print "List of Experiments:\n";
520 foreach my $exp (@{$exps}) {
521     print "Id         : ", $exp->{id}, "\n";
522     print "Name       : ", $exp->{name}, "\n";
523     print "Description: ",
524     ($exp->{description} ? '' :  defined($exp->{description})), "\n\n";
525 }   
526 
527 # Make an array of all experiment ID's
528 my @expID = map { $_->{id} } @{$exps};
529 
530 # Call the getRawBioAssays for the first one (if you have any)
531 if( @expID ) {
532     my $useExpID = $expID[0];
533     print "Raw bioassays for experiment with ID = $useExpID\n";
534     my $files = $obj->getRawBioAssays_by_expID($useExpID);
535     foreach my $file (@$files) {
536  print "celfile: $file->{celFile} (design = $file->{cdfFile})\n";
537     }
538 
539     # Download all files to the local directory. Uncomment to apply!
540     #$obj->downloadRawBioAssays($files, './');
541 }
542 
543 # Logout
544 $obj->logout();
545 
546=cut
547 
5481;
Note: See TracBrowser for help on using the repository browser.