package NetHack::NAOdash; use 5.014000; use strict; use warnings; use re '/saa'; use parent qw/Exporter/; our $VERSION = '0.001'; our @EXPORT_OK = qw/naodash_xlog naodash_user/; our @EXPORT = @EXPORT_OK; use HTTP::Tiny; use List::Util qw/max min sum/; use List::MoreUtils qw/uniq/; use Text::XLogfile qw/parse_xlogline/; sub won_game { my %game = @_; $game{death} eq 'ascended' } our @check_subs = ( sub { # Combos my %game = @_; return unless won_game %game; $game{align0} //= $game{align}; "combo_$game{role}_$game{race}_$game{align0}" }, sub { # Achievements my %game = @_; my @achieves = qw/bell gehennom candelabrum book invocation amulet endgame astral ascended luckstone sokoban medusa/; map { $game{achieve} & (1 << $_) ? "achieve_$achieves[$_]" : () } 0 .. $#achieves }, sub { # Conducts my %game = @_; return unless won_game %game; my @conducts = qw/foodless vegan vegetarian atheist weaponless pacifist illiterate polypileless polyselfless wishless artiwishless genocideless/; map { $game{conduct} & (1 << $_) ? "conduct_$conducts[$_]" : () } 0 .. $#conducts }, sub { # Unofficial conducts my %game = @_; return unless won_game %game; my @uconducts; push @uconducts, 'survivor' if $game{deaths} == 0; push @uconducts, 'boneless' unless $game{flags} & 32; push @uconducts, 'minscore' if $game{points} - 100 * ($game{maxlvl} - 45) == 24_400; map { "uconduct_$_" } @uconducts }, ); our %sum_subs = ( games => sub { 1 }, ascensions => sub { my %game = @_; !!won_game %game }, totalrealtime => sub { my %game = @_; $game{realtime} // 0 }, ); sub make_attr_sub ($) { ## no critic (ProhibitSubroutinePrototypes) my ($attr) = @_; sub { my %game = @_; return unless won_game %game; $game{$attr} // () }, } our %max_subs = ( maxhp => make_attr_sub 'maxhp', maxpoints => make_attr_sub 'points', maxconducts => make_attr_sub 'nconducts', ); our %min_subs = ( minturns => make_attr_sub 'turns', minrealtime => make_attr_sub 'realtime', ); sub naodash_xlog { ## no critic (RequireArgUnpacking) my ($xlog) = join '', @_; my %number_subs = (%sum_subs, %max_subs, %min_subs); my @checks; my %numbers = map { $_ => [] } keys %number_subs; for my $logline (split /\n/, $xlog) { my %game = %{parse_xlogline $logline}; for (keys %game) { delete $game{$_} if $game{$_} eq '' } next if $game{flags} & 3; # flag 0x01 is wizard mode, 0x02 is explore mode push @checks, $_->(%game) for @check_subs; push @{$numbers{$_}}, $number_subs{$_}->(%game) for keys %number_subs; } $numbers{$_} = sum @{$numbers{$_}} for keys %sum_subs; $numbers{$_} = max @{$numbers{$_}} for keys %max_subs; $numbers{$_} = min @{$numbers{$_}} for keys %min_subs; @checks = uniq map { lc } @checks; {checks => [sort @checks], numbers => \%numbers} } my $ht = HTTP::Tiny->new(agent => "NetHack-NAOdash/$VERSION "); sub naodash_user { my ($name) = @_; my $ret = $ht->get("http://alt.org/nethack/player-all-xlog.php?player=$name"); die 'Error while retrieving xlogfile from alt.org: ' . $ret->{status} . ' ' . $ret->{reason} . "\n" unless $ret->{success}; my ($xlog) = $ret->{content} =~ m{
(.*)
}i; die "No xlogfile found for user $name\n" unless defined $xlog; naodash_xlog $xlog; } 1; __END__ =encoding utf-8 =head1 NAME NetHack::NAOdash - Analyze NetHack xlogfiles and extract statistics =head1 SYNOPSIS use NetHack::NAOdash; my $stats = naodash_user 'mgv'; # Retrieve and analyze mgv's xlogfile from alt.org my @checks = @{$stats->{checks}}; # List of "achievements" obtained by mgv my %checks = map { $_ => 1 } @checks; say "mgv has ascended an orcish rogue" if $checks{combo_rog_orc_cha}; say "mgv has ascended an atheist character" if $checks{conduct_atheist}; my %numbers = %{$stats->{numbers}}; say "mgv has ascended $numbers{ascensions} out of $numbers{games} games"; say "mgv has spent $numbers{totalrealtime} seconds playing NetHack on NAO"; use File::Slurp; $stats = naodash_xlog read_file 'path/to/my/xlogfile'; %checks = map { $_ => 1 } @{$stats->{checks}}; say "I have ascended a survivor" if $checks{uconduct_survivor}; =head1 DESCRIPTION NetHack::NAOdash analyzes a NetHack xlogfile and reports statistics. There are two types of statistics: B, which are flags (booleans) and B which are integers. The B are tracked across all games. That is, a B will be true in the statistics if it is true in at least one game. Except for B in the I category, only games that end in an ascension are considered for awarding a B. The B, sorted by category, are: =over =item B These start with C and represent significant milestones in a game. They are usually relevant only for users who never ascended, as a game that ends in an ascension generally meets all of them. achieve_sokoban achieve_luckstone achieve_medusa achieve_bell achieve_gehennom achieve_candelabrum achieve_book achieve_invocation achieve_amulet achieve_endgame achieve_astral achieve_ascended =item B These look like C and represent role/race/alignment combinations in ascended games. The starting alignment, not the alignment at the end of the game is considered. For example, C is true if the user ascended at least one gnomish caveman. =item B These start with C and represent the 12 officially tracked conducts. conduct_foodless conduct_vegan conduct_vegetarian conduct_atheist conduct_weaponless conduct_pacifist conduct_illiterate conduct_genocideless conduct_polypileless conduct_polyselfless conduct_wishless conduct_artiwishless =item B These start with C and represent conducts that are not officially tracked by the game. uconduct_survivor uconduct_bones uconduct_minscore =back The numbers are: =over =item B The total time spent playing NetHack on NAO, in seconds. =item B The number of games played. =item B The number of games played that ended in an ascension. =item B The highest maxHP at the end of an ascension. =item B The highest score obtained at the end of an ascension. =item B The maximum number of conducts at the end of an ascension. =item B The minimum turns across ascended games. =item B The minimum realtime across ascended games, in seconds. =back This module exports two functions: =over =item B(I<@lines>) =item B(I<$xlog>) Takes the contents of an xlogfile and returns the results of the analysis. The arguments are joined together then split by the newline character, so they can be specified as a single string, as a list of lines, or as a combination thereof. The return value is of the following form: { checks => ['achieve_sokoban', 'achieve_luckstone', ...], numbers => {totalrealtime => 12345, games => 2, ...} } In other words, C<< @{$result->{checks}} >> is an array of B that are true and C<< %{$result->{numbers}} >> is a hash of B. =item B(I<$nao_username>) Retrieves the xlogfile of a user from NAO and gives it to B. Dies if no xlogfile is found or if the server cannot be contacted. =back =head1 SEE ALSO L, L, L =head1 AUTHOR Marius Gavrilescu, Emarius@ieval.roE =head1 COPYRIGHT AND LICENSE Copyright (C) 2015 by Marius Gavrilescu This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.20.2 or, at your option, any later version of Perl 5 you may have available. =cut