]>
iEval git - nethack-naodash.git/blob - lib/NetHack/NAOdash.pm
1 package NetHack
::NAOdash
;
7 use parent qw
/Exporter/;
9 our $VERSION = '0.003';
10 our @EXPORT_OK = qw
/naodash_xlog naodash_user/;
11 our @EXPORT = @EXPORT_OK;
14 use File
::Spec
::Functions qw
/tmpdir catdir catfile/;
16 use List
::Util qw
/max min sum/;
17 use List
::MoreUtils qw
/uniq/;
18 use Text
::XLogfile qw
/parse_xlogline/;
22 $game{death
} eq 'ascended'
28 return unless won_game
%game;
29 $game{align0
} //= $game{align
};
30 "combo_$game{role}_$game{race}_$game{align0}"
35 my @achieves = qw
/bell gehennom candelabrum book invocation amulet endgame astral ascended luckstone sokoban medusa/;
36 map { $game{achieve
} & (1 << $_) ?
"achieve_$achieves[$_]" : () } 0 .. $#achieves
41 return unless won_game
%game;
42 my @conducts = qw
/foodless vegan vegetarian atheist weaponless pacifist illiterate polypileless polyselfless wishless artiwishless genocideless/;
43 map { $game{conduct
} & (1 << $_) ?
"conduct_$conducts[$_]" : () } 0 .. $#conducts
46 sub { # Unofficial conducts
48 return unless won_game
%game;
50 push @uconducts, 'survivor' if $game{deaths
} == 0;
51 push @uconducts, 'boneless' unless $game{flags
} & 32;
52 push @uconducts, 'minscore' if $game{points
} - 100 * ($game{maxlvl
} - 45) == 24_400
;
53 map { "uconduct_$_" } @uconducts
63 totalrealtime
=> sub {
69 sub make_attr_sub
($) { ## no critic (ProhibitSubroutinePrototypes)
73 return unless won_game
%game;
79 maxhp
=> make_attr_sub
'maxhp',
80 maxpoints
=> make_attr_sub
'points',
81 maxconducts
=> make_attr_sub
'nconducts',
85 minturns
=> make_attr_sub
'turns',
86 minrealtime
=> make_attr_sub
'realtime',
89 sub naodash_xlog
{ ## no critic (RequireArgUnpacking)
90 my (%args, %exclude, %include);
91 %args = %{shift()} if ref $_[0] eq 'HASH'; ## no critic (Builtin)
92 %exclude = map { $_ => 1 } @
{$args{exclude_versions
} // []};
93 %include = map { $_ => 1 } @
{$args{include_versions
} // []};
94 my ($xlog) = join '', @_;
95 my %number_subs = (%sum_subs, %max_subs, %min_subs);
98 my %numbers = map { $_ => [] } keys %number_subs;
100 for my $logline (split /\n/, $xlog) {
101 my %game = %{parse_xlogline
$logline};
103 delete $game{$_} if $game{$_} eq ''
105 next if $exclude{$game{version
}} || %include && !$include{$game{version
}};
106 next if $game{flags
} & 3; # flag 0x01 is wizard mode, 0x02 is explore mode
107 push @checks, $_->(%game) for @check_subs;
108 push @
{$numbers{$_}}, $number_subs{$_}->(%game) for keys %number_subs;
111 $numbers{$_} = sum @
{$numbers{$_}} for keys %sum_subs;
112 $numbers{$_} = max @
{$numbers{$_}} for keys %max_subs;
113 $numbers{$_} = min @
{$numbers{$_}} for keys %min_subs;
114 @checks = uniq
map { lc } @checks;
116 {checks
=> [sort @checks], numbers
=> \
%numbers}
119 my $ht = HTTP
::Tiny
->new(agent
=> "NetHack-NAOdash/$VERSION ");
121 sub _get_xlog_from_server
{
123 my $ret = $ht->get("http://alt.org/nethack/player-all-xlog.php?player=$name");
124 die 'Error while retrieving xlogfile from alt.org: ' . $ret->{status
} . ' ' . $ret->{reason
} . "\n" unless $ret->{success
};
125 $ret->{content
} =~ m{<pre>(.*)</pre>}i;
130 return _get_xlog_from_server
$name if $ENV{NAODASH_CACHE
} && lc $ENV{NAODASH_CACHE
} eq 'none';
131 my $dir = $ENV{NAODASH_CACHE
} || catdir tmpdir
, 'naodash';
132 mkdir $dir or die "Cannot create cache directory: $!\n" unless -d
$dir;
133 my $file = catfile
$dir, $name;
134 write_file
$file, _get_xlog_from_server
$name if ! -f
$file || time - (stat $file)[9] >= 86_400
;
135 scalar read_file
$file
138 sub naodash_user
{ ## no critic (RequireArgUnpacking)
140 $args = shift if ref $_[0] eq 'HASH';
142 my $xlog = _get_xlog
$name;
143 die "No xlogfile found for user $name\n" unless defined $xlog;
144 naodash_xlog
$args, $xlog;
154 NetHack::NAOdash - Analyze NetHack xlogfiles and extract statistics
158 use NetHack::NAOdash;
159 my $stats = naodash_user 'mgv'; # Retrieve and analyze mgv's xlogfile from alt.org
160 my @checks = @{$stats->{checks}}; # List of 'achievements' obtained by mgv
161 my %checks = map { $_ => 1 } @checks;
162 say 'mgv has ascended an orcish rogue' if $checks{combo_rog_orc_cha};
163 say 'mgv has ascended an atheist character' if $checks{conduct_atheist};
164 my %numbers = %{$stats->{numbers}};
165 say "mgv has ascended $numbers{ascensions} out of $numbers{games} games";
166 say "mgv has spent $numbers{totalrealtime} seconds playing NetHack on NAO";
168 $stats = naodash_user {include_versions => ['3.6.0']}, 'mgv';
169 say 'mgv has ascended an orcish rogue in 3.6.0' if $checks{combo_rog_orc_cha};
170 $stats = naodash_user {exclude_versions => ['3.6.0']}, 'mgv';
171 say 'mgv has ascended an atheist character pre-3.6.0' if $checks{conduct_atheist};
174 $stats = naodash_xlog read_file 'path/to/my/xlogfile';
175 %checks = map { $_ => 1 } @{$stats->{checks}};
176 say 'I have ascended a survivor' if $checks{uconduct_survivor};
180 NetHack::NAOdash analyzes a NetHack xlogfile and reports statistics.
181 There are two types of statistics: B<checks>, which are flags
182 (booleans) and B<numbers> which are integers.
184 The B<checks> are tracked across all games. That is, a B<check> will
185 be true in the statistics if it is true in at least one game. Except
186 for B<checks> in the I<Achievements> category, only games that end in
187 an ascension are considered for awarding a B<check>.
189 The B<checks>, sorted by category, are:
193 =item B<Achievements>
195 These start with C<achieve_> and represent significant milestones in a
196 game. They are usually relevant only for users who never ascended, as
197 a game that ends in an ascension generally meets all of them.
199 achieve_sokoban achieve_luckstone achieve_medusa achieve_bell
200 achieve_gehennom achieve_candelabrum achieve_book achieve_invocation
201 achieve_amulet achieve_endgame achieve_astral achieve_ascended
203 =item B<Starting Combos>
205 These look like C<combo_role_race_alignment> and represent
206 role/race/alignment combinations in ascended games. The starting
207 alignment, not the alignment at the end of the game is considered. For
208 example, C<cav_gno_neu> is true if the user ascended at least one
213 These start with C<conduct_> and represent the 12 officially tracked
216 conduct_foodless conduct_vegan conduct_vegetarian
217 conduct_atheist conduct_weaponless conduct_pacifist
218 conduct_illiterate conduct_genocideless conduct_polypileless
219 conduct_polyselfless conduct_wishless conduct_artiwishless
221 =item B<Unofficial Conducts>
223 These start with C<uconduct_> and represent conducts that are not
224 officially tracked by the game.
226 uconduct_survivor uconduct_bones uconduct_minscore
234 =item B<totalrealtime>
236 The total time spent playing NetHack on NAO, in seconds.
240 The number of games played.
244 The number of games played that ended in an ascension.
248 The highest maxHP at the end of an ascension.
252 The highest score obtained at the end of an ascension.
256 The maximum number of conducts at the end of an ascension.
260 The minimum turns across ascended games.
264 The minimum realtime across ascended games, in seconds.
268 This module exports two functions:
272 =item B<naodash_xlog>([\%args], I<@lines>)
274 =item B<naodash_xlog>([\%args], I<$xlog>)
276 Takes an optional hashref followed by the contents of an xlogfile and
277 returns the results of the analysis. The contents are joined together
278 then split by the newline character, so they can be specified as a
279 single string, as a list of lines, or as a combination thereof.
281 The following keys are recognised in the optional hashref:
285 =item include_versions
287 The associated value is an arrayref of NetHack versions that should be
288 considered. Any game that was played on a version that is not in this
289 arrayref will be ignored. If this key is not present or the value is
290 an empty arrayref, all versions are considered.
292 =item exclude_versions
294 The associated value is an arrayref of NetHack versions that should
295 not be considered. Any game that was played on a version that is in
296 this arrayref will be ignored. If a version is both included and
297 excluded at the same time, it will not be considered (in other words,
298 exclude_versions overrides include_versions).
302 The return value is of the following form:
304 { checks => ['achieve_sokoban', 'achieve_luckstone', ...],
305 numbers => {totalrealtime => 12345, games => 2, ...} }
307 In other words, C<< @{$result->{checks}} >> is an array of B<checks>
308 that are true and C<< %{$result->{numbers}} >> is a hash of
311 =item B<naodash_user>([I<\%args>], I<$nao_username>)
313 Retrieves the xlogfile of a user from NAO and gives it to
314 B<naodash_xlog>. Dies if no xlogfile is found or if the server cannot
317 An optional hashref can be passed as a first argument. In this case it
318 will be supplied as a first argument to B<naodash_xlog>, see that
319 function's documentation for an explanation of useful keys.
321 This method caches the downloaded xlogfiles for one day in the
322 directory named by the NAODASH_CACHE environment variable.
332 Path to a directory that should be used to cache xlogfiles downloaded
333 from NAO, or the special value 'none' (case-insensitive) to disable
336 By default a directory named 'naodash' in the default temporary
337 directory (C<< File::Spec->tmpdir >>) is used.
343 L<App::NAOdash>, L<App::Web::NAOdash>, L<http://alt.org/nethack/>
347 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
349 =head1 COPYRIGHT AND LICENSE
351 Copyright (C) 2015 by Marius Gavrilescu
353 This library is free software; you can redistribute it and/or modify
354 it under the same terms as Perl itself, either Perl version 5.20.2 or,
355 at your option, any later version of Perl 5 you may have available.
This page took 0.085689 seconds and 5 git commands to generate.