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