+++ /dev/null
-#**************************************************************************
-# Copyright (C) 2006 by Michael Andreen <harvATruinDOTnu> *
-# *
-# This program is free software; you can redistribute it and/or modify *
-# it under the terms of the GNU General Public License as published by *
-# the Free Software Foundation; either version 2 of the License, or *
-# (at your option) any later version. *
-# *
-# This program is distributed in the hope that it will be useful, *
-# but WITHOUT ANY WARRANTY; without even the implied warranty of *
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
-# GNU General Public License for more details. *
-# *
-# You should have received a copy of the GNU General Public License *
-# along with this program; if not, write to the *
-# Free Software Foundation, Inc., *
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *
-#**************************************************************************/
-
-package NDWeb::Graph;
-use strict;
-use warnings;
-use ND::Include;
-use GD::Graph::lines;
-require Exporter;
-
-our @ISA = qw/Exporter/;
-
-our @EXPORT = qw/graphFromQuery/;
-
-sub graphFromQuery {
- my ($x,$y,$settings,$query,) = @_;
-
- my %graph_settings = (
- line_width => 1,
- y_number_format => sub { prettyValue abs $_[0]},
- legend_placement => 'BL',
- #zero_axis => 1,
- box_axis => 0,
- boxclr => 'black',
- axislabelclr => 'black',
- );
-
- my $fields = $query->{NUM_OF_FIELDS};
- my @fields;
- for (my $i = 0; $i < $fields; $i++){
- push @fields,[];
- }
- while (my @result = $query->fetchrow){
- for (my $i = 0; $i < $fields; $i++){
- push @{$fields[$i]},$result[$i];
- }
-
- }
- $graph_settings{x_label_skip} = int(1+(scalar @{$fields[0]}) / 6);
-
- my $graph = GD::Graph::lines->new($x,$y);
- $graph->set_legend(@{$query->{NAME}}[1..$fields]) or die $graph->error;
-
- for my $key (keys %{$settings}){
- $graph_settings{$key} = $settings->{$key};
- }
-
- $graph->set(%graph_settings);
- my $gd = $graph->plot(\@fields) or die $graph->error;
- return $gd->png;
-}
-
-1;
+++ /dev/null
-#**************************************************************************
-# Copyright (C) 2006 by Michael Andreen <harvATruinDOTnu> *
-# *
-# This program is free software; you can redistribute it and/or modify *
-# it under the terms of the GNU General Public License as published by *
-# the Free Software Foundation; either version 2 of the License, or *
-# (at your option) any later version. *
-# *
-# This program is distributed in the hope that it will be useful, *
-# but WITHOUT ANY WARRANTY; without even the implied warranty of *
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
-# GNU General Public License for more details. *
-# *
-# You should have received a copy of the GNU General Public License *
-# along with this program; if not, write to the *
-# Free Software Foundation, Inc., *
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *
-#**************************************************************************/
-
-package NDWeb::Image;
-use strict;
-use warnings;
-
-use base qw/NDWeb::Page/;
-
-
-sub render {
- my $self = shift;
-
- my $img;
- eval {
- $img = $self->render_body;
- };
- if (defined $img){
- if ((my $rc = $self->{R}->meets_conditions) != Apache2::Const::OK){
- $self->{R}->status($rc);
- }else{
- $self->{R}->headers_out->set(Content_Length => length $img);
- $self->{R}->content_type('image/png');
- $self->{R}->rflush;
- binmode STDOUT;
- print $img;
- }
- }elsif(defined $@){
- $self->{R}->content_type('text/plain');
- print $@;
- }
-};
-
-1;
+++ /dev/null
-#**************************************************************************
-# Copyright (C) 2006 by Michael Andreen <harvATruinDOTnu> *
-# *
-# This program is free software; you can redistribute it and/or modify *
-# it under the terms of the GNU General Public License as published by *
-# the Free Software Foundation; either version 2 of the License, or *
-# (at your option) any later version. *
-# *
-# This program is distributed in the hope that it will be useful, *
-# but WITHOUT ANY WARRANTY; without even the implied warranty of *
-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
-# GNU General Public License for more details. *
-# *
-# You should have received a copy of the GNU General Public License *
-# along with this program; if not, write to the *
-# Free Software Foundation, Inc., *
-# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *
-#**************************************************************************/
-
-package NDWeb::Pages::Graph;
-use strict;
-use warnings FATAL => 'all';
-use ND::Include;
-use NDWeb::Graph;
-use DBI qw(:sql_types);
-use DBD::Pg qw(:pg_types);
-
-
-use base qw/NDWeb::Image/;
-
-$NDWeb::Page::PAGES{graph} = 'NDWeb::Pages::Graph';
-
-sub render_body {
- my $self = shift;
- my $DBH = $self->{DBH};
-
- my %graph_settings = (
- y_number_format => sub { prettyValue abs $_[0]},
- y1_label => 'size',
- y2_label => 'rest',
- );
-
- my ($tick) = $DBH->selectrow_array(q{SELECT max(tick) from planet_stats});
- my %req;
- my $type;
- if ($self->{URI} =~ m{^/\w+/(stats|ranks)/(.*)}){
- $type = $1;
- if ($2 =~ m{(\d+)(?: |:)(\d+)(?:(?: |:)(\d+))?$}){
- $req{x} = $1;
- $req{y} = $2;
- $req{z} = $3;
- if (defined $3){
- ($req{id}) = $DBH->selectrow_array(q{SELECT planetid($1,$2,$3,$4)},undef,$1,$2,$3,$tick);
- }else{
- $type = "gal$type";
- $req{id} = 100*$1+$2;
- }
- }
- }elsif($self->{URI} =~ m{^/\w+/(alliance(?:avg)?)/(\d+)}){
- $type = $1;
- $req{id} = $2;
- }elsif($self->{URI} =~ m{^/\w+/planetvsnd/(\d+)}){
- $type = 'planetvsnd';
- $req{id} = $1;
- }
-
- die 'no real type' unless $type;
-
- my $findGraph = $DBH->prepare(q{SELECT EXTRACT(EPOCH FROM last_modified) AS last_modified FROM graphs WHERE id = $1 AND tick = $2 AND type = $3});
- $findGraph->execute($req{id},$tick,$type) or die $DBH->errstr;
- if (my $graph = $findGraph->fetchrow_hashref){
- $self->{R}->set_last_modified($graph->{last_modified});
- if ((my $rc = $self->{R}->meets_conditions) != Apache2::Const::OK){
- $self->{R}->status($rc);
- return;
- }
- my $findGraph = $DBH->prepare(q{SELECT img FROM graphs WHERE id = $1 AND tick = $2 AND type = $3});
- $findGraph->execute($req{id},$tick,$type) or die $DBH->errstr;
- $graph = $findGraph->fetchrow_hashref;
- return $graph->{img}
- }
-
- my $img;
- my $delGraph = $DBH->prepare(q{DELETE FROM graphs WHERE id = $1 AND type = $2});
- my $addGraph = $DBH->prepare(q{INSERT INTO graphs (type,id,tick,img) VALUES($1,$2,$3,$4)});
- if ($type eq 'stats' || $type eq 'ranks'){
- my $type = $1;
- my $findGraph;
- my ($x,$y,$z) = ($req{x},$req{y},$req{z});
- my $query;
- if ($type eq 'stats'){
- $query = $DBH->prepare(q{SELECT tick,score,size,value,xp*60 AS "xp*60" FROM planets natural join planet_stats WHERE id = planetid($1,$2,$3,$4) ORDER BY tick ASC});
- $graph_settings{y_min_value} = 0;
- }elsif($type eq 'ranks'){
- $query = $DBH->prepare(q{SELECT tick,-scorerank AS score,-sizerank AS size,-valuerank AS value,-xprank AS xp FROM planets natural join planet_stats WHERE id = planetid($1,$2,$3,$4) ORDER BY tick ASC});
- $graph_settings{y_max_value} = 0;
- }
- $query->execute($x,$y,$z,$tick) or die $DBH->errstr;
- $graph_settings{title} = "$type: $x:$y:$z";
- $graph_settings{two_axes} = 1;
- $graph_settings{use_axis} = [2,1,2,2];
- $img = graphFromQuery 500,300,\%graph_settings,$query;
- }elsif ($type eq 'galstats' || $type eq 'galranks'){
- my $query;
- my ($x,$y) = ($req{x},$req{y});
- if ($type eq 'galstats'){
- $query = $DBH->prepare(q{SELECT tick,score,size,value,xp*60 AS "xp*60" FROM galaxies WHERE x = $1 AND y = $2 ORDER BY tick ASC});
- $graph_settings{y_min_value} = 0;
- }elsif($type eq 'galranks'){
- $query = $DBH->prepare(q{SELECT tick,-scorerank AS score,-sizerank AS size,-valuerank AS value,-xprank AS xp FROM galaxies WHERE x = $1 AND y = $2 ORDER BY tick ASC});
- $graph_settings{y_max_value} = 0;
- }
- $query->execute($x,$y) or die $DBH->errstr;
- $graph_settings{title} = "$type: $x:$y";
- $graph_settings{two_axes} = 1;
- $graph_settings{use_axis} = [2,1,2,2];
- $img = graphFromQuery 500,300,\%graph_settings,$query;
- }elsif ($type eq 'alliance' || $type eq 'allianceavg'){
-
-
- $graph_settings{title} = 'Alliance vs known members';
- $graph_settings{two_axes} = 1;
- $graph_settings{use_axis} = [2,1,1,2];
- $graph_settings{y2_label} = 'score';
-
- my $query;
- if ($type eq 'alliance'){
- $query = $DBH->prepare(q{SELECT a.tick,a.score,a.size,memsize, memscore FROM (SELECT tick,SUM(size) AS memsize,SUM(score) AS memscore FROM planets p JOIN planet_stats ps USING (id) WHERE p.alliance_id = $1 GROUP BY tick) p JOIN alliance_stats a ON a.tick = p.tick
-WHERE a.id = $1 AND a.tick > (SELECT max(tick) - 50 FROM alliance_stats) ORDER BY tick});
- }else{
- $graph_settings{title} = 'Average alliance vs known members';
- $query = $DBH->prepare(q{SELECT a.tick,a.score/members AS score,a.size/members AS size,memsize, memscore FROM (SELECT tick,AVG(size) AS memsize,AVG(score) AS memscore FROM planets p JOIN planet_stats ps USING (id) WHERE p.alliance_id = $1 GROUP BY tick) p JOIN alliance_stats a ON a.tick = p.tick
-WHERE a.id = $1 AND a.tick > (SELECT max(tick) - 50 FROM alliance_stats)ORDER BY tick});
- }
- $query->execute($2) or die $DBH->errstr;
-
- $img = graphFromQuery 500,300,\%graph_settings,$query;
- }elsif ($type eq 'planetvsnd'){
- $graph_settings{title} = 'You vs ND AVG';
- $graph_settings{two_axes} = 1;
- $graph_settings{use_axis} = [2,1,1,2];
- $graph_settings{y2_label} = 'score';
-
- my $query = $DBH->prepare(q{SELECT a.tick,a.score/members AS NDscore,a.size/members as NDsize,memsize, memscore FROM (SELECT tick,size AS memsize,score AS memscore FROM planets p JOIN planet_stats ps USING (id) WHERE p.id = $1) p JOIN alliance_stats a ON a.tick = p.tick
- WHERE a.id = 1 ORDER BY tick});
- $query->execute($req{id}) or die $DBH->errstr;
-
- $img = graphFromQuery 500,300,\%graph_settings,$query;
- }
-
- die 'no image' unless defined $img;
-
- $delGraph->execute($req{id},$type) or die $DBH->errstr;
- $addGraph->bind_param('$1',$type,{TYPE => DBI::SQL_VARCHAR }) or die $DBH->errstr;
- $addGraph->bind_param('$2',$req{id},{TYPE => DBI::SQL_INTEGER }) or die $DBH->errstr;
- $addGraph->bind_param('$3',$tick,{TYPE => DBI::SQL_INTEGER }) or die $DBH->errstr;
- $addGraph->bind_param('$4',$img,{TYPE => DBI::SQL_VARBINARY }) or die $DBH->errstr;
- $addGraph->execute or die $DBH->errstr;
- $self->{R}->set_last_modified(time);
-
- return $img;
-};
-
-1;
INSERT INTO roles VALUES('admin_users');
INSERT INTO roles VALUES('rankings_planet_intel');
INSERT INTO roles VALUES('alliances_resources');
+INSERT INTO roles VALUES('graphs_intel');
INSERT INTO group_roles (gid,role) VALUES(2,'member_menu');
INSERT INTO group_roles (gid,role) VALUES(2,'attack_menu');
INSERT INTO group_roles (gid,role) VALUES(1,'admin_users');
INSERT INTO group_roles (gid,role) VALUES(1,'rankings_planet_intel');
INSERT INTO group_roles (gid,role) VALUES(1,'alliances_resources');
+INSERT INTO group_roles (gid,role) VALUES(1,'graphs_intel');
INSERT INTO group_roles (gid,role) VALUES(3,'dc_menu');
INSERT INTO group_roles (gid,role) VALUES(3,'bc_menu');
INSERT INTO group_roles (gid,role) VALUES(3,'admin_users');
INSERT INTO group_roles (gid,role) VALUES(3,'rankings_planet_intel');
INSERT INTO group_roles (gid,role) VALUES(3,'alliances_resources');
+INSERT INTO group_roles (gid,role) VALUES(3,'graphs_intel');
__PACKAGE__->config( name => 'NDWeb' );
__PACKAGE__->config->{'Plugin::Authentication'}{'use_session'} = 1;
-
+__PACKAGE__->config(session => {
+ storage => "/tmp/ndweb-$>/sesession",
+ directory_umask => 077,
+});
+__PACKAGE__->config( cache => {
+ backend => {
+ class => "Cache::FileCache",
+ cache_root => "/tmp/ndweb-$>",
+ directory_umask => 077,
+ },
+});
+
+__PACKAGE__->config( page_cache => {
+ set_http_headers => 1,
+});
# Start the application
Session
Session::Store::File
Session::State::Cookie
+
+ Cache
+ PageCache
/);
+
__PACKAGE__->deny_access_unless('/users',[qw/admin_users/]);
__PACKAGE__->deny_access_unless('/alliances/resources',[qw/alliances_resources/]);
+__PACKAGE__->deny_access_unless('/graphs/alliancevsintel',[qw/graphs_intel/]);
+__PACKAGE__->deny_access_unless('/graphs/avgalliancevsintel',[qw/graphs_intel/]);
=head1 NAME
--- /dev/null
+package NDWeb::Controller::Graphs;
+
+use strict;
+use warnings;
+use parent 'Catalyst::Controller';
+
+use ND::Include;
+
+=head1 NAME
+
+NDWeb::Controller::Graphs - Catalyst Controller
+
+=head1 DESCRIPTION
+
+Catalyst Controller.
+
+=head1 METHODS
+
+=cut
+
+
+=head2 index
+
+=cut
+
+sub begin : Private {
+ my ( $self, $c ) = @_;
+
+ $c->stash(width => 500);
+ $c->stash(height => 300);
+ $c->stash(settings => {
+ line_width => 1,
+ y_number_format => sub { prettyValue abs $_[0]},
+ legend_placement => 'BL',
+ #zero_axis => 1,
+ box_axis => 0,
+ boxclr => 'black',
+ axislabelclr => 'black',
+ use_axis => [2,1,2,2],
+ y1_label => 'size',
+ two_axes => 1,
+ y2_label => 'rest',
+ });
+ $c->stash(defaultgraph => 1);
+}
+
+sub planetranks : Local {
+ my ( $self, $c, $planet ) = @_;
+ my $dbh = $c->model;
+
+ $c->cache_page(3600);
+
+ $c->stash->{settings}->{y_max_value} = '0';
+ my $query = $dbh->prepare(q{SELECT tick,-scorerank AS score,-sizerank AS size
+ ,-valuerank AS value,-xprank AS xp
+ FROM planets NATUral JOIN planet_stats
+ WHERE id = $1 ORDER BY tick ASC
+ });
+ $query->execute($planet);
+ $c->stash(query => $query);
+}
+
+sub planetstats : Local {
+ my ( $self, $c, $planet ) = @_;
+ my $dbh = $c->model;
+
+ $c->cache_page(3600);
+
+ $c->stash->{settings}->{y_min_value} = '0';
+ my $query = $dbh->prepare(q{SELECT tick,score,size,value,xp*60 AS "xp*60"
+ FROM planets NATURAL JOIN planet_stats
+ WHERE id = $1 ORDER BY tick ASC
+ });
+ $query->execute($planet);
+ $c->stash(query => $query);
+}
+
+
+sub galaxyranks : Local {
+ my ( $self, $c, $x,$y ) = @_;
+ my $dbh = $c->model;
+
+ $c->cache_page(3600);
+
+ $c->stash->{settings}->{title} = "Ranks : $x:$y";
+ $c->stash->{settings}->{y_max_value} = '0';
+ my $query = $dbh->prepare(q{SELECT tick,-scorerank AS score,-sizerank AS size
+ ,-valuerank AS value,-xprank AS xp
+ FROM galaxies WHERE x = $1 AND y = $2
+ ORDER BY tick ASC
+ });
+ $query->execute($x,$y);
+ $c->stash(query => $query);
+}
+
+sub galaxystats : Local {
+ my ( $self, $c, $x,$y ) = @_;
+ my $dbh = $c->model;
+
+ $c->cache_page(3600);
+
+ $c->stash->{settings}->{title} = "Stats : $x:$y";
+ $c->stash->{settings}->{y_min_value} = '0';
+ my $query = $dbh->prepare(q{SELECT tick,score,size,value,xp*60 AS "xp*60"
+ FROM galaxies WHERE x = $1 AND y = $2
+ ORDER BY tick ASC
+ });
+ $query->execute($x,$y);
+ $c->stash(query => $query);
+}
+
+sub planetvsnd : Local {
+ my ( $self, $c, $planet ) = @_;
+ my $dbh = $c->model;
+
+ $c->cache_page(3600);
+
+ $c->stash->{settings}->{title} = 'You vs ND AVG';
+ $c->stash->{settings}->{use_axis} = [2,1,1,2];
+ $c->stash->{settings}->{y2_label} = 'score';
+
+ my $query = $dbh->prepare(q{SELECT a.tick,a.score/LEAST(members,60) AS NDscore
+ ,a.size/members as NDsize,memsize, memscore
+ FROM (SELECT tick,size AS memsize,score AS memscore
+ FROM planets p JOIN planet_stats ps USING (id) WHERE p.id = $1) p
+ JOIN alliance_stats a ON a.tick = p.tick
+ WHERE a.id = 1 ORDER BY tick
+ });
+ $query->execute($planet);
+ $c->stash(query => $query);
+}
+
+
+sub alliancevsintel : Local {
+ my ( $self, $c, $alliance ) = @_;
+ my $dbh = $c->model;
+
+ $c->stash->{settings}->{title} = 'Alliance vs known members';
+ $c->stash->{settings}->{use_axis} = [2,1,1,2];
+ $c->stash->{settings}->{y2_label} = 'score';
+
+ my $query = $dbh->prepare(q{SELECT a.tick,a.score,a.size,memsize, memscore
+ FROM (SELECT tick,SUM(size) AS memsize,SUM(score) AS memscore
+ FROM planets p JOIN planet_stats ps USING (id)
+ WHERE p.alliance_id = $1 GROUP BY tick) p
+ JOIN alliance_stats a ON a.tick = p.tick
+ WHERE a.id = $1
+ AND a.tick > (SELECT max(tick) - 50 FROM alliance_stats)
+ ORDER BY tick
+ });
+ $query->execute($alliance);
+ $c->stash(query => $query);
+}
+
+sub avgalliancevsintel : Local {
+ my ( $self, $c, $alliance ) = @_;
+ my $dbh = $c->model;
+
+ $c->stash->{settings}->{title} = 'Average alliance vs known members';
+ $c->stash->{settings}->{use_axis} = [2,1,1,2];
+ $c->stash->{settings}->{y2_label} = 'score';
+
+ my $query = $dbh->prepare(q{SELECT a.tick,a.score/LEAST(members,60) AS score
+ ,a.size/members AS size,memsize, memscore
+ FROM (SELECT tick,AVG(size) AS memsize,AVG(score) AS memscore
+ FROM planets p JOIN planet_stats ps USING (id) WHERE p.alliance_id = $1
+ GROUP BY tick) p
+ JOIN alliance_stats a ON a.tick = p.tick
+ WHERE a.id = $1
+ AND a.tick > (SELECT max(tick) - 50 FROM alliance_stats)
+ ORDER BY tick
+ });
+ $query->execute($alliance);
+ $c->stash(query => $query);
+}
+
+
+sub end : ActionClass('RenderView') {
+ my ( $self, $c ) = @_;
+ $c->res->headers->content_type('image/png');
+ if ($c->stash->{defaultgraph}){
+ $c->stash(template => 'graphs/index.tt2');
+
+ my $query = $c->stash->{query};
+ my $fields = $query->{NUM_OF_FIELDS};
+ my @fields;
+ for (my $i = 0; $i < $fields; $i++){
+ push @fields,[];
+ }
+ while (my @result = $query->fetchrow){
+ for (my $i = 0; $i < $fields; $i++){
+ push @{$fields[$i]},$result[$i];
+ }
+ }
+ $c->stash->{settings}->{x_label_skip} = int(1+(scalar @{$fields[0]}) / 6);
+ my @legend = @{$query->{NAME}}[1..$fields];
+ $c->stash(legend => \@legend);
+ $c->stash(data => \@fields);
+ }
+
+}
+
+=head1 AUTHOR
+
+Michael Andreen (harv@ruin.nu)
+
+=head1 LICENSE
+
+GPL 2.0, or later.
+
+=cut
+
+1;
[% IF template.name.match('\.(css|js|txt)');
- debug("Passing page through as text: $template.name");
- content;
- ELSE;
- debug("Applying HTML page layout wrappers to $template.name\n");
- content WRAPPER site/html.tt2 + site/layout.tt2;
- END;
+ debug("Passing page through as text: $template.name");
+ content;
+ELSIF template.name.match('graphs/');
+ debug("Passing page through graph: $template.name");
+ content;
+ELSE;
+ debug("Applying HTML page layout wrappers to $template.name\n");
+ content WRAPPER site/html.tt2 + site/layout.tt2;
+END;
-%]
--- /dev/null
+[% FILTER null;
+ USE g = GD.Graph.lines(width,height);
+
+ g.set(settings);
+ g.set_legend(legend);
+END;
+ g.plot(data).png;
+-%]
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+BEGIN { use_ok 'Catalyst::Test', 'NDWeb' }
+BEGIN { use_ok 'NDWeb::Controller::Graphs' }
+
+ok( request('/graphs')->is_success, 'Request should succeed' );
+
+
projects / ndwebbie.git / commitdiff