view release on metacpan or  search on metacpan

lib/CGI/Mungo/Session.pm  view on Meta::CPAN

	return $result;
}
###########################################################################################

=pod

=head2 delete()

Remove the current session from memory, disk and expire it in the browser.

=cut

###########################################################################################
sub delete{	#remove a session
	my($self, $response) = @_;
	my $result = 0;
	my $sessionId = $self->getId();
	my $prefix = $self->_getPrefix();
	if($sessionId =~ m/^$prefix[a-f0-9]+$/){	#id valid
		my $path = $self->_getPath();
		my $sessionFile = File::Spec->catfile($path, $sessionId);
		if(unlink($sessionFile)){
			$self->log("Deleted session: $sessionId");
			if($response){
				my $cookie = &Set_Cookie(NAME => 'SESSION', EXPIRE => 'delete');
				if($cookie =~ m/^([^ ]+): (.+)$/){
					$response->header($1 => $2);
				}
				else{
					$self->setError("Invalid cookie line: $cookie");
				}
			}
			else{
				print &Set_Cookie(NAME => 'SESSION', EXPIRE => 'delete');
			}
			$self = undef;	#destroy this object
			$result = 1;
		}
		else{
			$self->setError("Could not delete session");
		}
	}
	else{
		$self->setError("Session ID invalid: $sessionId");
	}
	return $result;
}
###############################################################################################################
#private class method
###############################################################################################################
sub _expire{	#remove old session files
	my $self = shift;
	my $path = $self->_getPath();
	if(opendir(COOKIES, $path)){
		my @sessions = readdir(COOKIES);
		my $expire = (time - 86400);
		foreach(@sessions){	#check each of the cookies
			my $prefix = $self->_getPrefix();
			if($_ =~ m/^($prefix[a-f0-9]+)$/){	#found a cookie file
				my $sessionFile = File::Spec->catfile($path, $1);
				my @stat = stat($sessionFile);
				if(defined($stat[9]) && $stat[9] < $expire){	#cookie is more than a day old, so remove it
					unlink $sessionFile;
				}
			}
		}
		closedir(COOKIES);
	}
}
############################################################################################################
#private methods
###########################################################################################
sub _write{	#writes a server-side cookie for the session
	my $self = shift;
	my $prefix = $self->_getPrefix();
	if($self->getId() =~ m/^($prefix[a-f0-9]+)$/){	#filename valid
		my $path = $self->_getPath();
		my $sessionFile = File::Spec->catfile($path, $1);
		if(open(SSIDE, ">", $sessionFile)){
			$Data::Dumper::Freezer = 'freeze';
			$Data::Dumper::Toaster = 'toast';
			$Data::Dumper::Indent = 0;	#turn off formatting
			my $dump = Dumper $self->{'vars'};
			if($dump){	#if we have any data
				print SSIDE $dump;
			}
			close(SSIDE);
		}
		else{$self->setError("Cant write session: $!");}
	}
	else{$self->setError('Session ID invalid');}
	if($self->getError()){return 0;}
	else{return 1;}
}
############################################################################################################
sub _getCookie{	#returns the value of a cookie
	my $self = shift;
	my $name = shift;
	my $value = undef;
	if(exists($ENV{'HTTP_COOKIE'})){	#we have some kind of cookie
		my @pairs = split(/; /, $ENV{'HTTP_COOKIE'});	#this cookie might contain multiple name value pairs
		foreach(@pairs){
			my($n, $v) = split(/=/, $_, 2);
			if($n eq $name){$value = $v;}
		}
	}
	return $value;
}
##########################################################################################################################
sub _storeVar{	#stores a variable in the session
	my($self, $name, $value) = @_;
	if(!defined($value)){	#remove the var
		if($self->{'vars'}){	
			my %vars = %{$self->{'vars'}};
			delete $vars{$name};
			$self->{'vars'} = \%vars;
		}
	}
	else{	#update/create a var
		$self->{'vars'}->{$name} = $value;	#store for later
	}