adding web services client wobject
This commit is contained in:
JT Smith
parent
685d2d9315
commit
a44824f5e0
7 changed files with 562 additions and 2 deletions
|
|
@ -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.)
|
||||
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -431,6 +431,7 @@ foreach my $wobject (@{$wobjects}) {
|
|||
push(@newWobjects,$wobject);
|
||||
}
|
||||
}
|
||||
push(@newWobjects,"WSClient");
|
||||
$conf->set("wobjects"=>\@newWobjects);
|
||||
$conf->write;
|
||||
|
||||
|
|
|
|||
|
|
@ -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,'<b>Debug:</b> Error: The URI/WSDL specified is of an improper format.',1033575504,NULL);
|
||||
INSERT INTO international VALUES (31,'WSClient',1,'<b>Debug:</b> Error: There was a problem with the SOAP call.',1033575504,NULL);
|
||||
INSERT INTO international VALUES (32,'WSClient',1,'<b>Debug:</b> Error: Could not connect to the SOAP server.',1033575504,NULL);
|
||||
INSERT INTO international VALUES (35,'WSClient',1,'<b>Debug:</b> 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.<p></p>\n\n<b>SOAP URI/WSDL</b><br>\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.<p></p>\n\n<b>SOAP Proxy</b><br>\nThe SOAP proxy is the full name of the server and/or script that is listening for SOAP calls. For example:\n<code>http://mydomain.com/cgi-bin/soaplistener.pl</code><p></p>\n\n<b>SOAP Method/Call</b><br>\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.<p></p>\n\n<b>SOAP Call Parameters</b><br>\nIf your SOAP call requires any additional parameters, include them here as a valid perl hash, array or scalar. For example: <code>\'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.\'</code>.<p></p>\n\n<b>Execute by default?</b><br>\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.<p></p>\n\n<b>Template</b><br>\nChoose a layout for this SOAP client.<p></p>\n\n<b>Preprocess macros on query?</b><br>\nIf you\'re using WebGUI macros in your query you\'ll want to check this box.<p></p>\n\n<b>Pagination After</b><br>\nHow many rows should be displayed before splitting the results into separate pages? In other words, how many rows should be displayed per page?<p></p>\n\n<b>Pagination Variable</b><br>\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.<p></p>\n\n<b>Debug?</b><br>\nIf you want to display debugging and error messages on the page, check this box.<p></p>\n\n<b>Decode utf8?</b><br />\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.<p></p><b>results</b><br />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<blockquote><b>numResults</b><br />Number of rows found by the client, if an array was returned.<p></p>\n\n<b>firstPage</b><br />Link to first page in a paginated set.<p></p>\n\n<b>lastPage</b><br />Link to last page in a paginated set.<p></p>\n\n<b>nextPage</b><br />Link to next page in a paginated set.<p></p>\n\n<b>pageList</b><br />List of all pages in a paginated set.<p></p>\n\n<b>previousPage</b><br />Link to previous page in a paginated set.<p></p>\n\n<b>multiplePages</b><br />Boolean indicating multiple pages in a paginated set.<p></p>\n\n<b>numberOfPages</b><br />Number of pages in a paginated set.<p></p>\n\n<b>pageNumber</b><br />Current page number in a paginated set.</blockquote>',1072812143,NULL);
|
||||
INSERT INTO template VALUES (1,'Xmethods: getTemp','<h1><tmpl_var title></h1>\n\n<tmpl_if description>\n <tmpl_var description><br /><br />\n</tmpl_if>\n\n\r\n<tmpl_if results>\r\n <tmpl_loop results>\r\n The current temp is: <tmpl_var result>\r\n </tmpl_loop>\r\n<tmpl_else>\r\n Failed to retrieve temp.\r\n</tmpl_if>','WSClient');
|
||||
INSERT INTO template VALUES (2,'Google: doGoogleSearch','<style>\n.googleDetail {\n font-size: 9px;\n}\n</style>\n\n<h1><tmpl_var title></h1>\n\n<tmpl_if description>\n <tmpl_var description><br /><br />\n</tmpl_if>\n\n<form method=\"post\">\n <input type=\"hidden\" name=\"func\" value=\"view\">\n <input type=\"hidden\" name=\"wid\" value=\"<tmpl_var wobjectId>\">\n <input type=\"hidden\" name=\"targetWobjects\" value=\"doGoogleSearch\">\n <input type=\"text\" name=\"q\"><input type=\"submit\" value=\"Search\">\n</form>\n\n<tmpl_if results>\n <tmpl_loop results>\n <tmpl_if resultElements>\n <p> You searched for <b><tmpl_var searchQuery></b>. We found around <tmpl_var estimatedTotalResultsCount> matching records.</p>\n </tmpl_if>\n\n <tmpl_loop resultElements>\n <a href=\"<tmpl_var URL>\">\n <tmpl_if title>\n <tmpl_var title>\n <tmpl_else>\n <tmpl_var url>\n </tmpl_if>\n </a><br />\n <tmpl_if snippet>\n <tmpl_var snippet><br />\n </tmpl_if>\n <div class=\"googleDetail\">\n <tmpl_if summary>\n <b>Description:</b> <tmpl_var summary><br />\n </tmpl_if>\n <a href=\"<tmpl_var URL>\"><tmpl_var URL></a>\n <tmpl_if cachedSize>\n - <tmpl_var cachedSize>\n </tmpl_if>\n </div><br />\n </tmpl_loop>\n </tmpl_loop>\n<tmpl_else>\n Could not retrieve results from Google.\n</tmpl_if>','WSClient');
|
||||
|
||||
|
|
|
|||
499
lib/WebGUI/Wobject/WSClient.pm
Normal file
499
lib/WebGUI/Wobject/WSClient.pm
Normal file
|
|
@ -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;
|
||||
Loading…
Add table
Add a link
Reference in a new issue