]>
iEval git - nethack-naodash.git/blob - lib/NetHack/NAOdash.pm
1 package NetHack
::NAOdash
;
7 use parent qw
/Exporter/;
9 our $VERSION = '0.001';
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 ($xlog) = join '', @_;
91 my %number_subs = (%sum_subs, %max_subs, %min_subs);
94 my %numbers = map { $_ => [] } keys %number_subs;
96 for my $logline (split /\n/, $xlog) {
97 my %game = %{parse_xlogline
$logline};
99 delete $game{$_} if $game{$_} eq ''
101 next if $game{flags
} & 3; # flag 0x01 is wizard mode, 0x02 is explore mode
102 push @checks, $_->(%game) for @check_subs;
103 push @
{$numbers{$_}}, $number_subs{$_}->(%game) for keys %number_subs;
106 $numbers{$_} = sum @
{$numbers{$_}} for keys %sum_subs;
107 $numbers{$_} = max @
{$numbers{$_}} for keys %max_subs;
108 $numbers{$_} = min @
{$numbers{$_}} for keys %min_subs;
109 @checks = uniq
map { lc } @checks;
111 {checks
=> [sort @checks], numbers
=> \
%numbers}
114 my $ht = HTTP
::Tiny
->new(agent
=> "NetHack-NAOdash/$VERSION ");
116 sub _get_xlog_from_server
{
118 my $ret = $ht->get("http://alt.org/nethack/player-all-xlog.php?player=$name");
119 die 'Error while retrieving xlogfile from alt.org: ' . $ret->{status
} . ' ' . $ret->{reason
} . "\n" unless $ret->{success
};
120 $ret->{content
} =~ m{<pre>(.*)</pre>}i;
125 return _get_xlog_from_server
$name if $ENV{NAODASH_CACHE
} && lc $ENV{NAODASH_CACHE
} eq 'none';
126 my $dir = $ENV{NAODASH_CACHE
} || catdir tmpdir
, 'naodash';
127 mkdir $dir or die "Cannot create cache directory: $!\n" unless -d
$dir;
128 my $file = catfile
$dir, $name;
129 write_file
$file, _get_xlog_from_server
$name unless -f
$file && time - (stat $file)[9] < 86400;
130 scalar read_file
$file
135 my $xlog = _get_xlog
$name;
136 die "No xlogfile found for user $name\n" unless defined $xlog;
147 NetHack::NAOdash - Analyze NetHack xlogfiles and extract statistics
151 use NetHack::NAOdash;
152 my $stats = naodash_user 'mgv'; # Retrieve and analyze mgv's xlogfile from alt.org
153 my @checks = @{$stats->{checks}}; # List of "achievements" obtained by mgv
154 my %checks = map { $_ => 1 } @checks;
155 say "mgv has ascended an orcish rogue" if $checks{combo_rog_orc_cha};
156 say "mgv has ascended an atheist character" if $checks{conduct_atheist};
157 my %numbers = %{$stats->{numbers}};
158 say "mgv has ascended $numbers{ascensions} out of $numbers{games} games";
159 say "mgv has spent $numbers{totalrealtime} seconds playing NetHack on NAO";
162 $stats = naodash_xlog read_file 'path/to/my/xlogfile';
163 %checks = map { $_ => 1 } @{$stats->{checks}};
164 say "I have ascended a survivor" if $checks{uconduct_survivor};
168 NetHack::NAOdash analyzes a NetHack xlogfile and reports statistics.
169 There are two types of statistics: B<checks>, which are flags
170 (booleans) and B<numbers> which are integers.
172 The B<checks> are tracked across all games. That is, a B<check> will
173 be true in the statistics if it is true in at least one game. Except
174 for B<checks> in the I<Achievements> category, only games that end in
175 an ascension are considered for awarding a B<check>.
177 The B<checks>, sorted by category, are:
181 =item B<Achievements>
183 These start with C<achieve_> and represent significant milestones in a
184 game. They are usually relevant only for users who never ascended, as
185 a game that ends in an ascension generally meets all of them.
187 achieve_sokoban achieve_luckstone achieve_medusa achieve_bell
188 achieve_gehennom achieve_candelabrum achieve_book achieve_invocation
189 achieve_amulet achieve_endgame achieve_astral achieve_ascended
191 =item B<Starting Combos>
193 These look like C<combo_role_race_alignment> and represent
194 role/race/alignment combinations in ascended games. The starting
195 alignment, not the alignment at the end of the game is considered. For
196 example, C<cav_gno_neu> is true if the user ascended at least one
201 These start with C<conduct_> and represent the 12 officially tracked
204 conduct_foodless conduct_vegan conduct_vegetarian
205 conduct_atheist conduct_weaponless conduct_pacifist
206 conduct_illiterate conduct_genocideless conduct_polypileless
207 conduct_polyselfless conduct_wishless conduct_artiwishless
209 =item B<Unofficial Conducts>
211 These start with C<uconduct_> and represent conducts that are not
212 officially tracked by the game.
214 uconduct_survivor uconduct_bones uconduct_minscore
222 =item B<totalrealtime>
224 The total time spent playing NetHack on NAO, in seconds.
228 The number of games played.
232 The number of games played that ended in an ascension.
236 The highest maxHP at the end of an ascension.
240 The highest score obtained at the end of an ascension.
244 The maximum number of conducts at the end of an ascension.
248 The minimum turns across ascended games.
252 The minimum realtime across ascended games, in seconds.
256 This module exports two functions:
260 =item B<naodash_xlog>(I<@lines>)
262 =item B<naodash_xlog>(I<$xlog>)
264 Takes the contents of an xlogfile and returns the results of the
265 analysis. The arguments are joined together then split by the newline
266 character, so they can be specified as a single string, as a list of
267 lines, or as a combination thereof.
269 The return value is of the following form:
271 { checks => ['achieve_sokoban', 'achieve_luckstone', ...],
272 numbers => {totalrealtime => 12345, games => 2, ...} }
274 In other words, C<< @{$result->{checks}} >> is an array of B<checks>
275 that are true and C<< %{$result->{numbers}} >> is a hash of
278 =item B<naodash_user>(I<$nao_username>)
280 Retrieves the xlogfile of a user from NAO and gives it to
281 B<naodash_xlog>. Dies if no xlogfile is found or if the server cannot
284 This method caches the downloaded xlogfiles for one day in the
285 directory named by the NAODASH_CACHE environment variable.
295 Path to a directory that should be used to cache xlogfiles downloaded
296 from NAO, or the special value 'none' (case-insensitive) to disable
299 By default a directory named 'naodash' in the default temporary
300 directory (C<< File::Spec->tmpdir >>) is used.
306 L<App::NAOdash>, L<App::Web::NAOdash>, L<http://alt.org/nethack/>
310 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
312 =head1 COPYRIGHT AND LICENSE
314 Copyright (C) 2015 by Marius Gavrilescu
316 This library is free software; you can redistribute it and/or modify
317 it under the same terms as Perl itself, either Perl version 5.20.2 or,
318 at your option, any later version of Perl 5 you may have available.
This page took 0.071213 seconds and 5 git commands to generate.