From a44824f5e08d84d7ca2cacef72942c26498bf5bb Mon Sep 17 00:00:00 2001 From: JT Smith Date: Mon, 9 Feb 2004 01:17:47 +0000 Subject: [PATCH] adding web services client wobject --- docs/changelog/6.x.x.txt | 1 + docs/credits.txt | 1 + docs/gotcha.txt | 4 +- docs/install.txt | 6 +- docs/upgrades/upgrade_5.9.9-6.0.0.pl | 1 + docs/upgrades/upgrade_5.9.9-6.0.0.sql | 52 +++ lib/WebGUI/Wobject/WSClient.pm | 499 ++++++++++++++++++++++++++ 7 files changed, 562 insertions(+), 2 deletions(-) create mode 100644 lib/WebGUI/Wobject/WSClient.pm diff --git a/docs/changelog/6.x.x.txt b/docs/changelog/6.x.x.txt index 2911c5c96..97a2287f6 100644 --- a/docs/changelog/6.x.x.txt +++ b/docs/changelog/6.x.x.txt @@ -59,6 +59,7 @@ webgui. hard to maintain and users were confused by it. - Added a "Turn Admin On" group to determine who can enable or disable admin mode. + - Added the Web Services Client wobject. (Thanks to Alan Ritari and DonorWare.) diff --git a/docs/credits.txt b/docs/credits.txt index 096cfc352..103c8ccd0 100644 --- a/docs/credits.txt +++ b/docs/credits.txt @@ -31,6 +31,7 @@ Contributing Developers..............Peter Beardsley / Appropriate Solutions Christophe Marcant Tavis Parker / ParkerOne Consulting Daniel Quinlan + Alan Ritari / DonorWare Hal Roberts / Harvard Steve Simms Ben Simpson diff --git a/docs/gotcha.txt b/docs/gotcha.txt index efda8f0d9..8268a3eb8 100644 --- a/docs/gotcha.txt +++ b/docs/gotcha.txt @@ -23,7 +23,9 @@ save you many hours of grief. * The Paginator API has been significantly changed. Please see docs/migration.txt for details. - * WebGUI now requires Data::Serializer to be installed. + * WebGUI now requires the following Perl modules to be installed: + Data::Serializer + SOAP::Lite 5.5.0 diff --git a/docs/install.txt b/docs/install.txt index 674e1797d..fc6f8d668 100644 --- a/docs/install.txt +++ b/docs/install.txt @@ -22,8 +22,12 @@ QnD INSTALL INSTRUCTIONS: HTML::Parser Archive::Tar Compress::Zlib + IO::Zlib + SOAP::Lite + Data::Serializer Image::Magick (optional) - Cache::FileCache (optional) + Cache::Cache (optional) + 3. Install Apache (preferably with mod_perl) and set up your config. If you are using Apache 2, see the additional instructions below. diff --git a/docs/upgrades/upgrade_5.9.9-6.0.0.pl b/docs/upgrades/upgrade_5.9.9-6.0.0.pl index 2757fdbf4..c9e67aa65 100644 --- a/docs/upgrades/upgrade_5.9.9-6.0.0.pl +++ b/docs/upgrades/upgrade_5.9.9-6.0.0.pl @@ -431,6 +431,7 @@ foreach my $wobject (@{$wobjects}) { push(@newWobjects,$wobject); } } +push(@newWobjects,"WSClient"); $conf->set("wobjects"=>\@newWobjects); $conf->write; diff --git a/docs/upgrades/upgrade_5.9.9-6.0.0.sql b/docs/upgrades/upgrade_5.9.9-6.0.0.sql index 264d35d7e..0a1d8bf96 100644 --- a/docs/upgrades/upgrade_5.9.9-6.0.0.sql +++ b/docs/upgrades/upgrade_5.9.9-6.0.0.sql @@ -361,3 +361,55 @@ insert into groupGroupings (groupId, inGroup) values (11,5); +CREATE TABLE WSClient ( + wobjectId int(11) NOT NULL default '0', + call text NOT NULL, + uri varchar(255) NOT NULL default '', + proxy varchar(255) NOT NULL default '', + preprocessMacros int(11) NOT NULL default '0', + paginateAfter int(11) NOT NULL default '50', + paginateVar varchar(35) default NULL, + debugMode int(11) NOT NULL default '0', + params text, + execute_by_default tinyint(4) NOT NULL default '1', + templateId int(11) NOT NULL default '1', + decodeUtf8 tinyint(3) unsigned NOT NULL default '0', + httpHeader varchar(50), + PRIMARY KEY (wobjectId) +) TYPE=MyISAM; +INSERT INTO help VALUES (1,'WSClient',61,71,'2,WSClient;21,WebGUI;'); +INSERT INTO help VALUES (2,'WSClient',72,73,'1,WSClient;51,WebGUI;'); +INSERT INTO international VALUES (1,'WSClient',1,'Web Services Client',1033575504,NULL); +INSERT INTO international VALUES (2,'WSClient',1,'SOAP URI or WSDL',1033575504,NULL); +INSERT INTO international VALUES (3,'WSClient',1,'SOAP Proxy',1033575504,NULL); +INSERT INTO international VALUES (5,'WSClient',1,'SOAP Call Parameters',1033575504,NULL); +INSERT INTO international VALUES (8,'WSClient',1,'Preprocess macros on query?',1033575504,NULL); +INSERT INTO international VALUES (9,'WSClient',1,'Debug?',1033575504,NULL); +INSERT INTO international VALUES (11,'WSClient',1,'Execute by default?',1033575504,NULL); +INSERT INTO international VALUES (12,'WSClient',1,'Msg if no results',1033575504,NULL); +INSERT INTO international VALUES (13,'WSClient',1,'Pagination after',1072810296,NULL); +INSERT INTO international VALUES (14,'WSClient',1,'Pagination variable',1072810296,NULL); +insert into international values (15,'WSClient',1,'Decode utf8 data?',1033575504,NULL); +insert into international values (16,'WSClient',1,'HTTP Header Override', 1033575504,NULL); +INSERT INTO international VALUES (20,'WSClient',1,'Edit Web Services Client',1033575504,NULL); +INSERT INTO international VALUES (21,'WSClient',1,'There were no results for this query.',1033575504,NULL); +INSERT INTO international VALUES (22,'WSClient',1,'Parse error on SOAP parameters.',1055348597,NULL); +INSERT INTO international VALUES (23,'WSClient',1,'The URI/WSDL specified is of an improper format.',1055348955,NULL); +INSERT INTO international VALUES (24,'WSClient',1,'SOAP return is type: ',1055349028,NULL); +INSERT INTO international VALUES (25,'WSClient',1,'There was a problem with the SOAP call: ',1055349116,NULL); +INSERT INTO international VALUES (26,'WSClient',1,'Could not connect to SOAP server.',1055349311,NULL); +INSERT INTO international VALUES (30,'WSClient',1,'Debug: Error: The URI/WSDL specified is of an improper format.',1033575504,NULL); +INSERT INTO international VALUES (31,'WSClient',1,'Debug: Error: There was a problem with the SOAP call.',1033575504,NULL); +INSERT INTO international VALUES (32,'WSClient',1,'Debug: Error: Could not connect to the SOAP server.',1033575504,NULL); +INSERT INTO international VALUES (35,'WSClient',1,'Debug: No template specified, using default.',1033575504,NULL); +INSERT INTO international VALUES (61,'WSClient',1,'Web Services Client, Add/Edit',1033575504,NULL); +INSERT INTO international VALUES (71,'WSClient',1,'A Web Services Client allows a user to query data from any SOAP server to which they have access. This wobject is in development status and should not be made accessible to un-trusted site administratores.

\n\nSOAP URI/WSDL
\nFrom the SOAP::Lite manpage, "URIs are just identifiers. They may look like URLs, but they are not guaranteed to point to anywhere and shouldn\'t be used as such pointers. URIs assume to be unique within the space of all XML documents, so consider them as unique identifiers and nothing else." If you specify a URI, you probably also need a proxy below. Alternatively, you can specify a WSDL file in place of a URI. This file refers to a real location at which a SOAP service description can be downloaded and used. For our purposes, the file must end in ".wsdl" to be properly recognized. If you use a WSDL file, you probably don\'t need to specify a proxy.

\n\nSOAP Proxy
\nThe SOAP proxy is the full name of the server and/or script that is listening for SOAP calls. For example:\nhttp://mydomain.com/cgi-bin/soaplistener.pl

\n\nSOAP Method/Call
\nThe SOAP method is the name of the function to be invoked by the SOAP server. Include any extra parameters in the SOAP Call Parameters field below.

\n\nSOAP Call Parameters
\nIf your SOAP call requires any additional parameters, include them here as a valid perl hash, array or scalar. For example: \'userid\' => \'12\', companyid => \'^FormParam("companyid"); Whether you need to use scalar, hash or array is entirely dependent on what your SOAP service expects as input. Likewise, what you get back is entirely dependent on what the service deems to return.\'.

\n\nExecute by default?
\nLeave this set to yes unless your page is calling itself with additional parameters. You will probably know if/when you need to turn off default execution. To force execution when it has been disabled by default, pass a form variable "targetWobjects" specifying the name of the SOAP call to force execution.

\n\nTemplate
\nChoose a layout for this SOAP client.

\n\nPreprocess macros on query?
\nIf you\'re using WebGUI macros in your query you\'ll want to check this box.

\n\nPagination After
\nHow many rows should be displayed before splitting the results into separate pages? In other words, how many rows should be displayed per page?

\n\nPagination Variable
\nBecause a SOAP call can return complex data structures, you\'ll need to specify which named variable is to be paginated. If none is specified, no pagination will occur.

\n\nDebug?
\nIf you want to display debugging and error messages on the page, check this box.

\n\nDecode utf8?
\nThis option will only display if you have Data::Structure::Util installed. SOAP calls return utf8 strings even if they may not have utf8 characters within them. This converts utf8 characters to that there aren\'t collisions with any character sets specified in the page header. Deocing is turned off by default, but try turning it on if you see goofy gibberish, especially with the display of copyright symbols and the like.',1033739828,NULL); +INSERT INTO international VALUES (72,'WSClient',1,'Web Services Client Template',1072812143,NULL); +INSERT INTO international VALUES (73,'WSClient',1,'This is the list of +template variables available for Web Services Client +templates.

results
This loop contains all the results from +the SOAP call. Within the loop, you may access specific data elements by the +names set for them by the SOAP server (i.e. perhaps "localTime" for a time query). In addition, there are a number of special template variables:\n\n
numResults
Number of rows found by the client, if an array was returned.

\n\nfirstPage
Link to first page in a paginated set.

\n\nlastPage
Link to last page in a paginated set.

\n\nnextPage
Link to next page in a paginated set.

\n\npageList
List of all pages in a paginated set.

\n\npreviousPage
Link to previous page in a paginated set.

\n\nmultiplePages
Boolean indicating multiple pages in a paginated set.

\n\nnumberOfPages
Number of pages in a paginated set.

\n\npageNumber
Current page number in a paginated set.
',1072812143,NULL); +INSERT INTO template VALUES (1,'Xmethods: getTemp','

\n\n\n

\n\n\n\r\n\r\n \r\n The current temp is: \r\n \r\n\r\n Failed to retrieve temp.\r\n','WSClient'); +INSERT INTO template VALUES (2,'Google: doGoogleSearch','\n\n

\n\n\n

\n\n\n
\n \n \">\n \n \n
\n\n\n \n \n

You searched for . We found around matching records.

\n \n\n \n \">\n \n \n \n \n \n
\n \n
\n \n
\n \n Description:
\n \n \">\n \n - \n \n

\n \n \n\n Could not retrieve results from Google.\n','WSClient'); + diff --git a/lib/WebGUI/Wobject/WSClient.pm b/lib/WebGUI/Wobject/WSClient.pm new file mode 100644 index 000000000..27ff765e7 --- /dev/null +++ b/lib/WebGUI/Wobject/WSClient.pm @@ -0,0 +1,499 @@ +package WebGUI::Wobject::WSClient; + +use strict; +use Data::Dumper; +use Digest::MD5; +use SOAP::Lite; +use Storable; +use WebGUI::Cache; +use WebGUI::ErrorHandler; +use WebGUI::HTMLForm; +use WebGUI::International; +use WebGUI::Macro; +use WebGUI::Paginator; +use WebGUI::Privilege; +use WebGUI::Session; +use WebGUI::Wobject; + +my ($hasUnblessAcme, $hasUnblessData, $hasUtf8, $utf8FieldType); + +# we really would like to be able to unbless references and strip utf8 data, +# but that requires non-standard and possibly difficult to install modules +BEGIN { + + # check for Data::Structure::Util, which requires perl 5.8.0 :-P + eval { require Data::Structure::Util; }; + if ($@) { + + $utf8FieldType = 'hidden'; + + # try Acme::Damn as partial fallback + eval { require Acme::Damn; }; + $hasUnblessAcme = 1 if !$@; + + } else { + + $utf8FieldType = 'yesNo'; + $hasUnblessData = 1; + $hasUtf8 = 1 if $] >= 5.008; + } +} + +our @ISA = qw(WebGUI::Wobject); + + +#------------------------------------------------------------------- +sub name { + return WebGUI::International::get(1, $_[0]->get('namespace')); +} + +#------------------------------------------------------------------- +sub new { + my ($self, $class, $httpHeaderFieldType, $property); + + $class = shift; + $property = shift; + + # specify in the config file if you want to force diff http headers, + # for outputting raw pdfs, etc + if ($session{'config'}{'soapHttpHeaderOverride'}) { + $httpHeaderFieldType = 'text'; + } else { + $httpHeaderFieldType = 'hidden'; + } + + $self = WebGUI::Wobject->new( + -properties => $property, + -extendedProperties => { + call => { + fieldType => 'textarea', + }, + debugMode => { + fieldType => 'integer', + defaultValue => 0, + }, + execute_by_default => { + fieldType => 'yesNo', + defaultValue => 1, + }, + paginateAfter => { + defaultValue => 100, + }, + paginateVar => { + fieldType => 'text', + }, + params => { + fieldType => 'textarea', + }, + preprocessMacros => { + fieldType => 'integer', + defaultValue => 0, + }, + proxy => { + fieldType => 'text', + defaultValue => $session{'config'}{'soapproxy'}, + }, + templateId => { + defaultValue => 1, + }, + uri => { + fieldType => 'text', + defaultValue => $session{'config'}{'soapuri'} + }, + decodeUtf8 => { + fieldType => $utf8FieldType, + defaultValue => 0, + }, + httpHeader => { + fieldType => $httpHeaderFieldType, + }, + }, + ); + bless $self, $class; +} + + +#------------------------------------------------------------------- +sub www_edit { + return WebGUI::Privilege::insufficient() + unless WebGUI::Privilege::canEditPage(); + + my $layout = WebGUI::HTMLForm->new; + my $privileges = WebGUI::HTMLForm->new; + my $properties = WebGUI::HTMLForm->new; + + # "Layout" tab + $layout->template( + -name => 'templateId', + -value => $_[0]->getValue('templateId'), + -namespace => $_[0]->get('namespace'), + ); + $layout->yesNo ( + -name => 'preprocessMacros', + -label => WebGUI::International::get(8, $_[0]->get('namespace')), + -value => $_[0]->get('preprocessMacros'), + ); + $layout->integer( + -name => 'paginateAfter', + -label => WebGUI::International::get(13, $_[0]->get('namespace')), + -value => $_[0]->getValue("paginateAfter") + ); + $layout->text ( + -name => 'paginateVar', + -label => WebGUI::International::get(14, $_[0]->get('namespace')), + -value => $_[0]->get('paginateVar'), + ); + + # "Properties" tab + $properties->text ( + -name => 'uri', + -label => WebGUI::International::get(2, $_[0]->get('namespace')), + -value => $_[0]->get('uri'), + ); + $properties->text ( + -name => 'proxy', + -label => WebGUI::International::get(3, $_[0]->get('namespace')), + -value => $_[0]->get('proxy'), + ); + $properties->text ( + -name => 'call', + -label => WebGUI::International::get(4, $_[0]->get('namespace')), + -value => $_[0]->get('call'), + ); + $properties->textarea ( + -name => 'params', + -label => WebGUI::International::get(5, $_[0]->get('namespace')), + -value => $_[0]->get('params'), + ); + + if ($session{'config'}{'soapHttpHeaderOverride'}) { + $properties->text ( + -name => 'httpHeader', + -label => WebGUI::International::get(16, $_[0]->get('namespace')), + -value => $_[0]->get('httpHeader'), + ); + } else { + $properties->hidden ( + -name => 'httpHeader', + -label => WebGUI::International::get(16, $_[0]->get('namespace')), + -value => $_[0]->get('httpHeader'), + ); + } + + $properties->yesNo ( + -name => 'execute_by_default', + -label => WebGUI::International::get(11, $_[0]->get('namespace')), + -value => $_[0]->get('execute_by_default'), + ); + $properties->yesNo ( + -name => 'debugMode', + -label => WebGUI::International::get(9, $_[0]->get('namespace')), + -value => $_[0]->get('debugMode'), + ); + + if ($utf8FieldType eq 'yesNo') { + $properties->yesNo ( + -name => 'decodeUtf8', + -label => WebGUI::International::get(15, $_[0]->get('namespace')), + -value => $_[0]->get('decodeUtf8'), + ); + } else { + $properties->hidden ( + -name => 'decodeUtf8', + -label => WebGUI::International::get(15, $_[0]->get('namespace')), + -value => $_[0]->get('decodeUtf8'), + ); + } + + return $_[0]->SUPER::www_edit ( + -layout => $layout->printRowsOnly, + -privileges => $privileges->printRowsOnly, + -properties => $properties->printRowsOnly, + -headingId => 20, + -helpId => 1, + ); +} + +#------------------------------------------------------------------- +sub www_view { + my ( $arr_ref, # temp var holding params + $cache_key, # unique cache identifier + $cache, # cache object + $call, # SOAP method call + $p, # pagination object + $param_str, # raw SOAP params before parsing + @params, # params to soap method call + @result, # SOAP result reference + $soap, # SOAP object + @targetWobjects, # list of non-default wobjects to exec + $url, # current page url + %var # HTML::Template variables + ); + my $self= shift; + + # this page, with important params + $url = WebGUI::URL::page("func=view&wid=" . $self->get("wobjectId")); + + # snag our SOAP call and preprocess if needed + $call = WebGUI::Macro::process($self->get('call')); + $param_str = WebGUI::Macro::process($self->get('params')); + if ($self->get('preprocessMacros')) { + WebGUI::Macro::process($call); + WebGUI::Macro::process($param_str); + } + + # advanced use, if you want to pass SOAP results to a single, particular + # wobject on a page + if (ref $session{'form'}{'targetWobjects'}) { + @targetWobjects = @{$session{'form'}{'targetWobjects'}}; + } else { + push @targetWobjects, $session{'form'}{'targetWobjects'}; + } + + # check to see if this exact query has already been cached + $cache_key = $session{'form'}{'cache'} || + Digest::MD5::md5_hex($call, $param_str); + $cache = WebGUI::Cache->new($cache_key, + WebGUI::International::get(4, $self->get('namespace'))); + @result = Storable::thaw($cache->get); + + # prep SOAP unless we found cached data + if (!$result[0]) { + # this is the magic right here. We're allowing perl to parse out + # the ArrayOfHash info so that we don't have to regex it ourselves + # FIXME: we need to protect against eval-ing unknown strings + # the solution is to normalize all params to another table + eval "\$arr_ref = [$param_str];"; + eval { @params = @$arr_ref; }; + WebGUI::ErrorHandler::warn(WebGUI::International::get(22, + $self->get('namespace'))) if $@ && $self->get('debugMode'); + + if ($self->get('execute_by_default') || grep /^$call$/, + @targetWobjects) { + + # there's certainly a better pattern match than this to check for + # valid looking uri, but I haven't hunted for the relevant RFC yet + if ($self->get("uri") =~ m!.+/.+!) { + + WebGUI::ErrorHandler::warn('uri=' . $self->get("uri")) + if $self->get('debugMode'); + $soap = $self->_instantiate_soap; + + } else { + WebGUI::ErrorHandler::warn(WebGUI::International::get(23, + $self->get('namespace'))) if $self->get('debugMode'); + } + } + } + + # continue if our SOAP connection was successful or we have cached data + if (defined $soap || $result[0]) { + + if (!$result[0]) { + eval { + # here's the rub. `perldoc SOAP::Lite` says, "the method in + # question will return the current object (if not stated + # otherwise)". That "not stated otherwise" bit is important. + my $return = $soap->$call(@params); + + WebGUI::ErrorHandler::warn("$call(" . (join ',', @params) . ')') + if $self->get('debugMode'); + + # The possible return types I've come across include a SOAP object, + # a hash reference, a blessed object or a simple scalar. Each type + # requires different handling (woohoo!) before being passed to the + # template system + WebGUI::ErrorHandler::warn(WebGUI::International::get(24, + $self->get('namespace')) . + (ref $return ? ref $return : 'scalar')) + if $self->get('debugMode'); + + # SOAP object + if ((ref $return) =~ /SOAP/i) { + @result = $return->paramsall; + + # hashref + } elsif (ref $return eq 'HASH') { + @result = $return; + + # blessed object, to be stripped with Acme::Damn + } elsif ($hasUnblessAcme && ref $return) { + WebGUI::ErrorHandler::warn("Acme::Damn::unbless($return)"); + @result = Acme::Damn::unbless($return); + + # blessed object, to be stripped with Data::Structure::Util + } elsif ($hasUnblessData && ref $return) { + WebGUI::ErrorHandler::warn("Data::Structure::Util::unbless($return)"); + @result = Data::Structure::Util::unbless($return); + + # scalar value, we hope + } else { + # there's got to be a way to get into the SOAP body and find the + # key name for the value returned, but I haven't figured it out + @result = { 'result' => $return }; + } + + $cache->set(Storable::freeze(@result)); + }; + + # did the soap call fault? + if ($@) { + WebGUI::ErrorHandler::warn($@) if $self->get('debugMode'); + $var{'soapError'} = $@; + WebGUI::ErrorHandler::warn(WebGUI::International::get(25, + $self->get('namespace')) . $var{'soapError'}) + if $self->get('debugMode'); + } + + # cached data was found + } else { + WebGUI::ErrorHandler::warn("Using cached data"); + } + + WebGUI::ErrorHandler::warn(Dumper(@result)) if + $self->get('debugMode'); + + # Do we need to decode utf8 data? Will only decode if modules were + # loaded and the wobject requests it + if ($self->{'decodeUtf8'} && $hasUtf8) { + if (Data::Structure::Util::has_utf8(\@result)) { + @result = @{Data::Structure::Util::utf8_off(\@result)}; + } + } + + # pagination is tricky because we don't know the specific portion of the + # data we need to paginate. Trust the user to have told us the right + # thing. If not, try to Do The Right Thing + if (scalar @result > 1) { + # this case hasn't ever happened running against my dev SOAP::Lite + # services, but let's assume it might. If our results array has + # more than one element, let's hope if contains scalars + $p = WebGUI::Paginator->new($url, \@result, + $self->get('paginateAfter')); + @result = (); + @result = @$p; + + } else { + + # In my experience, the most common case. We have an array + # containing a single hashref for which we have been given a key name + if (my $aref = $result[0]->{$self->get('paginateVar')}) { + + $var{'numResults'} = scalar @$aref; + $p = WebGUI::Paginator->new($url, $aref, + $self->get('paginateAfter')); + $result[0]->{$self->get('paginateVar')} = $p->getPageData; + + } else { + + if ((ref $result[0]) =~ /HASH/) { + + # this may not paginate the one that they want, but it will + # prevent the wobject from dying + for (keys %{$result[0]}) { + if ((ref $result[0]->{$_}) =~ /ARRAY/) { + $p = WebGUI::Paginator->new($url, $result[0]->{$_}, + $self->get('paginateAfter')); + last; + } + } + $p ||= WebGUI::Paginator->new($url, []); + $result[0]->{$_} = $p->getPageData; + + } elsif ((ref $result[0]) =~ /ARRAY/) { + $p = WebGUI::Paginator->new($url, $result[0], + $self->get('paginateAfter')); + $result[0] = $p->getPageData; + + } else { + $p = WebGUI::Paginator->new($url, [$result[0]], + $self->get('paginateAfter')); + $result[0] = $p->getPageData; + } + } + } + + # set pagination links + if ($p) { + $var{"firstPage"} = $p->getFirstPageLink; + $var{"lastPage"} = $p->getLastPageLink; + $var{"nextPage"} = $p->getNextPageLink; + $var{"pageList"} = $p->getPageLinks; + $var{"previousPage"} = $p->getPreviousPageLink; + $var{"multiplePages"} = ($p->getNumberOfPages > 1); + $var{'numberOfPages'} = $p->getNumberOfPages; + $var{'pageNumber'} = $p->getPageNumber; + + for ('firstPage','lastPage','nextPage','pageList','previousPage') { + $var{$_} =~ s/\?/\?cache=$cache_key\&/g; + } + } + + + } else { + WebGUI::ErrorHandler::warn(WebGUI::International::get(26, + $self->get('namespace')) . $@) if $self->get('debugMode'); + } + + # did they request a funky http header? + if ($session{'config'}{'soapHttpHeaderOverride'} && + $self->get("httpHeader")) { + + $session{'header'}{'mimetype'} = $self->get("httpHeader"); + WebGUI::ErrorHandler::warn("changed mimetype: " . + $session{'header'}{'mimetype'}); + } + + # Note, we still process our template below even though it will never + # be displayed if the redirectURL is set. Not sure how important it is + # to do it this way, but it certainly is the least obtrusive to default + # webgui flow. This feature currently requires a patched WebGUI.pm file. + if ($session{'form'}{'redirectURL'}) { + $session{'page'}{'redirectURL'} = $session{'form'}{'redirectURL'}; + } + + $var{'results'} = \@result; + return $self->processTemplate($self->get("templateId"),\%var); +} + + +sub _instantiate_soap { + my ($soap, @wobject); + my $self = shift; + + # a wsdl file was specified + # we don't use fault handling with wsdls becuase they seem to behave + # differently. Not sure if that is by design. + if ($self->get("uri") =~ m/\.wsdl\s*$/i) { + + WebGUI::ErrorHandler::warn('wsdl=' . $self->get('uri')) + if $self->get('debugMode'); + + # instantiate SOAP service + $soap = SOAP::Lite->service($self->get('uri')); + + # standard uri namespace + } else { + WebGUI::ErrorHandler::warn('uri=' . $self->get('uri')) + if $self->get('debugMode'); + + # instantiate SOAP service, with fault handling + $soap = new SOAP::Lite + on_fault => sub { + my ($soap, $res) = @_; + die $res->faultstring; + }; + $soap->uri($self->get('uri')); + + # proxy the call if requested + if ($self->get("proxy") && $soap) { + + WebGUI::ErrorHandler::warn('proxy=' . $self->get('proxy')) + if $self->get('debugMode'); + $soap->proxy($self->get('proxy')); + } + } + + return $soap; +} +1;