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