misc/tools/WeaponEncounterProfile.pm

   1 #!/usr/bin/perl
   2
   3 package WeaponEncounterProfile;
   4 use strict;
   5 use warnings;
   6
   7 sub new
   8 {
   9         my ($cls, $filename) = @_;
  10         my $self = bless { fn => $filename }, 'WeaponEncounterProfile';
  11         $self->load();
  12         return $self;
  13 }
  14
  15 sub load($)
  16 {
  17         my ($self) = @_;
  18         $self->{stats} = {};
  19         $self->{mapstats} = {};
  20         $self->{typestats} = {};
  21         $self->{addrstats} = {};
  22         $self->{allstats} = {};
  23         open my $fh, "<", $self->{fn}
  24                 or return;
  25         while(<$fh>)
  26         {
  27                 chomp;
  28                 /^$/ and next;
  29                 /^#/ and next;
  30                 /^\/\// and next;
  31                 my ($addr, $map, $attackerweapon, $targweapon, $value);
  32                 if(/^([^\t]+)\t(\S+)\t(\d+) (\d+)\t(\d+) (\d+)\t(\d+) (\d+) (\S+)$/)
  33                 {
  34                         # new format (Xonotic)
  35                         ($addr, $map, $attackerweapon, $targweapon) = ($1, $2, $3, $5);
  36                         next if $4 and not $ENV{WEAPONPROFILER_WITHBOTS};
  37                         next if $6 and not $ENV{WEAPONPROFILER_WITHBOTS};
  38                         $value =
  39                                 $ENV{WEAPONPROFILER_DAMAGE} ? $9 :
  40                                 $ENV{WEAPONPROFILER_HITS} ? $8 :
  41                                 $7;
  42                 }
  43                 elsif(/^([^\t]+)\t(\S+)\t(\d+)\t(\d+)\t(\S+)$/)
  44                 {
  45                         # legacy format (Nexuiz)
  46                         ($addr, $map, $attackerweapon, $targweapon, $value) = ($1, $2, $3, $4, $5);
  47                 }
  48                 else
  49                 {
  50                         print STDERR "UNRECOGNIZED: $_\n";
  51                         next;
  52                 }
  53                 $targweapon = int $self->weaponid_from_name($targweapon)
  54                         if $targweapon ne int $targweapon;
  55                 $attackerweapon = int $self->weaponid_from_name($attackerweapon)
  56                         if $attackerweapon ne int $attackerweapon;
  57                 $map =~ /(.*?)_(.*)/
  58                         or do { warn "invalid map name: $map"; next; };
  59                 (my $type, $map) = ($1, $2);
  60                 $self->{stats}->{$addr}{$type}{$map}{$attackerweapon}{$targweapon} += $value;
  61                 $self->{typestats}->{$type}{$attackerweapon}{$targweapon} += $value;
  62                 $self->{typemapstats}->{$type}{$map}{$attackerweapon}{$targweapon} += $value;
  63                 $self->{mapstats}->{$map}{$attackerweapon}{$targweapon} += $value;
  64                 $self->{addrstats}->{$addr}{$attackerweapon}{$targweapon} += $value;
  65                 $self->{allstats}->{$attackerweapon}{$targweapon} += $value;
  66         }
  67 }
  68
  69 sub save($)
  70 {
  71         my ($self) = @_;
  72         open my $fh, ">", $self->{fn}
  73                 or die "save: $!";
  74         while(my ($addr, $addrhash) = each %{$self->{stats}})
  75         {
  76                 while(my ($map, $maphash) = each %$addrhash)
  77                 {
  78                         while(my ($attackerweapon, $attackerweaponhash) = each %$maphash)
  79                         {
  80                                 while(my ($targweapon, $value) = each %$attackerweaponhash)
  81                                 {
  82                                         print $fh "$addr\t$map\t$attackerweapon\t$targweapon\t$value\n";
  83                                 }
  84                         }
  85                 }
  86         }
  87 }
  88
  89 sub event($$$$$$)
  90 {
  91         my ($self, $addr, $map, $attackerweapon, $targweapon, $value) = @_;
  92         return if $map eq '';
  93         if($value > 0)
  94         {
  95                 $map =~ /(.*?)_(.*)/
  96                         or do { warn "invalid map name: $map"; return; };
  97                 (my $type, $map) = ($1, $2);
  98                 $self->{stats}->{$addr}{$type}{$map}{$attackerweapon}{$targweapon} += $value;
  99                 $self->{typemapstats}->{$type}{$map}{$attackerweapon}{$targweapon} += $value;
 100                 $self->{typestats}->{$type}{$attackerweapon}{$targweapon} += $value;
 101                 $self->{mapstats}->{$map}{$attackerweapon}{$targweapon} += $value;
 102                 $self->{addrstats}->{$addr}{$attackerweapon}{$targweapon} += $value;
 103                 $self->{allstats}->{$attackerweapon}{$targweapon} += $value;
 104         }
 105 }
 106
 107 sub allstats($$)
 108 {
 109         my ($self, $callback) = @_;
 110         # send global stats
 111         $callback->(undef, undef, undef, $self->{allstats});
 112         # send per-host stats
 113         while(my ($k, $v) = each %{$self->{addrstats}})
 114         {
 115                 $callback->($k, undef, undef, $v);
 116         }
 117         # send per-type stats
 118         while(my ($k, $v) = each %{$self->{typestats}})
 119         {
 120                 $callback->(undef, $k, undef, $v);
 121         }
 122         # send per-type-map stats
 123         while(my ($k1, $v1) = each %{$self->{typemapstats}})
 124         {
 125                 while(my ($k2, $v2) = each %$v1)
 126                 {
 127                         $callback->(undef, $k1, $k2, $v2);
 128                 }
 129         }
 130         # send per-map stats
 131         while(my ($k, $v) = each %{$self->{mapstats}})
 132         {
 133                 $callback->(undef, undef, $k, $v);
 134         }
 135         # send single stats
 136         while(my ($k1, $v1) = each %{$self->{stats}})
 137         {
 138                 while(my ($k2, $v2) = each %$v1)
 139                 {
 140                         while(my ($k3, $v3) = each %$v2)
 141                         {
 142                                 $callback->($k1, $k2, $k3, $v3);
 143                         }
 144                 }
 145         }
 146 }
 147
 148 our %WeaponMap = (
 149          1 => ["Laser", "laser"],
 150          2 => ["Shotgun", "shotgun"],
 151          3 => ["Uzi", "uzi"],
 152          4 => ["Mortar", "grenadelauncher"],
 153          5 => ["Mine Layer", "minelayer"],
 154          6 => ["Electro", "electro"],
 155          7 => ["Crylink", "crylink"],
 156          8 => ["Nex", "nex"],
 157          9 => ["Hagar", "hagar"],
 158         10 => ["Rocket Launcher", "rocketlauncher"],
 159         11 => ["Port-O-Launch", "porto"],
 160         12 => ["MinstaNex", "minstanex"],
 161         13 => ["Grappling Hook", "hook"],
 162         14 => ["Heavy Laser Assault Cannon", "hlac"],
 163         15 => ["@!#%'n Tuba", "tuba"],
 164         16 => ["Sniper Rifle", "rifle"],
 165         17 => ["Fireball", "fireball"],
 166         18 => ["Seeker", "seeker"],
 167 );
 168
 169 sub weaponid_valid($$)
 170 {
 171         my ($self, $id) = @_;
 172         return exists $WeaponMap{$id};
 173 }
 174
 175 sub weaponid_to_name($$)
 176 {
 177         my ($self, $id) = @_;
 178         exists $WeaponMap{$id} or warn "weapon of id $id not found\n";
 179         return $WeaponMap{$id}[0];
 180 }
 181
 182 sub weaponid_to_model($$)
 183 {
 184         my ($self, $id) = @_;
 185         exists $WeaponMap{$id} or warn "weapon of id $id not found\n";
 186         return $WeaponMap{$id}[1];
 187 }
 188
 189 sub weaponid_from_name($$)
 190 {
 191         my ($self, $name) = @_;
 192         for(keys %WeaponMap)
 193         {
 194                 return $_
 195                         if $WeaponMap{$_}[0] eq $name;
 196         }
 197 }
 198
 199 1;