| 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.001'; |
| 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 '✓' : RED '✗'; |
| 89 | $base =~ s/#([a-zA-Z-]+)/$color$1$rst/; |
| 90 | } |
| 91 | |
| 92 | $base |
| 93 | } |
| 94 | |
| 95 | sub run { |
| 96 | my ($user_or_path) = @_; |
| 97 | my $stats; |
| 98 | if ($user_or_path =~ /^\w+$/) { # Looks like a user |
| 99 | $stats = naodash_user $user_or_path |
| 100 | } else { |
| 101 | $stats = naodash_xlog read_file $user_or_path |
| 102 | } |
| 103 | print encode 'UTF-8', naodash_to_ansi $stats ## no critic (RequireCheckedSyscalls) |
| 104 | } |
| 105 | |
| 106 | 1; |
| 107 | __END__ |
| 108 | |
| 109 | =encoding utf-8 |
| 110 | |
| 111 | =head1 NAME |
| 112 | |
| 113 | App::NAOdash - Analyze NetHack xlogfiles and extract statistics (command-line interface) |
| 114 | |
| 115 | =head1 SYNOPSIS |
| 116 | |
| 117 | use App::NAOdash; |
| 118 | App::NAOdash::run(@ARGV); |
| 119 | |
| 120 | =head1 DESCRIPTION |
| 121 | |
| 122 | App::NAOdash is the backend of the L<naodash> script, a command-line |
| 123 | interface to L<NetHack::NAOdash>. |
| 124 | |
| 125 | It defines two functions: |
| 126 | |
| 127 | =over |
| 128 | |
| 129 | =item B<naodash_to_ansi>(I<$stats>) |
| 130 | |
| 131 | Takes the result of B<naodash_user> or B<naodash_xlog> and presents it |
| 132 | in a text form, using ANSI color escape sequences and unicode ticks |
| 133 | (✓) and X marks (✗) to indicate the presence/absence of checks. |
| 134 | |
| 135 | =item B<run>(I<$user_or_path>) |
| 136 | |
| 137 | Analyzes the xlogfile for the given user / at the given path, passes |
| 138 | the result through B<naodash_to_ansi> and prints the result. |
| 139 | |
| 140 | If the argument contains non-word characters, it is interpreted as a |
| 141 | path. Otherwise it is interpreted as a NAO username. |
| 142 | |
| 143 | =back |
| 144 | |
| 145 | =head1 SEE ALSO |
| 146 | |
| 147 | L<naodash>, L<NetHack::NAOdash>, L<App::Web::NAOdash> |
| 148 | |
| 149 | =head1 AUTHOR |
| 150 | |
| 151 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> |
| 152 | |
| 153 | =head1 COPYRIGHT AND LICENSE |
| 154 | |
| 155 | Copyright (C) 2015 by Marius Gavrilescu |
| 156 | |
| 157 | This library is free software; you can redistribute it and/or modify |
| 158 | it under the same terms as Perl itself, either Perl version 5.20.2 or, |
| 159 | at your option, any later version of Perl 5 you may have available. |
| 160 | |
| 161 | |
| 162 | =cut |