]>
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.003';
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/;
18 my ($dash, $css, $css_hash);
21 $css = read_file
'web/dash.css';
23 $css =~ s/([):]) /$1/g;
24 $css =~ s/ ([{(])/$1/g;
25 $css_hash = 'sha256-' . sha256_base64
($css) . '=';
26 my $tb = HTML
::TreeBuilder
->new;
27 $tb->ignore_unknown(0);
28 $dash = $tb->parse_file('web/dash.html');
29 $dash->find('link')->postinsert([style
=> $css])->detach;
34 return unless defined $time;
46 unshift @parts, ($time % $units{$_}) . $_;
53 my ($name, $query, $result) = @_;
54 my @checks = @
{$result->{checks
}};
55 my %numbers = %{$result->{numbers
}};
56 $numbers{totalrealtime
} = format_time
$numbers{totalrealtime
};
57 $numbers{minrealtime
} = format_time
$numbers{minrealtime
};
59 my $tree = $dash->clone;
60 $tree->find('title')->delete_content->push_content("Dashboard for $name");
61 $tree->find('a')->attr(href
=> $tree->find('a')->attr('href') . $name);
62 $tree->find('a')->delete_content->push_content($name);
64 my $el = $tree->look_down(id
=> $_);
65 warn "No element for check $_" unless $el; ## no critic (RequireCarping)
66 $el->attr(class => 'done') if $el;
68 while (my ($id, $num) = each %numbers) {
69 next unless defined $num;
70 my $el = $tree->look_down(id
=> $id);
71 warn "No element for check $id" unless $el; ## no critic (RequireCarping)
72 $el->delete_content->push_content($num);
74 my $ahref = $tree->look_down(href
=> "?$query");
75 $ahref->replace_with(join '', $ahref->content_list) if $ahref;
80 my ($code, $message, $type) = @_;
81 $type //= 'text/plain';
83 'Cache-Control' => ($code < 500 ?
'max-age=86400' : 'no-cache'),
84 'Content-Type' => "$type; charset=utf-8",
85 'Content-Length' => length $message,
86 # Safari implements CSP Level 1 but not CSP Level 2
87 # 'Content-Security-Policy' => "default-src 'none'; style-src '$css_hash';",
92 my ($self, $env) = @_;
93 my $req = Plack
::Request
->new($env);
94 return reply
400, 'Bad request: user contains characters outside [a-zA-Z0-9_]' unless $req->path =~ m{^/(\w+)$};
97 include_versions
=> [$req->query_parameters->get_all('include_versions')],
98 exclude_versions
=> [$req->query_parameters->get_all('exclude_versions')],
100 my $result = eval { naodash_user \
%args, $name } or return reply
500, $@
;
102 return reply
200, encode_json
($result), 'application/json' if $self->{json
};
103 return reply
200, make_html
($name, $req->query_string, $result), 'text/html';
113 App::Web::NAOdash - Analyze NetHack xlogfiles and extract statistics (web interface)
118 use App::Web::NAOdash;
122 mount '/dash/' => App::Web::NAOdash->new->to_app;
123 mount '/json/' => App::Web::NAOdash->new(json => 1)->to_app;
129 App::Web::NAOdash is a web interface to L<NetHack::NAOdash>.
131 It handles URLs of the form C</username>, where I<username> is a NAO
132 username. It retrieves the xlogfile from NAO and returns the result of
135 Two query parameters are accepted: include_versions and
136 exclude_versions, both of which can take multiple values by
137 specifiying them multiple times. They are passed directly to the
138 B<naodash_user> function, see the documentation of L<NetHack::NAOdash>
139 for an explanation of their function.
141 The constructor takes a single named parameter, I<json>, that is false
142 by default. The result will be returned as HTML is I<json> is false,
143 as JSON if I<json> is true.
147 L<NetHack::NAOdash>, L<App::NAOdash>
151 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
153 =head1 COPYRIGHT AND LICENSE
155 Copyright (C) 2015 by Marius Gavrilescu
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.
This page took 0.066572 seconds and 5 git commands to generate.