Support filtering by version in App::Web::NAOdash

diff --git a/lib/App/Web/NAOdash.pm b/lib/App/Web/NAOdash.pm
index 985aaccd5f3bf94be8816edd21e6e949cd35987e..be36928bd3f0f61a3ea4fb8125162d270fd06747 100644 (file)
--- a/lib/App/Web/NAOdash.pm
+++ b/lib/App/Web/NAOdash.pm
@@ -13,6 +13,7 @@ use File::Slurp;
 use HTML::TreeBuilder;
 use JSON::MaybeXS qw/encode_json/;
 use NetHack::NAOdash qw/naodash_user/;
 use HTML::TreeBuilder;
 use JSON::MaybeXS qw/encode_json/;
 use NetHack::NAOdash qw/naodash_user/;

+use Plack::Request;

 
 my ($dash, $css, $css_hash);
 
 
 my ($dash, $css, $css_hash);
 


@@ -49,7 +50,7 @@ sub format_time {
 }
 
 sub make_html {
 }
 
 sub make_html {

-       my ($name, $result) = @_;
+       my ($name, $query, $result) = @_;

        my @checks = @{$result->{checks}};
        my %numbers = %{$result->{numbers}};
        $numbers{totalrealtime} = format_time $numbers{totalrealtime};
        my @checks = @{$result->{checks}};
        my %numbers = %{$result->{numbers}};
        $numbers{totalrealtime} = format_time $numbers{totalrealtime};


@@ -70,6 +71,8 @@ sub make_html {
                warn "No element for check $id" unless $el; ## no critic (RequireCarping)
                $el->delete_content->push_content($num);
        }
                warn "No element for check $id" unless $el; ## no critic (RequireCarping)
                $el->delete_content->push_content($num);
        }

+       my $ahref = $tree->look_down(href => "?$query");
+       $ahref->replace_with(join '', $ahref->content_list) if $ahref;

        $tree->as_HTML;
 }
 
        $tree->as_HTML;
 }
 


@@ -87,12 +90,17 @@ sub reply {
 
 sub call {
        my ($self, $env) = @_;
 
 sub call {
        my ($self, $env) = @_;

-       return reply 400, 'Bad request: user contains characters outside [a-zA-Z0-9_]' unless $env->{PATH_INFO} =~ m{^/(\w+)$};
+       my $req = Plack::Request->new($env);
+       return reply 400, 'Bad request: user contains characters outside [a-zA-Z0-9_]' unless $req->path =~ m{^/(\w+)$};

        my $name = $1;
        my $name = $1;

-       my $result = eval { naodash_user $name } or return reply 500, $@;
+       my %args = (
+               include_versions => [$req->query_parameters->get_all('include_versions')],
+               exclude_versions => [$req->query_parameters->get_all('exclude_versions')],
+       );
+       my $result = eval { naodash_user \%args, $name } or return reply 500, $@;

 
        return reply 200, encode_json($result), 'application/json' if $self->{json};
 
        return reply 200, encode_json($result), 'application/json' if $self->{json};

-       return reply 200, make_html($name, $result), 'text/html';
+       return reply 200, make_html($name, $req->query_string, $result), 'text/html';

 }
 
 1;
 }
 
 1;


@@ -124,6 +132,12 @@ It handles URLs of the form C</username>, where I<username> is a NAO
 username. It retrieves the xlogfile from NAO and returns the result of
 the analysis.
 
 username. It retrieves the xlogfile from NAO and returns the result of
 the analysis.
 

+Two query parameters are accepted: include_versions and
+exclude_versions, both of which can take multiple values by
+specifiying them multiple times. They are passed directly to the
+B<naodash_user> function, see the documentation of L<NetHack::NAOdash>
+for an explanation of their function.
+

 The constructor takes a single named parameter, I<json>, that is false
 by default. The result will be returned as HTML is I<json> is false,
 as JSON if I<json> is true.
 The constructor takes a single named parameter, I<json>, that is false
 by default. The result will be returned as HTML is I<json> is false,
 as JSON if I<json> is true.

diff --git a/web/dash.css b/web/dash.css
index 5c57cb66dcedb95e76ede79f04a94710e8b9dde7..9e1887717a6565f056fc291273592ac548e542cc 100644 (file)
--- a/web/dash.css
+++ b/web/dash.css
@@ -39,6 +39,24 @@ h2:after {
        text-align: center;
 }
 
        text-align: center;
 }
 

+#versions {
+       text-align:center;
+       margin: 5px;
+}
+
+#versions li {
+       display: inline;
+}
+
+#versions li::after {
+       content: "|";
+       margin: 0 0.5em;
+}
+
+#versions li:last-child::after {
+       content: "";
+}
+

 span[title] {
        color: #D33;
        font-family: monospace;
 span[title] {
        color: #D33;
        font-family: monospace;

diff --git a/web/dash.html b/web/dash.html
index 3131fc74a87299c9d66475229b1ccc0311c46959..0dc930c93ffc139d81703d2428574352b102aab8 100644 (file)
--- a/web/dash.html
+++ b/web/dash.html
@@ -5,6 +5,7 @@
 <link rel="stylesheet" href="dash.css">
 
 <h1 id="title">NAO dashboard for <a href="http://alt.org/nethack/plr.php?player=">NAME</a></h1>
 <link rel="stylesheet" href="dash.css">
 
 <h1 id="title">NAO dashboard for <a href="http://alt.org/nethack/plr.php?player=">NAME</a></h1>

+<ul id="versions"><li><a href="?">all versions</a> <li><a href="?include_versions=3.6.0">3.6.0</a> <li><a href="?exclude_versions=3.6.0">pre-3.6.0</a></ul>

 
 <div id="achievements">
 <h2>Achievements</h2>
 
 <div id="achievements">
 <h2>Achievements</h2>