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