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