lib/App/NAOdash.pm

   1 package App::NAOdash;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6 use re '/saa';
   7 use utf8;
   8
   9 our $VERSION = '0.002';
  10
  11 use Encode qw/encode/;
  12 use File::Slurp;
  13 use NetHack::NAOdash;
  14 use Term::ANSIColor ':constants';
  15
  16 my @order = qw/
  17 achieve_sokoban achieve_luckstone achieve_medusa achieve_bell achieve_gehennom achieve_candelabrum achieve_book achieve_invocation achieve_amulet achieve_endgame achieve_astral achieve_ascended
  18
  19 combo_arc_hum_law combo_arc_hum_neu combo_arc_dwa_law combo_arc_gno_neu
  20 combo_bar_hum_neu combo_bar_hum_cha combo_bar_orc_cha
  21 combo_cav_hum_law combo_cav_hum_neu combo_cav_dwa_law combo_cav_gno_neu
  22 combo_hea_hum_neu combo_hea_gno_neu
  23 combo_kni_hum_law
  24 combo_mon_hum_law combo_mon_hum_neu combo_mon_hum_cha
  25 combo_pri_hum_law combo_pri_hum_neu combo_pri_hum_cha combo_pri_elf_cha
  26 combo_ran_hum_neu combo_ran_hum_cha combo_ran_elf_cha combo_ran_gno_neu combo_ran_orc_cha
  27 combo_rog_hum_cha combo_rog_orc_cha
  28 combo_sam_hum_law
  29 combo_tou_hum_neu
  30 combo_val_hum_law combo_val_hum_neu combo_val_dwa_law
  31 combo_wiz_hum_neu combo_wiz_hum_cha combo_wiz_elf_cha combo_wiz_gno_neu combo_wiz_orc_cha
  32
  33 conduct_foodless conduct_vegan conduct_vegetarian conduct_atheist conduct_weaponless conduct_pacifist conduct_illiterate conduct_genocideless conduct_polypileless conduct_polyselfless conduct_wishless conduct_artiwishless
  34
  35 uconduct_survivor uconduct_boneless uconduct_minscore/;
  36
  37 sub naodash_to_ansi {
  38         my ($dash) = @_;
  39         my @checks = @{$dash->{checks}};
  40         my %numbers = %{$dash->{numbers}};
  41
  42         my $base = <<"EOF";
  43 ACHIEVEMENTS
  44 ============
  45 #Sokoban #Luckstone  #Medusa #Bell    #Gehennom #Candelabrum
  46 #Book    #Invocation #Amulet #Endgame #Astral   #Ascended
  47
  48 STARTING COMBOS
  49 ===============
  50 #Arc-Hum-Law #Arc-Hum-Neu #Arc-Dwa-Law #Arc-Gno-Neu
  51 #Bar-Hum-Neu #Bar-Hum-Cha #Bar-Orc-Cha
  52 #Cav-Hum-Law #Cav-Hum-Neu #Cav-Dwa-Law #Cav-Gno-Neu
  53 #Hea-Hum-Neu #Hea-Gno-Neu
  54 #Kni-Hum-Law
  55 #Mon-Hum-Law #Mon-Hum-Neu #Mon-Hum-Cha
  56 #Pri-Hum-Law #Pri-Hum-Neu #Pri-Hum-Cha #Pri-Elf-Cha
  57 #Ran-Hum-Neu #Ran-Hum-Cha #Ran-Elf-Cha #Ran-Gno-Neu #Ran-Orc-Cha
  58 #Rog-Hum-Cha #Rog-Orc-Cha
  59 #Sam-Hum-Law
  60 #Tou-Hum-Neu
  61 #Val-Hum-Law #Val-Hum-Neu #Val-Dwa-Law
  62 #Wiz-Hum-Neu #Wiz-Hum-Cha #Wiz-Elf-Cha #Wiz-Gno-Neu #Wiz-Orc-Cha
  63
  64 CONDUCTS
  65 ========
  66 #Foodless     #Vegan        #Vegetarian #Atheist
  67 #Weaponless   #Pacifist     #Illiterate #Genocideless
  68 #Polypileless #Polyselfless #Wishless   #Artiwishless
  69
  70 UNOFFICIAL CONDUCTS
  71 ===================
  72 #Survivor #Boneless #Minscore
  73
  74 NUMBERS
  75 =======
  76 Time played:   $numbers{totalrealtime}
  77 Games:         $numbers{games}
  78 Ascensions:    $numbers{ascensions}
  79 Most HP:       $numbers{maxhp}
  80 Most points:   $numbers{maxpoints}
  81 Most conducts: $numbers{maxconducts}
  82 Least turns:   $numbers{minturns}
  83 Least time:    $numbers{minrealtime}
  84 EOF
  85
  86         my $rst = RESET;
  87         for my $check (@order) {
  88                 my $color = (grep { $_ eq $check } @checks) ? GREEN UNDERLINE : RED;
  89                 $base =~ s/#([a-zA-Z-]+)/$color$1$rst/;
  90         }
  91         $base =~ s/([A-Z ]+)\n=*/BOLD($1).RESET/ge;
  92
  93         $base
  94 }
  95
  96 sub run {
  97         my ($user_or_path) = @_;
  98         my $stats;
  99         if ($user_or_path =~ /^\w+$/) { # Looks like a user
 100                 $stats = naodash_user $user_or_path
 101         } else {
 102                 $stats = naodash_xlog read_file $user_or_path
 103         }
 104         print encode 'UTF-8', naodash_to_ansi $stats ## no critic (RequireCheckedSyscalls)
 105 }
 106
 107 1;
 108 __END__
 109
 110 =encoding utf-8
 111
 112 =head1 NAME
 113
 114 App::NAOdash - Analyze NetHack xlogfiles and extract statistics (command-line interface)
 115
 116 =head1 SYNOPSIS
 117
 118   use App::NAOdash;
 119   App::NAOdash::run(@ARGV);
 120
 121 =head1 DESCRIPTION
 122
 123 App::NAOdash is the backend of the L<naodash> script, a command-line
 124 interface to L<NetHack::NAOdash>.
 125
 126 It defines two functions:
 127
 128 =over
 129
 130 =item B<naodash_to_ansi>(I<$stats>)
 131
 132 Takes the result of B<naodash_user> or B<naodash_xlog> and presents it
 133 in a text form, using ANSI escape sequences to indicate the
 134 presence/absence of checks.
 135
 136 =item B<run>(I<$user_or_path>)
 137
 138 Analyzes the xlogfile for the given user / at the given path, passes
 139 the result through B<naodash_to_ansi> and prints the result.
 140
 141 If the argument contains non-word characters, it is interpreted as a
 142 path. Otherwise it is interpreted as a NAO username.
 143
 144 =back
 145
 146 =head1 SEE ALSO
 147
 148 L<naodash>, L<NetHack::NAOdash>, L<App::Web::NAOdash>
 149
 150 =head1 AUTHOR
 151
 152 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 153
 154 =head1 COPYRIGHT AND LICENSE
 155
 156 Copyright (C) 2015 by Marius Gavrilescu
 157
 158 This library is free software; you can redistribute it and/or modify
 159 it under the same terms as Perl itself, either Perl version 5.20.2 or,
 160 at your option, any later version of Perl 5 you may have available.
 161
 162
 163 =cut