oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

convert WebGUI to a mod perl handler

Browse source
This commit is contained in:
JT Smith 2005-11-03 09:14:23 +00:00
parent ec9d561c5a
commit 9b23c24a6a
13 changed files with 198 additions and 101 deletions
Download patch file Download diff file Expand all files Collapse all files

41
docs/upgrades/upgrade_6.7.8-6.8.0.pl Normal file
View file

@ -0,0 +1,41 @@
use lib "../../lib";
use strict;
use Getopt::Long;
use WebGUI::Session;
use WebGUI::SQL;
use WebGUI::Asset;
use WebGUI::Setting;
my $toVersion = "6.8.0";
my $configFile;
my $quiet;
start();
addTimeZonesToUserPreferences();
finish();
#-------------------------------------------------
sub addTimeZonesToUserPreferences {
WebGUI::SQL->write("delete from userProfileData where fieldName='timeOffset'");
WebGUI::SQL->write("update userProfileField set dataValues='', fieldName='timeZone', dataType='timeZone', dataDefault=".quote("['America/Chicago']")." where fieldName='timeOffset'");
}
#--- DO NOT EDIT BELOW THIS LINE
#-------------------------------------------------
sub start {
$|=1; #disable output buffering
GetOptions(
'configFile=s'=>\$configFile,
'quiet'=>\$quiet
);
WebGUI::Session::open("../..",$configFile);
WebGUI::Session::refreshUserInfo(3);
WebGUI::SQL->write("insert into webguiVersion values (".quote($toVersion).",'upgrade',".time().")");
}
#-------------------------------------------------
sub finish {
WebGUI::Session::close();
}

25
lib/WebGUI.pm
View file

@ -28,7 +28,32 @@ use WebGUI::SQL;
use WebGUI::Style;
use WebGUI::URL;
use WebGUI::PassiveProfiling;
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::Const -compile => qw(OK DECLINED);
our $s;
our $r;
sub handler {
$s = Apache2::ServerUtil->server;
$r = shift;
my $config = WebGUI::Config::getConfig($s->dir_config('WebguiRoot'),$r->dir_config('WebguiConfig'));
my $extras = $config->{extrasURL};
my $uploads = $config->{uploadsURL};
unless ($r->uri =~ m/^$extras/ || $r->uri =~ m/^$uploads/) {
$r->handler('perl-script');
$r->set_handlers(PerlResponseHandler => \&contentHandler);
}
return Apache2::Const::DECLINED;
}
sub contentHandler {
WebGUI::Session::open($s->dir_config('WebguiRoot'),$r->dir_config('WebguiConfig'),$r);
$r->print(page(undef,undef,1)); # Use existing session
WebGUI::Session::close();
return Apache2::Const::OK;
}
#-------------------------------------------------------------------
sub _processOperations {

2
lib/WebGUI/Asset.pm
View file

@ -1083,7 +1083,7 @@ A specific revision to instanciate. By default we instanciate the newest publish
sub newByUrl {
my $class = shift;
my $url = shift || $session{env}{PATH_INFO};
my $url = shift || $session{env}{SCRIPT_NAME};
my $revisionDate = shift;
$url = lc($url);
$url =~ s/\/$//;

2
lib/WebGUI/Asset/Post/Thread.pm
View file

@ -666,7 +666,7 @@ sub view {
} else {
$sql .= "asset.lineage";
}
my $currentPageUrl = $session{env}{PATH_INFO};
my $currentPageUrl = $session{env}{SCRIPT_NAME};
$currentPageUrl =~ s/^\///;
$p->setDataByQuery($sql, undef, undef, undef, "url", $currentPageUrl);
foreach my $dataSet (@{$p->getPageData()}) {

2
lib/WebGUI/Auth.pm
View file

@ -381,7 +381,7 @@ sub displayLogin {
my $method = $_[0] || "login";
my $vars = $_[1];
unless ($session{form}{op} eq "auth") {
WebGUI::Session::setScratch("redirectAfterLogin",WebGUI::URL::gateway($session{env}{PATH_INFO},$session{env}{QUERY_STRING}));
WebGUI::Session::setScratch("redirectAfterLogin",WebGUI::URL::gateway($session{env}{SCRIPT_NAME},$session{env}{QUERY_STRING}));
}
$vars->{title} = WebGUI::International::get(66);
my $action;

78
lib/WebGUI/Form/TimeZone.pm Normal file
View file

@ -0,0 +1,78 @@
package WebGUI::Form::SelectList;
=head1 LEGAL
-------------------------------------------------------------------
WebGUI is Copyright 2001-2005 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
-------------------------------------------------------------------
=cut
use strict;
use base 'WebGUI::Form::Control';
use WebGUI::DateTime;
use WebGUI::Form::SelectList;
use WebGUI::International;
use WebGUI::Session;
=head1 NAME
Package WebGUI::Form::TimeZone
=head1 DESCRIPTION
Creates a template chooser control.
=head1 SEE ALSO
This is a subclass of WebGUI::Form::Control.
=head1 METHODS
The following methods are specifically available from this class. Check the superclass for additional methods.
=cut
#-------------------------------------------------------------------
=head2 getName ()
Returns the human readable name or type of this form control.
=cut
sub getName {
return WebGUI::International::get("timezone","DateTime");
}
#-------------------------------------------------------------------
=head2 toHtml ( )
Renders a database connection picker control.
=cut
sub toHtml {
my $self = shift;
my $cmd = "WebGUI::Form::SelectList";
my $selectList = $cmd->new(
id=>$self->{id},
name=>$self->{name},
options=>WebGUI::DateTime::getTimeZones(),
value=>[$self->{value}],
extras=>$self->{extras}
);
return $selectList->toHtml;
}
1;

41
lib/WebGUI/HTTP.pm
View file

@ -62,14 +62,10 @@ sub getHeader {
return undef if ($session{http}{noHeader});
my %params;
if (isRedirect()) {
%params = (
-location => $session{http}{location}
);
$session{modperl}->headers_out->set(Location => $session{http}{location});
$session{modperl}->status(301);
} else {
%params = (
-type => $session{http}{mimetype} || "text/html",
-charset => "UTF-8"
);
$session{modperl}->content_type($session{http}{mimetype} || "text/html");
if ($session{setting}{preventProxyCache}) {
$params{"-expires"} = "-1d";
}
@ -79,21 +75,9 @@ sub getHeader {
}
$params{"-cookie"} = $session{http}{cookie};
my $status = getStatus();
if($session{env}{MOD_PERL}) {
my $r;
if ($mod_perl::VERSION >= 1.999023) {
$r = Apache2::RequestUtil->request;
} else {
$r = Apache->request;
}
if(defined($r)) {
$r->custom_response($status, '<!-- '.$session{http}{statusDescription}.' -->' );
$r->status($status);
}
} else {
$params{"-status"} = $status.' '.$session{http}{statusDescription};
}
return $session{cgi}->header(%params);
# $session{modperl}->custom_response($status, '<!-- '.$session{http}{statusDescription}.' -->' );
$session{modperl}->status($status);
return;
}
@ -159,12 +143,13 @@ sub setCookie {
my $name = shift;
my $value = shift;
my $ttl = shift || '+10y';
push @{$session{http}{cookie}}, $session{cgi}->cookie(
-name=>$name,
-value=>$value,
-expires=>$ttl,
-path=>'/'
);
my $cookie = Apache2::Cookie->new($session{modperl},
-name=>$name,
-value=>$value,
-expires=>$ttl,
-path=>'/'
);
$cookie->bake($session{modperl});
}

32
lib/WebGUI/Icon.pm
View file

@ -101,7 +101,7 @@ The URL to any page. Defaults to the current page.
sub copyIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'copy.gif" align="middle" border="0" alt="'.WebGUI::International::get('Copy','Icon').'" title="'.WebGUI::International::get('Copy','Icon').'" /></a>';
return $output;
@ -125,7 +125,7 @@ The URL to any page. Defaults to the current page.
sub cutIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'cut.gif" align="middle" border="0" alt="'.WebGUI::International::get('Cut','Icon').'" title="'.WebGUI::International::get('Cut','Icon').'" /></a>';
return $output;
@ -158,7 +158,7 @@ sub deleteIcon {
$confirmText = qq| onclick="return confirm('$confirmText')" |;
}
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'" '.$confirmText.'>';
$output .= '<img src="'._getBaseURL().'delete.gif" align="middle" border="0" alt="'.WebGUI::International::get('Delete','Icon').'" title="'.WebGUI::International::get('Delete','Icon').'" /></a>';
@ -195,7 +195,7 @@ The URL to any page. Defaults to the current page.
sub editIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'edit.gif" align="middle" border="0" alt="'.WebGUI::International::get('Edit','Icon').'" title="'.WebGUI::International::get('Edit','Icon').'" /></a>';
return $output;
@ -219,7 +219,7 @@ The URL to any page. Defaults to the current page.
sub exportIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
# TODO Change icon to Jeffs export icon
$output .= '<img src="'._getBaseURL().'export.gif" align="middle" border="0" alt="'.WebGUI::International::get('Export','Icon').'" title="'.WebGUI::International::get('Export','Icon').'" /></a>';
@ -292,7 +292,7 @@ The URL to any page. Defaults to the current page.
sub lockedIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'locked.gif" align="middle" border="0" alt="'.WebGUI::International::get('locked','Icon').'" title="'.WebGUI::International::get('locked','Icon').'" /></a>';
return $output;
@ -316,7 +316,7 @@ The URL to any page. Defaults to the current page.
sub manageIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'manage.gif" align="middle" border="0" alt="'.WebGUI::International::get('Manage','Icon').'" title="'.WebGUI::International::get('Manage','Icon').'" /></a>';
return $output;
@ -340,7 +340,7 @@ The URL to any page. Defaults to the current page.
sub moveBottomIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'moveBottom.gif" align="middle" border="0" alt="'.WebGUI::International::get('Move To Bottom','Icon').'" title="'.WebGUI::International::get('Move To Bottom','Icon').'" /></a>';
return $output;
@ -364,7 +364,7 @@ The URL to any page. Defaults to the current page.
sub moveDownIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'moveDown.gif" align="middle" border="0" alt="'.WebGUI::International::get('Move Down','Icon').'" title="'.WebGUI::International::get('Move Down','Icon').'" /></a>';
return $output;
@ -388,7 +388,7 @@ The URL to any page. Defaults to the current page.
sub moveLeftIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'moveLeft.gif" align="middle" border="0" alt="'.WebGUI::International::get('Move Left','Icon').'" title="'.WebGUI::International::get('Move Left','Icon').'" /></a>';
return $output;
@ -412,7 +412,7 @@ The URL to any page. Defaults to the current page.
sub moveRightIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'moveRight.gif" align="middle" border="0" alt="'.WebGUI::International::get('Move Right','Icon').'" title="'.WebGUI::International::get('Move Right','Icon').'" /></a>';
return $output;
@ -436,7 +436,7 @@ The URL to any page. Defaults to the current page.
sub moveTopIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'moveTop.gif" align="middle" border="0" alt="'.WebGUI::International::get('Move To Top','Icon').'" title="'.WebGUI::International::get('Move To Top','Icon').'" /></a>';
return $output;
@ -460,7 +460,7 @@ The URL to any page. Defaults to the current page.
sub moveUpIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'moveUp.gif" align="middle" border="0" alt="'.WebGUI::International::get('Move Up','Icon').'" title="'.WebGUI::International::get('Move Up','Icon').'" /></a>';
return $output;
@ -496,7 +496,7 @@ The URL to any page. Defaults to the current page.
sub pasteIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'paste.gif" align="middle" border="0" alt="'.WebGUI::International::get('Paste','Icon').'" title="'.WebGUI::International::get('Paste','Icon').'" /></a>';
return $output;
@ -520,7 +520,7 @@ The URL to any page. Defaults to the current page.
sub shortcutIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'shortcut.gif" align="middle" border="0" alt="'.WebGUI::International::get('Create Shortcut','Icon').'" title="'.WebGUI::International::get('Create Shortcut','Icon').'" /></a>';
return $output;
@ -544,7 +544,7 @@ The URL to any page. Defaults to the current page.
sub viewIcon {
my ($output, $pageURL);
$pageURL = $_[1] || $session{env}{PATH_INFO};
$pageURL = $_[1] || $session{env}{SCRIPT_NAME};
$output = '<a href="'.WebGUI::URL::gateway($pageURL,$_[0]).'">';
$output .= '<img src="'._getBaseURL().'view.gif" align="middle" border="0" alt="'.WebGUI::International::get('View','Icon').'" title="'.WebGUI::International::get('View','Icon').'" /></a>';
return $output;

2
lib/WebGUI/Macro/PageUrl.pm
View file

@ -16,7 +16,7 @@ use WebGUI::URL;
#-------------------------------------------------------------------
sub process {
my $pathinfo = $session{env}{PATH_INFO};
my $pathinfo = $session{env}{SCRIPT_NAME};
$pathinfo =~ s#^/##;
return WebGUI::URL::getScriptURL().$pathinfo;
}

2
lib/WebGUI/Macro/r_printable.pm
View file

@ -26,7 +26,7 @@ sub process {
if ($session{env}{REQUEST_URI} =~ /op\=/) {
$append = 'op2='.WebGUI::URL::escape($append);
}
$temp = WebGUI::URL::gateway($session{env}{PATH_INFO},$append);
$temp = WebGUI::URL::gateway($session{env}{SCRIPT_NAME},$append);
$temp =~ s/\/\//\//;
$temp = WebGUI::URL::append($temp,$session{env}{QUERY_STRING});
if ($param[1] ne "") {

57
lib/WebGUI/Session.pm
View file

@ -14,8 +14,6 @@ package WebGUI::Session;
=cut
use CGI;
use Date::Manip;
use DBI;
use Exporter;
@ -30,6 +28,8 @@ use WebGUI::SQL;
use WebGUI::User;
use WebGUI::Utility;
use URI::Escape;
use Apache2::Request;
use Apache2::Cookie;
our @ISA = qw(Exporter);
our @EXPORT = qw(%session);
@ -98,17 +98,7 @@ sub _setupSessionVars {
sub _setupUserInfo {
my $u = WebGUI::User->new(shift);
%{$session{user}} = (%{$u->{_profile}}, %{$u->{_user}});
if ($session{env}{MOD_PERL}) {
my $r;
if ($mod_perl::VERSION >= 1.999023) {
$r = Apache2::RequestUtil->request;
} else {
$r = Apache->request;
}
if(defined($r)) {
$r->user($session{user}{username});
}
}
# $session{modperl}->user($session{user}{username});
$session{user}{alias} = $session{user}{username} if ($session{user}{alias} =~ /^\W+$/ || $session{user}{alias} eq "");
}
@ -143,10 +133,9 @@ sub close {
$slavedbh->disconnect();
}
$session{dbh}->disconnect() if (exists $session{dbh});
$session{cgi}->DESTROY() if (exists $session{cgi});
undef %session;
$ENV{PATH_INFO} = "/"; #work around to fix a bug in mod_perl (win32)
}
#-------------------------------------------------------------------
sub DESTROY {
WebGUI::Session::close();
@ -293,7 +282,7 @@ A pointer to a Fast CGI object.
sub open {
my $webguiRoot = shift;
my $configFile = shift;
my $fastcgi = shift;
$session{modperl} = shift;
my ($key);
###----------------------------
### operating system specific things
@ -331,28 +320,23 @@ sub open {
### global system settings (from settings table)
$session{setting} = WebGUI::Setting::get();
###----------------------------
### CGI object
$CGI::POST_MAX=1024 * $session{setting}{maxAttachmentSize};
$session{cgi} = $fastcgi || CGI->new();
if ($session{cgi}->cgi_error =~ /^413/) {
$session{http}{status} = $session{cgi}->cgi_error;
WebGUI::ErrorHandler::warn("File upload too big. May need to adjust Max File Size setting.");
$CGI::POST_MAX=-1;
$session{cgi} = CGI->new();
}
### Apache2::Request object
$session{req} = Apache2::Request->new($session{modperl}, POST_MAX => 1024 * $session{setting}{maxAttachmentSize});
###----------------------------
### form variables
foreach ($session{cgi}->param) {
$session{form}{$_} = $session{cgi}->param($_);
#
foreach ($session{req}->param) {
$session{form}{$_} = $session{req}->param($_);
}
foreach ($session{cgi}->url_param) {
$session{form}{$_} = $session{cgi}->url_param($_) unless (defined $session{form}{$_});
}
###----------------------------
### cookies
foreach ($session{cgi}->cookie) {
$session{cookie}{$_} = $session{cgi}->cookie($_);
}
my %cookies = Apache2::Cookie->fetch();
foreach my $key (keys %cookies) {
my $value = $cookies{$key};
$value =~ s/$key=//; # Strange... The Apache2::Cookie value also contains the key ????
# Must be a bug in Apache2::Cookie...
$session{cookie}{$key} = $value;
}
###----------------------------
### session variables
if ($session{cookie}{wgSession} eq "") {
@ -474,12 +458,7 @@ sub start {
$sessionId = $_[1] || _uniqueSessionId();
WebGUI::SQL->write("insert into userSession values ('$sessionId', ".
(_time()+$session{setting}{sessionTimeout}).", "._time().", 0, '$ENV{REMOTE_ADDR}', ".quote($_[0]).")");
push @{$session{http}{cookie}}, $session{cgi}->cookie(
-name=>"wgSession",
-value=>$sessionId,
-expires=>'+10y',
-path=>'/'
);
WebGUI::HTTP::setCookie("wgSession",$sessionId);
refreshSessionVars($sessionId);
return $sessionId;
}

2
lib/WebGUI/URL.pm
View file

@ -267,7 +267,7 @@ sub page {
if ($session{asset}) {
$pathinfo = $session{asset}->get("url");
} else {
$pathinfo = $session{env}{PATH_INFO};
$pathinfo = $session{env}{SCRIPT_NAME};
$pathinfo =~ s/^\/(.*)/$1/;
}
$url .= $pathinfo;

13
sbin/uploadsAccessHandler.perl
View file

@ -13,12 +13,7 @@ package WebGUI::UploadsAccessHandler;
our $webguiRoot;
BEGIN {
my $s;
if ($mod_perl::VERSION >= 1.999023) {
$s = Apache2::ServerUtil->server;
} else {
$s = Apache->server;
}
my $s = Apache2::ServerUtil->server;
$webguiRoot = $s->dir_config('WebguiRoot');
unshift (@INC, $webguiRoot."/lib");
}
@ -35,15 +30,9 @@ sub handler {
my $r;
my $ok;
my $notfound;
if ($mod_perl::VERSION >= 1.999023) {
$r = Apache2::RequestUtil->request;
$ok = Apache2::Const::OK();
$notfound = Apache2::Const::NOT_FOUND();
} else {
$r = Apache->request;
$ok = Apache::OK();
$notfound = Apache::NOT_FOUND();
}
if (-e $r->filename) {
my $path = $r->filename;
$path =~ s/^(\/.*\/).*$/$1/;