From 9b23c24a6aac99219b98067873875f61e123eb44 Mon Sep 17 00:00:00 2001 From: JT Smith Date: Thu, 3 Nov 2005 09:14:23 +0000 Subject: [PATCH] convert WebGUI to a mod perl handler --- docs/upgrades/upgrade_6.7.8-6.8.0.pl | 41 +++++++++++++++ lib/WebGUI.pm | 25 +++++++++ lib/WebGUI/Asset.pm | 2 +- lib/WebGUI/Asset/Post/Thread.pm | 2 +- lib/WebGUI/Auth.pm | 2 +- lib/WebGUI/Form/TimeZone.pm | 78 ++++++++++++++++++++++++++++ lib/WebGUI/HTTP.pm | 41 +++++---------- lib/WebGUI/Icon.pm | 32 ++++++------ lib/WebGUI/Macro/PageUrl.pm | 2 +- lib/WebGUI/Macro/r_printable.pm | 2 +- lib/WebGUI/Session.pm | 57 +++++++------------- lib/WebGUI/URL.pm | 2 +- sbin/uploadsAccessHandler.perl | 13 +---- 13 files changed, 198 insertions(+), 101 deletions(-) create mode 100644 docs/upgrades/upgrade_6.7.8-6.8.0.pl create mode 100644 lib/WebGUI/Form/TimeZone.pm diff --git a/docs/upgrades/upgrade_6.7.8-6.8.0.pl b/docs/upgrades/upgrade_6.7.8-6.8.0.pl new file mode 100644 index 000000000..e3ab0bfe9 --- /dev/null +++ b/docs/upgrades/upgrade_6.7.8-6.8.0.pl @@ -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(); +} + diff --git a/lib/WebGUI.pm b/lib/WebGUI.pm index 6f1d0528c..bb9c3cbeb 100644 --- a/lib/WebGUI.pm +++ b/lib/WebGUI.pm @@ -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 { diff --git a/lib/WebGUI/Asset.pm b/lib/WebGUI/Asset.pm index cf490958c..759f8aaf2 100644 --- a/lib/WebGUI/Asset.pm +++ b/lib/WebGUI/Asset.pm @@ -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/\/$//; diff --git a/lib/WebGUI/Asset/Post/Thread.pm b/lib/WebGUI/Asset/Post/Thread.pm index f66e9230f..711697800 100644 --- a/lib/WebGUI/Asset/Post/Thread.pm +++ b/lib/WebGUI/Asset/Post/Thread.pm @@ -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()}) { diff --git a/lib/WebGUI/Auth.pm b/lib/WebGUI/Auth.pm index 30138dec6..4fca13c6f 100644 --- a/lib/WebGUI/Auth.pm +++ b/lib/WebGUI/Auth.pm @@ -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; diff --git a/lib/WebGUI/Form/TimeZone.pm b/lib/WebGUI/Form/TimeZone.pm new file mode 100644 index 000000000..316e6ca0a --- /dev/null +++ b/lib/WebGUI/Form/TimeZone.pm @@ -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; + diff --git a/lib/WebGUI/HTTP.pm b/lib/WebGUI/HTTP.pm index f05d45db9..7cb7c48ea 100644 --- a/lib/WebGUI/HTTP.pm +++ b/lib/WebGUI/HTTP.pm @@ -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, '' ); - $r->status($status); - } - } else { - $params{"-status"} = $status.' '.$session{http}{statusDescription}; - } - return $session{cgi}->header(%params); + # $session{modperl}->custom_response($status, '' ); + $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}); } diff --git a/lib/WebGUI/Icon.pm b/lib/WebGUI/Icon.pm index 9cb2ef421..d5c8298e7 100644 --- a/lib/WebGUI/Icon.pm +++ b/lib/WebGUI/Icon.pm @@ -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 = ''; $output .= ''.WebGUI::International::get('Copy','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Cut','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Delete','Icon').''; @@ -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 = ''; $output .= ''.WebGUI::International::get('Edit','Icon').''; 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 = ''; # TODO Change icon to Jeffs export icon $output .= ''.WebGUI::International::get('Export','Icon').''; @@ -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 = ''; $output .= ''.WebGUI::International::get('locked','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Manage','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Move To Bottom','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Move Down','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Move Left','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Move Right','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Move To Top','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Move Up','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Paste','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('Create Shortcut','Icon').''; 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 = ''; $output .= ''.WebGUI::International::get('View','Icon').''; return $output; diff --git a/lib/WebGUI/Macro/PageUrl.pm b/lib/WebGUI/Macro/PageUrl.pm index 24b290719..6091160dd 100644 --- a/lib/WebGUI/Macro/PageUrl.pm +++ b/lib/WebGUI/Macro/PageUrl.pm @@ -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; } diff --git a/lib/WebGUI/Macro/r_printable.pm b/lib/WebGUI/Macro/r_printable.pm index 1ba25fbe3..54f377863 100644 --- a/lib/WebGUI/Macro/r_printable.pm +++ b/lib/WebGUI/Macro/r_printable.pm @@ -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 "") { diff --git a/lib/WebGUI/Session.pm b/lib/WebGUI/Session.pm index 4d03e54d6..1978b09e5 100644 --- a/lib/WebGUI/Session.pm +++ b/lib/WebGUI/Session.pm @@ -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; } diff --git a/lib/WebGUI/URL.pm b/lib/WebGUI/URL.pm index bedce78e6..3cf10ccff 100644 --- a/lib/WebGUI/URL.pm +++ b/lib/WebGUI/URL.pm @@ -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; diff --git a/sbin/uploadsAccessHandler.perl b/sbin/uploadsAccessHandler.perl index 82713a679..3846deeb3 100644 --- a/sbin/uploadsAccessHandler.perl +++ b/sbin/uploadsAccessHandler.perl @@ -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/;