Make DBI connect errors not infinitely recurse.

lib/WebGUI/SQL.pm

@@ -315,7 +315,13 @@ sub connect {
 	my $dsn = shift;
 	my $user = shift;
 	my $pass = shift;
-	my $dbh = DBI->connect($dsn,$user,$pass,{RaiseError=>0,AutoCommit=>1 }) or $session->errorHandler->fatal("Couldn't connect to database.");
+	my $dbh = DBI->connect($dsn,$user,$pass,{RaiseError=>0,AutoCommit=>1 });
+
+	unless (defined $dbh) {
+		$session->setDbNotAvailable;
+		$session->errorHandler->fatal("Couldn't connect to database.");
+	}
+
 	if ( $dsn =~ /Oracle/ ) { # Set Oracle specific attributes
 		$dbh->{LongReadLen} = 512 * 1024;
 		$dbh->{LongTruncOk} = 1;

lib/WebGUI/Session.pm

@@ -117,14 +117,13 @@ Cleans up a WebGUI session information from memory and disconnects from any reso
 
 sub close {
 	my $self = shift;
-	$self->db->disconnect;
-	##Must destroy the logger last!
-	my %mykeys = grep { ($_ ne '_errorHandler' && $_ ne '_request' && $_ eq '_sessionId' && $_ eq '_server') } keys %{ $self };
-	foreach my $object (keys %mykeys) {
-		$self->{$object} and $self->{$object}->DESTROY;
+	$self->db->disconnect unless $self->dbNotAvailable;
+
+	# Kill circular references.  The literal list is so that the order
+	# can be explicitly shuffled as necessary.
+	foreach my $key (qw/_asset _datetime _icon _slave _db _env _form _http _id _output _os _privilege _scratch _setting _stow _style _url _user _var _errorHandler/) {
+		delete $self->{$key};
 	}
-	$self->{_errorHandler} and $self->{_errorHandler}->DESTROY;
-	undef $self;
 }
 
 #-------------------------------------------------------------------
@@ -494,7 +493,7 @@ sub server {
 
 =head2 setting ( param ) 
 
-Returns a WebGUI::Session object.
+Returns the associated WebGUI::Session::Setting object.
 
 =cut
 
@@ -612,5 +611,28 @@ sub var {
 	return $self->{_var};
 }
 
+#-------------------------------------------------------------------
+
+=head2 setDbNotAvailable ( )
+
+Sets a flag for this session indicating that database accesses are known to be probably broken and should not be performed.
+
+=cut
+
+sub setDbNotAvailable {
+	my $self = shift;
+	$self->{_dbNotAvailable} = 1;
+}
+
+=head2 dbNotAvailable ( )
+
+Returns true iff there is an error condition such that no database accesses should be attempted for this session whatsoever.
+
+=cut
+
+sub dbNotAvailable {
+	my $self = shift;
+	return $self->{_dbNotAvailable};
+}
 
 1;

lib/WebGUI/Session/DateTime.pm

@@ -642,6 +642,7 @@ Returns the timezone for this user, in DateTime::TimeZone format.  Checks to mak
 
 sub getTimeZone {
 	my $self = shift;
+	return 'America/Chicago' if $self->session->dbNotAvailable;
 	return $self->session->user->{_timeZone} if $self->session->user->{_timeZone};
 	my @zones = @{DateTime::TimeZone::all_names()};
 	my $zone = $self->session->user->profileField('timeZone');

lib/WebGUI/Session/ErrorHandler.pm

@@ -176,33 +176,42 @@ sub error {
 
 #-------------------------------------------------------------------
 
-=head2 fatal ( )
+=head2 fatal ( message [, flags] )
 
 Adds a FATAL type message to the log, outputs an error message to the user, and forces a close on the session. This should only be called if the system cannot recover from an error, or it would be unsafe to recover from an error like database connectivity problems.
 
+=head3 message
+
+The message to use.
+
 =cut
 
 sub fatal {
 	my $self = shift;
 	my $message = shift;
+
 	$self->session->http->setStatus("500","Server Error");
 	Apache2::RequestUtil->request->content_type('text/html') if ($self->session->request);
 	$self->getLogger->fatal($message);
 	$self->getLogger->debug("Stack trace for FATAL ".$message."\n".$self->getStackTrace());
 	$self->session->http->sendHeader if ($self->session->request);
-	unless ($self->canShowDebug()) {
-		#NOTE: You can't internationalize this because with some types of errors that would cause an infinite loop.
+
+	if ($self->session->dbNotAvailable) {
+		# We can't even _determine_ whether we can show the debug text.  Punt.
+		$self->session->output->print("<h1>Fatal Internal Error</h1>");
+	} elsif ($self->canShowDebug()) {
+		$self->session->output->print("<h1>WebGUI Fatal Error</h1><p>Something unexpected happened that caused this system to fault.</p>\n",1);
+		$self->session->output->print("<p>".$message."</p>\n",1);
+		$self->session->output->print($self->getStackTrace(), 1);
+		$self->session->output->print($self->showDebug(),1);
+	} else {
+		# NOTE: You can't internationalize this because with some types of errors that would cause an infinite loop.
 		$self->session->output->print("<h1>Problem With Request</h1>
 		We have encountered a problem with your request. Please use your back button and try again.
 		If this problem persists, please contact us with what you were trying to do and the time and date of the problem.<br />",1);
 		$self->session->output->print('<br />'.$self->session->setting->get("companyName"),1);
 		$self->session->output->print('<br />'.$self->session->setting->get("companyEmail"),1);
 		$self->session->output->print('<br />'.$self->session->setting->get("companyURL"),1);
-	} else {
-		$self->session->output->print("<h1>WebGUI Fatal Error</h1><p>Something unexpected happened that caused this system to fault.</p>\n",1);
-		$self->session->output->print("<p>".$message."</p>\n",1);
-		$self->session->output->print($self->getStackTrace(), 1);
-		$self->session->output->print($self->showDebug(),1);
 	}
 	$self->session->close();
 	exit;

lib/WebGUI/Session/Http.pm

@@ -165,18 +165,21 @@ sub new {
 
 #-------------------------------------------------------------------
 
-=head2 sendHeader ( ) 
+=head2 sendHeader ( )
 
-Generates and sends HTTP headers.
+Generates and sends HTTP headers for a response.
 
 =cut
 
 sub sendHeader {
 	my $self = shift;
 	return undef if ($self->{_http}{noHeader});
+	return $self->_sendMinimalHeader if $self->session->dbNotAvailable;
+
 	my ($request, $datetime) = $self->session->quick(qw(request datetime));
 	return undef unless $request;
 	my $userId = $self->session->var->get("userId");
+
 	$self->{_http}{noHeader} = 1;
 	my %params;
 	if ($self->isRedirect()) {
@@ -208,6 +211,17 @@ sub sendHeader {
 	return;
 }
 
+sub _sendMinimalHeader {
+	my $self = shift;
+	my $request = $self->session->request;
+	$request->content_type('text/html; charset=UTF-8');
+	$request->headers_out->set('Cache-Control' => 'private');
+	$request->no_cache(1);
+	$request->status($self->getStatus());
+	$request->status_line($self->getStatus().' '.$self->{_http}{statusDescription});
+	return;
+}
+
 
 #-------------------------------------------------------------------
 
@@ -257,6 +271,7 @@ The value to set.
 =head3 timeToLive
 
 The time that the cookie should remain in the browser. Defaults to "+10y" (10 years from now).
+This may be "session" to indicate that the cookie is for the current browser session only.
 
 =head3 domain
 
@@ -271,6 +286,7 @@ sub setCookie {
 	my $ttl = shift;
 	my $domain = shift;
 	$ttl = (defined $ttl ? $ttl : '+10y');
+
 	if ($self->session->request) {
 		require Apache2::Cookie;
 		my $cookie = Apache2::Cookie->new($self->session->request,