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