]>
iEval git - nethack-naodash.git/blob - lib/App/Web/NAOdash.pm
1 package App
::Web
::NAOdash
;
7 use parent qw
/Plack::Component/;
9 our $VERSION = '0.002';
11 use Digest
::SHA qw
/sha256_base64/;
13 use HTML
::TreeBuilder
;
14 use JSON
::MaybeXS qw
/encode_json/;
15 use NetHack
::NAOdash qw
/naodash_user/;
17 my ($dash, $css, $css_hash);
20 $css = read_file
'web/dash.css';
22 $css =~ s/([):]) /$1/g;
23 $css =~ s/ ([{(])/$1/g;
24 $css_hash = 'sha256-' . sha256_base64
($css) . '=';
25 my $tb = HTML
::TreeBuilder
->new;
26 $tb->ignore_unknown(0);
27 $dash = $tb->parse_file('web/dash.html');
28 $dash->find('link')->postinsert([style
=> $css])->detach;
33 return unless defined $time;
45 unshift @parts, ($time % $units{$_}) . $_;
52 my ($name, $result) = @_;
53 my @checks = @
{$result->{checks
}};
54 my %numbers = %{$result->{numbers
}};
55 $numbers{totalrealtime
} = format_time
$numbers{totalrealtime
};
56 $numbers{minrealtime
} = format_time
$numbers{minrealtime
};
58 my $tree = $dash->clone;
59 $tree->find('title')->delete_content->push_content("Dashboard for $name");
60 $tree->find('a')->attr(href
=> $tree->find('a')->attr('href') . $name);
61 $tree->find('a')->delete_content->push_content($name);
63 my $el = $tree->look_down(id
=> $_);
64 warn "No element for check $_" unless $el; ## no critic (RequireCarping)
65 $el->attr(class => 'done') if $el;
67 while (my ($id, $num) = each %numbers) {
68 next unless defined $num;
69 my $el = $tree->look_down(id
=> $id);
70 warn "No element for check $id" unless $el; ## no critic (RequireCarping)
71 $el->delete_content->push_content($num);
77 my ($code, $message, $type) = @_;
78 $type //= 'text/plain';
80 'Cache-Control' => ($code < 500 ?
'max-age=86400' : 'no-cache'),
81 'Content-Type' => "$type; charset=utf-8",
82 'Content-Length' => length $message,
83 # Safari implements CSP Level 1 but not CSP Level 2
84 # 'Content-Security-Policy' => "default-src 'none'; style-src '$css_hash';",
89 my ($self, $env) = @_;
90 return reply
400, 'Bad request: user contains characters outside [a-zA-Z0-9_]' unless $env->{PATH_INFO
} =~ m{^/(\w+)$};
92 my $result = eval { naodash_user
$name } or return reply
500, $@
;
94 return reply
200, encode_json
($result), 'application/json' if $self->{json
};
95 return reply
200, make_html
($name, $result), 'text/html';
105 App::Web::NAOdash - Analyze NetHack xlogfiles and extract statistics (web interface)
110 use App::Web::NAOdash;
114 mount '/dash/' => App::Web::NAOdash->new->to_app;
115 mount '/json/' => App::Web::NAOdash->new(json => 1)->to_app;
121 App::Web::NAOdash is a web interface to L<NetHack::NAOdash>.
123 It handles URLs of the form C</username>, where I<username> is a NAO
124 username. It retrieves the xlogfile from NAO and returns the result of
127 The constructor takes a single named parameter, I<json>, that is false
128 by default. The result will be returned as HTML is I<json> is false,
129 as JSON if I<json> is true.
133 L<NetHack::NAOdash>, L<App::NAOdash>
137 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
139 =head1 COPYRIGHT AND LICENSE
141 Copyright (C) 2015 by Marius Gavrilescu
143 This library is free software; you can redistribute it and/or modify
144 it under the same terms as Perl itself, either Perl version 5.20.2 or,
145 at your option, any later version of Perl 5 you may have available.
This page took 0.062872 seconds and 5 git commands to generate.