Update documentation for previous commit

[nethack-naodash.git] / lib / NetHack / NAOdash.pm

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{<pre>(.*)</pre>}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<checks>, which are flags
(booleans) and B<numbers> which are integers.

The B<checks> are tracked across all games. That is, a B<check> will
be true in the statistics if it is true in at least one game. Except
for B<checks> in the I<Achievements> category, only games that end in
an ascension are considered for awarding a B<check>.

The B<checks>, sorted by category, are:

=over

=item B<Achievements>

These start with C<achieve_> 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<Starting Combos>

These look like C<combo_role_race_alignment> 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<cav_gno_neu> is true if the user ascended at least one
gnomish caveman.

=item B<Conducts>

These start with C<conduct_> 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<Unofficial Conducts>

These start with C<uconduct_> and represent conducts that are not
officially tracked by the game.

  uconduct_survivor uconduct_bones uconduct_minscore

=back

The numbers are:

=over

=item B<totalrealtime>

The total time spent playing NetHack on NAO, in seconds.

=item B<games>

The number of games played.

=item B<ascensions>

The number of games played that ended in an ascension.

=item B<maxhp>

The highest maxHP at the end of an ascension.

=item B<maxpoints>

The highest score obtained at the end of an ascension.

=item B<maxconducts>

The maximum number of conducts at the end of an ascension.

=item B<minturns>

The minimum turns across ascended games.

=item B<minrealtime>

The minimum realtime across ascended games, in seconds.

=back

This module exports two functions:

=over

=item B<naodash_xlog>(I<@lines>)

=item B<naodash_xlog>(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<checks>
that are true and C<< %{$result->{numbers}} >> is a hash of
B<numbers>.

=item B<naodash_user>(I<$nao_username>)

Retrieves the xlogfile of a user from NAO and gives it to
B<naodash_xlog>. Dies if no xlogfile is found or if the server cannot
be contacted.

=back

=head1 SEE ALSO

L<App::NAOdash>, L<App::Web::NAOdash>, L<http://alt.org/nethack/>

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=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