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