| thepoetwarrior |
01-16-2014 07:13 PM |
Players Online
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.
http://i40.tinypic.com/2eeejki.png
Code:
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()
|