view release on metacpan or  search on metacpan

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

	while ($data = $sth -> fetchrow_hashref() )
	{
		# Untaint the data the brute force way.

		($untainted_data) = $$data{'a_session'} =~ /(.*)/;

		if ($serializer eq 'eval')
		{
			eval $untainted_data;

			push @id, $$data{id} if ($self -> _check_expiry($D) );
		}
		else
		{
			my($serializer)	= "CGI::Session::Serialize::$serializer";
			my($thawed)		= $serializer -> thaw($untainted_data);

			push @id, $$data{id} if ($self -> _check_expiry($thawed) );
		}
	}

	for (@id)
	{
		print STDOUT "Expiring db id: $_. \n" if ($$self{'_verbose'});

		$sth = $$self{'_dbh'} -> prepare("delete from $$self{'_table_name'} where id = ?");

		$sth -> execute($_);

		$sth -> finish();
	}

	if ( ($#id < 0) && $$self{'_verbose'})
	{
		print STDOUT "No db ids are due to expire. \n";
	}

}	# End of expire_db_sessions.

# -----------------------------------------------

sub expire_file_sessions
{
	my($self, %arg) = @_;

	$self -> set(%arg) if (%arg);

	Carp::croak(__PACKAGE__ . ". You must specify a value for the parameter 'temp_dir'") if (! $$self{'_temp_dir'});

	opendir(INX, $$self{'_temp_dir'}) || Carp::croak("Can't opendir($$self{'_temp_dir'}): $!");
	my(@file) = map{File::Spec -> catfile($$self{'_temp_dir'}, $_)} grep{/cgisess_[0-9a-f]{32}/} readdir(INX);
	closedir INX;

	my($count)	= 0;
	my($time)	= time();

	my($file, @stat, $D);

	for my $file (@file)
	{
		@stat = stat($file);

		# Delete old, tiny files.

		if ( ( ($time - $stat[8]) >= $$self{'_delta'}) && ($stat[7] <= 5) )
		{
			$count++;

			print STDOUT "Delta time: $$self{'_delta'}. Size: $stat[7] bytes. Time elapsed: ", $time - $stat[8], ". Expired?: 1. \n" if ($$self{'_verbose'});

			unlink $file;

			next;
		}

		# Ignore new, tiny files.

		next if ($stat[7] <= 5);

		open(INX, $file) || Carp::croak("Can't open($file): $!");
		binmode INX;
		my(@session) = <INX>;
		close INX;

		# Pod/perlfunc.html#item_eval
		# This does not work:
		# eval{no warnings 'all'; $session[0]};
		# This was when I used to say 'eval $session[0];', but that fails
		# when the session data contains \n characters. Hence the join.

		eval join('', @session);

		if ($@)
		{
			print STDOUT "Unable to parse contents of file: $file. \n" if ($$self{'_verbose'});

			next;
		}

		if ($self -> _check_expiry($D) )
		{
			$count++;

			print STDOUT "Expiring file id: $$D{'_SESSION_ID'}. \n" if ($$self{'_verbose'});

			unlink $file;
		}
	}

	print STDOUT "No file ids are due to expire. \n" if ( ($count == 0) && $$self{'_verbose'});

}	# End of expire_file_sessions.

# -----------------------------------------------

sub expire_sessions
{
	my($self, %arg) = @_;

	return if (! CGI::Session -> can('find') );