]> ruin.nu Git - ndwebbie.git/commitdiff
graphs
authorMichael Andreen <harv@ruin.nu>
Sat, 13 Jan 2007 12:42:54 +0000 (12:42 +0000)
committerMichael Andreen <harv@ruin.nu>
Sat, 13 Jan 2007 12:42:54 +0000 (12:42 +0000)
ND.pm
ND/Web/Pages/Check.pm
ND/Web/Pages/Graph.pm [new file with mode: 0644]
apache-conf.conf
startup.pl
stylesheets/black.css
templates/check.tmpl

diff --git a/ND.pm b/ND.pm
index 7bac9f764c9fdf145bd8e1be5d5feeb7ee01b9a8..997914241086d75eb46541e06dbd2e8b20121356 100755 (executable)
--- a/ND.pm
+++ b/ND.pm
@@ -41,7 +41,7 @@ our $NOACCESS = HTML::Template->new(filename => 'templates/NoAccess.tmpl', globa
 sub handler {
        local $ND::r = shift;
        local $ND::req = Apache2::Request->new($ND::r, POST_MAX => "1M");
-       local $ND::DBH;
+       local $ND::DBH = ND::DB::DB();
        local $ND::USER;
        local $ND::UID;
        local $ND::PLANET;
@@ -50,6 +50,7 @@ sub handler {
        local $ND::TICK;
        local %ND::GROUPS;
        local $ND::ERROR;
+       local $ND::USETEMPLATE = 1;
        local $ND::PAGE = $ND::req->param('page');
 
        if ($ENV{'SCRIPT_NAME'} =~ /(\w+)(\.(pl|php|pm))?$/){
@@ -59,13 +60,17 @@ sub handler {
 
        $PAGES{$ND::PAGE}->{parse}->($ENV{REQUEST_URI});
 
-       page($ND::PAGE);
+       if ($ND::USETEMPLATE){
+               page($ND::DBH,$ND::PAGE);
+       }else{
+               $PAGES{$ND::PAGE}->{render}->($ND::DBH,$ENV{REQUEST_URI});
+       }
+
        return Apache2::Const::OK;
 }
 
 sub page {
-       my ($PAGE) = @_;
-       our $DBH = ND::DB::DB();
+       my ($DBH,$PAGE) = @_;
        $DBH->do(q{SET timezone = 'GMT'});
 
        our $ERROR;
index bc24cf16e6c6ae0ba2ac111a71564e0773d44a0b..53b6ab089118b5c6932e3959f74964f00952b48e 100644 (file)
@@ -52,7 +52,7 @@ sub render {
                $x = $1;
                $y = $2;
                $z = $3;
-               $BODY->param(Coords => param('coords'));
+               $BODY->param(Coords => "$x:$y".(defined $z ? ":$z" : ''));
        }else{
                $ND::ERROR .= p b q{Couldn't parse coords};
                return $BODY;
@@ -156,7 +156,7 @@ sub render {
                $scan .= q{</table>};
                push @scans, {Scan => $scan};
 
-               $query = $DBH->prepare(q{SELECT x,y,z,tick FROM planet_stats WHERE id = ?});
+               $query = $DBH->prepare(q{SELECT x,y,z,tick FROM planet_stats WHERE id = ? ORDER BY tick ASC});
                $scan = q{
                <p>Previous Coords</p>
                <table><tr><th>Tick</th><th>Value</th><th>Difference</th></tr>};
diff --git a/ND/Web/Pages/Graph.pm b/ND/Web/Pages/Graph.pm
new file mode 100644 (file)
index 0000000..9d8db07
--- /dev/null
@@ -0,0 +1,130 @@
+#**************************************************************************
+#   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 ND::Web::Pages::Graph;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Include;
+use GD::Graph::lines;
+
+$ND::PAGES{graph} = {parse => \&parse, process => \&process, render=> \&render};
+
+sub parse {
+       my ($uri) = @_;
+       $ND::USETEMPLATE = 0;
+}
+
+sub process {
+
+}
+
+sub render {
+       my ($DBH,$uri) = @_;
+
+       my $type;
+       my ($x,$y,$z);
+       if ($uri =~ m{^/\w+/(stats|ranks)/(.*)}){
+               $type = $1;
+               if ($2 =~ m{(\d+)(?: |:)(\d+)(?:(?: |:)(\d+))(?: |:(\d+))?$}){
+                       $x = $1;
+                       $y = $2;
+                       $z = $3;
+               }
+       }
+
+       die "Not a proper type" unless defined $type;
+
+       my %graph_settings = (
+               line_width => 2,
+               y_number_format => sub { prettyValue abs $_[0]},
+               legend_placement => 'BL',
+               #x_label => 'tick',
+               y_label => '',
+               x_label_skip => 50,
+               x_tick_offset => 13,
+               zero_axis => 1,
+               box_axis => 0,
+               boxclr => 'black',
+               axislabelclr => 'black',
+               title => $type,
+               y1_label => 'size',
+               y2_label => 'rest',
+
+
+       );
+
+       my $findGraph;
+       if (defined $z){
+               $findGraph = $DBH->prepare(q{SELECT graph FROM planet_graphs WHERE planet = planetid($1,$2,$3,$4) AND tick = $4 AND type = $5});
+               $findGraph->execute($x,$y,$z,$ND::TICK,$type) or die $DBH->errstr;
+       }
+
+       my $img;
+       if (defined $findGraph and my $graph = $findGraph->fetchrow_hashref){
+               $img = $graph->{graph};
+       }elsif(defined $z){
+               my $planets = $DBH->prepare(q{SELECT id, tick,size,coords(x,y,z),score,size,value,xp,scorerank,sizerank,valuerank,xprank from planets natural join planet_stats where id = planetid($1,$2,$3,$4) ORDER BY tick ASC});
+               $planets->execute($x,$y,$z,$ND::TICK) or die $DBH->errstr;
+
+               my @score;
+               my @size;
+               my @value;
+               my @xp;
+               my @ticks;
+               
+               while (my $tick = $planets->fetchrow_hashref){
+                       push @ticks,$tick->{tick};
+                       if ($type eq 'stats'){
+                               push @score,$tick->{score};
+                               push @size,$tick->{size};
+                               push @value,$tick->{value};
+                               push @xp,$tick->{xp}*60;
+                       }elsif($type eq 'ranks'){
+                               push @score,-$tick->{scorerank};
+                               push @size,-$tick->{sizerank};
+                               push @value,-$tick->{valuerank};
+                               push @xp,-$tick->{xprank};
+                       }
+
+               }
+               my $graph = GD::Graph::lines->new(500,300);
+               if ($type eq 'stats'){
+                       $graph->set_legend(qw{score size value xp*60}) or die $graph->error;
+                       $graph_settings{two_axes} = 1;
+                       $graph_settings{use_axis} = [2,1,2,2];
+               }elsif($type eq 'ranks'){
+                       $graph->set_legend(qw{score size value xp}) or die $graph->error;
+                       $graph_settings{y_max_value} = 0;
+                       $graph_settings{two_axes} = 1;
+                       $graph_settings{use_axis} = [2,1,2,2];
+               }
+               $graph->set(%graph_settings);
+               my $gd = $graph->plot([\@ticks,\@score,\@size,\@value,\@xp]) or die $graph->error;
+               $img = $gd->png;
+       }
+
+       die 'no image' unless defined $img;
+
+       print header(-type=> 'image/png', -Content_Length => length $img);
+       binmode STDOUT;
+       print $img;
+}
+
+1;
index b9d355230ab8e59e53df69e20bdeef9292bf840f..ba4d9275fca771dc65e3ee08506edd662609e06a 100644 (file)
 
        PerlSwitches -T -I/var/www/ndawn/code/
        PerlRequire /var/www/ndawn/code/startup.pl
-       <Location ~ "^/[\w\\/]*(.*\.(pl|php|pm))?$">
+       <Location ~ "^/((\w+\.(pl|php|pm))|[^.]*)$">
                SetHandler perl-script
                PerlResponseHandler ND
        </Location>
index 5dc2eb7656a1bc7e2f6c7b9e3976c5a15bf89b22..4d4dc3f9a1a55cc49205408389b8cd1028802ce4 100644 (file)
@@ -38,6 +38,7 @@ use ND::Web::Pages::PlanetNaps;
 use ND::Web::Pages::Motd;
 use ND::Web::Pages::Forum;
 use ND::Web::Pages::Settings;
+use ND::Web::Pages::Graph;
 
 
 
index 50186a6c69d67ed552f6c2086c3c02a27422920e..d8797c13107f8015d4474409aee2fae85df8312e 100644 (file)
@@ -33,6 +33,10 @@ input,textarea,select {
        background: #B2B2B2;
 }
 
+img.graph {
+       background: gray;
+}
+
 
 legend {
        color: black;
index fce88763eee4f05e8ffcf6b52508d7481e9cc842..18774acd20e243f26ab92b5f24212323d59cd56e 100644 (file)
        </tr>
        </TMPL_LOOP>
 </table>
+<div class="leftinfo">
+<img class="graph" src="graph/stats/<TMPL_VAR NAME=Coords>" alt="stats" height="300" width="500"/>
+<img class="graph" src="graph/ranks/<TMPL_VAR NAME=Coords>" alt="ranks" height="300" width="500"/>
+</div>
 <TMPL_LOOP Scans>
 <div class="leftinfo">
 <TMPL_VAR NAME=Scan>