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