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