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