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

######################################################################
#
# $Id: BaseWebService.pm 261 2007-04-20 16:36:47Z jari $
#
# Copyright (C) Authors contributing to this file.
# 
# This file is part of BASE - BioArray Software Environment.
# Available at http://base.thep.lu.se/
# 
# BASE is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# BASE is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA  02111-1307, USA.
######################################################################
package BaseWebService;

use strict;
#use SOAP::Lite +trace => qw (debug);
#use SOAP::Lite +trace;
use SOAP::Lite;
use Data::Dumper;
use LWP::Simple;


#### General documentation ####
=pod

=head1 NAME

    BaseWebService - A module to connect to BASE using webservices.


=head1 SYNOPSIS

    $obj->BaseWebService->new(baseUrl => 'http://localhost:8080/base2');
    print "Session ID = ", $obj->{sessionID}, "\n";

    # Login
    $obj->login('test', 'hej');

    # Get project
    my $projs = $obj->getProjects();
    print "List of Projects:\n";
    foreach my $proj (@{$projs}) {
       print "Id         : ", $proj->{id}, "\n";
       print "Name       : ", $proj->{name}, "\n";
       print "Description: ", $proj->{description}, "\n\n";
    }    
    # Make an array of all projects
    my @projID = map { $_->{id} } @{$projs};

    # Set active project
    $obj->setActiveProject($projID[0]);

=head1 DESCRIPTION

    BaseWebService.pm is Perl module that can communucate with a BASE
    server through its webservice interface. This module can at the moment
    only handle simple requests, such as listing projects, experiments and
    raw bioassays. It can however be used to download raw bioassays and design
    files from Base.  See below for some examples of its use.

=head1 CONSTRUCTOR   

=head2 BaseWebService->new()

    $obj = BaseWebservice->new(baseUrl => 'http://localhost:8080/base2');
    $obj = BaseWebservice->new(baseUrl => 'http://localhost:8080/base2', 
                               sessionID => 'b1212121212121212');
 
    The new() class method constructs a new BaseWebService object. The
    returned object can be used to connect to a BASE server using
    webservices. new() accept the following parameters:

=over 5

=item baseUrl

    The url for the BASE server. Default value is
    'http://localhost:8080/base2'

=item sessionID 

    The sessionID. Usually one does not need to set this, beacuse a new
    sessionID is obtained from the BASE server for each new call to
    new(). Sometimes it might however be usefull to reuse an old sessionID.

=back

=cut
sub new {
    # The constructor

    my $class = shift;
    my $self = {
  baseUrl    => "http://localhost:8080/base2",
  sessionID  => undef,
  @_            # Override    
    };

    # Set the other urls
    $self->{uri}             = "http://server.ws.basedb.sf.net/xsd";
    $self->{sessionProxy}    = "$self->{baseUrl}/services/Session";
    $self->{experimentProxy} = "$self->{baseUrl}/services/Experiment";
    $self->{projectProxy}    = "$self->{baseUrl}/services/Project";

    # If we got a sessionID use that otherwise get a new one
    unless( $self->{sessionID} ) {
  my $service = SOAP::Lite
      ->uri($self->{uri})
      ->proxy($self->{sessionProxy})
      ->newSession();
  $self->{sessionID} = $service->result;
    }

    bless($self, $class);
    return $self;

} # End of new 

##########################################################
#
# Session, login, logout etc
#
##########################################################

=head1 METHODS   

=head2 $obj->sessionID

    Title   : sessionID 
    Usage   : $ID = $obj->sessionID();
    Function: Returns the sesssion ID for webservice object
    
    Returns : A string containing the sessionID
    Args    : None

=cut

sub sessionID {
    # Get the sessionID

    my $self = shift;
    return $self->{sessionID};
    
} # End of sessionID

=head2 $obj->login

    Title   : login
    Usage   : $obj->login('login', 'password');
    Function: To login to a specific account on the BASE server. 

    Returns : None
    Args    : The first argument is the login name and the second argument
              is the password

=cut
sub login {
    # Login

    my $self = shift;
    
    unless( @_ == 2 ) {
  die "User and password needed\n";
    }
    my ($user, $passwd) = @_;

    unless( $self->{sessionID} ) {
  die "No sessionID found\n";
    }
    my $service = SOAP::Lite
  ->uri($self->{uri})
  ->proxy($self->{sessionProxy})
  ->login($self->{sessionID}, $user, $passwd, 'WebService', 0);
    
    if( $service ) {
  print "login error: ", $service->faultstring, "\n";
    }

} # End of Login


=head2 $obj->logout

    Title   : logout
    Usage   : $obj->logout();
    Function: To logout of the BASE server

    Returns : None
    Args    : None

=cut
sub logout {
    # Logout
    
    my $self = shift;
    
    unless( $self->{sessionID} ) {
  die "No sessionID found\n";
    }

    my $service = SOAP::Lite
  ->uri($self->{uri})
  ->proxy($self->{sessionProxy})
  ->logout($self->{sessionID});

    if( $service ) {
  print "logout error: ", $service->faultstring, "\n";
    }
    
} # End of Logout

##########################################################
#
# Project routines
#
##########################################################

=head2 $obj->getProjects

    Title   : getProjects 
    Usage   : $projs = $obj->getProjects();
    Function: This function returns all projects associated with the current
              user.

    Returns : This function returns a reference to an array of hashes. 
              Each hash has the followoing keys: 'id', 'name' and 
              'description', corresponding to the id, name and description
              of the projects for the current user. The value behind the 
              'id' key is used later to make a specific project active. 
              See the 'setActiveProject' method.
              
    Args    : None

=cut
sub getProjects {
    
    my $self = shift;

    # Use the getProjects webservice function at BASE
    my $service = SOAP::Lite
  ->uri($self->{uri})
  ->proxy($self->{projectProxy})
  ->getProjects($self->{sessionID});

    # Error check
    if( $service->fault ) {
  print "getProjects error: ", $service->faultstring, "\n";
  return;
    }
    
    my @projs;
    push(@projs, $service->result);
    push(@projs, $service->paramsout);

    return(\@projs);
    

} # End of getProjects 


=head2 $obj->setActiveProject

    Title   : setActiveProject
    Usage   : $obj->setActiveProject($ID);
    Function: This is used to make a specific project active. The project
              is identified by its ID-number, returned by the getProjects
              method. 

    Returns : None
    Args    : ID number (integer)

=cut
sub setActiveProject {
    
    my ($self, $projID) = @_;

    # Use the getExperiments webservice function at BASE
    my $service = SOAP::Lite
  ->uri($self->{uri})
  ->proxy($self->{projectProxy})
  ->setActiveProject($self->{sessionID}, $projID);
    
    if( $service ) {
  print "setActiveProject error: ", $service->faultstring, "\n";
    }
    
} # End of setActiveProject


##########################################################
#
# Experiments and Raw bioassays
#
##########################################################

=head2 $obj->getExperiments

    Title   : getExperiments 
    Usage   : $exps = $obj->getExperiments();
    Function: Lists all experiments for the current user.

    Returns : This function returns a reference to an array of hashes. 
              Each hash has the followoing keys: 'id', 'name' and 
              'description', corresponding to the id, name and description
              of the experiments for the current user. Note, that this method
              currently lists all experiments for user, not only the ones
              associated with the active project.
    Args    : None

=cut
sub getExperiments {
    # get all Experiments

    my $self = shift;

    # Use the getExperiments webservice function at BASE
    my $service = SOAP::Lite
  ->uri($self->{uri})
  ->proxy($self->{experimentProxy})
  ->getExperiments($self->{sessionID});

    # Error check
    if( $service->fault ) {
  print "getExperiment error: ", $service->faultstring, "\n";
  return;
    }
    
    my @exps;
    push(@exps, $service->result);
    push(@exps, $service->paramsout);

    return(\@exps);
    
} # End of listExperiments


=head2 $obj->getRawBioAssays_by_expID

    Title   : getRawBioAssays_by_expID
    Usage   : $assays = $obj->getRawBioAssays_by_expID($ID);
    Function: This function returns a list of all raw bio assays and
              the corresponding design files for the specified experiment.

    Returns : A reference to an array of hashes. Each hash has the following
              keys: 'celFile', 'celFileUrl', 'cdfFile' and 'cdfFileUrl'. Each
              raw bio assay ('celFile') has a corresponding design ('cdfFile').
              The 'celFileUrl' and 'cdfFileUrl' are internal urls of these files
              and are used for the 'downloadRasBioAssays' method.
    Args    : The experiment ID (integer).

=cut
sub getRawBioAssays_by_expID {
    # List raw bioassays given an array if experiment ID
    
    my ($self, $exp) = @_;

    my @result;
    my $service = SOAP::Lite
  ->uri($self->{uri})
  ->proxy($self->{experimentProxy})
  ->getRawBioAssays($self->{sessionID}, $exp);
    
    if( $service->fault ) {
  print "getRawBioAssays_by_expID error: ", $service->faultstring, "\n"; 
    }
    
    my @files;
    push(@files, $service->result);
    push(@files, $service->paramsout);
    
    foreach my $ass (@files) {

  # Report both the url and the filename
  my $cdfFileUrl = $ass->{cdfFileUrl};
  my $cdfFile = $cdfFileUrl;
  $cdfFile =~ s/^.*\///g;
  my $celFileUrl = $ass->{celFileUrl};
  my $celFile = $celFileUrl;
  $celFile =~ s/^.*\///g;
  
  # Store in the result array
  push(@result, {
      cdfFileUrl => $cdfFileUrl,
      cdfFile    => $cdfFile,
      celFileUrl => $celFileUrl,
      celFile    => $celFile
      });
    }

    return(\@result);

} # End of getRawBioAssays_by_expID


=head2 $obj->downloadRawBioAssays

    Title   : downloadRawBioAssays
    Usage   : $obj->downloadRawBioAssays($assys, $path);
    Function: To download raw bioassays to a local directory.

    Returns : None
    Args    : The first is a reference to an array of hashes, describing the
              raw bioassays. See the 'getRawBioAssays_by_expID' method. The second
              argument is the path where to download the files.

=cut
sub downloadRawBioAssays {

    my($self, $files, $path) = @_;
    
    # Make sure that the supplied path exists
    unless( -d $path ) {
  die "downloadRawBioAssays error: no such directory $path\n";
    }
    
    # Loop over all files
    my %design;
    foreach my $assay (@{$files}) {
  my $cel = $assay->{celFileUrl};
  my $celName = $assay->{celFile};
  my $cdf = $assay->{cdfFileUrl};
  my $cdfFile = $assay->{cdfFile};
  $design{$cdfFile} = $cdf;
  
  # Make the correct path
  my $celUrl = "$self->{baseUrl}/$cel";
  my $celLocal = "$path/$celName";

  #print "Downloading $celLocal\n";
  getstore($celUrl, $celLocal);
    }

    # Now download the designs (cdf files)
    foreach my $cdfFile (keys %design) {
  my $cdfUrl = "$self->{baseUrl}/$design{$cdfFile}";
  my $cdfLocal = "$path/$cdfFile";

  #print "Downloading $cdfLocal\n";
  getstore($cdfUrl, $cdfLocal);
    }

} # End of downloadRawBioAssays


=head2 $obj->downloadRawBioAssays_by_expID

    Title   : downloadRawBioAssays_by_expID
    Usage   : $obj->downloadRawBioAssays_by_expID($ID $path);
    Function: To download raw bioassays to a local directory. This function
              takes an experiment ID as argument and downloads all the files
              to the given path. This function is a simple wrapper of 
              getRawBioAssays_by_expID and downloadRawBioAssays.

    Returns : None
    Args    : The first is the experiment ID (integer) and the second
              argument is the path where to download the files.

=cut
sub downloadRawBioAssays_by_expID {

    my($self, $ID, $path) = @_;

    my $files = $self->getRawBioAssays_by_expID($ID);
    $self->downloadRawBioAssays($files, $path);
    
} # End of downloadRawBioAssays_by_expID


=head1 Examples

 Here follows an example script with comments

 use BaseWebService;
 use strict;
 use Data::Dumper;
 
 # Create the BaseWebService object
 my $obj = BaseWebService->new(baseUrl => 'http://base2.thep.lu.se:8080/demo');
 my $sessionID = $obj->sessionID();
 print "Session ID = $sessionID \n";
 
 # Login, change to fit your account
 $obj->login('base2', 'base2');
 
 # Get all the projects
 my $projs = $obj->getProjects();
 print "List of Projects:\n";
 foreach my $proj (@{$projs}) {
     print "Id         : ", $proj->{id}, "\n";
     print "Name       : ", $proj->{name}, "\n";
     print "Description: ", 
     ($proj->{description} ? '' : defined($proj->{description})), "\n\n";
 }    
 # Make an array of all project ID's
 my @projID = map { $_->{id} } @{$projs};
 
 
 # Set active project. This is an important step, since 
 # you have to have your project in an active state.
 # Here I simply select the first project ID.
 $obj->setActiveProject($projID[0]);
 
 # Get a listing of all experiments (At the moment you get a list of all 
 # experiments, unfortunately not only for the active project.
 my $exps = $obj->getExperiments(); 
 
 print "List of Experiments:\n";
 foreach my $exp (@{$exps}) {
     print "Id         : ", $exp->{id}, "\n";
     print "Name       : ", $exp->{name}, "\n";
     print "Description: ", 
     ($exp->{description} ? '' :  defined($exp->{description})), "\n\n";
 }    
 
 # Make an array of all experiment ID's
 my @expID = map { $_->{id} } @{$exps};
 
 # Call the getRawBioAssays for the first one (if you have any)
 if( @expID ) {
     my $useExpID = $expID[0];
     print "Raw bioassays for experiment with ID = $useExpID\n";
     my $files = $obj->getRawBioAssays_by_expID($useExpID);
     foreach my $file (@$files) {
  print "celfile: $file->{celFile} (design = $file->{cdfFile})\n";
     }
 
     # Download all files to the local directory. Uncomment to apply!
     #$obj->downloadRawBioAssays($files, './');
 }
 
 # Logout
 $obj->logout();
 
=cut
 
1;