| #************************************************************** |
| # |
| # Licensed to the Apache Software Foundation (ASF) under one |
| # or more contributor license agreements. See the NOTICE file |
| # distributed with this work for additional information |
| # regarding copyright ownership. The ASF licenses this file |
| # to you under the Apache License, Version 2.0 (the |
| # "License"); you may not use this file except in compliance |
| # with the License. You may obtain a copy of the License at |
| # |
| # http://www.apache.org/licenses/LICENSE-2.0 |
| # |
| # Unless required by applicable law or agreed to in writing, |
| # software distributed under the License is distributed on an |
| # "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY |
| # KIND, either express or implied. See the License for the |
| # specific language governing permissions and limitations |
| # under the License. |
| # |
| #************************************************************** |
| |
| |
| |
| |
| # |
| # Eis.pm - package for accessing/manipulating the EIS database via SOAP |
| # |
| |
| package Eis; |
| use strict; |
| |
| use SOAP::Lite; |
| use Class::Struct; |
| use Carp; |
| |
| # Declaration of class Eis together with ctor and accessors. |
| # See 'perldoc Class::Struct' for details |
| |
| struct Eis => [ |
| # public members |
| uri => '$', # name of webservice |
| proxy_list => '@', # list of proxy URLs |
| current_proxy => '$', # current proxy (index in proxy_list) |
| net_proxy => '$', # network proxy to pass through firewall |
| # private members |
| eis_connector => '$' # SOAP connector to EIS database |
| ]; |
| |
| #### public methods #### |
| |
| # Any not predeclared method call to this package is |
| # interpreted as a SOAP method call. We use the AUTOLOAD |
| # mechanism to intercept these calls and delgate them |
| # to the eis_connector. |
| # See the 'Camel Book', 3rd edition, page 337 for an |
| # explanation of the AUTOLOAD mechanism. |
| sub AUTOLOAD |
| { |
| my $self = shift; |
| my $callee = $Eis::AUTOLOAD; # $callee now holds the name of |
| # called subroutine |
| # |
| return if $callee =~ /::DESTROY$/; |
| $callee = substr($callee, 5); |
| |
| my $sl = $self->eis_connector(); |
| if ( !$sl ) { |
| $sl = $self->init_eis_connector(); |
| $self->eis_connector($sl); |
| } |
| |
| my $response; |
| while ( 1 ) { |
| # Call callee() on web service. |
| eval { $response = $sl->$callee(@_) }; |
| if ( $@ ) { |
| # Transport error (server not available, timeout, etc). |
| # Use backup server. |
| print STDERR ("Warning: web service unavailable. Trying backup server.\n"); |
| if ( !$self->set_next_proxy() ) { |
| # All proxies tried, out of luck |
| carp("ERROR: Connection to EIS database failed.\n"); |
| return undef; |
| } |
| } |
| else { |
| last; |
| } |
| } |
| |
| if ( $response->fault() ) { |
| my $fault_msg = get_soap_fault_message($response); |
| die $fault_msg; # throw $fault_msg as exception |
| } |
| else { |
| return $response->result(); |
| } |
| } |
| |
| #### public class methods #### |
| |
| # Turn scalar into SOAP string. |
| sub to_string |
| { |
| my $value = shift; |
| |
| return SOAP::Data->type(string => $value); |
| } |
| |
| #### non public instance methods #### |
| |
| # Initialize SOAP connection to EIS. |
| sub init_eis_connector |
| { |
| my $self = shift; |
| |
| # Init current_proxy with first element of the proxy list. |
| my $current = $self->current_proxy(0); |
| |
| if ( !$self->uri() ) { |
| carp("ERROR: web service URI not set."); |
| return undef; |
| } |
| |
| if ( !$self->proxy_list->[$current] ) { |
| carp("ERROR: proxy list not proper initialized."); |
| return undef; |
| } |
| |
| # might be needed to get through a firewall |
| if ( defined($self->net_proxy()) ) { |
| $ENV{HTTPS_PROXY}=$self->net_proxy(); |
| } |
| |
| my $proxy = $self->proxy_list()->[$current]; |
| if ( $proxy =~ /^\s*https\:\/\// ) { |
| # SOAP::Lite does not complain if Crypt::SSLeay is not available, |
| # but crypted connections will just not work. Force the detection of |
| # Crypt::SSLeay for https connections and fail with a meaningful |
| # message if it's not available. |
| require Crypt::SSLeay; |
| } |
| return create_eis_connector($self->uri(), $proxy); |
| } |
| |
| # Advance one entry in proxy list. |
| sub set_next_proxy |
| { |
| my $self = shift; |
| |
| my @proxies = @{$self->proxy_list()}; |
| my $current = $self->current_proxy(); |
| |
| if ( $current == $#proxies ) { |
| return 0; |
| } |
| else { |
| $self->current_proxy(++$current); |
| my $next_proxy = $self->proxy_list()->[$current]; |
| $self->eis_connector()->proxy($next_proxy); |
| return 1; |
| } |
| } |
| |
| #### misc #### |
| |
| # Create new SOAP EIS conector. |
| sub create_eis_connector |
| { |
| my $uri = shift; |
| my $proxy = shift; |
| |
| my $sl; |
| |
| # With version 0.66 of SOAP::Lite the uri() method |
| # has been deprecated in favour of ns(). There |
| # seems to be no way to switch of the deprecation warning |
| # (which may be a bug in this version of SOAP::Lite). |
| # Since older versions do not support the ns() method we |
| # either force everyone to upgrade now, or make the following |
| # dependent on the SOAP::Lite version. |
| my ($vmaj, $vmin) = (0, 0); |
| if( $SOAP::Lite::VERSION =~ m/([0-9]*)\.([0-9]*)/ ) { |
| $vmaj = $1; |
| $vmin = $2; |
| if ( $vmaj > 0 || ( $vmaj == 0 && $vmin >= 66 ) ) { |
| $sl = SOAP::Lite |
| -> ns($uri) |
| -> proxy($proxy); |
| } |
| else { |
| $sl = SOAP::Lite |
| -> uri($uri) |
| -> proxy($proxy); |
| } |
| } |
| else { |
| carp("ERROR: Can't determine SOAP::Lite version."); |
| } |
| |
| return $sl; |
| } |
| |
| # Retrieve SOAP fault message. |
| sub get_soap_fault_message |
| { |
| my $faulty_response = shift; |
| my $fault_msg = join(', ', $faulty_response->faultcode(), |
| $faulty_response->faultstring(), |
| $faulty_response->faultdetail()); |
| return $fault_msg; |
| } |
| |
| #### |
| |
| 1; # needed by "use" or "require" |