solenv/bin/modules/Eis.pm

   1 #*************************************************************************
   2 #
   3 # DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
   4 #
   5 # Copyright 2008 by Sun Microsystems, Inc.
   6 #
   7 # OpenOffice.org - a multi-platform office productivity suite
   8 #
   9 # $RCSfile: Eis.pm,v $
  10 #
  11 # $Revision: 1.7 $
  12 #
  13 # This file is part of OpenOffice.org.
  14 #
  15 # OpenOffice.org is free software: you can redistribute it and/or modify
  16 # it under the terms of the GNU Lesser General Public License version 3
  17 # only, as published by the Free Software Foundation.
  18 #
  19 # OpenOffice.org is distributed in the hope that it will be useful,
  20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 # GNU Lesser General Public License version 3 for more details
  23 # (a copy is included in the LICENSE file that accompanied this code).
  24 #
  25 # You should have received a copy of the GNU Lesser General Public License
  26 # version 3 along with OpenOffice.org.  If not, see
  27 # <http://www.openoffice.org/license.html>
  28 # for a copy of the LGPLv3 License.
  29 #
  30 #*************************************************************************
  31
  32
  33 #
  34 # Eis.pm - package for accessing/manipulating the EIS database via SOAP
  35 #
  36
  37 package Eis;
  38 use strict;
  39
  40 use SOAP::Lite;
  41 use Class::Struct;
  42 use Carp;
  43
  44 # Declaration of class Eis together with ctor and accessors.
  45 # See 'perldoc Class::Struct' for details
  46
  47 struct Eis => [
  48     # public members
  49     uri           => '$',           # name of webservice
  50     proxy_list    => '@',           # list of proxy URLs
  51     current_proxy => '$',           # current proxy (index in proxy_list)
  52     net_proxy     => '$',           # network proxy to pass through firewall
  53     # private members
  54     eis_connector => '$'            # SOAP connector to EIS database
  55 ];
  56
  57 #### public methods ####
  58
  59 # Any not predeclared method call to this package is
  60 # interpreted as a SOAP method call. We use the AUTOLOAD
  61 # mechanism to intercept these calls and delgate them
  62 # to the eis_connector.
  63 # See the 'Camel Book', 3rd edition, page 337 for an
  64 # explanation of the AUTOLOAD mechanism.
  65 sub AUTOLOAD
  66 {
  67     my $self = shift;
  68     my $callee = $Eis::AUTOLOAD; # $callee now holds the name of
  69                                  # called subroutine
  70                                  #
  71     return if $callee =~ /::DESTROY$/;
  72     $callee = substr($callee, 5);
  73
  74     my $sl = $self->eis_connector();
  75     if ( !$sl ) {
  76         $sl = $self->init_eis_connector();
  77         $self->eis_connector($sl);
  78     }
  79
  80     my $response;
  81     while ( 1 )  {
  82         # Call callee() on web service.
  83         eval { $response = $sl->$callee(@_) };
  84         if ( $@ ) {
  85             # Transport error (server not available, timeout, etc).
  86             # Use backup server.
  87             print STDERR ("Warning: web service unavailable. Trying backup server.\n");
  88             if ( !$self->set_next_proxy() ) {
  89                 # All proxies tried, out of luck
  90                 carp("ERROR: Connection to EIS database failed.\n");
  91                 return undef;
  92             }
  93         }
  94         else {
  95             last;
  96         }
  97     }
  98
  99     if ( $response->fault() ) {
 100         my $fault_msg = get_soap_fault_message($response);
 101         die $fault_msg; # throw $fault_msg as exception
 102     }
 103     else {
 104         return $response->result();
 105     }
 106 }
 107
 108 #### public class methods ####
 109
 110 # Turn scalar into SOAP string.
 111 sub to_string
 112 {
 113     my $value = shift;
 114
 115     return SOAP::Data->type(string => $value);
 116 }
 117
 118 #### non public instance methods ####
 119
 120 # Initialize SOAP connection to EIS.
 121 sub init_eis_connector
 122 {
 123     my $self = shift;
 124
 125     # Init current_proxy with first element of the proxy list.
 126     my $current = $self->current_proxy(0);
 127
 128     if ( !$self->uri() ) {
 129         carp("ERROR: web service URI not set.");
 130         return undef;
 131     }
 132
 133     if ( !$self->proxy_list->[$current] ) {
 134         carp("ERROR: proxy list not proper initialized.");
 135         return undef;
 136     }
 137
 138     # might be needed to get through a firewall
 139     if ( defined($self->net_proxy()) ) {
 140         $ENV{HTTPS_PROXY}=$self->net_proxy();
 141     }
 142
 143     my $proxy = $self->proxy_list()->[$current];
 144     if ( $proxy =~ /^\s*https\:\/\// ) {
 145         # SOAP::Lite does not complain if Crypt::SSLeay is not available,
 146         # but crypted connections will just not work. Force the detection of
 147         # Crypt::SSLeay for https connections and fail with a meaningful
 148         # message if it's not available.
 149         require Crypt::SSLeay;
 150     }
 151     return create_eis_connector($self->uri(), $proxy);
 152 }
 153
 154 # Advance one entry in proxy list.
 155 sub set_next_proxy
 156 {
 157     my $self = shift;
 158
 159     my @proxies = @{$self->proxy_list()};
 160     my $current = $self->current_proxy();
 161
 162     if ( $current == $#proxies ) {
 163         return 0;
 164     }
 165     else {
 166         $self->current_proxy(++$current);
 167         my $next_proxy = $self->proxy_list()->[$current];
 168         $self->eis_connector()->proxy($next_proxy);
 169         return 1;
 170     }
 171 }
 172
 173 #### misc ####
 174
 175 # Create new SOAP EIS conector.
 176 sub create_eis_connector
 177 {
 178     my $uri   = shift;
 179     my $proxy = shift;
 180
 181     my $sl;
 182
 183     # With version 0.66 of SOAP::Lite the uri() method
 184     # has been deprecated in favour of ns(). There
 185     # seems to be no way to switch of the deprecation warning
 186     # (which may be a bug in this version of SOAP::Lite).
 187     # Since older versions do not support the ns() method we
 188     # either force everyone to upgrade now, or make the following
 189     # dependent on the SOAP::Lite version.
 190     my ($vmaj, $vmin) = (0, 0);
 191     if( $SOAP::Lite::VERSION =~ m/([0-9]*)\.([0-9]*)/ ) {
 192         $vmaj = $1;
 193         $vmin = $2;
 194         if ( $vmaj > 0 || ( $vmaj == 0 && $vmin >= 66 ) ) {
 195             $sl = SOAP::Lite
 196             -> ns($uri)
 197             -> proxy($proxy);
 198         }
 199         else {
 200             $sl = SOAP::Lite
 201             -> uri($uri)
 202             -> proxy($proxy);
 203         }
 204     }
 205     else {
 206         carp("ERROR: Can't determine SOAP::Lite version.");
 207     }
 208
 209     return $sl;
 210 }
 211
 212 # Retrieve SOAP fault message.
 213 sub get_soap_fault_message
 214 {
 215     my $faulty_response = shift;
 216     my $fault_msg = join(', ', $faulty_response->faultcode(),
 217                                $faulty_response->faultstring(),
 218                                $faulty_response->faultdetail());
 219     return $fault_msg;
 220 }
 221
 222 ####
 223
 224 1; # needed by "use" or "require"