use re '/saa';
use parent qw/Exporter/;
-our $VERSION = '0.001';
+our $VERSION = '0.003';
our @EXPORT_OK = qw/naodash_xlog naodash_user/;
our @EXPORT = @EXPORT_OK;
+use File::Slurp;
+use File::Spec::Functions qw/tmpdir catdir catfile/;
use HTTP::Tiny;
use List::Util qw/max min sum/;
use List::MoreUtils qw/uniq/;
);
sub naodash_xlog { ## no critic (RequireArgUnpacking)
+ my (%args, %exclude, %include);
+ %args = %{shift()} if ref $_[0] eq 'HASH'; ## no critic (Builtin)
+ %exclude = map { $_ => 1 } @{$args{exclude_versions} // []};
+ %include = map { $_ => 1 } @{$args{include_versions} // []};
my ($xlog) = join '', @_;
my %number_subs = (%sum_subs, %max_subs, %min_subs);
for (keys %game) {
delete $game{$_} if $game{$_} eq ''
}
+ next if $exclude{$game{version}} || %include && !$include{$game{version}};
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;
my $ht = HTTP::Tiny->new(agent => "NetHack-NAOdash/$VERSION ");
-sub naodash_user {
+sub _get_xlog_from_server {
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;
+ $ret->{content} =~ m{<pre>(.*)</pre>}i;
+}
+
+sub _get_xlog {
+ my ($name) = @_;
+ return _get_xlog_from_server $name if $ENV{NAODASH_CACHE} && lc $ENV{NAODASH_CACHE} eq 'none';
+ my $dir = $ENV{NAODASH_CACHE} || catdir tmpdir, 'naodash';
+ mkdir $dir or die "Cannot create cache directory: $!\n" unless -d $dir;
+ my $file = catfile $dir, $name;
+ write_file $file, _get_xlog_from_server $name if ! -f $file || time - (stat $file)[9] >= 86_400;
+ scalar read_file $file
+}
+
+sub naodash_user { ## no critic (RequireArgUnpacking)
+ my $args = {};
+ $args = shift if ref $_[0] eq 'HASH';
+ my ($name) = @_;
+ my $xlog = _get_xlog $name;
die "No xlogfile found for user $name\n" unless defined $xlog;
- naodash_xlog $xlog;
+ naodash_xlog $args, $xlog;
}
1;
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 = @{$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};
+ 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";
+ $stats = naodash_user {include_versions => ['3.6.0']}, 'mgv';
+ say 'mgv has ascended an orcish rogue in 3.6.0' if $checks{combo_rog_orc_cha};
+ $stats = naodash_user {exclude_versions => ['3.6.0']}, 'mgv';
+ say 'mgv has ascended an atheist character pre-3.6.0' if $checks{conduct_atheist};
+
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};
+ say 'I have ascended a survivor' if $checks{uconduct_survivor};
=head1 DESCRIPTION
=over
-=item B<naodash_xlog>(I<@lines>)
+=item B<naodash_xlog>([\%args], I<@lines>)
+
+=item B<naodash_xlog>([\%args], I<$xlog>)
+
+Takes an optional hashref followed by the contents of an xlogfile and
+returns the results of the analysis. The contents 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 following keys are recognised in the optional hashref:
+
+=over
+
+=item include_versions
-=item B<naodash_xlog>(I<$xlog>)
+The associated value is an arrayref of NetHack versions that should be
+considered. Any game that was played on a version that is not in this
+arrayref will be ignored. If this key is not present or the value is
+an empty arrayref, all versions are considered.
-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.
+=item exclude_versions
+
+The associated value is an arrayref of NetHack versions that should
+not be considered. Any game that was played on a version that is in
+this arrayref will be ignored. If a version is both included and
+excluded at the same time, it will not be considered (in other words,
+exclude_versions overrides include_versions).
+
+=back
The return value is of the following form:
that are true and C<< %{$result->{numbers}} >> is a hash of
B<numbers>.
-=item B<naodash_user>(I<$nao_username>)
+=item B<naodash_user>([I<\%args>], 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.
+An optional hashref can be passed as a first argument. In this case it
+will be supplied as a first argument to B<naodash_xlog>, see that
+function's documentation for an explanation of useful keys.
+
+This method caches the downloaded xlogfiles for one day in the
+directory named by the NAODASH_CACHE environment variable.
+
+=back
+
+=head1 ENVIRONMENT
+
+=over
+
+=item NAODASH_CACHE
+
+Path to a directory that should be used to cache xlogfiles downloaded
+from NAO, or the special value 'none' (case-insensitive) to disable
+caching.
+
+By default a directory named 'naodash' in the default temporary
+directory (C<< File::Spec->tmpdir >>) is used.
+
=back
=head1 SEE ALSO
projects / nethack-naodash.git / blobdiff