Players Online

[thepoetwarrior]

Wrote a simple perl script to see how many players have been online within last 30 minutes, or within last 24 hours.

Since some players only play for a few hours, this could give better perspective how many have played within the last 24 hours total.

This script can go anywhere (player.pl, global_player.pl, npc_names.pl, etc) and doesn't need any editing, just DBI enabled which we probably all have anyways.

This would allow my vote kick script to have a more dynamic number of required votes based on population size.

Can probably modify this later to give total by unique IP via INNER JOIN statements to the account_ip table.

UPDATED: Added IP log in. This only updates when player first connects, so number of characters online will be way higher than current players online, even if limited to 1 character per IP. This gives a more accurate picture will be of how many characters vs IP logged in during the last 24 hours.

sub EVENT_SAY
{
	if ($status > 0)
	{
		if ($text =~/^#Online Month$/i)
		{
			my $GET_SECONDS		= (60 * 60 * 24 * 30);	# 1 Month (Minutes)
			my $GET_MINUTES		= $GET_SECONDS / 60;	# 1 Month (Seconds)
			my $GET_ONLINE_IP	= GET_IP_ONLINE($GET_MINUTES);
			my $GET_ONLINE_CHAR	= GET_PLAYERS_ONLINE($GET_SECONDS);
			$client->Message(2, "IP Log Online Month: $GET_ONLINE_IP");
			$client->Message(2, "Players Online Month: $GET_ONLINE_CHAR");
		}

		if ($text =~/^#Online Week$/i)
		{
			my $GET_SECONDS		= (60 * 60 * 24 * 7);	# 1 Week (Minutes)
			my $GET_MINUTES		= $GET_SECONDS / 60;	# 1 Week (Seconds)
			my $GET_ONLINE_IP	= GET_IP_ONLINE($GET_MINUTES);
			my $GET_ONLINE_CHAR	= GET_PLAYERS_ONLINE($GET_SECONDS);
			$client->Message(2, "IP Log Online Week: $GET_ONLINE_IP");
			$client->Message(2, "Players Online Week: $GET_ONLINE_CHAR");
		}

		if ($text =~/^#Online Today$/i)
		{
			my $GET_SECONDS		= (60 * 60 * 24 * 1);	# 1 Day (Minutes)
			my $GET_MINUTES		= $GET_SECONDS / 60;	# 1 Day (Seconds)
			my $GET_ONLINE_IP	= GET_IP_ONLINE($GET_MINUTES);
			my $GET_ONLINE_CHAR	= GET_PLAYERS_ONLINE($GET_SECONDS);
			$client->Message(2, "IP Log Online Today: $GET_ONLINE_IP");
			$client->Message(2, "Players Online Today: $GET_ONLINE_CHAR");
		}

		if ($text =~/^#Online 30$/i)
		{
			my $GET_SECONDS		= (30 * 60 * 1 * 1);	# 30 Minutes (Minutes)
			my $GET_MINUTES		= $GET_SECONDS / 60;	# 30 Minutes (Seconds)
			my $GET_ONLINE_IP	= GET_IP_ONLINE($GET_MINUTES);
			my $GET_ONLINE_CHAR	= GET_PLAYERS_ONLINE($GET_SECONDS);
			$client->Message(2, "IP Log Online 30 Minutes: $GET_ONLINE_IP");
			$client->Message(2, "Players Online 30 Minutes: $GET_ONLINE_CHAR");
		}
	}
}


sub GET_PLAYERS_ONLINE
{
	my $GET_ONLINE		= 0;
	my $connect			= LoadMySQLConnection();
	my $query 			=	"
							SELECT count(timelaston)
							FROM character_
							WHERE UNIX_TIMESTAMP() - ($_[0]) < timelaston
							";
	# $client->Message(7, "$query");
	my $query_handle = $connect->prepare($query);
	$query_handle->execute();
	if ($query_handle->rows)
	{
		my $ref		= $query_handle->fetchrow_hashref();
		$GET_ONLINE	= $ref->{'count(timelaston)'};
	}

	$query_handle->finish();
	$connect->disconnect();
	return $GET_ONLINE;
} # End GET_PLAYERS_ONLINE


sub GET_IP_ONLINE
{
	my $GET_ONLINE		= 0;
	my $connect			= LoadMySQLConnection();
	my $query 			=	"
							SELECT count(lastused)
							FROM account_ip
							WHERE TIMESTAMPDIFF(MINUTE, lastused, NOW()) < $_[0]
							";
	# $client->Message(7, "$query");
	my $query_handle = $connect->prepare($query);
	$query_handle->execute();
	if ($query_handle->rows)
	{
		my $ref		= $query_handle->fetchrow_hashref();
		$GET_ONLINE	= $ref->{'count(lastused)'};
	}
	$query_handle->finish();
	$connect->disconnect();
	return $GET_ONLINE;
} # End GET_IP_ONLINE


sub LoadMySQLConnection
{
	use DBI;
	use DBD::mysql;
	# GET DB, USER, AND PASS FROM CONFIG FILE
	my $confile = "eqemu_config.xml"; #default config file
	# open(F, "<$confile") or die "Unable to open config: $confile\n";
	open(F, "<$confile") or quest::gmsay("GM: sub LoadMySQLConnection() 'open' FAILED !!!!", 15, 1);
	my $indb = 0;

	while(<F>)
	{
		s/\r//g;
		if(/<database>/i) 						{ $indb = 1; }
		next unless($indb == 1);
		if(/<\/database>/i) 					{ $indb = 0; last; }
		if(/<host>(.*)<\/host>/i) 				{ $host = $1; }
		elsif(/<username>(.*)<\/username>/i) 	{ $user = $1; }
		elsif(/<password>(.*)<\/password>/i) 	{ $pass = $1; }
		elsif(/<db>(.*)<\/db>/i) 				{ $db 	= $1; }
	}

	# DATA SOURCE NAME
	my $dsn = "dbi:mysql:$db:localhost:3306";
	# PERL DBI CONNECT
	my $connect = DBI->connect($dsn, $user, $pass) or quest::gmsay("GM: sub LoadMySQLConnection() 'connect' FAILED !!!!", 15, 1);
	return $connect;
} # End LoadMySQLConnection()