File Coverage

blib/lib/Games/FEAR/Log.pm

Criterion	Covered	Total	%
statement	19	255	7.4
branch	0	128	0.0
condition	0	30	0.0
subroutine	7	18	38.8
pod	9	9	100.0
total	35	440	7.9

package Games::FEAR::Log;
{

use warnings;
use strict;

use Carp;
use DBI;
use File::Copy;
use File::Temp;

## Object Attributes ##

# objects of this class have the following attributes...
my %dbh_of;           # open database handle of type DBI
my %create_of;        # indicator of whether to create table if doesnt exist
my %table_of;         # main stats table in database
my %logfile_of;       # logfile of the source logfile
my %tempfile_of;      # temp file via File::Temp (only if truncate is false)
my %history_of;       # length of time before
my %truncate_of;      # indicator of whether to truncate logfile after analysis

## Object Methods ##

# class constructor, takes hashref of arguments
sub new {
  my ($class, $args) = @_;

  # bless a scalar to instantiate the new object...
  my $new_object = bless \do{my $anon_scalar}, $class;

  # temporary variable (to save on expensive hash accesses, etc)
  my $temp_arg;

  # if no hashref of arguments provided, croak with error
  if (ref $args ne 'HASH') {
    croak "missing hash reference of constructor arguments";
  }

  # if logfile argument doesnt exist or is undef
  if ( !exists $args->{'-logfile'} || !defined $args->{'-logfile'} ) {
    # set logfile and tempfile attributes as undef
    $logfile_of{ident $new_object} = undef;
    $tempfile_of{ident $new_object} = undef;
  }
  else {
    # if logfile is anything other than a scalar value, scalar ref, or glob ref
    $temp_arg = ref $args->{'-logfile'};
    if ($temp_arg ne 'SCALAR' && $temp_arg ne 'GLOB' && $temp_arg ne '') {
      # croak on invalid logfile
      croak "invalid logfile attribute, must be string, scalar ref, or filehandle ref";
    }

    # set logfile as attribute
    $logfile_of{ident $new_object} = $args->{'-logfile'};

    # set tempfile (File::Temp object) as attribute
    $tempfile_of{ident $new_object} = new File::Temp();
  }

  # if dbh doesnt exist or is undefined
  if ( !exists $args->{'-dbi'} || !defined $args->{'-dbi'} ) {
    # croak on missing db handle
    croak "missing or undefined dbi attribute"
  }

  # if anonymous hash of 3 elements (dsn, user, pass) is not provided
  my $dbh = $args->{'-dbi'};
  if( ref $dbh ne 'ARRAY' || $#{$dbh} != 2 ) {
    # croak on invalid arguments
    croak "invalid dbi attribute, must be an arrayref of dsn, username, and password";
  }

  # get database driver name from the dsn
  (undef,$temp_arg,undef) = split /\:/, $dbh->[0],3;

  # if support for this db driver not found in the %_QUERIES hash
  if ( ! exists $Games::FEAR::Log::_QUERIES{$temp_arg} ) {
    # croak with reason
    croak "database driver '$temp_arg' is not yet supported";
  }

  # create dbi connection
  $dbh = DBI->connect(
    $dbh->[0], $dbh->[1], $dbh->[2], # dsn, username, password
    { PrintError => 0, PrintWarn => 0, RaiseError => 1, AutoCommit => 0}
  ) or croak "could not connect to database: $DBI::errstr";

  # set dbi object as attribute
  $dbh_of{ident $new_object} = $dbh;

  # if create is not provided or undefined
  if ( ! exists $args->{'-create'} || ! defined $args->{'-create'} ) {
    # default to one (true)
    $args->{'-create'} = 1;
  }

  # if not true
  $temp_arg = $args->{'-create'};
  if (! $temp_arg ) {
    # set to zero (false)
    $temp_arg = 0;
  }

  # set create mode as attribute
  $create_of{ident $new_object} = $temp_arg;

  # if stats tablename doesnt exist or is undefined
  if ( ! exists $args->{'-table'} || ! defined $args->{'-table'} || $args->{'-table'} !~ m/\A[a-z0-9_]+\z/) {
    # croak on missing table name
    croak "missing, undefined, or invalid table attribute"
  }

  # test if stats table exists, trapping potential errors in an eval
  $temp_arg = $args->{'-table'};
  eval {
    # select with an always false WHERE clause, will return an empty but existing dataset
    my $query_ref = $dbh->selectall_arrayref( _build_query('test_exist',$temp_arg) );
  };

  # if eval failed
  if ($@ ne '') {
    # if table doesnt exist
    if ($@ =~ m/table .+ exist/imsx) { # mysql error is "table '' doesn't exist"

      # if indicated NOT to create table if it doesnt exist
      if (! $create_of{ident $new_object} ) {
        # croak with reason
        croak $@;
      }

      # create table (in an eval)
      eval {
        $dbh->do( _build_query('ddl',$temp_arg) ) or die $dbh->errstr;
        $dbh->commit;
      };
      # if create fails
      if($@ ne '') {
        # croak with reason
        croak "could not create stats table: $@";
      }
    }
    else {
      # croak with reason
      croak "could not access stats table: $@";
    }
  }

  # set stats table as attribute
  $table_of{ident $new_object} = $temp_arg;

  # if history doesnt exist or is undefined
  if ( ! exists $args->{'-history'} || ! defined $args->{'-history'} ) {
    # default to zero
    $args->{'-history'} = 0;
  }

  # if parsing of timespan returns undefined
  $temp_arg = _timespan_parse( $args->{'-history'} );
  if ( ! defined $temp_arg ) {
    # croak on invalid duration (not zero, not timespan as defined in the docs)
    croak "invalid history attribute, must be zero or valid duration (see docs)";
  }

  # set truncate mode as attribute
  $history_of{ident $new_object} = $temp_arg;

  # if truncate is not provided or undefined
  if ( ! exists $args->{'-truncate'} || ! defined $args->{'-truncate'}) {
    # default to zero (false)
    $args->{'-truncate'} = 0;
  }

  # if not zero (false)
  $temp_arg = $args->{'-truncate'};
  if ( $temp_arg != 0 ) {
    # set to one (true)
    $temp_arg = 1;
  }

  # set truncate mode as attribute
  $truncate_of{ident $new_object} = $temp_arg;

  return $new_object;
}

# load logfile and build data structure
sub process {
  my ($self) = @_;

  # if no logfile was defined
  if ( !defined $logfile_of{ident $self} ) {
    # croak with error
    croak "process method called without supplying a logfile";
  }

  # make local copies of relevant attributes to save some expensive hash accesses
  my $logfile = $logfile_of{ident $self};
  my $tempfile = $tempfile_of{ident $self};

  # put temp file into binary mode and seek to start of file
  binmode $tempfile;
  seek $tempfile, 0, 0;

  # if logfile attribute is a scalar reference
  if(ref $logfile eq 'SCALAR') {
    # assume it's a ref to the file *content*, and write to temp file
    print { $tempfile } $logfile;
  }
  # if logfile attribute is a filehandle reference
  elsif(ref $logfile eq 'GLOB') {
    # put into binary mode and seek to start of filehandle (just in case)
    binmode $logfile;
    seek $logfile, 0, 0;

    # copy directly from one filehandle to another
    if ( copy($logfile, $tempfile) != 1 ) {
      # croak if copy fails for any reason
      croak "copy of logfile failed: $!"
    }
  }
  # if logfile attribute is (presumably) scalar value
  else {
    # check that file actually exists in filesystem
    if (! -e $logfile) {
      croak "logfile '$logfile' does not exist"
    }

    # copy logfile overwriting temp file
    if ( copy($logfile, $tempfile) != 1 ) {
      # croak if copy fails for any reason
      croak "copy of logfile failed: $!"
    }
  }

  # if source log is to be truncated
  if ( $truncate_of{ident $self} == 1 ) {
    # if logfile is scalar reference
    if (ref $logfile eq 'SCALAR') {
      # truncate referenced scalar to an empty string
      ${$logfile} = "";
    }
    # if filehandle reference
    elsif (ref $logfile eq 'GLOB') {
      # truncate filehandle to zero bytes (trapping potential errors)
      my $return_val = 0;
      eval { $return_val = truncate $logfile, 0; };

      # if truncate failed on error, croak with eval error
      if ( $@ ne '' ) {
        croak "truncate failed: $@"
      }

      # otherwise, if truncate didnt return true, croak with error
      if (! $return_val) {
        croak "truncate failed: $!";
      }
    }
    # if (presumably) scalar value
    else {
      # open for destructive write, and immediately close
      open my $trunc_file, '>', $logfile or carp "couldnt open logfile for truncation: $!";
      close $trunc_file;
    }
  }

  # if non-zero history duration...
  my $duration = $history_of{ident $self};
  my $dbh = $dbh_of{ident $self};
  if ( $duration != 0 ) {
    # remove any expired history records
    eval {
      $dbh->do(
        _build_query('remove_expired',$table_of{ident $self}),
        undef,
        $duration
      ) or croak $dbh->errstr;
      $dbh->commit or croak $dbh->errstr;
    };

    # if delete failed
    if ( $@ ne '' ) {
      # croak with reason
      croak "deletion of outdated records failed: $@";
    }
  }

  # seek to start of file and turn off binary mode
  seek $tempfile, 0, 0;
  binmode $tempfile, ':crlf';

  # loop through temp file, line by line
  my(%session, $team);
  while( my $line = <$tempfile> )
  {
    # if start of a new map, reset team variable
    if ( $line =~ m/] \*+? Results for Map/i ) {
      $team = 0;
    }

    # if team entry found, set team
    if ( $line =~ m/] Team: Team (\d)/i ) {
      $team = $1;
    }

    # if player entry found, set timestamp, player, and uid
    if ( $line =~ m/\[(.+?)] Player: ([^ ]+) \(uid: (.+?)\)/i ) {
      $session{'timestamp'} = $1;
      $session{'player'} = $2;
      $session{'uid'} = $3;

      # adapt timestamp to a SQL-compatible date/time string
      $session{'timestamp'} =~ s/\A\w+ (\w+) (\d+) ([\d:]+) (\d+)\z/$4-$Games::FEAR::Log::_MONTHS{$1}-$2 $3/;
    }

    # for every stat found, set corresponding stat
    foreach my $stat ( 'score', 'kills', 'deaths', 'suicides', 'team kills' ) {
      if ( $line =~ m/] $stat: (\d+)/i ) {
        $session{$stat} = $1;
        last;
      }
    }

    # if final stat of an entry found...
    if( $line =~ m/] objective: (\d+)/i ) {
      # finalize session stats hash
      $session{'objective'} = $1;
      $session{'team'} = $team;

      # select to see if this record already exists
      my $count = 0;
      eval {
        ($count) = $dbh->selectrow_array(
          _build_query('test_dml', $table_of{ident $self}),
          $session{'timestamp'},
          $session{'uid'},
        ) or croak $dbh->errstr;
      };

      # if select indicates record doesnt exist
      if($count < 1) {

        # insert into database, trapping in an eval
        eval {
          $dbh->do(
            _build_query('dml', $table_of{ident $self}),
            $session{'timestamp'},
            $session{'uid'},
            $session{'player'},
            $session{'team'},
            $session{'score'},
            $session{'kills'},
            $session{'deaths'},
            $session{'teamkills'},
            $session{'suicides'},
            $session{'objective'}
          ) or croak $dbh->errstr;
        };

        # if error during insert
        if ($@ ne '') {
          # croak with reason
          croak "an error occurred inserting records: $@";
        }

      }

      # clear session hash
      %session = ();
    }
  }

  # commit changes made, trapping in an eval
  eval {
    $dbh->commit or croak $dbh->errstr;
  };

  # if error during commit
  if ($@ ne '') {
    # croak with reason
    croak "an error occurred committing database changes: $@";
  }

  # return true on success
  return 1;
}

sub get_uids {
  my $self = @_;

  # store dbh to save hash accesses
  my $dbh = $dbh_of{ident $self};

  # build uid column from SELECT into an array reference, trapping in an eval
  my $array_ref;
  eval {
    $array_ref = $dbh->selectcol_arrayref(
      _build_query('get_uids', $table_of{ident $self})
    );
  };

  # if error occurred during select
  if ( $@ ne '' ) {
    # croak with reason
    croak "listing of uids failed: $@";
  }

  # if nonfatal error indicated
  if ( defined $dbh->err ) {
    croak "listing of uids failed:  ", $dbh->errstr;
  }

  # return dereferenced array
  return @{$array_ref};
}

sub get_playernames {
  my $self = shift;
  my $uid = shift;

  # store dbh to save hash accesses
  my $dbh = $dbh_of{ident $self};

  # build player names for the given uid into an array reference, in order of commonality
  my $array_ref;
  eval {
    $array_ref = $dbh->selectcol_arrayref(
      _build_query('get_players', $table_of{ident $self}),
      undef,
      $uid
    );
  };

  # if error occurred during select
  if ( $@ ne '' ) {
    # croak with reason
    croak "listing of playernames failed: $@";
  }

  # if nonfatal error indicated
  if ( defined $dbh->err ) {
    croak "listing of playernames failed:  ", $dbh->errstr;
  }

  # return dereferenced array
  return @{$array_ref};
}

sub get_stats {
  my $self = shift;
  my $uid = shift;

  # store dbh to save hash accesses
  my $dbh = $dbh_of{ident $self};

  # build anonymous hash of averaged and totalled statistics
  my $hash_ref;
  eval {
    $hash_ref = $dbh->selectrow_hashref(
      _build_query('get_stats', $table_of{ident $self}),
      undef,
      $uid
    );
  };

  # if error occurred during select
  if ( $@ ne '' ) {
    # croak with reason
    croak "listing of stats failed: $@";
  }

  # if nonfatal error indicated
  if ( defined $dbh->err ) {
    croak "listing of stats failed:  ", $dbh->errstr;
  }

  # return hash reference
  return $hash_ref;
}

sub get_history {
  my $self = shift;
  my $uid = shift;

  # store dbh to save hash accesses
  my $dbh = $dbh_of{ident $self};

  # build anonymous hash of hashrefs of game records
  my $hash_ref;
  eval {
    $hash_ref = $dbh->selectall_hashref(
      _build_query('get_history', $table_of{ident $self}),
      'timestamp',
      undef,
      $uid
    );
  };

  # if error occurred during select
  if ( $@ ne '' ) {
    # croak with reason
    croak "listing of history failed: $@";
  }

  # if nonfatal error indicated
  if ( defined $dbh->err ) {
    croak "listing of history failed:  ", $dbh->errstr;
  }

  # return hash reference
  return $hash_ref;
}

sub get_game {
  my $self = shift;
  my $timestamp = shift;

  # store dbh to save hash accesses
  my $dbh = $dbh_of{ident $self};

  # build anonymous hash of hashrefs of game records
  my $hash_ref;
  eval {
    $hash_ref = $dbh->selectall_hashref(
      _build_query('get_game', $table_of{ident $self}),
      'uid',
      undef,
      $timestamp
    );
  };

  # if error occurred during select
  if ( $@ ne '' ) {
    # croak with reason
    croak "listing of games failed: $@";
  }

  # if nonfatal error indicated
  if ( defined $dbh->err ) {
    croak "listing of games failed:  ", $dbh->errstr;
  }

  # return hash reference
  return $hash_ref;
}

sub build_scoreboard {
  my $self = shift;

  my($offset,$length) = @_;

  # for each argument, use default if no value provided, or croak if invalid

  # offset to start resultset at
  $offset = 0 if ! defined $offset;
  croak "invalid offset, not a positive integer: '$offset'" if $offset !~ m/^[0-9]+$/;

  # number of records in resultset
  $length = 0 if ! defined $length;
  croak "invalid length, not a positive integer: '$length'" if $offset !~ m/^[0-9]+$/;

  # get local reference to db handle
  my $dbh = $dbh_of{ident $self};

  my $sth;
  if($length) {
    # limit
    $sth = $dbh->prepare(
      _build_query('build_scoreboard_limit', $table_of{ident $self}),
      undef,
      $length, $offset
    );
  }
  else {
    # no limit
    $sth = $dbh->prepare(
      _build_query('build_scoreboard', $table_of{ident $self})
    );
  }

  # retrieve resultset, trapping any errors in an eval
  my @rowset;
  eval {
    # execute prepared statement
    $sth->execute();

    # fetch rows as hashrefs, push to array
    my $row_ref;
    while( $row_ref = $sth->fetchrow_hashref ) {
      push @rowset, $row_ref;
    }
  };

  # get playernames for all, duplicating entries if multiple playernames found
  my @results;
  foreach my $row_ref (@rowset) {
    #
    my @players = $self->get_playernames( $row_ref->{'uid'} );

    foreach my $player (@players) {
      $row_ref->{'player'} = $player;
      push(@results, $row_ref);
    }
    $row_ref = undef;
  }
  undef @rowset;

  return @results;
}

# class destructor
sub DESTROY {
  my $self = shift;

  # close created db handle
  $dbh_of{ident $self}->disconnect;

  # deallocate inside-out object attributes
  delete $dbh_of{ident $self};
  delete $create_of{ident $self};
  delete $logfile_of{ident $self};
  delete $history_of{ident $self};
  delete $table_of{ident $self};
  delete $tempfile_of{ident $self};
  delete $truncate_of{ident $self};

  return;
}

## Public subroutines ##

sub supported_dbds {
  # return database driver names with explicit support
  return keys(%Games::FEAR::Log::_QUERIES);
}

## Utility Subroutines ##

# takes a string representing a timespan (ex: "1M" is 1 month) and returns
# a representative number of seconds
sub _timespan_parse {
  my $span = shift;

  my $span_types = join '|', keys(%Games::FEAR::Log::_SPANS);
  if ($span =~ m/\A  \+? (\d+) ($span_types)  \z/xms) {
    return $1 * $Games::FEAR::Log::_SPANS{$2};
  }
  elsif ($span eq '0') {
    return 0;
  }
  else {
    return;
  }

}

sub _build_query {
  my $queryname = shift;
  my $tablename = shift;

  #if(exists $_QUERIES{ $dbd_of{ident $self} }->{$queryname}) {
    #return join $tablename, @{ $_QUERIES{ $dbd_of{ident $self} }->{$queryname} };
  if( exists $Games::FEAR::Log::_QUERIES{ 'mysql' }->{$queryname} ) {
    return join $tablename, @{ $Games::FEAR::Log::_QUERIES{ 'mysql' }->{$queryname} };
  }
}

## Utility Variables ##

# serial month to numeric month conversion table
my %_MONTH = (
  'jan' => '01',  'feb' => '02',  'mar' => '03',  'apr' => '04',
  'may' => '05',  'jun' => '06',  'jul' => '07',  'aug' => '08',
  'sep' => '09',  'oct' => '10',  'nov' => '11',  'dec' => '12',
);

# timespan format to second format conversion table
my %_SPANS = (
  's' =>  1,           # seconds
  'm' =>  60,          # minutes
  'h' =>  60*60,       # hours
  'd' =>  60*60*24,    # days
  'M' =>  60*60*24*30, # months (roughly, 30 days specifically)
  'y' =>  60*60*24*365 # years (roughly, 365 days specifically)
);

# declare hash to store SQL queries (for definitions, see near end of file)
my %_QUERIES;

# for DBD::mysql (MySQL)
$_QUERIES{'mysql'} = {
  'ddl' => [
    'CREATE TABLE `',
    '` (
  `gametime` bigint NOT NULL,
  `uid` varchar(255) NOT NULL,
  `player` varchar(255) NOT NULL,
  `team` int(11) UNSIGNED NOT NULL,
  `score` int(11) NOT NULL,
  `kills` int(11) UNSIGNED NOT NULL,
  `deaths` int(11) UNSIGNED NOT NULL,
  `teamkills` int(11) UNSIGNED NOT NULL,
  `suicides` int(11) UNSIGNED NOT NULL,
  `objective` int(11) UNSIGNED NOT NULL,
  PRIMARY KEY(`gametime`, `uid`)
)'
  ],
  'dml' => [
    'INSERT INTO `',
    '`
  (`gametime`, `uid`, `player`, `team`, `score`, `kills`, `deaths`, `teamkills`, `suicides`, `objective`)
VALUES
  (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)'
  ],
  'test_dml' => [
    'SELECT COUNT(*) FROM `',
    '` WHERE `gametime` = ? AND `uid` = ?'
  ],
  'test_exist' => [
    'SELECT * FROM `',
    '` WHERE 1=0'
  ],
  'remove_expired' => [
    'DELETE FROM `',
    '` WHERE `gametime` < (UNIX_TIMESTAMP() - ?)'
  ],
  'get_uids' => [
    'SELECT DISTINCT `uid` FROM `',
    '` WHERE 1'
  ],
  'get_players' => [
    'SELECT `player`, COUNT(`player`) as `occurances` FROM `',
    '` WHERE `uid` = ? GROUP BY `player` ORDER BY `occurances` DESC'
  ],
  'get_stats' => [
    'SELECT COUNT(`gametime`) as `game_count`,
AVG(`score`) as `avg_score`, AVG(`kills`) as `avg_kills`,
AVG(`deaths`) as `avg_deaths`, AVG(`suicides`) as `avg_suicides`,
AVG(`teamkills`) as `avg_teamkills`, AVG(`objective`) as `avg_objective`,
SUM(`score`) as `tot_score`, SUM(`kills`) as `tot_kills`,
SUM(`deaths`) as `tot_deaths`, SUM(`suicides`) as `tot_suicides`,
SUM(`teamkills`) as `tot_teamkills`, SUM(`objective`) as `tot_objective`
FROM `',
    '` WHERE `uid` = ? LIMIT 1'
  ],
  'get_history' => [
    'SELECT `gametime`, `team`, `player`, `score`, `kills`, `deaths`, `teamkills`, `suicides`, `objective` FROM `',
    '` WHERE `uid` = ?'
  ],
  'get_game' => [
    'SELECT `uid`, `team`, `player`, `score`, `kills`, `deaths`, `teamkills`, `suicides`, `objective` FROM `',
    '` WHERE `gametime` = ?'
  ],
  'build_scoreboard' => [
    'SELECT `uid`,
ROUND(AVG(`score`)) as `avg_score`, ROUND(AVG(`kills`)) as `avg_kills`,
ROUND(AVG(`deaths`)) as `avg_deaths`, ROUND(AVG(`suicides`)) as `avg_suicides`,
ROUND(AVG(`teamkills`)) as `avg_teamkills`, ROUND(AVG(`objective`)) as `avg_objective`,
SUM(`score`) as `tot_score`, SUM(`kills`) as `tot_kills`,
SUM(`deaths`) as `tot_deaths`, SUM(`suicides`) as `tot_suicides`,
SUM(`teamkills`) as `tot_teamkills`, SUM(`objective`) as `tot_objective`
FROM `',
    '` GROUP BY `uid`'
  ],
  'build_scoreboard_limit' => [
    'SELECT `uid`,
ROUND(AVG(`score`)) as `avg_score`, ROUND(AVG(`kills`)) as `avg_kills`,
ROUND(AVG(`deaths`)) as `avg_deaths`, ROUND(AVG(`suicides`)) as `avg_suicides`,
ROUND(AVG(`teamkills`)) as `avg_teamkills`, ROUND(AVG(`objective`)) as `avg_objective`,
SUM(`score`) as `tot_score`, SUM(`kills`) as `tot_kills`,
SUM(`deaths`) as `tot_deaths`, SUM(`suicides`) as `tot_suicides`,
SUM(`teamkills`) as `tot_teamkills`, SUM(`objective`) as `tot_objective`
FROM `',
    '` GROUP BY `uid` LIMIT ? OFFSET ?'
  ],
};

# for DBD::pg (PostgreSQL)
$_QUERIES{'pg'} = {
  'ddl' => [
    'CREATE TABLE "',
    '"
(
   "gametime" integer NOT NULL,
   "uid" varchar NOT NULL,
   "player" varchar NOT NULL,
   "team" integer NOT NULL,
   "score" integer NOT NULL,
   "kills" integer NOT NULL,
   "deaths" integer NOT NULL,
   "teamkills" integer NOT NULL,
   "suicides" integer NOT NULL,
   "objective" integer NOT NULL,
   CONSTRAINT "PRIMARY" PRIMARY KEY ("gametime", "uid")
) WITHOUT OIDS'
  ],
  'dml' => [
    'INSERT INTO "',
    '"
  ("gametime", "uid", "player", "team", "score", "kills", "deaths", "teamkills", "suicides", "objective")
VALUES
  (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)'
  ],
  'test_dml' => [
    'SELECT COUNT(*) FROM `',
    '` WHERE `gametime` = ? AND `uid` = ?'
  ],
  'test_exist' => [
    'SELECT * FROM "',
    '" WHERE 1=0'
  ],
  'remove_expired' => [
    'DELETE FROM "',
    '" WHERE "gametime" < (EXTRACT(EPOCH FROM TIMESTAMP WITH TIME ZONE NOW()) - ?)'
  ],
  'get_uids' => [
    'SELECT DISTINCT "uid" FROM "',
    '" WHERE 1'
  ],
  'get_players' => [
    'SELECT "player", COUNT("player") as "occurances" FROM "',
    '" WHERE "uid" = ? GROUP BY "player" ORDER BY "occurances" DESC'
  ],
  'get_stats' => [
    'SELECT COUNT("gametime") as "game_count",
AVG("score") as "avg_score", AVG("kills") as "avg_kills",
AVG("deaths") as "avg_deaths", AVG("suicides") as "avg_suicides",
AVG("teamkills") as "avg_teamkills", AVG("objective") as "avg_objective",
SUM("score") as "tot_score", SUM("kills") as "tot_kills",
SUM("deaths") as "tot_deaths", SUM("suicides") as "tot_suicides",
SUM("teamkills") as "tot_teamkills", SUM("objective") as "tot_objective"
FROM "',
    '" WHERE "uid" = ? LIMIT 1'
  ],
  'get_history' => [
    'SELECT "gametime", "team", "player", "score", "kills", "deaths", "teamkills", "suicides", "objective" FROM "',
    '" WHERE "uid" = ?'
  ],
  'get_game' => [
    'SELECT "uid", "team", "player", "score", "kills", "deaths", "teamkills", "suicides", "objective" FROM "',
    '" WHERE "gametime" = ?'
  ],
  'build_scoreboard' => [
    'SELECT "uid",
ROUND(AVG("score")) as "avg_score", ROUND(AVG("kills")) as "avg_kills",
ROUND(AVG("deaths")) as "avg_deaths", ROUND(AVG("suicides")) as "avg_suicides",
ROUND(AVG("teamkills")) as "avg_teamkills", ROUND(AVG("objective")) as "avg_objective",
SUM("score") as "tot_score", SUM("kills") as "tot_kills",
SUM("deaths") as "tot_deaths", SUM("suicides") as "tot_suicides",
SUM("teamkills") as "tot_teamkills", SUM("objective") as "tot_objective"
FROM "',
    '" GROUP BY "uid"'
  ],
  'build_scoreboard_limit' => [
    'SELECT "uid",
ROUND(AVG("score"),0) as "avg_score", ROUND(AVG("kills"),0) as "avg_kills",
ROUND(AVG("deaths"),0) as "avg_deaths", ROUND(AVG("suicides"),0) as "avg_suicides",
ROUND(AVG("teamkills"),0) as "avg_teamkills", ROUND(AVG("objective"),0) as "avg_objective",
SUM("score") as "tot_score", SUM("kills") as "tot_kills",
SUM("deaths") as "tot_deaths", SUM("suicides") as "tot_suicides",
SUM("teamkills") as "tot_teamkills", SUM("objective") as "tot_objective"
FROM "',
    '" GROUP BY "uid" LIMIT ? OFFSET ?'
  ],
};

=head1 NAME

Games::FEAR::Log - Log analysis tool for F.E.A.R. dedicated servers

=head1 VERSION

Version 0.02

=cut

our $VERSION = '0.02';

=head1 SYNOPSIS

    use Games::FEAR::Log;

    # instantiate new object, passing a hash reference of options
    my $log_obj = Games::FEAR::Log->new( {
      # database information: a dsn, username, and password
      -dbi => [
                'DBI:mysql:database=scoreboard;host=localhost;port=3306',
                'scoreboard_admin',
                'scoreboard_password'
              ],
      # table to store info
      -table => 'deathmatch1',
      # create table if it doesnt exist
      -create => ,
      # full path to logfile
      -logfile => '/var/log/FEAR/mp_scores.log',
      # empty the source logfile after reading it
      -truncate => 1,
      # delete any records older than 30 days
      -history => '30d'
    } );

    # process log file, importing new entries
    $log_obj->process() or die 'processing failed';

    # get ID of first user
    my @uids = $log_obj->get_uids();

    # get playernames this user goes by
    my @names = $log_obj->get_playernames( $uid[0] );

    # get stats for this user
    my $stats = $log_obj->get_stats( $uid[0] );

    # get history for this user
    my $history = $log_obj->get_history( $uid[0] );
    my @gametimes = keys %{$history};

    # get information for a game played by said user
    my $game = $log_obj->get_game( $gametimes[0] );

    # get scoreboard-structured informatuon
    my @scores = build_scoreboard('player', 'asc');

=head1 DESCRIPTION

This module allows the parsing of a F.E.A.R. multiplayer server log into a
manageable database format, and provides an easy to use object-oriented
interface to access that information.  This information could then be used
to create a CGI scoreboard application, such as the one included in the
C directory.

The underlying system uses a SQL relational database to store and retrieve
game information.  Initially, this implimentation is built to use a MySQL or
PostgreSQL database, but I can add support for other database systems if
there is a demand.

Ideally, there could be two different 'pieces' to an application using this
module, an administrative interface to import new log entries into the
database, and a public interface to display and/or cross-reference already
imported information.

If performance is not a concern, however, it could be a one-piece
application where new entries are checked for and added every time the
interface is viewed.

=head1 METHODS

=head2 new()

Creates and returns a new object.  Takes a single argument, a hash reference
containing configuration options.  The available options are as follows:

=over

=item * C<-dbi>

An anonymous array of a DSN (data source name), username, and password for
connecting to the database. See the L docs for an explanation and
syntax of a DSN.  An error will be thrown if this option is not found or
invalid.

    [ 'DBI:mysql:database=test;host=localhost', 'devuser', 'devpass' ]

=item * C<-table>

Name of the database table to use for this set of statistics.  If stats are
being kept for multiple game servers, each one should have its own seperate
table.  An error will be thrown if this option is not found or invalid.

=item * C<-create>

Indicate whether the given table should be created if it does not already
exist.  A true value creates the table if necessary, while a false value
throws an error if the table doesnt exist.  The default is to create the
table.

=item * C<-logfile>

Source of the log entries.  This is not a required parameter unless you
plan on calling the C method.  If a scalar value is passed, it is
assumed to be a filename.  If a scalar reference is passed, it is assumed
to be the contents of the log, and will be dereferenced and processed.  If
a glob reference is passed, it is assumed to be an open filehandle to the
logfile (note that it should be opened for read I write operations).

=item * C<-history>

Length of time to keep records, specified in a format similar to that used
by the L module, with a numeric quantity followed by  a one-letter
unit indicator:

    86400s  # 1 day specified in seconds
    1440m   # 1 day specified in minutes
    24h     # 1 day specified in hours
    90d     # 3 months specified in days
    12M     # 1 year specified in months
    2y      # 2 years specified in years

The default is to keep them forever, and this can be specified by passing an empty or undefined scalar, or a value of zero.

=item * C<-truncate>

Indicate whether the source log should be truncated to zero bytes (and in
effect emptied).  This is useful if you are reading from a live log file
and don't want to waste resources reprocessing old log entries.  Note, of
course, that if a logfile is already locked by the server process, any
attempted writes to it will fail.  A non-zero value turns on log truncating,
and a zero value turns it off.  The default is off.

=back

=head2 process()

Truncates log file if the C option is set to true, deletes expired
records if C option is specified, and processes any new entries.
Returns 1 on success.  If a C option is not specified, an error will
be thrown.

    $log_obj->process();

=head2 get_uids()

Returns an array of all unique UIDs found in the current database table.
See the L section for an explanation of UIDs in the FEAR
server logs.

    @uids = $log_obj->get_uids();

=head2 get_playernames(UID)

Returns an array of all unique playernames found for the given UID.  They
are ordered by frequency of use.

    @names = $log_obj->get_playernames($uid);

=head2 get_stats(UID)

Returns a hash reference containing averaged and totalled stats for the
given UID.  The data structure returned is as follows:

    {
      game_count    => $game_count,
      tot_score     => $tot_score,
      avg_score     => $avg_score,
      tot_kills     => $tot_kills,
      avg_kills     => $avg_kills,
      tot_deaths    => $tot_deaths,
      avg_deaths    => $avg_deaths,
      tot_suicides  => $tot_suicides,
      avg_suicides  => $avg_suicides,
      tot_teamkills => $tot_teamkills,
      avg_teamkills => $avg_teamkills,
      tot_objective => $tot_objective,
      avg_objective => $avg_objective,
    }

=head2 get_history(UID)

Returns a hashref of hashrefs of games played by the given UID, each
keyed to the game time.  Note that C is a unix timestamp as
would be returned by the C builtin.  The data structure returned
is as follows:

    {
      $gametime => {
        gametime  => $gametime,
        team      => $team,
        player    => $player,
        score     => $score,
        kills     => $kills,
        deaths    => $deaths,
        teamkills => $teamkills,
        suicides  => $suicides,
        objective => $objective,
      },
    }

=head2 get_game(GAMETIME)

Returns a hashref of hashrefs of players in the game at the given game
time, each keyed to a UID.  Note that C is a unix timestamp as
would be returned by the C builtin.  The data structure returned
is as follows:

    {
      $uid => {
        uid       => $uid,
        team      => $team,
        player    => $player,
        score     => $score,
        kills     => $kills,
        deaths    => $deaths,
        teamkills => $teamkills,
        suicides  => $suicides,
        objective => $objective,
      }
    }

=head2 build_scoreboard(OFFSET,LENGTH)

Returns an array of hashrefs ideal for displaying a summary scoreboard.
Takes two optional arguments:

=over

=item * OFFSET

How many records into the start of a resultset to begin retrieving results,
akin to a SQL I clause.  The default is C<0>.

=item * LENGTH

How many records to retrieve from a resultset, akin to a SQL I clause.
The default is C<0> which is interpreted as 'no limit'.

=back

The data structure returned is as follows:

    (
      {
        uid           => $uid,
        player        => $player,
        avg_score     => $avg_score,
        avg_kills     => $avg_kills,
        avg_deaths    => $avg_deaths,
        avg_suicides  => $avg_suicides,
        avg_teamkills => $avg_teamkills,
        avg_objective => $avg_objective,
        tot_score     => $tot_score,
        tot_kills     => $tot_kills,
        tot_deaths    => $tot_deaths,
        tot_suicides  => $tot_suicides,
        tot_teamkills => $tot_teamkills,
        tot_objective => $tot_objective,
      }
    )

=head2 DESTROY()

The class destructor that, when called, closes the database connection
and any open filehandles, and destroys the object.

=head1 FUNCTIONS

=head2 supported_dbds()

Returns a list of the currently supported DBI drivers.  This function
can be called from an instantiated object, or directly.

    # called from an object
    @drivers = $log_object->supported_dbds();

    # called directly from the module namespace
    @drivers = Games::FEAR::Log::supported_dbds();

=head1 JARGON

Here, a few of the terms used throughout this documentation are briefly
defined.

=head2 UID

The UID found in the FEAR multiplayer log is used to uniquely identify a
user.  It is calculated as a hexadecimal
MD5 hash of their CD key.  For example, the UID for a CD key of
C would be C.

=head2 Player Name

The player name is, as it suggests, a name picked by the user and is how
they appear in-game.  It is not suitable for tracking statistics since it
can be changed at the user's discretion, so we use the UID for that purpose.

=head2 Game Time

The game time is a timestamp of precisely when a specific game ended.  By
matching up different players with the same game times, you can determine
the participants of any specific game.

=head1 DEPENDANCIES

L - Used by the test suite during C

L - Used for database connectivity

L - Used to copy log during processing

L - Used to create temp file during processing

=head1 AUTHOR

Evan Kaufman, C<<  >>

=head1 BUGS

Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.

=head1 ACKNOWLEDGEMENTS

The fine folks at PerlMonks.org, always willing to lend a helping hand to a
struggling programmer.

=head1 COPYRIGHT

Copyright 2007 Evan Kaufman, all rights reserved.

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

}
1; # End of Games::FEAR::Log