3 package WeaponEncounterProfile;
9 my ($cls, $filename) = @_;
10 my $self = bless { fn => $filename }, 'WeaponEncounterProfile';
19 $self->{mapstats} = {};
20 $self->{typestats} = {};
21 $self->{addrstats} = {};
22 $self->{allstats} = {};
23 open my $fh, "<", $self->{fn}
31 my ($addr, $map, $attackerweapon, $targweapon, $value);
32 if(/^([^\t]+)\t(\S+)\t(\d+) (\d+)\t(\d+) (\d+)\t(\d+) (\d+) (\S+)$/)
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};
39 $ENV{WEAPONPROFILER_DAMAGE} ? $9 :
40 $ENV{WEAPONPROFILER_HITS} ? $8 :
43 elsif(/^([^\t]+)\t(\S+)\t(\d+)\t(\d+)\t(\S+)$/)
45 # legacy format (Nexuiz)
46 ($addr, $map, $attackerweapon, $targweapon, $value) = ($1, $2, $3, $4, $5);
50 print STDERR "UNRECOGNIZED: $_\n";
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;
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;
72 open my $fh, ">", $self->{fn}
74 while(my ($addr, $addrhash) = each %{$self->{stats}})
76 while(my ($map, $maphash) = each %$addrhash)
78 while(my ($attackerweapon, $attackerweaponhash) = each %$maphash)
80 while(my ($targweapon, $value) = each %$attackerweaponhash)
82 print $fh "$addr\t$map\t$attackerweapon\t$targweapon\t$value\n";
91 my ($self, $addr, $map, $attackerweapon, $targweapon, $value) = @_;
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;
109 my ($self, $callback) = @_;
111 $callback->(undef, undef, undef, $self->{allstats});
112 # send per-host stats
113 while(my ($k, $v) = each %{$self->{addrstats}})
115 $callback->($k, undef, undef, $v);
117 # send per-type stats
118 while(my ($k, $v) = each %{$self->{typestats}})
120 $callback->(undef, $k, undef, $v);
122 # send per-type-map stats
123 while(my ($k1, $v1) = each %{$self->{typemapstats}})
125 while(my ($k2, $v2) = each %$v1)
127 $callback->(undef, $k1, $k2, $v2);
131 while(my ($k, $v) = each %{$self->{mapstats}})
133 $callback->(undef, undef, $k, $v);
136 while(my ($k1, $v1) = each %{$self->{stats}})
138 while(my ($k2, $v2) = each %$v1)
140 while(my ($k3, $v3) = each %$v2)
142 $callback->($k1, $k2, $k3, $v3);
149 1 => ["Laser", "laser"],
150 2 => ["Shotgun", "shotgun"],
152 4 => ["Mortar", "grenadelauncher"],
153 5 => ["Mine Layer", "minelayer"],
154 6 => ["Electro", "electro"],
155 7 => ["Crylink", "crylink"],
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"],
169 sub weaponid_valid($$)
171 my ($self, $id) = @_;
172 return exists $WeaponMap{$id};
175 sub weaponid_to_name($$)
177 my ($self, $id) = @_;
178 exists $WeaponMap{$id} or warn "weapon of id $id not found\n";
179 return $WeaponMap{$id}[0];
182 sub weaponid_to_model($$)
184 my ($self, $id) = @_;
185 exists $WeaponMap{$id} or warn "weapon of id $id not found\n";
186 return $WeaponMap{$id}[1];
189 sub weaponid_from_name($$)
191 my ($self, $name) = @_;
195 if $WeaponMap{$_}[0] eq $name;