webservices/se.lu.thep.webservices/trunk/BaseWebService.pm

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

Generated on Tue Nov 21 03:45:37 2023 (UTC) by svndigest 0.11.2pre (dev build 1672)