migrated http proxy and ws client
This commit is contained in:
JT Smith
parent
15c48e14d0
commit
7416bda04f
14 changed files with 282 additions and 1306 deletions
|
|
@ -1,410 +0,0 @@
|
|||
package WebGUI::Wobject::FileManager;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2004 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#-------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use strict;
|
||||
use Tie::CPHash;
|
||||
use WebGUI::DateTime;
|
||||
use WebGUI::Grouping;
|
||||
use WebGUI::HTMLForm;
|
||||
use WebGUI::HTTP;
|
||||
use WebGUI::Icon;
|
||||
use WebGUI::Id;
|
||||
use WebGUI::International;
|
||||
use WebGUI::Paginator;
|
||||
use WebGUI::Privilege;
|
||||
use WebGUI::Search;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::SQL;
|
||||
use WebGUI::URL;
|
||||
use WebGUI::Utility;
|
||||
use WebGUI::Wobject;
|
||||
|
||||
our @ISA = qw(WebGUI::Wobject);
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _sortByColumn {
|
||||
if ($session{scratch}{$_[0]->get("namespace").".".$_[0]->get("wobjectId").".sortDirection"} eq "asc") {
|
||||
return WebGUI::URL::append($_[2],'sort='.$_[1]."&sortDirection=desc");
|
||||
} else {
|
||||
return WebGUI::URL::append($_[2],'sort='.$_[1]."&sortDirection=asc");
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub duplicate {
|
||||
my ($file, $w, %row, $sth, $newDownloadId);
|
||||
tie %row, 'Tie::CPHash';
|
||||
$w = $_[0]->SUPER::duplicate($_[1]);
|
||||
$sth = WebGUI::SQL->read("select * from FileManager_file where wobjectId=".quote($_[0]->get("wobjectId")));
|
||||
while (%row = $sth->hash) {
|
||||
$newDownloadId = WebGUI::Id::generate();
|
||||
$file = WebGUI::Attachment->new($row{downloadFile},$_[0]->get("wobjectId"),$row{FileManager_fileId});
|
||||
$file->copy($w,$newDownloadId);
|
||||
$file = WebGUI::Attachment->new($row{alternateVersion1},$_[0]->get("wobjectId"),$row{FileManager_fileId});
|
||||
$file->copy($w,$newDownloadId);
|
||||
$file = WebGUI::Attachment->new($row{alternateVersion2},$_[0]->get("wobjectId"),$row{FileManager_fileId});
|
||||
$file->copy($w,$newDownloadId);
|
||||
WebGUI::SQL->write("insert into FileManager_file values (".quote($newDownloadId).", ".quote($w).", ".
|
||||
quote($row{fileTitle}).", ".quote($row{downloadFile}).", ".quote($row{groupToView}).", ".
|
||||
quote($row{briefSynopsis}).", $row{dateUploaded}, $row{sequenceNumber}, ".
|
||||
quote($row{alternateVersion1}).", ".quote($row{alternateVersion2}).")");
|
||||
}
|
||||
$sth->finish;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub getIndexerParams {
|
||||
my $self = shift;
|
||||
my $now = shift;
|
||||
return {
|
||||
FileManager_file => {
|
||||
sql => "select FileManager_file.wobjectId as wid,
|
||||
FileManager_file.fileTitle as fileTitle,
|
||||
FileManager_file.downloadFile as downloadFile,
|
||||
FileManager_file.briefSynopsis as briefSynopsis,
|
||||
FileManager_file.alternateVersion1 as alternateVersion1,
|
||||
FileManager_file.alternateVersion2 as alternateVersion2,
|
||||
FileManager_file.FileManager_fileId as fid,
|
||||
wobject.addedBy as ownerId,
|
||||
wobject.namespace as namespace,
|
||||
page.urlizedTitle as urlizedTitle,
|
||||
page.languageId as languageId,
|
||||
page.pageId as pageId,
|
||||
page.groupIdView as page_groupIdView,
|
||||
wobject.groupIdView as wobject_groupIdView,
|
||||
FileManager_file.groupToView as wobject_special_groupIdView
|
||||
from FileManager_file, wobject, page
|
||||
where FileManager_file.wobjectId = wobject.wobjectId
|
||||
and wobject.pageId = page.pageId
|
||||
and wobject.startDate < $now
|
||||
and wobject.endDate > $now
|
||||
and page.startDate < $now
|
||||
and page.endDate > $now",
|
||||
fieldsToIndex => ["fileTitle", "downloadFile", "briefSynopsis", "alternateVersion1", "alternateVersion2"],
|
||||
contentType => 'wobjectDetail',
|
||||
url => '$data{urlizedTitle}."#".$data{wid}',
|
||||
headerShortcut => 'select fileTitle from FileManager_file where FileManager_fileId = \'$data{fid}\'',
|
||||
bodyShortcut => 'select briefSynopsis from FileManager_file where FileManager_fileId = \'$data{fid}\'',
|
||||
}
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub name {
|
||||
return WebGUI::International::get(1,$_[0]->get("namespace"));
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $property = shift;
|
||||
my $self = WebGUI::Wobject->new(
|
||||
-properties=>$property,
|
||||
-extendedProperties=>{
|
||||
paginateAfter=>{
|
||||
defaultValue=>50,
|
||||
}
|
||||
},
|
||||
-useTemplate=>1,
|
||||
-useMetaData=>1
|
||||
);
|
||||
bless $self, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub purge {
|
||||
WebGUI::SQL->write("delete from FileManager_file where wobjectId=".quote($_[0]->get("wobjectId")));
|
||||
$_[0]->SUPER::purge();
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub uiLevel {
|
||||
return 4;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_deleteFile {
|
||||
return WebGUI::Privilege::insufficient() unless ($_[0]->canEdit);
|
||||
$_[0]->setCollateral("FileManager_file","FileManager_fileId",
|
||||
{$session{form}{file}=>'',FileManager_fileId=>$session{form}{did}},0,0);
|
||||
return $_[0]->www_editDownload();
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_deleteDownloadConfirm {
|
||||
return WebGUI::Privilege::insufficient() unless ($_[0]->canEdit);
|
||||
my ($output, $file);
|
||||
$file = WebGUI::Attachment->new("",$session{form}{wid},$session{form}{did});
|
||||
$file->deleteNode;
|
||||
$_[0]->deleteCollateral("FileManager_file","FileManager_fileId",$session{form}{did});
|
||||
$_[0]->reorderCollateral("FileManager_file","FileManager_fileId");
|
||||
return "";
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_download {
|
||||
$_[0]->logView() if ($session{setting}{passiveProfilingEnabled});
|
||||
my (%download, $file);
|
||||
tie %download,'Tie::CPHash';
|
||||
%download = WebGUI::SQL->quickHash("select * from FileManager_file where FileManager_fileId=".quote($session{form}{did}));
|
||||
if (WebGUI::Grouping::isInGroup($download{groupToView})) {
|
||||
if ($session{form}{alternateVersion} == 1) {
|
||||
$file = WebGUI::Attachment->new($download{alternateVersion1},
|
||||
$session{form}{wid},
|
||||
$session{form}{did});
|
||||
} elsif ($session{form}{alternateVersion} == 2) {
|
||||
$file = WebGUI::Attachment->new($download{alternateVersion2},
|
||||
$session{form}{wid},
|
||||
$session{form}{did});
|
||||
} else {
|
||||
$file = WebGUI::Attachment->new($download{downloadFile},
|
||||
$session{form}{wid},
|
||||
$session{form}{did});
|
||||
}
|
||||
WebGUI::HTTP::setRedirect($file->getURL);
|
||||
return "";
|
||||
} else {
|
||||
return WebGUI::Privilege::insufficient();
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_edit {
|
||||
my $properties = WebGUI::HTMLForm->new;
|
||||
my $layout = WebGUI::HTMLForm->new;
|
||||
$layout->integer(
|
||||
-name=>"paginateAfter",
|
||||
-label=>WebGUI::International::get(20,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("paginateAfter")
|
||||
);
|
||||
if ($_[0]->get("wobjectId") eq "new") {
|
||||
$properties->whatNext(
|
||||
-options=>{
|
||||
addFile=>WebGUI::International::get(74,$_[0]->get("namespace")),
|
||||
backToPage=>WebGUI::International::get(745)
|
||||
},
|
||||
-value=>"addFile"
|
||||
);
|
||||
}
|
||||
return $_[0]->SUPER::www_edit(
|
||||
-properties=>$properties->printRowsOnly,
|
||||
-layout=>$layout->printRowsOnly,
|
||||
-headingId=>9,
|
||||
-helpId=>"file manager add/edit"
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editSave {
|
||||
return WebGUI::Privilege::insufficient() unless ($_[0]->canEdit);
|
||||
$_[0]->SUPER::www_editSave();
|
||||
if ($session{form}{proceed} eq "addFile") {
|
||||
$session{form}{did} = "new";
|
||||
return $_[0]->www_editDownload();
|
||||
} else {
|
||||
return "";
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editDownload {
|
||||
return WebGUI::Privilege::insufficient() unless ($_[0]->canEdit);
|
||||
$session{page}{useAdminStyle} = 1;
|
||||
my ($output, $file, $f);
|
||||
$file = $_[0]->getCollateral("FileManager_file","FileManager_fileId",$session{form}{did});
|
||||
$output .= helpIcon("file add/edit",$_[0]->get("namespace"));
|
||||
$output .= '<h1>'.WebGUI::International::get(10,$_[0]->get("namespace")).'</h1>';
|
||||
$f = WebGUI::HTMLForm->new;
|
||||
$f->hidden("wid",$_[0]->get("wobjectId"));
|
||||
$f->hidden("did",$file->{FileManager_fileId});
|
||||
$f->hidden("func","editDownloadSave");
|
||||
$f->text("fileTitle",WebGUI::International::get(5,$_[0]->get("namespace")),$file->{fileTitle});
|
||||
if ($file->{downloadFile} ne "") {
|
||||
$f->readOnly('<a href="'.WebGUI::URL::page('func=deleteFile&file=downloadFile&wid='.
|
||||
$_[0]->get("wobjectId").'&did='.$file->{FileManager_fileId}).'">'.WebGUI::International::get(391).
|
||||
'</a>',WebGUI::International::get(6,$_[0]->get("namespace")));
|
||||
} else {
|
||||
$f->file("downloadFile",WebGUI::International::get(6,$_[0]->get("namespace")));
|
||||
}
|
||||
if ($file->{alternateVersion1} ne "") {
|
||||
$f->readOnly('<a href="'.WebGUI::URL::page('func=deleteFile&file=alternateVersion1&wid='.
|
||||
$_[0]->get("wobjectId").'&did='.$file->{FileManager_fileId}).'">'.
|
||||
WebGUI::International::get(391).'</a>',WebGUI::International::get(17,$_[0]->get("namespace")));
|
||||
} else {
|
||||
$f->file("alternateVersion1",WebGUI::International::get(17,$_[0]->get("namespace")));
|
||||
}
|
||||
if ($file->{alternateVersion2} ne "") {
|
||||
$f->readOnly('<a href="'.WebGUI::URL::page('func=deleteFile&file=alternateVersion2&wid='.
|
||||
$_[0]->get("wobjectId").'&did='.$file->{FileManager_fileId}).'">'.
|
||||
WebGUI::International::get(391).'</a>',WebGUI::International::get(18,$_[0]->get("namespace")));
|
||||
} else {
|
||||
$f->file("alternateVersion2",WebGUI::International::get(18,$_[0]->get("namespace")));
|
||||
}
|
||||
$f->text("briefSynopsis",WebGUI::International::get(8,$_[0]->get("namespace")),$file->{briefSynopsis});
|
||||
$f->group("groupToView",WebGUI::International::get(7,$_[0]->get("namespace")),[$file->{groupToView}]);
|
||||
if ($file->{FileManager_fileId} eq "new") {
|
||||
$f->whatNext(
|
||||
-options=>{
|
||||
addFile=>WebGUI::International::get(74,$_[0]->get("namespace")),
|
||||
backToPage=>WebGUI::International::get(745)
|
||||
},
|
||||
-value=>"backToPage"
|
||||
);
|
||||
}
|
||||
$f->submit;
|
||||
$output .= $f->print;
|
||||
return $output;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_editDownloadSave {
|
||||
return WebGUI::Privilege::insufficient() unless ($_[0]->canEdit);
|
||||
my ($file, %files);
|
||||
$files{FileManager_fileId} = $_[0]->setCollateral("FileManager_file", "FileManager_fileId", {
|
||||
FileManager_fileId => $session{form}{did},
|
||||
fileTitle => $session{form}{fileTitle},
|
||||
briefSynopsis => $session{form}{briefSynopsis},
|
||||
dateUploaded => time(),
|
||||
groupToView => $session{form}{groupToView}
|
||||
});
|
||||
$_[0]->reorderCollateral("FileManager_file","FileManager_fileId");
|
||||
$file = WebGUI::Attachment->new("",$_[0]->get("wobjectId"),$files{FileManager_fileId});
|
||||
$file->save("downloadFile");
|
||||
if ($file->getFilename ne "") {
|
||||
$files{downloadFile} = $file->getFilename;
|
||||
$files{fileTitle} = $files{downloadFile} if ($session{form}{fileTitle} eq "");
|
||||
}
|
||||
$file = WebGUI::Attachment->new("",$_[0]->get("wobjectId"),$files{FileManager_fileId});
|
||||
$file->save("alternateVersion1");
|
||||
if ($file->getFilename ne "") {
|
||||
$files{alternateVersion1} = $file->getFilename;
|
||||
}
|
||||
$file = WebGUI::Attachment->new("",$_[0]->get("wobjectId"),$files{FileManager_fileId});
|
||||
$file->save("alternateVersion2");
|
||||
if ($file->getFilename ne "") {
|
||||
$files{alternateVersion2} = $file->getFilename;
|
||||
}
|
||||
$_[0]->setCollateral("FileManager_file", "FileManager_fileId", \%files);
|
||||
if ($session{form}{proceed} eq "addFile") {
|
||||
$session{form}{did} = "new";
|
||||
return $_[0]->www_editDownload();
|
||||
} else {
|
||||
return "";
|
||||
}
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_moveDownloadDown {
|
||||
return WebGUI::Privilege::insufficient() unless ($_[0]->canEdit);
|
||||
WebGUI::Session::setScratch($_[0]->get("namespace").".".$_[0]->get("wobjectId").".sortDirection","-delete-");
|
||||
WebGUI::Session::setScratch($_[0]->get("namespace").".".$_[0]->get("wobjectId").".sort","-delete-");
|
||||
$_[0]->moveCollateralUp("FileManager_file","FileManager_fileId",$session{form}{did});
|
||||
return "";
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_moveDownloadUp {
|
||||
return WebGUI::Privilege::insufficient() unless ($_[0]->canEdit);
|
||||
WebGUI::Session::setScratch($_[0]->get("namespace").".".$_[0]->get("wobjectId").".sortDirection","-delete-");
|
||||
WebGUI::Session::setScratch($_[0]->get("namespace").".".$_[0]->get("wobjectId").".sort","-delete-");
|
||||
$_[0]->moveCollateralDown("FileManager_file","FileManager_fileId",$session{form}{did});
|
||||
return "";
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_view {
|
||||
$_[0]->logView() if ($session{setting}{passiveProfilingEnabled});
|
||||
my ($sortDirection, %var, @fileloop, $files, $sort, $file, $p, $file1, $file2, $file3, $constraints,
|
||||
$url, $numResults, $sql, $flag);
|
||||
$url = WebGUI::URL::page("func=view&wid=".$_[0]->get("wobjectId"));
|
||||
WebGUI::Session::setScratch($_[0]->get("namespace").".".$_[0]->get("wobjectId").".sortDirection",$session{form}{sortDirection});
|
||||
WebGUI::Session::setScratch($_[0]->get("namespace").".".$_[0]->get("wobjectId").".sort",$session{form}{sort});
|
||||
$numResults = $_[0]->get("paginateAfter") || 25;
|
||||
$var{"titleColumn.label"} = WebGUI::International::get(14,$_[0]->get("namespace"));
|
||||
$var{"titleColumn.url"} = $_[0]->_sortByColumn("fileTitle",$url);
|
||||
$var{"descriptionColumn.label"} = WebGUI::International::get(15,$_[0]->get("namespace"));
|
||||
$var{"descriptionColumn.url"} = $_[0]->_sortByColumn("briefSynopsis",$url);
|
||||
$var{"dateColumn.label"} = WebGUI::International::get(16,$_[0]->get("namespace"));
|
||||
$var{"dateColumn.url"} = $_[0]->_sortByColumn("dateUploaded",$url);
|
||||
$session{form}{sort} = "sequenceNumber" if ($session{form}{sort} eq "");
|
||||
$var{"search.form"} = WebGUI::Search::form({wid=>$_[0]->get("wobjectId"),func=>"view"});
|
||||
$var{"search.url"} = WebGUI::Search::toggleURL("wid=".$_[0]->get("wobjectId")."&func=view");
|
||||
$var{"search.label"} = WebGUI::International::get(364);
|
||||
$var{"addfile.url"} = WebGUI::URL::page('func=editDownload&did=new&wid='.$_[0]->get("wobjectId"));
|
||||
$var{"addfile.label"} = WebGUI::International::get(11,$_[0]->get("namespace"));
|
||||
$sql = "select * from FileManager_file where wobjectId=".quote($_[0]->get("wobjectId"))." ";
|
||||
if ($session{scratch}{search}) {
|
||||
$numResults = $session{scratch}{numResults};
|
||||
$constraints = WebGUI::Search::buildConstraints(
|
||||
[qw(fileTitle downloadFile alternateVersion1 alternateVersion2 briefSynopsis)]);
|
||||
$sql .= " and ".$constraints if ($constraints ne "");
|
||||
}
|
||||
$sort = $session{scratch}{$_[0]->get("namespace").".".$_[0]->get("wobjectId").".sort"} || "sequenceNumber";
|
||||
$sortDirection = $session{scratch}{$_[0]->get("namespace").".".$_[0]->get("wobjectId").".sortDirection"} || "desc";
|
||||
$sql .= " order by $sort $sortDirection";
|
||||
$p = WebGUI::Paginator->new($url,$numResults);
|
||||
$p->setDataByQuery($sql);
|
||||
$files = $p->getPageData;
|
||||
my $canEditWobject = ($_[0]->canEdit);
|
||||
foreach $file (@$files) {
|
||||
$file1 = WebGUI::Attachment->new($file->{downloadFile},$_[0]->get("wobjectId"),$file->{FileManager_fileId});
|
||||
$file2 = WebGUI::Attachment->new($file->{alternateVersion1},$_[0]->get("wobjectId"),$file->{FileManager_fileId});
|
||||
$file3 = WebGUI::Attachment->new($file->{alternateVersion2},$_[0]->get("wobjectId"),$file->{FileManager_fileId});
|
||||
push (@fileloop,{
|
||||
"file.canView"=>(WebGUI::Grouping::isInGroup($file->{groupToView}) || $canEditWobject),
|
||||
"file.controls"=>deleteIcon('func=deleteDownloadConfirm&wid='.$_[0]->get("wobjectId")
|
||||
.'&did='.$file->{FileManager_fileId},'',WebGUI::International::get(12,$_[0]->get("namespace"))).editIcon('func=editDownload&wid='.$_[0]->get("wobjectId")
|
||||
.'&did='.$file->{FileManager_fileId}).moveUpIcon('func=moveDownloadUp&wid='
|
||||
.$_[0]->get("wobjectId")
|
||||
.'&did='.$file->{FileManager_fileId}).moveDownIcon('func=moveDownloadDown&wid='
|
||||
.$_[0]->get("wobjectId").'&did='.$file->{FileManager_fileId}),
|
||||
"file.title"=>$file->{fileTitle},
|
||||
"file.version1.name"=>$file1->getFilename,
|
||||
"file.version1.url"=>$file1->getURL,
|
||||
"file.version1.icon"=>$file1->getIcon,
|
||||
"file.version1.size"=>$file1->getSize,
|
||||
"file.version1.type"=>$file1->getType,
|
||||
"file.version1.thumbnail"=>$file1->getThumbnail,
|
||||
"file.version1.isImage"=>$file1->isImage,
|
||||
"file.version2.name"=>$file2->getFilename,
|
||||
"file.version2.url"=>$file2->getURL,
|
||||
"file.version2.icon"=>$file2->getIcon,
|
||||
"file.version2.size"=>$file2->getSize,
|
||||
"file.version2.type"=>$file2->getType,
|
||||
"file.version2.thumbnail"=>$file2->getThumbnail,
|
||||
"file.version2.isImage"=>$file2->isImage,
|
||||
"file.version3.name"=>$file3->getFilename,
|
||||
"file.version3.url"=>$file3->getURL,
|
||||
"file.version3.icon"=>$file3->getIcon,
|
||||
"file.version3.size"=>$file3->getSize,
|
||||
"file.version3.type"=>$file3->getType,
|
||||
"file.version3.thumbnail"=>$file3->getThumbnail,
|
||||
"file.version3.isImage"=>$file3->isImage,
|
||||
"file.description"=>$file->{briefSynopsis},
|
||||
"file.date"=>epochToHuman($file->{dateUploaded},"%z"),
|
||||
"file.time"=>epochToHuman($file->{dateUploaded},"%Z")
|
||||
});
|
||||
$flag = 1;
|
||||
}
|
||||
$var{"noresults.message"} = WebGUI::International::get(19,$_[0]->get("namespace"));
|
||||
$var{noresults} = !$flag;
|
||||
$var{file_loop} = \@fileloop;
|
||||
$p->appendTemplateVars(\%var);
|
||||
return $_[0]->processTemplate($_[0]->get("templateId"),\%var);
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
||||
|
||||
|
|
@ -1,307 +0,0 @@
|
|||
package WebGUI::Wobject::HttpProxy;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2004 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#-------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use strict;
|
||||
use URI;
|
||||
use LWP;
|
||||
use HTTP::Cookies;
|
||||
use HTTP::Request::Common;
|
||||
use HTML::Entities;
|
||||
use WebGUI::HTMLForm;
|
||||
use WebGUI::HTTP;
|
||||
use WebGUI::Icon;
|
||||
use WebGUI::International;
|
||||
use WebGUI::Privilege;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::Wobject;
|
||||
use WebGUI::Wobject::HttpProxy::Parse;
|
||||
use WebGUI::Cache;
|
||||
|
||||
our @ISA = qw(WebGUI::Wobject);
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub name {
|
||||
return WebGUI::International::get(3,$_[0]->get("namespace"));
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $property = shift;
|
||||
my $self = WebGUI::Wobject->new(
|
||||
-properties=>$property,
|
||||
-extendedProperties=>{
|
||||
proxiedUrl=>{
|
||||
defaultValue=>'http://'
|
||||
},
|
||||
timeout=>{
|
||||
defaultValue=>30
|
||||
},
|
||||
removeStyle=>{
|
||||
defaultValue=>1
|
||||
},
|
||||
filterHtml=>{
|
||||
defaultValue=>"javascript"
|
||||
},
|
||||
followExternal=>{
|
||||
defaultValue=>1
|
||||
},
|
||||
rewriteUrls=>{
|
||||
defaultValue=>1
|
||||
},
|
||||
followRedirect=>{
|
||||
defaultValue=>0
|
||||
},
|
||||
searchFor=>{
|
||||
defaultValue=>''
|
||||
},
|
||||
stopAt=>{
|
||||
defaultValue=>''
|
||||
},
|
||||
},
|
||||
-useTemplate=>1,
|
||||
-useMetaData=>1
|
||||
);
|
||||
bless $self, $class;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub uiLevel {
|
||||
return 5;
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_edit {
|
||||
my %hash;
|
||||
tie %hash, 'Tie::IxHash';
|
||||
%hash=(5=>5,10=>10,20=>20,30=>30,60=>60);
|
||||
my $privileges = WebGUI::HTMLForm->new;
|
||||
my $properties = WebGUI::HTMLForm->new;
|
||||
my $layout = WebGUI::HTMLForm->new;
|
||||
$properties->url(
|
||||
-name=>"proxiedUrl",
|
||||
-label=>WebGUI::International::get(1,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("proxiedUrl")
|
||||
);
|
||||
$privileges->yesNo(
|
||||
-name=>"followExternal",
|
||||
-label=>WebGUI::International::get(5,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("followExternal")
|
||||
);
|
||||
$properties->yesNo(
|
||||
-name=>"followRedirect",
|
||||
-label=>WebGUI::International::get(8,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("followRedirect")
|
||||
);
|
||||
$properties->yesNo(
|
||||
-name=>"rewriteUrls",
|
||||
-label=>WebGUI::International::get(12,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("rewriteUrls")
|
||||
);
|
||||
$layout->yesNo(
|
||||
-name=>"removeStyle",
|
||||
-label=>WebGUI::International::get(6,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("removeStyle")
|
||||
);
|
||||
$layout->filterContent(
|
||||
-name=>"filterHtml",
|
||||
-value=>$_[0]->getValue("filterHtml")
|
||||
);
|
||||
$properties->select(
|
||||
-name=>"timeout",
|
||||
-options=>\%hash,
|
||||
-label=>WebGUI::International::get(4,$_[0]->get("namespace")),
|
||||
-value=>[$_[0]->getValue("timeout")]
|
||||
);
|
||||
$layout->text(
|
||||
-name=>"searchFor",
|
||||
-label=>WebGUI::International::get(13,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("searchFor")
|
||||
);
|
||||
$layout->text(
|
||||
-name=>"stopAt",
|
||||
-label=>WebGUI::International::get(14,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("stopAt")
|
||||
);
|
||||
return $_[0]->SUPER::www_edit(
|
||||
-properties=>$properties->printRowsOnly,
|
||||
-layout=>$layout->printRowsOnly,
|
||||
-privileges=>$privileges->printRowsOnly,
|
||||
-helpId=>"http proxy add/edit",
|
||||
-headingId=>2
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_view {
|
||||
my (%var, %formdata, @formUpload, $redirect, $response, $header, $userAgent, $proxiedUrl, $request, $ttl);
|
||||
$_[0]->logView() if ($session{setting}{passiveProfilingEnabled});
|
||||
my $node = WebGUI::Node->new("temp",$_[0]->get("namespace")."_cookies");
|
||||
$node->create;
|
||||
my $cookiebox = WebGUI::URL::escape($session{var}{sessionId});
|
||||
$cookiebox =~ s/[^A-Za-z0-9\-\.\_]//g; #removes all funky characters
|
||||
$cookiebox .= '.cookie';
|
||||
$cookiebox = $node->getPath.$session{os}{slash}.$cookiebox;
|
||||
my $jar = HTTP::Cookies->new(File => $cookiebox, AutoSave => 1, Ignore_Discard => 1);
|
||||
|
||||
if($session{form}{wid} eq $_[0]->get("wobjectId") && $session{form}{func}!~/editSave/i) {
|
||||
$proxiedUrl = $session{form}{FormAction} || $session{form}{proxiedUrl} || $_[0]->get("proxiedUrl") ;
|
||||
} else {
|
||||
$proxiedUrl = $_[0]->get("proxiedUrl");
|
||||
$session{env}{REQUEST_METHOD}='GET';
|
||||
}
|
||||
|
||||
$redirect=0;
|
||||
|
||||
return $_[0]->processTemplate($_[0]->get("templateId"),{}) unless ($proxiedUrl ne "");
|
||||
|
||||
my $cachedContent = WebGUI::Cache->new($proxiedUrl,"URL");
|
||||
my $cachedHeader = WebGUI::Cache->new($proxiedUrl,"HEADER");
|
||||
$var{header} = $cachedHeader->get;
|
||||
$var{content} = $cachedContent->get;
|
||||
unless ($var{content} && $session{env}{REQUEST_METHOD}=~/GET/i) {
|
||||
$redirect=0;
|
||||
until($redirect == 5) { # We follow max 5 redirects to prevent bouncing/flapping
|
||||
$userAgent = new LWP::UserAgent;
|
||||
$userAgent->agent($session{env}{HTTP_USER_AGENT});
|
||||
$userAgent->timeout($_[0]->get("timeout"));
|
||||
$userAgent->env_proxy;
|
||||
|
||||
$proxiedUrl = URI->new($proxiedUrl);
|
||||
|
||||
#my $allowed_url = URI->new($_[0]->get('proxiedUrl'))->abs;;
|
||||
|
||||
#if ($_[0]->get("followExternal")==0 && $proxiedUrl !~ /\Q$allowed_url/i) {
|
||||
if ($_[0]->get("followExternal")==0 &&
|
||||
(URI->new($_[0]->get('proxiedUrl'))->host) ne (URI->new($proxiedUrl)->host) ) {
|
||||
$var{header} = "text/html";
|
||||
return "<h1>You are not allowed to leave ".$_[0]->get("proxiedUrl")."</h1>";
|
||||
}
|
||||
|
||||
$header = new HTTP::Headers;
|
||||
$header->referer($_[0]->get("proxiedUrl")); # To get around referrer blocking
|
||||
|
||||
if($session{env}{REQUEST_METHOD}=~/GET/i || $redirect != 0) { # request_method is also GET after a redirection. Just to make sure we're
|
||||
# not posting the same data over and over again.
|
||||
if($redirect == 0 && $session{form}{wid} eq $_[0]->get("wobjectId")) {
|
||||
foreach my $input_name (keys %{$session{form}}) {
|
||||
next if ($input_name !~ /^HttpProxy_/); # Skip non proxied form var's
|
||||
$input_name =~ s/^HttpProxy_//;
|
||||
$proxiedUrl=WebGUI::URL::append($proxiedUrl,"$input_name=$session{form}{'HttpProxy_'.$input_name}");
|
||||
}
|
||||
}
|
||||
$request = HTTP::Request->new(GET => $proxiedUrl, $header) || return "wrong url"; # Create GET request
|
||||
} else { # It's a POST
|
||||
|
||||
my $contentType = 'application/x-www-form-urlencoded'; # default Content Type header
|
||||
|
||||
# Create a %formdata hash to pass key/value pairs to the POST request
|
||||
foreach my $input_name (keys %{$session{form}}) {
|
||||
next if ($input_name !~ /^HttpProxy_/); # Skip non proxied form var's
|
||||
$input_name =~ s/^HttpProxy_//;
|
||||
|
||||
my $uploadFile = $session{cgi}->tmpFileName($session{form}{'HttpProxy_'.$input_name});
|
||||
if(-r $uploadFile) { # Found uploaded file
|
||||
@formUpload=($uploadFile, qq/$session{form}{'HttpProxy_'.$input_name}/);
|
||||
$formdata{$input_name}=\@formUpload;
|
||||
$contentType = 'form-data'; # Different Content Type header for file upload
|
||||
} else {
|
||||
$formdata{$input_name}=qq/$session{form}{'HttpProxy_'.$input_name}/;
|
||||
}
|
||||
}
|
||||
# Create POST request
|
||||
$request = HTTP::Request::Common::POST($proxiedUrl, \%formdata, Content_Type => $contentType);
|
||||
}
|
||||
$jar->add_cookie_header($request);
|
||||
|
||||
|
||||
$response = $userAgent->simple_request($request);
|
||||
|
||||
$jar->extract_cookies($response);
|
||||
|
||||
if ($response->is_redirect) { # redirected by http header
|
||||
$proxiedUrl = URI::URL::url($response->header("Location"))->abs($proxiedUrl);;
|
||||
$redirect++;
|
||||
} elsif ($response->content_type eq "text/html" && $response->content =~
|
||||
/<meta[^>]+refresh[^>]+content[^>]*url=([^\s'"<>]+)/gis) {
|
||||
# redirection through meta refresh
|
||||
my $refreshUrl = $1;
|
||||
if($refreshUrl=~ /^http/gis) { #Refresh value is absolute
|
||||
$proxiedUrl=$refreshUrl;
|
||||
} else { # Refresh value is relative
|
||||
$proxiedUrl =~ s/[^\/\\]*$//; #chop off everything after / in $proxiedURl
|
||||
$proxiedUrl .= URI::URL::url($refreshUrl)->rel($proxiedUrl); # add relative path
|
||||
}
|
||||
$redirect++;
|
||||
} else {
|
||||
$redirect = 5; #No redirection found. Leave loop.
|
||||
}
|
||||
$redirect=5 if (not $_[0]->get("followRedirect")); # No redirection. Overruled by setting
|
||||
}
|
||||
|
||||
if($response->is_success) {
|
||||
$var{content} = $response->content;
|
||||
$var{header} = $response->content_type;
|
||||
if($response->content_type eq "text/html" ||
|
||||
($response->content_type eq "" && $var{content}=~/<html/gis)) {
|
||||
|
||||
$var{"search.for"} = $_[0]->getValue("searchFor");
|
||||
$var{"stop.at"} = $_[0]->getValue("stopAt");
|
||||
if ($var{"search.for"}) {
|
||||
$var{content} =~ /^(.*?)\Q$var{"search.for"}\E(.*)$/gis;
|
||||
$var{"content.leading"} = $1 || $var{content};
|
||||
$var{content} = $2;
|
||||
}
|
||||
if ($var{"stop.at"}) {
|
||||
$var{content} =~ /(.*?)\Q$var{"stop.at"}\E(.*)$/gis;
|
||||
$var{content} = $1 || $var{content};
|
||||
$var{"content.trailing"} = $2;
|
||||
}
|
||||
my $p = WebGUI::Wobject::HttpProxy::Parse->new($proxiedUrl, $var{content}, $_[0]->get("wobjectId"),$_[0]->get("rewriteUrls"));
|
||||
$var{content} = $p->filter; # Rewrite content. (let forms/links return to us).
|
||||
$p->DESTROY;
|
||||
|
||||
if ($var{content} =~ /<frame/gis) {
|
||||
$var{header} = "text/html";
|
||||
$var{content} = "<h1>HttpProxy: Can't display frames</h1>
|
||||
Try fetching it directly <a href='$proxiedUrl'>here.</a>";
|
||||
} else {
|
||||
$var{content} =~ s/\<style.*?\/style\>//isg if ($_[0]->get("removeStyle"));
|
||||
$var{content} = WebGUI::HTML::cleanSegment($var{content});
|
||||
$var{content} = WebGUI::HTML::filter($var{content}, $_[0]->get("filterHtml"));
|
||||
}
|
||||
}
|
||||
} else { # Fetching page failed...
|
||||
$var{header} = "text/html";
|
||||
$var{content} = "<b>Getting <a href='$proxiedUrl'>$proxiedUrl</a> failed</b>".
|
||||
"<p><i>GET status line: ".$response->status_line."</i>";
|
||||
}
|
||||
if ($session{user}{userId} eq '1') {
|
||||
$ttl = $session{page}{cacheTimeoutVisitor};
|
||||
} else {
|
||||
$ttl = $session{page}{cacheTimeout};
|
||||
}
|
||||
|
||||
$cachedContent->set($var{content},$ttl);
|
||||
$cachedHeader->set($var{header},$ttl);
|
||||
}
|
||||
|
||||
if($var{header} ne "text/html") {
|
||||
WebGUI::HTTP::setMimeType($var{header});
|
||||
return $var{content};
|
||||
} else {
|
||||
return $_[0]->processTemplate($_[0]->get("templateId"),\%var);
|
||||
}
|
||||
}
|
||||
1;
|
||||
|
|
@ -1,160 +0,0 @@
|
|||
package WebGUI::Wobject::HttpProxy::Parse;
|
||||
|
||||
|
||||
# -------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2004 Plain Black Corporation.
|
||||
# -------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
# -------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
# -------------------------------------------------------------------
|
||||
|
||||
|
||||
use HTML::Parser;
|
||||
use HTML::Entities;
|
||||
use URI::URL;
|
||||
use WebGUI::URL;
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(HTML::Parser);
|
||||
|
||||
|
||||
my %linkElements = # from HTML::Element.pm
|
||||
(
|
||||
body => 'background',
|
||||
base => 'href',
|
||||
a => 'href',
|
||||
img => [qw(src lowsrc usemap)], # lowsrc is a Netscape invention
|
||||
form => 'action',
|
||||
input => 'src',
|
||||
'link' => 'href', # need quoting since link is a perl builtin
|
||||
frame => 'src',
|
||||
iframe => 'src',
|
||||
applet => 'codebase',
|
||||
area => 'href',
|
||||
script => 'src',
|
||||
iframe => 'src',
|
||||
);
|
||||
|
||||
my %tag_attr;
|
||||
for my $tag (keys %linkElements) {
|
||||
my $tagval = $linkElements{$tag};
|
||||
for my $attr (ref $tagval ? @$tagval : $tagval) {
|
||||
$tag_attr{"$tag $attr"}++;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
sub new {
|
||||
my $pack = shift;
|
||||
my $self = $pack->SUPER::new();
|
||||
$self->{Url} = shift;
|
||||
$self->{Content} = shift;
|
||||
$self->{wid} = shift;
|
||||
$self->{rewriteUrls} = shift;
|
||||
$self->{Filtered} ="";
|
||||
$self->{FormAction} = "";
|
||||
$self->{FormActionIsDefined} = 0;
|
||||
$self->{recurseCheck} = 0;
|
||||
$self;
|
||||
}
|
||||
|
||||
|
||||
sub filter {
|
||||
my $self=shift;
|
||||
$self->parse($self->{Content}); # Make paths absolute and let them return to us
|
||||
$self->eof;
|
||||
return "<p>Error: HttpProxy can't recursively proxy its own content.</p>" if ($self->{recurseCheck});
|
||||
return $self->{Filtered};
|
||||
}
|
||||
|
||||
## some items stolen from HTML::Filter
|
||||
|
||||
|
||||
|
||||
sub output {
|
||||
$_[0]->{Filtered} .= $_[1];
|
||||
}
|
||||
|
||||
|
||||
sub declaration {
|
||||
$_[0]->output("<!$_[1]>")
|
||||
}
|
||||
|
||||
|
||||
sub comment {
|
||||
$_[0]->output("<!--$_[1]-->")
|
||||
}
|
||||
|
||||
sub text {
|
||||
$_[0]->output($_[1])
|
||||
}
|
||||
|
||||
|
||||
sub end {
|
||||
$_[0]->output("</$_[1]>")
|
||||
}
|
||||
|
||||
sub start {
|
||||
my $self = shift;
|
||||
my ($tag, $attr, $attrseq, $origtext) = @_;
|
||||
# Check on the div class and div id attributes to see if we're proxying ourself.
|
||||
if($tag eq "div" && $attr->{'class'} eq 'wobjectHttpProxy' && $attr->{'id'} eq ('wobjectId'.$self->{wid})) {
|
||||
$self->{recurseCheck} = 1;
|
||||
}
|
||||
$self->output("<$tag");
|
||||
for (keys %$attr) {
|
||||
if ($_ eq '/') {
|
||||
$self->output('/');
|
||||
next;
|
||||
}
|
||||
$self->output(" $_=\"");
|
||||
my $val = $attr->{$_};
|
||||
if ((lc($tag) eq "input" || lc($tag) eq "textarea" || lc($tag) eq "select")
|
||||
&& (lc($_) eq "name" || lc($_) eq "submit")) { # Rewrite input type names
|
||||
$val = 'HttpProxy_' . $val;
|
||||
}
|
||||
if (lc($tag) eq "form" && not $self->{FormActionIsDefined}) {
|
||||
$self->{FormAction} = $self->{Url};
|
||||
}
|
||||
if ($tag_attr{"$tag $_"}) { # needs rewrite
|
||||
if ($val =~ /^\?/) { # link that starts with ? i.e. <a href="?var=hello">
|
||||
my @urlBase = split(/\?/, $self->{Url});
|
||||
$val = URI::URL::url($urlBase[0] . $val);
|
||||
|
||||
# catch internal # anchors
|
||||
} elsif ($val =~ /^#/){
|
||||
$val = URI::URL::url($val);
|
||||
|
||||
} else {
|
||||
$val = URI::URL::url($val)->abs($self->{Url},1); # make absolute
|
||||
}
|
||||
if ($val->scheme eq "http") {
|
||||
if ($self->{rewriteUrls} && lc($tag) ne "iframe") {
|
||||
if (lc($tag) eq "form" && lc($_) eq "action") { # Found FORM ACTION
|
||||
$self->{FormActionIsDefined}=1;
|
||||
$self->{FormAction} = $val; # set FormAction to include hidden field later
|
||||
$val = WebGUI::URL::page; # Form Action returns to us
|
||||
} else {
|
||||
$val =~ s/\n//g; # Bugfix 757068
|
||||
$val = WebGUI::URL::page('proxiedUrl='.WebGUI::URL::escape($val).
|
||||
'&wid='.$self->{wid}.'&func=view'); # return to us
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$self->output($val.'"');
|
||||
}
|
||||
$self->output(">");
|
||||
if ($self->{FormAction} ne "") {
|
||||
$self->output('<input type="hidden" name="FormAction" value="'.$self->{FormAction}.'">');
|
||||
$self->output('<input type="hidden" name="wid" value="'.$self->{wid}.'">');
|
||||
$self->output('<input type="hidden" name="func" value="view">');
|
||||
$self->{FormAction} = '';
|
||||
$self->{FormActionIsDefined}=0;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
1;
|
||||
|
|
@ -1,145 +0,0 @@
|
|||
package WebGUI::Wobject::SiteMap;
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
# WebGUI is Copyright 2001-2004 Plain Black Corporation.
|
||||
#-------------------------------------------------------------------
|
||||
# Please read the legal notices (docs/legal.txt) and the license
|
||||
# (docs/license.txt) that came with this distribution before using
|
||||
# this software.
|
||||
#-------------------------------------------------------------------
|
||||
# http://www.plainblack.com info@plainblack.com
|
||||
#-------------------------------------------------------------------
|
||||
|
||||
use strict;
|
||||
use Tie::CPHash;
|
||||
use WebGUI::HTMLForm;
|
||||
use WebGUI::Icon;
|
||||
use WebGUI::International;
|
||||
use WebGUI::Page;
|
||||
use WebGUI::Privilege;
|
||||
use WebGUI::Session;
|
||||
use WebGUI::SQL;
|
||||
use WebGUI::URL;
|
||||
use WebGUI::Wobject;
|
||||
|
||||
our @ISA = qw(WebGUI::Wobject);
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub _traversePageTree {
|
||||
my ($parent, $sth, $data, $indent, @pages, $i, $currentDepth, $depth, $indentString, $alphabetic, $orderBy);
|
||||
$parent = $_[0];
|
||||
$currentDepth = $_[1];
|
||||
$depth = $_[2] || 99;
|
||||
$indent = $_[3];
|
||||
$alphabetic = $_[4];
|
||||
$indentString = " " x ($indent*$currentDepth);
|
||||
if ($currentDepth < $depth) {
|
||||
if ($alphabetic) {
|
||||
$orderBy = 'title';
|
||||
} else {
|
||||
$orderBy = 'nestedSetLeft';
|
||||
}
|
||||
$sth = WebGUI::SQL->read("select urlizedTitle, menuTitle, title, pageId, synopsis, isSystem from page where parentId=".quote($parent)." and hideFromNavigation = 0 order by $orderBy");
|
||||
while ($data = $sth->hashRef) {
|
||||
if (!$data->{isSystem} && WebGUI::Page::canView($data->{pageId})) {
|
||||
push(@pages,{
|
||||
"page.indent" => $indentString,
|
||||
"page.url" => WebGUI::URL::gateway($data->{urlizedTitle}),
|
||||
"page.id" => $data->{pageId},
|
||||
"page.title" => $data->{title},
|
||||
"page.menuTitle" => $data->{menuTitle},
|
||||
"page.synopsis" => $data->{synopsis},
|
||||
"page.isRoot" => ($parent eq "0"),
|
||||
"page.isTop" => ($currentDepth == 0 || ($currentDepth == 1 && $parent eq "0"))
|
||||
});
|
||||
push(@pages,@{_traversePageTree($data->{pageId},($currentDepth+1),$depth,$indent,$alphabetic)});
|
||||
}
|
||||
}
|
||||
$sth->finish;
|
||||
}
|
||||
return \@pages;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub name {
|
||||
return WebGUI::International::get(2,$_[0]->get("namespace"));
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $property = shift;
|
||||
my $self = WebGUI::Wobject->new(
|
||||
-properties=>$property,
|
||||
-extendedProperties=>{
|
||||
startAtThisLevel=>{
|
||||
defaultValue=>1
|
||||
},
|
||||
indent=>{
|
||||
defaultValue=>5
|
||||
},
|
||||
depth=>{
|
||||
defaultValue=>0
|
||||
},
|
||||
alphabetic=>{
|
||||
defaultValue=>0
|
||||
}
|
||||
},
|
||||
-useTemplate=>1,
|
||||
-useMetaData=>1
|
||||
);
|
||||
bless $self, $class;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_edit {
|
||||
my $options = WebGUI::SQL->buildHashRef("select pageId,title from page where parentId='0'
|
||||
and (pageId='1' or pageId>'999') order by title");
|
||||
my $layout = WebGUI::HTMLForm->new;
|
||||
my $properties = WebGUI::HTMLForm->new;
|
||||
$properties->select(
|
||||
-name=>"startAtThisLevel",
|
||||
-label=>WebGUI::International::get(3,$_[0]->get("namespace")),
|
||||
-value=>[$_[0]->getValue("startAtThisLevel")],
|
||||
-options=>{
|
||||
0=>WebGUI::International::get(75,$_[0]->get("namespace")),
|
||||
$session{page}{pageId}=>WebGUI::International::get(74,$_[0]->get("namespace")),
|
||||
%{$options}
|
||||
}
|
||||
);
|
||||
$layout->integer(
|
||||
-name=>"depth",
|
||||
-label=>WebGUI::International::get(4,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("depth")
|
||||
);
|
||||
$layout->integer(
|
||||
-name=>"indent",
|
||||
-label=>WebGUI::International::get(6,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("indent")
|
||||
);
|
||||
$layout->yesNo(
|
||||
-name=>"alphabetic",
|
||||
-label=>WebGUI::International::get(7,$_[0]->get("namespace")),
|
||||
-value=>$_[0]->getValue("alphabetic")
|
||||
);
|
||||
return $_[0]->SUPER::www_edit(
|
||||
-properties=>$properties->printRowsOnly,
|
||||
-layout=>$layout->printRowsOnly,
|
||||
-headingId=>5,
|
||||
-helpId=>"site map add/edit"
|
||||
);
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_view {
|
||||
$_[0]->logView() if ($session{setting}{passiveProfilingEnabled});
|
||||
my (%var);
|
||||
$var{page_loop} = _traversePageTree($_[0]->get("startAtThisLevel"),0,$_[0]->get("depth"),$_[0]->get("indent"),$_[0]->get("alphabetic"));
|
||||
return $_[0]->processTemplate($_[0]->get("templateId"),\%var);
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
|
|
@ -1,539 +0,0 @@
|
|||
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,
|
||||
-useMetaData => 1,
|
||||
-extendedProperties => {
|
||||
callMethod => {
|
||||
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'},
|
||||
},
|
||||
uri => {
|
||||
fieldType => 'text',
|
||||
defaultValue => $session{'config'}{'soapuri'}
|
||||
},
|
||||
decodeUtf8 => {
|
||||
fieldType => $utf8FieldType,
|
||||
defaultValue => 0,
|
||||
},
|
||||
httpHeader => {
|
||||
fieldType => $httpHeaderFieldType,
|
||||
},
|
||||
cacheTTL => {
|
||||
fieldType => 'integer',
|
||||
defaultValue => 60,
|
||||
},
|
||||
sharedCache => {
|
||||
fieldType => 'integer',
|
||||
defaultValue => '0',
|
||||
}
|
||||
}
|
||||
);
|
||||
bless $self, $class;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub uiLevel {
|
||||
return 9;
|
||||
}
|
||||
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
sub www_edit {
|
||||
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 => 'callMethod',
|
||||
-label => WebGUI::International::get(4, $_[0]->get('namespace')),
|
||||
-value => $_[0]->get('callMethod'),
|
||||
);
|
||||
$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'),
|
||||
);
|
||||
}
|
||||
|
||||
my $cacheopts = {
|
||||
0 => WebGUI::International::get(29, $_[0]->get('namespace')),
|
||||
1 => WebGUI::International::get(19, $_[0]->get('namespace')),
|
||||
};
|
||||
$properties->radioList (
|
||||
-name => 'sharedCache',
|
||||
-options => $cacheopts,
|
||||
-label => WebGUI::International::get(28, $_[0]->get('namespace')),
|
||||
-value => $_[0]->get('sharedCache'),
|
||||
);
|
||||
|
||||
$properties->text (
|
||||
-name => 'cacheTTL',
|
||||
-label => WebGUI::International::get(27, $_[0]->get('namespace')),
|
||||
-value => $_[0]->get('cacheTTL'),
|
||||
);
|
||||
|
||||
return $_[0]->SUPER::www_edit (
|
||||
-layout => $layout->printRowsOnly,
|
||||
-privileges => $privileges->printRowsOnly,
|
||||
-properties => $properties->printRowsOnly,
|
||||
-headingId => 20,
|
||||
-helpId => "web services client add/edit",
|
||||
);
|
||||
}
|
||||
|
||||
#-------------------------------------------------------------------
|
||||
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;
|
||||
$self->logView() if ($session{setting}{passiveProfilingEnabled});
|
||||
# this page, with important params
|
||||
$url = WebGUI::URL::page("func=view&wid=" . $self->get("wobjectId"));
|
||||
|
||||
# snag our SOAP call and preprocess if needed
|
||||
if ($self->get('preprocessMacros')) {
|
||||
$call = WebGUI::Macro::process($self->get("callMethod"));
|
||||
$param_str = WebGUI::Macro::process($self->get("params"));
|
||||
} else {
|
||||
$call = $self->get('callMethod');
|
||||
$param_str = $self->get('params');
|
||||
}
|
||||
|
||||
# see if we can shortcircuit this whole process
|
||||
if ((ref $session{'form'}{'disableWobjects'} && grep /^$call$/,
|
||||
@{$session{'form'}{'disableWobjects'}}) ||
|
||||
($session{'form'}{'disableWobjects'} && grep /^$call$/,
|
||||
$session{'form'}{'disableWobjects'})) {
|
||||
|
||||
WebGUI::ErrorHandler::warn("disabling soap call $call");
|
||||
$var{'disableWobject'} = 1;
|
||||
return $self->processTemplate($self->get("templateId"),\%var);
|
||||
}
|
||||
|
||||
# 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, using either
|
||||
# a cache specific to this session, or a shared global cache
|
||||
$cache_key = $self->get('sharedCache')
|
||||
? Digest::MD5::md5_hex($call, $param_str)
|
||||
: Digest::MD5::md5_hex($call, $param_str, $session{'var'}{'sessionId'});
|
||||
WebGUI::ErrorHandler::warn(($self->get('sharedCache')?'shared':'session')
|
||||
. " cache_key=$cache_key md5_hex($call, $param_str)");
|
||||
$cache = WebGUI::Cache->new($cache_key,
|
||||
WebGUI::International::get(4, $self->get('namespace')));
|
||||
|
||||
# passing a form param WSClient_skipCache lets us ignore even good caches
|
||||
if (!$session{'form'}{'WSClient_skipCache'}) {
|
||||
@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),
|
||||
$self->get('cacheTTL'));
|
||||
};
|
||||
|
||||
# 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, $self->get('paginateAfter'));
|
||||
$p->setDataByArrayRef(\@result);
|
||||
@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, $self->get('paginateAfter'));
|
||||
$p->setDataByArrayRef($aref);
|
||||
$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, $self->get('paginateAfter'));
|
||||
$p->setDataByArrayRef($result[0]->{$_});
|
||||
last;
|
||||
}
|
||||
}
|
||||
$p ||= WebGUI::Paginator->new($url);
|
||||
$result[0]->{$_} = $p->getPageData;
|
||||
|
||||
} elsif ((ref $result[0]) =~ /ARRAY/) {
|
||||
$p = WebGUI::Paginator->new($url, $self->get('paginateAfter'));
|
||||
$p->setDataByArrayRef($result[0]);
|
||||
$result[0] = $p->getPageData;
|
||||
|
||||
} else {
|
||||
$p = WebGUI::Paginator->new($url, $self->get('paginateAfter'));
|
||||
$p->setDataByArrayRef([$result[0]]);
|
||||
$result[0] = $p->getPageData;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
# set pagination links
|
||||
if ($p) {
|
||||
$p->appendTemplateVars(\%var);
|
||||
for ('pagination.firstPage','pagination.lastPage','pagination.nextPage','pagination.pageList',
|
||||
'pagination.previousPage', 'pagination.pageList.upTo20', 'pagination.pageList.upTo10') {
|
||||
$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'}) {
|
||||
WebGUI::HTTP::setRedirect($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) || ($self->get("uri") =~ m/\.\w*\?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'),
|
||||
options => {compress_threshold => 10000});
|
||||
}
|
||||
}
|
||||
|
||||
return $soap;
|
||||
}
|
||||
1;
|
||||
Loading…
Add table
Add a link
Reference in a new issue