#! /usr/bin/perl # # cod_stat.pl - simple statistics generator for Call of Duty (and MoHAA?) # Copyright (C) 2005 Tommi Saviranta (tsaviran@cs.helsinki.fi) # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # # Version: smer v0.2.10 16-Jan-2005 tsaviran@cs.helsinki.fi use strict; use warnings FATAL => 'all'; my @gametypes; my $script_name = "cod_stat.pl"; # script name my $script_revision = "0.2.10"; # revision my $host = "foobar64 (katei.dyndns.org)"; # server name # following two values define who to list "in full" on player list my $min_gametime = 10; # minumun time played my $min_games = 5; # minumun games played my $played_games_number = 16; # list up to 16 latest games my $suicide_penalty = 0.2; # not used :-) my ($time, $min, $sec, $action); my @stuff; my ($type, $tmp); my $free_id = 0; my $game_id = 0; my (@played_game_id, @played_map, @played_players, @played_gametype); my $played_index = 0; my %server_restarted; # Rounds when server was restarted my $had_game = 1; # Prevents empty sessions my %players_id_name; # {id} => name my %players_name_id; # {name} => id (aliases, too) my (%players_rating, %players_rating_change); my (%players_games); # games played by player my (%kills, %deaths, %suicides); # kills/deaths/suicides statistic my (%played_time, %played_games); # map/gametype time/games statistics my (%hit_by_weapon, %hit_by_location); my %current_players; # list of current players (true_id) # value is join-time or -1 is not # with us anymore my @current_player_id; # [game_id] = true_id (track aliases) my @current_player_name; # [game_id] = name my %current_player_id_reverse; # true_id => game_id my %current_player_team; # {true_id} = team_no;team_no;team_no my %current_score; # {true_id} = player_score my %current_teams; # {team_id} = "1": available teams my ($current_map, $current_gametype); # map/gametype being played my (%current_kills, %current_deaths, %current_suicides); my %current_played_time; # playtime per round per user my ($first_blood, %current_spree, %best_spree, %spree_end_reason); my %known_maps; # known maps my %known_weapons; # known weapons my %known_locations; # known locations my @known_gametypes; # known gametypes @known_gametypes = ( "dm", "tdm", "bel", "hq", "sd", "re" ); my %translation; $translation{"dm"} = "Deathmatch"; $translation{"tdm"} = "Team Deathmatch"; $translation{"bel"} = "Behind Enemy Lines"; $translation{"hq"} = "Headquarters"; $translation{"sd"} = "Search & Destroy"; $translation{"re"} = "Retrieval"; $translation{"head"} = "Head"; $translation{"helmet"} = "Helmet"; $translation{"neck"} = "Neck"; $translation{"torso_upper"} = "Torso (upper)"; $translation{"torso_lower"} = "Torso (lower)"; $translation{"left_arm_upper"} = "Left arm (upper)"; $translation{"left_arm_lower"} = "Left arm (lower)"; $translation{"left_hand"} = "Left hand"; $translation{"right_arm_upper"} = "Right arm (upper)"; $translation{"right_arm_lower"} = "Right arm (lower)"; $translation{"right_hand"} = "Right hand"; $translation{"left_leg_upper"} = "Left leg (upper)"; $translation{"left_leg_lower"} = "Left leg (lower)"; $translation{"left_foot"} = "Left foot"; $translation{"right_leg_upper"} = "Right leg (upper)"; $translation{"right_leg_lower"} = "Right leg (lower)"; $translation{"right_foot"} = "Right foot"; $translation{"none"} = "Explosion/Fall/Bloodloss etc."; $translation{"rgd-33russianfrag_mp"} = "RGD-33 (Russian frag grenade)"; $translation{"mosin_nagant_mp"} = "Mosin Nagant"; $translation{"thompson_mp"} = "Thompson"; $translation{"colt_mp"} = "Colt"; $translation{"bar_slow_mp"} = "BAR (slow)"; $translation{"fraggrenade_mp"} = "Fragmentation grenade"; $translation{"kar98k_sniper_mp"} = "KR-98 k (Sniper)"; $translation{"mp44_mp"} = "MP-44"; $translation{"sten_mp"} = "Sten"; $translation{"mp40_mp"} = "MP-40"; $translation{"springfield_mp"} = "Springfield"; $translation{"panzerfaust_mp"} = "Panzerfaust"; $translation{"mosin_nagant_sniper_mp"} = "Mosin Nagant (Sniper)"; $translation{"enfield_mp"} = "Enfield"; $translation{"m1carbine_mp"} = "M-1 Carbine"; $translation{"bren_mp"} = "Bren"; $translation{"mk1britishfrag_mp"} = "MK-1 (British frag grenade)"; $translation{"kar98k_mp"} = "KAR-98 k"; $translation{"bar_mp"} = "BAR"; $translation{"ppsh_mp"} = "PPSH"; $translation{"stielhandgranate_mp"} = "Stielhandgranate"; $translation{"m1garand_mp"} = "M-1 Garand"; $translation{"luger_mp"} = "Luger"; $translation{"mg42_bipod_stand_mp"} = "MG-42 (Bipod stand)"; while () { s/\^+\d+//g; tr/$%@/s\-+/; next if (/^$/); ($min, $sec, $action) = /\s*(\d+):(\d+)\s+(.*)/; $time = $min * 60 + $sec; @stuff = split(/;/, $action); $type = $stuff[0]; if ($type eq "D") { # damage &parse_damage($time, @stuff); } elsif ($type eq "K") { # kill &parse_kill($time, @stuff); } elsif ($type eq "say") { # say &parse_say($time, @stuff); } elsif ($type eq "sayteam") { # sayteam &parse_sayteam($time, @stuff); } elsif ($type eq "J") { # join &parse_join($time, @stuff); } elsif ($type eq "Q") { # quit &parse_quit($time, @stuff); } elsif ($type eq "W") { # win &parse_win($time, @stuff); } elsif ($type eq "L") { # lose &parse_lose($time, @stuff); } elsif ($type eq "A") { # action &parse_action($time, @stuff); } elsif ($type eq "Weapon") { # collect weapon? XXX } elsif ($type eq "Item") { # collect item } elsif ($type =~ /^----/) { # separator } elsif ($type =~ /^ExitLevel/) { # end map &parse_end_game($time); } elsif ($type =~ /^InitGame/) { # new map ($tmp) = $action =~ /.*?: (.*)/; &parse_init_game($time, $tmp); } elsif ($type =~ /^Shutdown/) { # server shutdown &parse_end_game($time); } elsif ($type =~ /^RestartGame/) { # game restart &parse_end_game($time); } else { print "Unknown action/line: '$action'\n"; } } &create_statistics(); &create_basefiles(); sub parse_init_game { my ($time); my @stuff; undef @current_player_id; undef @current_player_name; undef %current_player_id_reverse; undef %current_players; undef %current_player_team; undef %current_score; undef %current_kills; undef %current_deaths; undef %current_suicides; undef %current_played_time; undef $first_blood; undef %current_spree; undef %best_spree; undef %spree_end_reason; $time = $_[0]; @stuff = split(/\\/, $_[1]); $current_gametype = &get_field("g_gametype", @stuff); $current_map = &get_field("mapname", @stuff); if ($time == 0 && $had_game == 1) { $server_restarted{$game_id} = 1; $had_game = 0; } $played_time{"\n\n$current_gametype"} = $time; $played_time{"\n\n$current_map"} = $time; $known_maps{"$current_map"} = 1; $current_kills{"\n"} = 0; } sub get_field { my $i; for ($i = 1; $i <= $#_ - 1; $i++) { if ($_[$i] eq $_[0]) { return $_[$i + 1]; } } return ""; } sub parse_end_game { my ($time); my ($pl_id, $op_id); my %player_op; my $t = 0; my $sanity = 0; return if (! defined($current_map)); return if ($current_kills{"\n"} == 0); $played_game_id[$played_index] = $game_id; $played_map[$played_index] = $current_map; $played_gametype[$played_index] = $current_gametype; $played_players[$played_index] = (keys %current_players) + 1; $played_index++; $time = $_[0]; $played_games{"\n\n$current_gametype"}++; $played_games{"\n\n$current_map"}++; print "#-# game $game_id\n"; # Per-player statistics foreach $pl_id (keys %current_players) { # Count played time &count_player_time($pl_id, $time); # Count played games $played_games{"gt\n$current_gametype\n$pl_id"}++; $played_games{"mn\n$current_map\n$pl_id"}++; { my ($pl_rating, $op_rating); my ($pl_kills, $op_kills); my ($pl_suicides); my ($pl_e, $op_e); my ($pl_s, $op_s); $pl_e = 0; $pl_s = 0; $pl_rating = $players_rating{"$pl_id\n$current_gametype"}; foreach $op_id (keys %current_players) { my ($ts, $te); # TODO don't count players on my side next if ($op_id == $pl_id); $op_rating = $players_rating{ "$op_id\n$current_gametype"}; $pl_kills = $current_kills{"$pl_id\n$op_id"}; $op_kills = $current_kills{"$op_id\n$pl_id"}; $pl_kills = 0 if (! defined($pl_kills)); $op_kills = 0 if (! defined($op_kills)); $pl_suicides = $current_suicides{$pl_id}; $pl_suicides = 0 if (! defined($pl_suicides)); $ts = $pl_kills * $op_rating; $op_s = $op_kills * $pl_rating; $players_rating_change{$pl_id} += ($ts - $op_s) / $pl_rating; } } } foreach $pl_id (keys %current_players) { $t = $players_rating_change{$pl_id}; $players_rating{"$pl_id\n$current_gametype"} += $t if (defined($t)); } # Count server time/games statistics $played_time{"\n$current_gametype"} += ($time - $played_time{"\n\n$current_gametype"}); $played_time{"\n$current_map"} += ($time - $played_time{"\n\n$current_map"}); &create_per_match_statistics(); undef($current_map); } sub parse_join { my ($time, $player, $id, $team, $save_id); my $true_id; $time = $_[0]; $team = $_[1]; if ($#_ == 4) { $player = $_[4]; $id = $_[3]; } else { $player = $_[3]; $id = $_[2]; } $true_id = &init_new_player($player); $players_games{$true_id} .= "$game_id," if (! ($players_games{$true_id} =~ /$game_id,$/)); $current_player_id[$id] = $true_id; $current_player_id_reverse{$true_id} = $id; $current_player_name[$id] = $player; $current_player_team{$true_id} = ";;"; $current_players{$true_id} = $time; $current_spree{$true_id} = 0; $best_spree{$true_id} = 0; $current_score{$true_id} = 0; $players_rating_change{$true_id} = 0; } sub init_new_player { my $player = $_[0]; my $gt; if (! defined($players_name_id{$player})) { $players_id_name{$free_id} = $player; $players_name_id{$player} = $free_id; foreach my $t (@known_gametypes) { $players_rating{"$free_id\n$t"} = 100; } $players_games{$free_id} = ""; $kills{$free_id} = 0; $deaths{$free_id} = 0; $suicides{$free_id} = 0; for $gt (@known_gametypes) { $kills{"\n$gt\n$free_id"} = 0; $deaths{"\n$gt\n$free_id"} = 0; $suicides{"\n$gt\n$free_id"} = 0; $played_time{"gt\n$gt\n$free_id"} = 0; $played_games{"gt\n$gt\n$free_id"} = 0; } $free_id++; return $free_id - 1; } else { return $players_name_id{$player}; } } sub parse_quit { my ($time, $player, $id); my $true_id; my $t; $time = $_[0]; if ($#_ == 4) { $player = $_[4]; $id = $_[3]; } else { $player = $_[3]; $id = $_[2]; } &track_aliases($id, $player); $true_id = $current_player_id[$id]; if (defined($true_id)) { &count_player_time($true_id, $time); $current_players{$true_id} = -1; } else { # print STDERR "$time: $player ($id)" # ." parts game he never joined!\n"; } } sub count_player_time { my ($true_id, $time); my $addtime; $true_id = $_[0]; $time = $_[1]; if ($current_players{$true_id} != -1) { $addtime = $time - $current_players{$true_id}; $played_time{"gt\n$current_gametype\n$true_id"} += $addtime; $played_time{"mn\n$current_map\n$true_id"} += $addtime; $current_played_time{$true_id} += $addtime; } } sub parse_win { # print "@_\n"; } sub parse_lose { # print "@_\n"; } sub parse_say { # print "@_\n"; } sub parse_sayteam { # print "@_\n"; } sub parse_damage { my ($attacker, $attackee, $attacker_id, $attackee_id); my ($attacker_true_id, $attackee_true_id); my ($weapon, $damage_type, $damage_location); my ($attacker_team, $attackee_team); if ($#_ == 13) { $attacker = $_[9]; $attacker_id = $_[7]; $attackee = $_[5]; $attackee_id = $_[3]; $weapon = $_[10]; $damage_type = $_[12]; $damage_location = $_[13]; $attacker_team = $_[8]; $attackee_team = $_[4]; } else { $attacker = $_[7]; $attacker_id = $_[5]; $attackee = $_[4]; $attackee_id = $_[2]; $weapon = $_[8]; $damage_type = $_[10]; $damage_location = $_[11]; $attacker_team = $_[6]; $attackee_team = $_[3]; } $attacker_true_id = $current_player_id[$attacker_id]; $attackee_true_id = $current_player_id[$attackee_id]; $current_player_team{$attacker_true_id} .= "$attacker_team;"; $current_player_team{$attackee_true_id} .= "$attackee_team;"; $current_teams{$attacker_team} = "1"; $current_teams{$attackee_team} = "1"; &track_aliases($attacker_id, $attacker); if (defined($attacker_true_id)) { # print "$_[0]: $attacker hitted $attackee $damage damage" # . " to $damage_location with $weapon\n"; } else { # print "$_[0]: $attackee hurt him/herself\n"; } &count_damage("D", $weapon, $damage_location, $attacker_true_id, $attackee_true_id); } sub parse_kill { my ($attacker_true_id, $attackee_true_id); my ($attacker, $attackee, $attacker_id, $attackee_id); my ($weapon, $damage_type, $damage_location); my ($attacker_team, $attackee_team); if ($#_ == 13) { $attacker = $_[9]; $attacker_id = $_[7]; $attackee = $_[5]; $attackee_id = $_[3]; $weapon = $_[10]; $damage_type = $_[12]; $damage_location = $_[13]; $attacker_team = $_[8]; $attackee_team = $_[4]; } else { $attacker = $_[7]; $attacker_id = $_[5]; $attackee = $_[4]; $attackee_id = $_[2]; $weapon = $_[8]; $damage_type = $_[10]; $damage_location = $_[11]; $attacker_team = $_[6]; $attackee_team = $_[3]; } $attacker_true_id = $current_player_id[$attacker_id]; $attackee_true_id = $current_player_id[$attackee_id]; &track_aliases($attacker_id, $attacker); $current_player_team{$attacker_true_id} .= "$attacker_team;"; $current_player_team{$attackee_true_id} .= "$attackee_team;"; $current_teams{$attacker_team} = "1"; $current_teams{$attackee_team} = "1"; if ($attacker_id != $attackee_id) { # print "$_[0]: $attacker killed $attackee with $weapon\n"; $kills{$attacker_true_id}++; $kills{"\n$current_gametype\n$attacker_true_id"}++; $current_score{$attacker_true_id}++; # FIXME $current_kills{"$attacker_true_id\n$attackee_true_id"}++; $current_kills{$attacker_true_id}++; $current_kills{"\n"}++; $first_blood = $attacker_id if (! defined($first_blood)); &update_spree($attacker_true_id, 1); &update_spree($attackee_true_id, 0, "\n$attacker_true_id\n$weapon"); } else { # print "$_[0]: $attackee killed him/herself\n"; $current_kills{"$attackee_true_id\n$attackee_true_id"}++; $current_suicides{$attackee_true_id}++; &update_spree($attackee_true_id, 0, "Suicide with " . $translation{$weapon}); } $deaths{$attackee_true_id}++; $deaths{"\n$current_gametype\n$attackee_true_id"}++; $current_deaths{$attackee_true_id}++; &count_damage("K", $weapon, $damage_location, $attacker_true_id, $attackee_true_id); $kills{"\n"}++; } sub update_spree { my $player = $_[0]; my $action = $_[1]; my $reason = $_[2]; my ($best, $current); $best = $best_spree{$player}; $current = $current_spree{$player}; if ($action == 0) { if ($current > $best) { $best_spree{$player} = $current; $spree_end_reason{$player} = $reason; } $current_spree{$player} = 0; } else { $current_spree{$player} += $action; } } sub count_damage { my ($weapon, $location, $attacker, $attackee); my $type; $type = $_[0]; $weapon = $_[1]; $location = $_[2]; $attacker = $_[3]; $attackee = $_[4]; $hit_by_weapon{$weapon}++; $hit_by_location{$location}++; $known_weapons{$weapon} = 1 if (! defined($known_weapons{$weapon})); $known_locations{$location} = 1 if (! defined($known_locations{$location})); if ($attacker != $attackee) { if ($type eq "K") { $kills{"\n\n$weapon\n$attacker"}++; $deaths{"\n\n$weapon\n$attackee"}++; } $hit_by_weapon{"\n$weapon\nd\n$attacker"}++; $hit_by_location{"\n$location\nd\n$attacker"}++; } else { if ($type eq "K") { $suicides{$attackee}++; $suicides{"\n\n$weapon\n$attackee"}++; $suicides{"\n$current_gametype\n$attackee"}++; } } $hit_by_weapon{"\n$weapon\nr\n$attackee"}++; $hit_by_location{"\n$location\nr\n$attackee"}++; } sub parse_action { # print "@_\n"; } sub create_statistics { my ($key, $true_id); my ($player, $player_id); my ($p_kills, $p_deaths, $p_suicides, $p_eff); my ($p_avg_kph, $p_avg_ttl); my ($p_matches, $p_rating, $p_time); my $t; my @rest_of_them; open(TFILE, "> players.html") or die "Can't create file players.html"; print TFILE &get_html_head(); # Rating print TFILE <Players EOF ; my $gametype; my @players_sorted; foreach $player_id (keys %players_id_name) { push(@players_sorted, $player_id); } @players_sorted = &sort_players_by_name(@players_sorted); foreach $true_id (@players_sorted) { $player = $players_id_name{$true_id}; $player_id = $true_id; &create_player_statistics($true_id); $p_kills = $kills{$true_id}; $p_deaths = $deaths{$true_id}; $p_suicides = $suicides{$true_id}; $p_matches = 0; $p_time = 0; foreach $gametype (@known_gametypes) { $p_matches += $played_games{"gt\n$gametype\n$true_id"}; $p_time += $played_time{"gt\n$gametype\n$true_id"}; } $p_time = 1 if ($p_time == 0); if ($p_time >= $min_gametime * 60 && $p_matches >= $min_games) { $p_eff = &count_efficiency($p_kills, $p_deaths, $p_suicides, 0); $p_avg_kph = &count_avg_per_time($p_kills, $p_time / 3600); $p_avg_ttl = &count_avg_per_time($p_time, $p_deaths + $p_matches); $p_time = &format_seconds_to_time($p_time); # $p_rating = &round($players_rating{$true_id}, 2); # print TFILE < EOF ; } else { push(@rest_of_them, $player_id); } } print TFILE "
Player Name Matches Kills Deaths Suicides Eff. % KPH Avg. TTL Time
$p_rating$player $p_matches $p_kills $p_deaths $p_suicides $p_eff $p_avg_kph $p_avg_ttl $p_time
\n"; print TFILE "

Players with less than $min_games matches played" . " (and less than $min_gametime minutes of" . " gametime)

\n"; print TFILE "
"; foreach $player_id (@rest_of_them) { $player = $players_id_name{$player_id}; print TFILE "/ $player "; } print TFILE "
\n"; print TFILE < EOF ; close(TFILE); } sub create_player_statistics { my ($player, $player_id); my ($p_gametype, $p_score); my ($p_kills, $p_deaths, $p_suicides, $p_teamkills); my ($p_eff, $p_avg_kph, $p_avg_ttl, $p_matches, $p_time); my ($p_rating); my ($p_weapon, $p_hit_dealt, $p_hit_recvd, $p_hit_ratio); my ($p_location); my $t; $player_id = $_[0]; $player = $players_id_name{$player_id}; open(PFILE, "> player_$player_id.html") or die "Can't create file!"; # Create career summary # FIXME -- see html -- have frags instead of score print PFILE &get_html_head("for $player"); print PFILE <Career Summary for $player EOF ; foreach $t (@known_gametypes) { $p_kills = $kills{"\n$t\n$player_id"}; $p_deaths = $deaths{"\n$t\n$player_id"}; $p_suicides = $suicides{"\n$t\n$player_id"}; $p_teamkills = 0; $p_score = $p_kills - $p_deaths - $p_teamkills; # TODO $p_eff = &count_efficiency($p_kills, $p_deaths, $p_suicides, $p_teamkills); $p_time = $played_time{"gt\n$t\n$player_id"}; $p_avg_kph = &count_avg_per_time($p_kills, $p_time / 3600); $p_matches = $played_games{"gt\n$t\n$player_id"}; $p_avg_ttl = &count_avg_per_time($p_time, $p_deaths + $p_matches); $p_time = &format_seconds_to_time($p_time); $p_gametype = $translation{$t}; $p_rating = &round($players_rating{"$player_id\n$t"}, 2); print PFILE < EOF ; } print PFILE "
Game Type Rating Frags K D S TK Eff. % Avg. KPH Avg. TTL Matches Time
$p_gametype $p_rating $p_score $p_kills $p_deaths $p_suicides $p_teamkills $p_eff $p_avg_kph $p_avg_ttl $p_matches $p_time
\n"; print PFILE <Weapon Specific Totals EOF ; foreach $p_weapon (keys %known_weapons) { $p_kills = $kills{"\n\n$p_weapon\n$player_id"}; $p_kills = 0 if (! defined($p_kills)); $p_deaths = $deaths{"\n\n$p_weapon\n$player_id"}; $p_deaths = 0 if (! defined($p_deaths)); $p_suicides = $suicides{"\n\n$p_weapon\n$player_id"}; $p_suicides = 0 if (! defined($p_suicides)); next if ($p_kills == 0 && $p_deaths == 0 && $p_suicides == 0); $p_eff = &count_efficiency($p_kills, $p_deaths, $p_suicides, 0); $p_hit_dealt = $hit_by_weapon{"\n$p_weapon\nd\n$player_id"}; $p_hit_dealt = 0 if (! defined($p_hit_dealt)); $p_hit_recvd = $hit_by_weapon{"\n$p_weapon\nr\n$player_id"}; $p_hit_recvd = 0 if (! defined($p_hit_recvd)); $p_hit_ratio = &format_ratio($p_hit_dealt, $p_hit_recvd); print PFILE < EOF ; } print PFILE "
Weapon Kills Deaths Suicides Eff. % Hit Recvd hit Hit ratio
$translation{$p_weapon} $p_kills $p_deaths $p_suicides $p_eff $p_hit_dealt $p_hit_recvd $p_hit_ratio
\n"; print PFILE <Damage Location Totals EOF ; foreach $p_location (keys %known_locations) { $p_hit_dealt = $hit_by_location{"\n$p_location\nd\n$player_id"}; $p_hit_dealt = 0 if (! defined($p_hit_dealt)); $p_hit_recvd = $hit_by_location{"\n$p_location\nr\n$player_id"}; $p_hit_recvd = 0 if (! defined($p_hit_recvd)); $p_hit_ratio = &format_ratio($p_hit_dealt, $p_hit_recvd); next if ($p_hit_dealt == 0 && $p_hit_recvd == 0); print PFILE < EOF ; } print PFILE "
Location Hit Recvd hit Hit ratio
$translation{$p_location} $p_hit_dealt $p_hit_recvd $p_hit_ratio
\n"; { my @games; my $game_id; print PFILE "

Played games

\n"; print PFILE "
\n"; foreach $game_id (split(/,/, $players_games{$player_id})) { print PFILE "$game_id / "; } print PFILE "\n
\n"; } print PFILE &get_html_tail(); close(PFILE); } sub count_efficiency { my $e; # efficiency my $k = $_[0]; # kills my $d = $_[1]; # deaths my $s = $_[2]; # suicides my $tk = defined($_[3]) ? $_[3] : 0; # teamkills if ($k != 0) { $e = $k / ($k + $d + $s + $tk) * 100; if ($e == int($e)) { $e = "$e.0"; } else { $e =~ s/(\d+\.\d).*/$1/; } } else { $e = "0.0"; } return $e; } sub count_avg_per_time { my $a; # average my $count = $_[0]; # count (kills) my $time = $_[1]; # time (hours) if ($time != 0) { $a = "" . ($count / $time) . ".0"; $a =~ s/(\d*\.\d).*/$1/; } else { $a = "0:00"; } return $a; } sub format_seconds_to_time { my $t; if (0 == 1) { my $time = $_[0]; $t = $time / 60 + 0.5; $t = "00" . (int($t % 60)); $t =~ s/.*(..)/$1/; $t = "" . (int($time / 3600)) . ":$t"; } else { my ($h, $m, $s); my $time = $_[0]; $s = $time % 60; $m = int($time / 60) % 60; $h = int($time / 3600); $t = ""; $t = "$h" if ($h > 0); $t .= " $m'" if ($m > 0 || $h > 0); $t .= " $s''" if ($s > 0 || $m > 0 || $h > 0); } return $t; } sub get_html_head { my $ext = defined($_[0]) ? " $_[0]" : ""; my $body = $ext eq " nobody" ? "" : ""; my $r = " Call of Duty statistics at $host$ext $body "; return $r; } sub get_html_tail { my $r = " "; return $r; } sub create_basefiles { my $t; open(FILE, "> index.html") or die "Can't create index.html"; print FILE &get_html_head(); print FILE <$script_name $script_revision (and constantly improving)

Recent matches

EOF ; { my $i; my $c = $game_id > $played_games_number ? $played_games_number : $game_id; print FILE "
\n"; for ($i = $game_id - $c; $i < $game_id; $i++) { print FILE "
\n" if (defined($server_restarted{$i}) && $i != $game_id - $c); print FILE &create_game_link($i); } print FILE "
\n"; } print FILE <Few words about the statistics
cod_stat.pl is simple Perl-script for generating statistics for private Call of Duty server. Generated figures shouldn't be taken too seriously -- especially rating score. Rating was originally based on ELO rating system but due to incompetence of the author to implement the algorithm in multiplayer game it was replaced with an experimental ranking system. Even though it might look like it, algorithm is not designed to make author's ranking look better.
EOF ; print FILE &get_html_tail(); close(FILE); { # players_h.html open(FILE, "> players_h.html") or die "Can't create players_h.html"; print FILE &get_html_head("nobody"); print FILE < <div class="text"> This page requires frames -- you can view only one player at a time. <ul> <li><a href="players.html">Player statistics</a></li> <li><a href="index.html">Main page</a></li> </ul> </div> EOF ; close(FILE); } { # players_v.html open(FILE, "> players_v.html") or die "Can't create players_v.html"; print FILE &get_html_head("nobody"); print FILE < <div class="text"> This page requires frames -- you can view only one player at a time. <ul> <li><a href="players.html">Player statistics</a></li> <li><a href="index.html">Main page</a></li> </ul> </div> EOF ; close(FILE); } { # players_c*.html for ($t = 1; $t < 4; $t++) { open(FILE, ">players_c$t.html") or die "Can't create players_c$t.html"; print FILE &get_html_head(); print FILE <switch main
s
w
i
t
c
h
 
m
a
i
n EOF ; print FILE &get_html_tail("plain"); close(FILE); } } { # players_sel.html my ($player, $player_id, $i); my @players_sorted; open(FILE, ">players_sel.html") or die "Can't create players_sel.html"; print FILE &get_html_head(" (player selection)"); print FILE "
\n"; foreach $player_id (keys %players_id_name) { push(@players_sorted, $player_id); } @players_sorted = &sort_players_by_name(@players_sorted); for ($i = 0; $i <= $#players_sorted; $i++) { $t = $players_sorted[$i]; print FILE "" . "$players_id_name{$t}
\n"; } print FILE "
\n"; print FILE &get_html_tail("plain"); close(FILE); } { # games.html my $i; open(FILE, "> games.html") or die "Can't create games.html"; print FILE &get_html_head(); print FILE <Hosted games
EOF ; for ($i = 0; $i < $game_id; $i++) { print FILE "
\n" if (defined($server_restarted{$i}) && $i != 0); print FILE &create_game_link($i); } print FILE "
\n"; print FILE &get_html_tail(); close(FILE); } } sub create_game_link { my $game_id = $_[0]; return "Game " . ($game_id) . ": " . $translation{$played_gametype[$game_id]} . " game in $played_map[$game_id] with" . " $played_players[$game_id] players
\n"; } sub sort_players_by_name { my @names; my @sorted; my ($i, $j); my ($small, $small_index); for ($i = 0; $i <= $#_; $i++) { $names[$_[$i]] = $players_id_name{$_[$i]}; $sorted[$i] = $_[$i]; } for ($i = 0; $i <= $#sorted - 1; $i++) { $small = $names[$sorted[$i]]; $small_index = $i; for ($j = $i + 1; $j <= $#sorted; $j++) { if ($names[$sorted[$j]] lt $small) { $small = $names[$sorted[$j]]; $small_index = $j; } } if ($small_index != $i) { my $t; $t = $sorted[$i]; $sorted[$i] = $sorted[$small_index]; $sorted[$small_index] = $t; } } return @sorted; } sub format_ratio { my $a = $_[0]; my $b = $_[1]; my $r; if ($b != 0) { $r = $a / $b; if ($r == 0) { $r = "0:inf"; } elsif ($r < 1) { $r = "0" . (1 / $r + 0.005) . "00"; $r =~ s/0*(\d+\.\d\d)\d*/$1/; $r = "1:$r"; } elsif ($r > 1) { $r = "0" . ($r + 0.005) . "00"; $r =~ s/0*(\d+\.\d\d)\d*/$1/; $r = "$r:1"; } else { $r = "1:1"; } } else { if ($a == 0) { $r = "0:0"; } else { $r = "inf:0"; } } return $r; } sub create_per_match_statistics { my @players_sorted; my ($player, $player_id); my ($player_a, $player_b); my ($team_id); my ($t, $class); my ($p_rank, $p_player, $p_kills, $p_deaths, $p_suicides); my ($p_eff, $p_avg_kph, $p_avg_ttl, $p_time); my ($p_rating, $p_rat_change); my @team_players; my %rank_per_score; my ($i, $j); open(RFILE, "> game_$game_id.html") or die "Can't create game_$game_id.html"; print RFILE &get_html_head(); print RFILE <Match Summary for Game $game_id

$translation{$current_gametype} game in $current_map

EOF ; print RFILE "\n"; { # Get rank per score my ($best_score); my (@rank_helper); foreach $player_id (keys %current_players) { $t = $current_kills{$player_id}; $t = 0 if (! defined($t)); push(@rank_helper, $t); } for ($i = 0; $i < $#rank_helper; $i++) { $best_score = $rank_helper[$i]; $t = $i; for ($j = $i + 1; $j <= $#rank_helper; $j++) { if ($rank_helper[$j] > $best_score) { $best_score = $rank_helper[$j]; $t = $j; } } if ($t != $i) { $rank_helper[$t] = $rank_helper[$i]; $rank_helper[$i] = $best_score; } } for ($i = 0; $i <= $#rank_helper; $i++) { $rank_per_score{$rank_helper[$i]} = $i + 1 if (! defined($rank_per_score{$rank_helper[$i]})); } } { my ($score, $best_score); foreach $team_id (keys %current_teams) { # Get players per team undef @team_players; foreach $player_id (keys %current_players) { $t = $current_player_team{$player_id}; if (defined($t) && $t =~ /;$team_id;/) { push(@team_players, $player_id); } } if ($#team_players >= 0) { $team_id = "everyone" if ($team_id =~ /^$/); # next if ($team_id =~ /^$/); print RFILE < EOF ; } # Sort and list players for ($i = 0; $i < $#team_players; $i++) { $best_score = $current_kills{$team_players[$i]}; $best_score = 0 if (! defined($best_score)); $t = $i; for ($j = $i + 1; $j <= $#team_players; $j++) { $score = $current_kills{$team_players[$j]}; if (defined($score) && $score > $best_score) { $best_score = $score; $t = $j; } } if ($t != $i) { my $tt = $team_players[$i]; $team_players[$i] = $team_players[$t]; $team_players[$t] = $tt; } } # Print player stats for ($i = 0; $i <= $#team_players; $i++) { $player_id = $team_players[$i]; $p_kills = $current_kills{$player_id}; $p_kills = 0 if (! defined($p_kills)); $p_rank = $rank_per_score{$p_kills}; $p_player = $players_id_name{$player_id}; $p_deaths = $current_deaths{$player_id}; $p_deaths = 0 if (! defined($p_deaths)); $p_suicides = $current_suicides{$player_id}; $p_suicides = 0 if (! defined($p_suicides)); $p_eff = &count_efficiency($p_kills, $p_deaths, $p_suicides, 0); $p_time = $current_played_time{$player_id}; $p_time = 0 if (! defined($p_time)); $p_avg_kph = &count_avg_per_time($p_kills, $p_time / 3600); $p_avg_ttl = &count_avg_per_time($p_time, $p_deaths); $p_time = &format_seconds_to_time($p_time); $p_rating = &round($players_rating{ "$player_id\n$current_gametype"}, 2); $p_rat_change = &format_rating_change( $players_rating_change{$player_id}); print RFILE < EOF ; } } print RFILE "Kills Match Up
Team: $team_id
Rank Player K D S Eff. % Avg KPH Avg TTL Rating Rating change Time
$p_rank $p_player $p_kills $p_deaths $p_suicides $p_eff $p_avg_kph $p_avg_ttl $p_rating $p_rat_change $p_time
EOF ; foreach $player_a (@players_sorted) { $t = $players_id_name{$player_a}; $t =~ s/(.)/$1
/g; print RFILE "\t\n"; } print RFILE "\t\n"; print RFILE "\n"; foreach $player_a (@players_sorted) { print RFILE "\n"; print RFILE "\n"; $p_kills = 0; foreach $player_b (@players_sorted) { $t = $current_kills{"$player_a\n$player_b"}; $t = 0 if (! defined($t)); $p_kills += $t if ($player_a != $player_b); $q = $current_kills{"$player_b\n$player_a"}; $q = 0 if (! defined($q)); $p_eff = &count_efficiency($t, $q, 0, 0); if ($player_a eq $player_b) { $class = " class=\"suicide\""; } else { $class = ""; } print RFILE "\t$t ($p_eff%)\n"; } print RFILE "\t\n"; print RFILE "\n"; } print RFILE "\n"; print RFILE "\t\n"; foreach $player_a (@players_sorted) { $t = $current_deaths{$player_a}; $t = 0 if (! defined($t)); print RFILE "\t\n"; } print RFILE "\t\n"; print RFILE "\n"; print RFILE < EOF ; } { # Special stuff my ($p_spree_len, $p_spree_player, $p_spree_end); my $p_first_blood; my ($long, $who); if (defined($first_blood)) { $t = $current_player_id[$first_blood]; $p_first_blood = $players_id_name{$t}; } else { $p_first_blood = "no kills"; } print RFILE <Special Stuff
Victim
\\
Killer		" . "$tT
o
t
a
l
" . $players_id_name{$player_a} . "$p_kills
Total$t 
First blood: $p_first_blood

Killing Sprees

EOF ; my @spree_who; my $players = 0; foreach $player_id (keys %current_players) { $spree_who[$players] = $player_id; &update_spree($player_id, 0, "Game ended"); $players++; } for ($i = 0; $i < $players; $i++) { $who = $i; $long = $best_spree{$spree_who[$who]}; for ($j = $i + 1; $j < $players; $j++) { if ($best_spree{$spree_who[$j]} > $long) { $long = $best_spree{$spree_who[$j]}; $who = $j; } } if ($i != $who) { $t = $spree_who[$i]; $spree_who[$i] = $spree_who[$who]; $spree_who[$who] = $t; } $who = $spree_who[$i]; $p_spree_len = $best_spree{$who}; next if ($p_spree_len < 5); $p_spree_player = $players_id_name{$who}; if ($p_spree_len > 0) { $p_spree_end = $spree_end_reason{$who}; if ($p_spree_end =~ /^\n/) { my ($killer, $weapon) = $p_spree_end =~ /\n(.*)\n(.*)/; $killer = $players_id_name{$killer}; $p_spree_end = "Killed by" . " " . "$killer with " . $translation{$weapon}; } print RFILE < EOF ; } } print RFILE "
Player Best Spree Length Reason Spree Stopped
$p_spree_player $p_spree_len $p_spree_end
\n"; } { # Player aliases # TODO ; } print RFILE "

Other Games

\n"; print RFILE "
" . "Game " . "<- " . ($game_id - 1) . " ... " . "" . ($game_id + 1) . " ->
\n"; print RFILE &get_html_tail(); close(RFILE); $game_id++; $had_game = 1; } sub update_rating_rating { my $id = $_[0]; my $e_a } sub format_rating_change { my $change = "$_[0].00"; my $t = $_[0]; if ($t > 0) { $change =~ s/(\d+\.\d\d).*/$1/; $change = "+$change"; } else { $change =~ s/(\-\d+\.\d\d).*/$1/; } return $change; } sub round { my $val = $_[0]; my $digit = $_[1]; my $round; my $t; $round = 1 / (10 ** ($digit + 1)) * 5; $val += $round; $t = "[+\-]?\\d+\."; for (my $i = 0; $i < $digit; $i++) { $t .= "\\d"; } $val =~ s/($t).*/$1/; return $val; } sub track_aliases { my $id = $_[0]; my $name = $_[1]; my $known; $known = $current_player_name[$id]; return if (! defined($known)); $players_name_id{$name} = $current_player_id[$id] if ($known ne $name); }