+++ /dev/null
-#!/usr/bin/perl -w -T
-#**************************************************************************
-# 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::AuthHandler;
-use strict;
-use warnings FATAL => 'all';
-
-use ND::DB;
-use Apache2::Access ();
-
-sub handler {
- my $r = shift;
- my($res, $sent_pw) = $r->get_basic_auth_pw;
- return $res if $res != Apache2::Const::OK;
-
- my $dbh = ND::DB::DB();
- my ($username) = $dbh->selectrow_array(q{SELECT username FROM users WHERE
- lower(username) = lower(?) AND password = MD5(?)},undef,$r->user,$sent_pw);
- $dbh->disconnect;
- if ($username){
- $r->user($username);
- return Apache2::Const::OK;
- }
- $r->note_basic_auth_failure();
- return Apache2::Const::AUTH_REQUIRED;
-}
-
-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 ND::Web::Forum;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw{:standard};
-use HTML::Template;
-use ND::Web::Include;
-require Exporter;
-
-our @ISA = qw/Exporter/;
-our @EXPORT = qw/viewForumThread addForumPost addForumThread markThreadAsRead/;
-
-sub viewForumThread {
- my ($thread) = @_;
-
- my $template = HTML::Template->new(filename => "templates/viewthread.tmpl", global_vars => 1, cache => 1);
-
- $template->param(Id => $thread->{id});
- $template->param(Post => $thread->{post});
-
- my $posts = $ND::DBH->prepare(q{SELECT u.username,date_trunc('seconds',fp.time::timestamp) AS time,fp.message,COALESCE(fp.time > ftv.time,TRUE) AS unread
-FROM forum_threads ft JOIN forum_posts fp USING (ftid) JOIN users u ON u.uid = fp.uid LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $2) ftv ON ftv.ftid = ft.ftid
-WHERE ft.ftid = $1
-ORDER BY fp.time ASC
-});
- $posts->execute($thread->{id},$ND::UID) or $ND::ERROR .= p($ND::DBH->errstr);
- my @posts;
- my $old = 1;
- while (my $post = $posts->fetchrow_hashref){
- if ($old && $post->{unread}){
- $old = 0;
- $post->{NewPosts} = 1;
- }
- $post->{message} = parseMarkup($post->{message});
- push @posts,$post;
- }
-
- if (defined param('cmd') && param('cmd') eq 'Preview'){
- my $text = parseMarkup(escapeHTML(param('message')));
- $text .= p b $@ if $@;
- push @posts,{message => $text, unread => 1, username => 'PREVIEW', Time => 'Not submitted yet', NewPosts => $old ? 1 : 0};
-
- $text = escapeHTML param('message');
- $text =~ s/\x{3}\d\d?//g; #mirc color TODO: possibly match until \x{0F} and change to [color] block
- $text =~ s/[^\x{9}\x{A}\x{D}\x{20}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
- $template->param(Message => $text);
- }
- $template->param(Posts => \@posts);
-
- markThreadAsRead($thread->{id});
-
- return $template->output;
-}
-
-sub addForumPost {
- my ($dbh,$thread,$uid,$message) = @_;
- my $insert = $dbh->prepare(q{INSERT INTO forum_posts (ftid,message,uid) VALUES($1,$2,$3)});
- unless ($insert->execute($thread->{id},escapeHTML($message),$uid)){
- $ND::ERROR .= p($dbh->errstr);
- return 0;
- }
- return 1;
-}
-
-sub addForumThread {
- my ($dbh,$board,$uid,$subject) = @_;
-
- my $insert = $dbh->prepare(q{INSERT INTO forum_threads (fbid,subject,uid) VALUES($1,$2,$3)});
-
- if ($insert->execute($board->{id},escapeHTML($subject),$uid)){
- my $id = $dbh->last_insert_id(undef,undef,undef,undef,"forum_threads_ftid_seq");
- return $dbh->selectrow_hashref(q{SELECT ftid AS id, subject, $2::boolean AS post FROM forum_threads WHERE ftid = $1}
- ,undef,$id,$board->{post})
- or $ND::ERROR .= p($dbh->errstr);
- }else{
- $ND::ERROR .= p($dbh->errstr);
- }
-}
-
-sub markThreadAsRead {
- my ($thread) = @_;
- my $rows = $ND::DBH->do(q{UPDATE forum_thread_visits SET time = now()
-WHERE uid = $1 AND ftid = $2},undef,$ND::UID,$thread);
- if ($rows == 0){
- $ND::DBH->do(q{INSERT INTO forum_thread_visits (uid,ftid) VALUES ($1,$2)}
- ,undef,$ND::UID,$thread) or $ND::ERROR .= p($ND::DBH->errstr);
- }elsif(not defined $rows){
- $ND::ERROR .= p($ND::DBH->errstr);
- }
-}
-
-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 ND::Web::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 ND::Web::Image;
-use strict;
-use warnings;
-
-use base qw/ND::Web::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 ND::Web::Include;
-use strict;
-use warnings;
-use CGI qw{:standard};
-require Exporter;
-use BBCode::Parser;
-
-our @ISA = qw/Exporter/;
-
-our @EXPORT = qw/parseMarkup min max
- alliances intelquery /;
-
-sub parseMarkup ($) {
- my ($text) = @_;
-
- #$text =~ s{\n}{\n<br/>}g;
- #$text =~ s{\[B\](.*?)\[/B\]}{<b>$1</b>}gi;
- #$text =~ s{\[I\](.*?)\[/I\]}{<i>$1</i>}gi;
- #$text =~ s{\[url\](.*?)\[/url\]}{<a href="$1">$1</a>}gi;
- #$text =~ s{\[PRE\](.*?)\[/PRE\]}{<pre>$1</pre>}sgi;
- #$text =~ s{\[PRE\](.*?)\[/PRE\]}{<pre>$1</pre>}sgi;
- #$1 =~ s{<br/>}{}g;
-
- eval{
- my $tree = BBCode::Parser->DEFAULT->parse($text);
- $text = $tree->toHTML;
- };
- $text =~ s/\x{3}\d\d?//g; #mirc color TODO: possibly match until \x{0F} and change to [color] block
- $text =~ s/[^\x{9}\x{A}\x{D}\x{20}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
- return $text;
-}
-
-
-sub min {
- my ($x,$y) = @_;
- return ($x > $y ? $y : $x);
-}
-
-sub max {
- my ($x,$y) = @_;
- return ($x < $y ? $y : $x);
-}
-
-
-sub alliances {
- my ($alliance) = @_;
- my @alliances;
- $alliance = -1 unless defined $alliance;
- push @alliances,{Id => -1, Name => ' ', Selected => not $alliance};
- my $query = $ND::DBH->prepare(q{SELECT id,name FROM alliances ORDER BY name});
- $query->execute;
- while (my $ally = $query->fetchrow_hashref){
- push @alliances,{Id => $ally->{id}, Name => $ally->{name}, Selected => $alliance == $ally->{id}};
- }
- return @alliances;
-}
-
-sub intelquery {
- my ($columns,$where) = @_;
- return qq{
-SELECT $columns, i.mission, i.tick AS landingtick,MIN(i.eta) AS eta, i.amount, i.ingal, u.username
-FROM (intel i NATURAL JOIN users u)
- JOIN current_planet_stats t ON i.target = t.id
- JOIN current_planet_stats o ON i.sender = o.id
-WHERE $where
-GROUP BY i.tick,i.mission,t.x,t.y,t.z,o.x,o.y,o.z,i.amount,i.ingal,u.username,t.alliance,o.alliance,t.nick,o.nick
-ORDER BY i.tick DESC, i.mission};
-}
-
-
-
-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 ND::Web::Page;
-use strict;
-use warnings;
-use CGI qw/:standard/;
-
-our %PAGES;
-
-sub new {
- my $invocant = shift;
- my $class = ref($invocant) || $invocant;
- my $self = {@_};
- $self->{PAGE} = 'main' unless (defined $self->{PAGE} and exists $PAGES{$self->{PAGE}});
- $class = $PAGES{$self->{PAGE}};
- bless $self, $class;
- $self->parse;
- $self->initiate;
- return $self;
-}
-
-sub initiate : method {
- my $self = shift;
- my $DBH = $self->{DBH};
-
- $DBH->do(q{SET timezone = 'GMT'});
-
- ($self->{UID},$self->{PLANET},$self->{USER}) = $DBH->selectrow_array('SELECT uid,planet,username FROM users WHERE username ILIKE ?'
- ,undef,$ENV{'REMOTE_USER'});
- $ND::UID = $self->{UID};
-
- ($self->{TICK}) = $DBH->selectrow_array('SELECT tick()',undef);
- $self->{TICK} = 0 unless defined $self->{TICK};
-
-
- my $query = $DBH->prepare('SELECT groupname,attack,gid from groupmembers NATURAL JOIN groups WHERE uid = ?');
- $query->execute($self->{UID});
-
- while (my ($name,$attack,$gid) = $query->fetchrow()){
- $self->{GROUPS}{$name} = $gid;
- $self->{ATTACKER} = 1 if $attack;
- }
-
-
-}
-
-sub parse : method {
-}
-
-sub render_body : method {
- return "";
-}
-
-sub render : method {
- my $self = shift;
-
- print header;
- print $self->render_body;
-}
-
-sub isInGroup ($) : method {
- my $self = shift;
- my $group = shift;
- return exists $self->{GROUPS}{$group} || exists $self->{GROUPS}{Tech} || exists $self->{GROUPS}{HC};
-}
-
-sub isMember () : method {
- my $self = shift;
- $self->isInGroup('Members');
-}
-
-sub isHC () : method {
- my $self = shift;
- $self->isInGroup('HC');
-}
-
-sub isDC () : method {
- $_[0]->isInGroup('DC');
-}
-
-sub isBC () : method {
- $_[0]->isInGroup('BC');
-}
-
-sub isOfficer () : method {
- $_[0]->isInGroup('Officers');
-}
-
-sub isScanner () : method {
- $_[0]->isInGroup('Scanners');
-}
-
-sub isIntel () : method {
- $_[0]->isInGroup('Intel');
-}
-
-sub isTech () : method {
- $_[0]->isInGroup('Tech');
-}
-
-
-
-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 ND::Web::Pages::AddIntel;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Forum;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{addintel} = 'ND::Web::Pages::AddIntel';
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
-
- my $DBH = $self->{DBH};
-
- $self->{TITLE} = 'Add Intel and Scans';
-
- my $error;
-
- return $self->noAccess unless $self->isMember;
-
- if (defined param('cmd')){
- if (param('cmd') eq 'submit' || param('cmd') eq 'submit_message'){
- my $findscan = $DBH->prepare("SELECT scan_id FROM scans WHERE scan_id = ? AND tick >= tick() - 168");
- my $addscan = $DBH->prepare('INSERT INTO scans (scan_id,tick,"type") VALUES (?,tick(),?)');
- my $addpoint = $DBH->prepare('UPDATE users SET scan_points = scan_points + 1 WHERE uid = ? ');
- my $intel = param('intel');
- my @scans;
- while ($intel =~ m/http:\/\/game.planetarion.com\/.+?scan(?:_id)?=(\d+)/g){
- my %scan;
- $scan{Scan} = $1;
- $scan{Message} = "Scan $1: ";
- $findscan->execute($1);
- if ($findscan->rows == 0){
- if ($addscan->execute($1,$ND::UID)){
- $addpoint->execute($ND::UID);
- $scan{Message} .= '<i>added</i>';
- }else{
- $scan{Message} .= "<b>something went wrong:</b> <i>$DBH->errstr</i>";
- }
- }else{
- $scan{Message} .= '<b>already exists</b>';
- }
- push @scans,\%scan;
- }
- $BODY->param(Scans => \@scans);
- my $tick = $self->{TICK};
- $tick = param('tick') if $tick =~ /^(\d+)$/;
- my $addintel = $DBH->prepare(qq{SELECT add_intel(?,?,?,?,?,?,?,?,?,?,?)});
- while ($intel =~ m/(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\*?\s+.+(?:Ter|Cat|Xan|Zik|Etd)?\s+(\d+)\s+(Attack|Defend)\s+(\d+)/g){
- $addintel->execute($tick,$9, $1,$2,$3,$4,$5,$6,$7,$8,$ND::UID) or $error .= $DBH->errstr;
- }
- }
- if (param('cmd') eq 'submit_message'){
- my $board = {id => 12};
- my $subject = param('subject');
- unless ($subject){
- if (param('intel') =~ /(.*\w.*)/){
- $subject = $1;
- }
-
- }
- if (my $thread = addForumThread $DBH,$board,$ND::UID,$subject){
- $error .= p 'Intel message added' if addForumPost $DBH,$thread,$ND::UID,param('intel')
- }
- }
- }
- $BODY->param(Tick => $self->{TICK});
- $BODY->param(Error => $error);
- return $BODY;
-}
-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 ND::Web::Pages::AllianceRankings;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{alliancerankings} = __PACKAGE__;
-
-sub parse {
- #TODO: Need to fix some links first
- #if ($uri =~ m{^/[^/]+/(\w+)}){
- # param('order',$1);
- #}
-}
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Top Alliances';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isMember;
-
- my $error = '';
-
- $BODY->param(isHC => $self->isHC);
-
- my $offset = 0;
- if (defined param('offset') && param('offset') =~ /^(\d+)$/){
- $offset = $1;
- }
- $BODY->param(Offset => $offset);
- $BODY->param(PrevOffset => $offset - 100);
- $BODY->param(NextOffset => $offset + 100);
-
- my $order = 'scorerank';
- if (defined param('order') && param('order') =~ /^(scorerank|sizerank|members|avgsize|avgscore)$/){
- $order = $1;
- }
- $BODY->param(Order => $order);
- $order .= ' DESC' unless $order =~ /rank$/;
-
-
- #my $extra_columns = '';
- #if ($self->isHC){
- # $extra_columns = ",alliance_status,hit_us, alliance,relationship,nick";
- #}
- my $query = $DBH->prepare(qq{SELECT a.name,
- size, size_gain, size_gain_day,
- score,score_gain,score_gain_day,
- avgsize,avgsize_gain,avgsize_gain_day,
- avgscore,avgscore_gain,avgscore_gain_day,
- sizerank,sizerank_gain,sizerank_gain_day,
- scorerank,scorerank_gain,scorerank_gain_day,
- members,members_gain,members_gain_day
- FROM
- ( SELECT id, members,members_gain,members_gain_day, size, score, (size/members) AS avgsize, (score/members) AS avgscore, sizerank, scorerank, size_gain, score_gain, (size_gain/members) AS avgsize_gain, (score_gain/members) AS avgscore_gain, sizerank_gain, scorerank_gain, size_gain_day, score_gain_day, (size_gain_day/members) AS avgsize_gain_day, (score_gain_day/members) AS avgscore_gain_day, sizerank_gain_day, scorerank_gain_day
- FROM alliance_stats WHERE tick = (( SELECT max(tick) AS max FROM alliance_stats))) ast
- NATURAL JOIN alliances a
- ORDER BY $order LIMIT 100 OFFSET ?});
- $query->execute($offset) or $error .= p($DBH->errstr);
- my @alliances;
- my $i = 0;
- while (my $alliance = $query->fetchrow_hashref){
- for my $type (qw/members size score avgsize avgscore/){
- #$alliance->{$type} = prettyValue($alliance->{$type});
- next unless defined $alliance->{"${type}_gain_day"};
- $alliance->{"${type}img"} = 'stay';
- $alliance->{"${type}img"} = 'up' if $alliance->{"${type}_gain_day"} > 0;
- $alliance->{"${type}img"} = 'down' if $alliance->{"${type}_gain_day"} < 0;
- if( $type eq 'size' || $type eq 'score'){
- $alliance->{"${type}rankimg"} = 'stay';
- $alliance->{"${type}rankimg"} = 'up' if $alliance->{"${type}rank_gain_day"} < 0;
- $alliance->{"${type}rankimg"} = 'down' if $alliance->{"${type}rank_gain_day"} > 0;
- }
- for my $type ($type,"${type}_gain","${type}_gain_day"){
- $alliance->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
- }
- }
- $i++;
- $alliance->{ODD} = $i % 2;
- push @alliances,$alliance;
- }
- $BODY->param(Alliances => \@alliances);
- $BODY->param(Error => $error);
- return $BODY;
-}
-
-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 ND::Web::Pages::Alliances;
-use strict;
-use warnings FATAL => 'all';
-use ND::Include;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{alliances} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Alliances';
- my $DBH = $self->{DBH};
- my $error;
-
- return $self->noAccess unless $self->isHC;
-
- my $alliance;
- if (defined param('alliance') && param('alliance') =~ /^(\d+)$/){
- my $query = $DBH->prepare(q{SELECT id,name, relationship FROM alliances WHERE id = ?});
- $alliance = $DBH->selectrow_hashref($query,undef,$1);
- }
- if ($alliance && defined param('cmd') && param ('cmd') eq 'change'){
- $DBH->begin_work;
- if (param('crelationship')){
- my $value = escapeHTML(param('relationship'));
- if ($DBH->do(q{UPDATE alliances SET relationship = NULLIF(?,'') WHERE id =?}
- ,undef,$value,$alliance->{id})){
- $alliance->{relationship} = $value;
- log_message $ND::UID,"HC set alliance: $alliance->{id} relationship: $value";
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- my $coords = param('coords');
- my $findplanet = $DBH->prepare(q{SELECT id FROM current_planet_stats WHERE x = ? AND y = ? AND z = ?});
- my $addplanet = $DBH->prepare(q{
- UPDATE planets SET alliance_id = $2, nick = coalesce($3,nick)
- WHERE id = $1;
- });
- while ($coords =~ m/(\d+):(\d+):(\d+)(?:\s+nick=(\S+))?/g){
- my ($id) = $DBH->selectrow_array($findplanet,undef,$1,$2,$3) or $ND::ERROR .= p $DBH->errstr;
- if ($addplanet->execute($id,$alliance->{id},$4)){
- my $nick = '';
- $nick = "(nick $4)" if defined $4;
- $error .= "<p> Added planet $1:$2:$3 $nick to this alliance</p>";
- intel_log $ND::UID,$id,"HC Added planet $1:$2:$3 $nick to alliance: $alliance->{id} ($alliance->{name})";
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
-
- if ($alliance){
- $BODY->param(Alliance => $alliance->{name});
- $BODY->param(Id => $alliance->{id});
- my @relationships;
- for my $relationship ("","Friendly", "NAP", "Hostile"){
- push @relationships,{Rel => $relationship, Selected => defined $alliance->{relationship} && $relationship eq $alliance->{relationship}}
- }
- $BODY->param(Relationships => \@relationships);
-
- my $order = "p.x,p.y,p.z";
- if (defined param('order') && param('order') =~ /^(score|size|value|xp|hit_us|race)$/){
- $order = "$1 DESC";
- }
- my $members = $DBH->prepare(qq{
- SELECT coords(x,y,z), nick, ruler, planet, race, size, score, value, xp,
- planet_status,hit_us, sizerank, scorerank, valuerank, xprank
- FROM current_planet_stats p
- WHERE p.alliance_id = ?
- ORDER BY $order});
- my @members;
- $members->execute($alliance->{id});
- my $i = 0;
- while (my $member = $members->fetchrow_hashref){
- $i++;
- $member->{ODD} = $i % 2;
- push @members,$member;
- }
- $BODY->param(Members => \@members);
-
- my $query = $DBH->prepare(intelquery('o.alliance AS oalliance,coords(o.x,o.y,o.z) AS origin, t.alliance AS talliance,coords(t.x,t.y,t.z) AS target',q{not ingal AND (o.alliance_id = $1 OR t.alliance_id = $1)
- AND (i.mission = 'Defend' OR i.mission = 'AllyDef')
- AND ((( t.alliance_id != o.alliance_id OR t.alliance_id IS NULL OR o.alliance_id IS NULL)))
- AND i.sender NOT IN (SELECT planet FROM users u NATURAL JOIN groupmembers gm WHERE gid = 8 AND planet IS NOT NULL)
- }));
- $query->execute($alliance->{id}) or $error .= $DBH->errstr;
-
- my @intel;
- $i = 0;
- while (my $intel = $query->fetchrow_hashref){
- if ($intel->{ingal}){
- $intel->{missionclass} = 'ingal';
- }else{
- $intel->{missionclass} = $intel->{mission};
- }
- $i++;
- $intel->{ODD} = $i % 2;
- push @intel,$intel;
- }
- $BODY->param(Intel => \@intel);
- }else{
-
- my $order = "score DESC";
- if (defined param('order') && param('order') =~ /^(score|kscore|size|ksize|members|kmem|kxp|kxp|scavg|kscavg|siavg|ksiavg|kxpavg|kvalue|kvalavg)$/){
- $order = "$1 DESC";
- }
- my $query = $DBH->prepare(qq{
- SELECT DISTINCT a.id,name,COALESCE(s.score,SUM(p.score)) AS score,COALESCE(s.size,SUM(p.size)) AS size,s.members,count(p.score) AS kmem,
- COALESCE(SUM(p.score),-1) AS kscore, COALESCE(SUM(p.size),-1) AS ksize, COALESCE(SUM(p.xp),-1) AS kxp,COALESCE(SUM(p.value),-1) AS kvalue,
- COALESCE(s.score/s.members,-1) AS scavg, COALESCE(AVG(p.score)::int,-1) AS kscavg, COALESCE(s.size/s.members,-1) AS siavg,
- COALESCE(AVG(p.size)::int,-1) AS ksiavg, COALESCE(AVG(p.xp)::int,-1) AS kxpavg, COALESCE(AVG(p.value)::int,-1) AS kvalavg
- FROM alliances a
- LEFT OUTER JOIN (SELECT * FROM alliance_stats WHERE tick = (SELECT max(tick) FROM alliance_stats)) s ON s.id = a.id
- LEFT OUTER JOIN current_planet_stats p ON p.alliance_id = a.id
- GROUP BY a.id,a.name,s.score,s.size,s.members
- ORDER BY $order
- })or $error .= $DBH->errstr;
- $query->execute or $error .= $DBH->errstr;
- my @alliances;
- my $i = 0;
- while (my $alliance = $query->fetchrow_hashref){
- next unless (defined $alliance->{score} || $alliance->{kscore} > 0);
- $i++;
- $alliance->{ODD} = $i % 2;
- push @alliances, $alliance;
- }
- $BODY->param(Alliances => \@alliances);
- }
- $BODY->param(Error => $error);
- return $BODY;
-}
-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 ND::Web::Pages::Calls;
-use strict;
-use warnings FATAL => 'all';
-use ND::Include;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{calls} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Defense Calls';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isDC;
-
- my $error;
-
- my $call;
- if (defined param('call') && param('call') =~ /^(\d+)$/){
- my $query = $DBH->prepare(q{
- SELECT c.id, coords(p.x,p.y,p.z), c.landing_tick, c.info, covered, open, dc.username AS dc, u.defense_points,c.member,u.planet
- FROM calls c
- JOIN users u ON c.member = u.uid
- LEFT OUTER JOIN users dc ON c.dc = dc.uid
- JOIN current_planet_stats p ON u.planet = p.id
- WHERE c.id = ?});
- $call = $DBH->selectrow_hashref($query,undef,$1);
- }
- if ($call && defined param('cmd')){
- if (param('cmd') eq 'Submit'){
- $DBH->begin_work;
- if (param('ctick')){
- if ($DBH->do(q{UPDATE calls SET landing_tick = ? WHERE id = ?}
- ,undef,param('tick'),$call->{id})){
- $call->{landing_tick} = param('tick');
- log_message $ND::UID,"DC updated landing tick for call $call->{id}";
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- if (param('cinfo')){
- if ($DBH->do(q{UPDATE calls SET info = ? WHERE id = ?}
- ,undef,param('info'),$call->{id})){
- $call->{info} = param('info');
- log_message $ND::UID,"DC updated info for call $call->{id}";
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }elsif(param('cmd') =~ /^(Cover|Uncover|Ignore|Open|Take) call$/){
- $error .= "test";
- my $extra_vars = '';
- if (param('cmd') eq 'Cover call'){
- $extra_vars = ", covered = TRUE, open = FALSE";
- }elsif (param('cmd') eq 'Uncover call'){
- $extra_vars = ", covered = FALSE, open = TRUE";
- }elsif (param('cmd') eq 'Ignore call'){
- $extra_vars = ", covered = FALSE, open = FALSE";
- }elsif (param('cmd') eq 'Open call'){
- $extra_vars = ", covered = FALSE, open = TRUE";
- }
- if ($DBH->do(qq{UPDATE calls SET dc = ? $extra_vars WHERE id = ?},
- ,undef,$ND::UID,$call->{id})){
- $call->{covered} = (param('cmd') eq 'Cover call');
- $call->{open} = (param('cmd') =~ /^(Uncover|Open) call$/);
- $call->{DC} = $self->{USER};
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }elsif(param('cmd') eq 'Remove'){
- $DBH->begin_work;
- my $query = $DBH->prepare(q{DELETE FROM incomings WHERE id = ? AND call = ?});
- for my $param (param()){
- if ($param =~ /^change:(\d+)$/){
- if($query->execute($1,$call->{id})){
- log_message $ND::UID,"DC deleted fleet: $1, call $call->{id}";
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- }
- $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }elsif(param('cmd') eq 'Change'){
- $DBH->begin_work;
- my $query = $DBH->prepare(q{UPDATE incomings SET shiptype = ? WHERE id = ? AND call = ?});
- for my $param (param()){
- if ($param =~ /^change:(\d+)$/){
- my $shiptype = escapeHTML(param("shiptype:$1"));
- if($query->execute($shiptype,$1,$call->{id})){
- log_message $ND::UID,"DC set fleet: $1, call $call->{id} to: $shiptype";
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- }
- $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
-
- if ($call){
- $BODY->param(Call => $call->{id});
- $BODY->param(Coords => $call->{coords});
- $BODY->param(DefensePoints => $call->{defense_points});
- $BODY->param(LandingTick => $call->{landing_tick});
- $BODY->param(ETA => $call->{landing_tick}-$self->{TICK});
- $BODY->param(Info => escapeHTML $call->{info});
- $BODY->param(DC => $call->{dc});
- if ($call->{covered}){
- $BODY->param(Cover => 'Uncover');
- }else{
- $BODY->param(Cover => 'Cover');
- }
- if ($call->{open} && !$call->{covered}){
- $BODY->param(Ignore => 'Ignore');
- }else{
- $BODY->param(Ignore => 'Open');
- }
- my $fleets = $DBH->prepare(q{
- SELECT id,mission,landing_tick,eta, back FROM fleets WHERE uid = ? AND (fleet = 0 OR (back >= ? AND landing_tick - eta - 11 < ? ))
- ORDER BY fleet ASC});
- my $ships = $DBH->prepare('SELECT ship,amount FROM fleet_ships WHERE fleet = ?');
- $fleets->execute($call->{member},$call->{landing_tick},$call->{landing_tick});
- my @fleets;
- while (my $fleet = $fleets->fetchrow_hashref){
- if ($fleet->{back} == $call->{landing_tick}){
- $fleet->{Fleetcatch} = 1;
- }
- $ships->execute($fleet->{id});
- my @ships;
- my $i = 0;
- while (my $ship = $ships->fetchrow_hashref){
- $i++;
- $ship->{ODD} = $i % 2;
- push @ships,$ship;
- }
- $fleet->{Ships} = \@ships;
- push @fleets, $fleet;
- }
- $BODY->param(Fleets => \@fleets);
-
-
- $fleets = $DBH->prepare(q{
- SELECT username, id,back - (landing_tick + eta - 1) AS recalled FROM fleets f JOIN users u USING (uid) WHERE target = $1 and landing_tick = $2
- });
- $fleets->execute($call->{planet},$call->{landing_tick}) or $ND::ERROR .= p $DBH->errstr;
- my @defenders;
- while (my $fleet = $fleets->fetchrow_hashref){
- $ships->execute($fleet->{id});
- my @ships;
- my $i = 0;
- while (my $ship = $ships->fetchrow_hashref){
- $i++;
- $ship->{ODD} = $i % 2;
- push @ships,$ship;
- }
- $fleet->{Ships} = \@ships;
- delete $fleet->{id};
- push @defenders, $fleet;
- }
- $BODY->param(Defenders => \@defenders);
-
- my $attackers = $DBH->prepare(q{
- SELECT coords(p.x,p.y,p.z), p.planet_status, p.race,i.eta,i.amount,i.fleet,i.shiptype,p.relationship,p.alliance,i.id
- FROM incomings i
- JOIN current_planet_stats p ON i.sender = p.id
- WHERE i.call = ?
- ORDER BY p.x,p.y,p.z});
- $attackers->execute($call->{id});
- my @attackers;
- my $i = 0;
- while(my $attacker = $attackers->fetchrow_hashref){
- $i++;
- $attacker->{ODD} = $i % 2;
- push @attackers,$attacker;
- }
- $BODY->param(Attackers => \@attackers);
- }else{
- my $where = 'open AND c.landing_tick-6 > tick()';
- if (defined param('show')){
- if (param('show') eq 'covered'){
- $where = 'covered';
- }elsif (param('show') eq 'all'){
- $where = 'true';
- }elsif (param('show') eq 'uncovered'){
- $where = 'not covered';
- }
- }
- my $pointlimits = $DBH->prepare(q{SELECT value :: int FROM misc WHERE id = ?});
- my ($minpoints) = $DBH->selectrow_array($pointlimits,undef,'DEFMIN');
- my ($maxpoints) = $DBH->selectrow_array($pointlimits,undef,'DEFMAX');
-
- my $query = $DBH->prepare(qq{
- SELECT id,coords(x,y,z),defense_points,landing_tick,dc,curreta,fleets,
- TRIM('/' FROM concat(DISTINCT race||' /')) AS race, TRIM('/' FROM concat(amount||' /')) AS amount,
- TRIM('/' FROM concat(DISTINCT eta||' /')) AS eta, TRIM('/' FROM concat(DISTINCT shiptype||' /')) AS shiptype,
- TRIM('/' FROM concat(DISTINCT alliance ||' /')) AS alliance,
- TRIM('/' FROM concat(coords||' /')) AS attackers
- FROM (SELECT c.id, p.x,p.y,p.z, u.defense_points, c.landing_tick, dc.username AS dc,
- (c.landing_tick - tick()) AS curreta,p2.race, i.amount, i.eta, i.shiptype, p2.alliance,
- coords(p2.x,p2.y,p2.z), COUNT(DISTINCT f.id) AS fleets
- FROM calls c
- JOIN incomings i ON i.call = c.id
- JOIN users u ON c.member = u.uid
- JOIN current_planet_stats p ON u.planet = p.id
- JOIN current_planet_stats p2 ON i.sender = p2.id
- LEFT OUTER JOIN users dc ON c.dc = dc.uid
- LEFT OUTER JOIN fleets f ON f.target = u.planet AND f.landing_tick = c.landing_tick AND f.back = f.landing_tick + f.eta - 1
- WHERE $where
- GROUP BY c.id, p.x,p.y,p.z, c.landing_tick, u.defense_points,dc.username,p2.race,i.amount,i.eta,i.shiptype,p2.alliance,p2.x,p2.y,p2.z) a
- GROUP BY id, x,y,z,landing_tick, defense_points,dc,curreta,fleets
- ORDER BY landing_tick DESC
- })or $error .= $DBH->errstr;
- $query->execute or $error .= $DBH->errstr;
- my @calls;
- my $i = 0;
- my $tick = $self->{TICK};
- while (my $call = $query->fetchrow_hashref){
- if ($call->{defense_points} < $minpoints){
- $call->{DefPrio} = 'LowestPrio';
- }elsif ($call->{defense_points} < $maxpoints){
- $call->{DefPrio} = 'MediumPrio';
- }else{
- $call->{DefPrio} = 'HighestPrio';
- }
- while ($tick - 24 > $call->{landing_tick}){
- $tick -= 24;
- push @calls,{};
- $i = 0;
- }
- $call->{attackers} =~ s{(\d+:\d+:\d+)}{<a href="/check?coords=$1">$1</a>}g;
- $call->{dcstyle} = 'Hostile' unless defined $call->{dc};
- $i++;
- $call->{ODD} = $i % 2;
- $call->{shiptype} = escapeHTML($call->{shiptype});
- push @calls, $call;
- }
- $BODY->param(Calls => \@calls);
- }
- $BODY->param(Error => $error);
- return $BODY;
-}
-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 ND::Web::Pages::Check;
-use strict;
-use warnings FATAL => 'all';
-no warnings qw(uninitialized);
-use ND::Include;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{check} = __PACKAGE__;
-
-sub parse {
- my $self = shift;
- if ($self->{URI} =~ m{^/.*/((\d+)(?: |:)(\d+)(?:(?: |:)(\d+))?(?: |:(\d+))?)$}){
- param('coords',$1);
- }
-}
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Check planets and galaxies';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->{ATTACKER};
-
- $BODY->param(isBC => $self->isMember && ($self->isOfficer || $self->isBC));
-
- my ($x,$y,$z);
- if (param('coords') =~ /(\d+)(?: |:)(\d+)(?:(?: |:)(\d+))?(?: |:(\d+))?/){
- $x = $1;
- $y = $2;
- $z = $3;
- $BODY->param(Coords => "$x:$y".(defined $z ? ":$z" : ''));
- }else{
- $ND::ERROR .= p b q{Couldn't parse coords};
- return $BODY;
- }
-
- if ($self->isMember && param('cmd') eq 'arbiter'){
- my $query = $DBH->prepare(q{SELECT count(*) AS friendlies FROM current_planet_stats WHERE x = ? AND y = ?
- AND (planet_status IN ('Friendly','NAP') OR relationship IN ('Friendly','NAP'))});
- my ($count) = $DBH->selectrow_array($query,undef,$x,$y);
- if ($count > 0){
- $BODY->param(Arbiter => '<b>DO NOT ATTACK THIS GAL</b>');
- }else{
- $BODY->param(Arbiter => '<b>KILL THESE BASTARDS</b>');
- }
- log_message $ND::UID,"Arbiter check on $x:$y";
- }
-
- my $where = '';
- my $extra_columns = '';
-
- $where = 'AND z = ?' if defined $z;
- if ($self->isMember && $self->isOfficer){
- $extra_columns = ",planet_status,hit_us, alliance,relationship,nick";
- }elsif ($self->isMember && $self->isBC){
- $extra_columns = ", planet_status,hit_us, alliance,relationship";
- }
-
- my $query = $DBH->prepare(qq{Select id,coords(x,y,z), ((ruler || ' OF ') || p.planet) as planet,race,
- size, size_gain, size_gain_day,
- score,score_gain,score_gain_day,
- value,value_gain,value_gain_day,
- xp,xp_gain,xp_gain_day,
- sizerank,sizerank_gain,sizerank_gain_day,
- scorerank,scorerank_gain,scorerank_gain_day,
- valuerank,valuerank_gain,valuerank_gain_day,
- xprank,xprank_gain,xprank_gain_day,
- p.value - p.size*200 - coalesce(c.metal+c.crystal+c.eonium,0)/150 - coalesce(c.structures,(SELECT avg(structures) FROM covop_targets)::int)*1500 AS fleetvalue,(c.metal+c.crystal+c.eonium)/100 AS resvalue $extra_columns from current_planet_stats_full p LEFT OUTER JOIN covop_targets c ON p.id = c.planet where x = ? AND y = ? $where order by x,y,z asc});
-
- if (defined $z){
- $query->execute($x,$y,$z);
- }else{
- $query->execute($x,$y);
- if ($self->isMember && ($self->isBC || $self->isOfficer) && !$self->isHC){
- log_message $ND::UID,"BC browsing $x:$y";
- }
- }
- my @planets;
- my $planet_id = undef;
- my $i = 0;
- while (my $planet = $query->fetchrow_hashref){
- $planet_id = $planet->{id};
- for my $type (qw/size score value xp/){
- $planet->{"${type}img"} = 'stay';
- $planet->{"${type}img"} = 'up' if $planet->{"${type}_gain_day"} > 0;
- $planet->{"${type}img"} = 'down' if $planet->{"${type}_gain_day"} < 0;
- $planet->{"${type}rankimg"} = 'stay';
- $planet->{"${type}rankimg"} = 'up' if $planet->{"${type}rank_gain_day"} < 0;
- $planet->{"${type}rankimg"} = 'down' if $planet->{"${type}rank_gain_day"} > 0;
- for my $type ($type,"${type}_gain","${type}_gain_day"){
- $planet->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
- }
- }
- if ($self->isMember && ($self->isOfficer || $self->isBC)){
- if ($z && $planet->{alliance} eq 'NewDawn' && not ($self->isHC || $self->isOfficer)){
- log_message $ND::UID,"BC browsing ND planet $planet->{coords} tick $self->{TICK}";
- }
- }
- $i++;
- $planet->{ODD} = $i % 2;
- delete $planet->{id};
- push @planets,$planet;
- }
- $BODY->param(GPlanets => \@planets);
-
- if ($z && $planet_id){
- $BODY->param(OnePlanet => 1);
-
- my $query = $DBH->prepare(q{
- SELECT i.mission, i.tick AS landingtick,MIN(eta) AS eta, i.amount, coords(p.x,p.y,p.z) AS target
- FROM intel i
- JOIN (planets
- NATURAL JOIN planet_stats) p ON i.target = p.id
- JOIN (planets
- NATURAL JOIN planet_stats) p2 ON i.sender = p2.id
- WHERE p.tick = ( SELECT max(tick) FROM planet_stats) AND i.tick > tick() AND i.uid = -1
- AND p2.tick = p.tick AND p2.id = ?
- GROUP BY p.x,p.y,p.z,p2.x,p2.y,p2.z,i.mission,i.tick,i.amount,i.ingal,i.uid
- ORDER BY p.x,p.y,p.z});
- $query->execute($planet_id);
- my @missions;
- while (my ($mission,$landingtick,$eta,$amount,$target) = $query->fetchrow){
- push @missions,{Target => $target, Mission => $mission, LandingTick => $landingtick
- , ETA => $eta, Amount => $amount};
- }
- $BODY->param(Missions => \@missions);
-
- my @scans;
- $query = $DBH->prepare(q{SELECT value,tick FROM planet_stats
- WHERE id = ? AND tick > tick() - 24});
- my $scan = q{
- <p>Value the last 24 ticks</p>
- <table><tr><th>Tick</th><th>Value</th><th>Difference</th></tr>};
- my $old = 0;
- $query->execute($planet_id);
- while (my($value,$tick) = $query->fetchrow){
- my $diff = $value-$old;
- $old = $value;
- my $class = 'Defend';
- $class = 'Attack' if $diff < 0;
- $scan .= qq{<tr><td>$tick</td><td>$value</td><td class="$class">$diff</td></tr>};
- }
- $scan .= q{</table>};
- push @scans, {Scan => $scan};
-
- $query = $DBH->prepare(q{SELECT DISTINCT ON (type) type,scan_id, tick, scan FROM scans WHERE planet = ?
- GROUP BY type,scan_id, tick, scan ORDER BY type,tick DESC});
- $query->execute($planet_id);
- my %scans;
- while (my($type,$scan_id,$tick,$scan) = $query->fetchrow){
- $scans{$type} = [$scan_id,$tick,$scan];
- }
-
- $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>};
- $query->execute($planet_id);
- $x = $y = $z = 0;
- while (my($nx,$ny,$nz,$tick) = $query->fetchrow){
- if ($nx != $x || $ny != $y || $nz != $z){
- $x = $nx;
- $y = $ny;
- $z = $nz;
- $scan .= qq{<tr><td>$tick</td><td>$x:$y:$z</td></tr>};
- }
- }
- $scan .= q{</table>};
- $scan .= $scans{'Ship Classes'}->[2] if $scans{'Ship Classes'};
- push @scans, {Scan => $scan};
-
- for my $type ('Planet','Jumpgate','Unit','Advanced Unit','Surface Analysis','Technology Analysis','Fleet Analysis','News'){
- next unless exists $scans{$type};
- my $scan_id = $scans{$type}->[0];
- my $tick = $scans{$type}->[1];
- my $scan = $scans{$type}->[2];
- if ($self->{TICK} - $tick > 10){
- $scan =~ s{<table( cellpadding="\d+")?>}{<table$1 class="old">};
- }
- push @scans,{Scan => qq{
- <p><b><a href="http://game.planetarion.com/showscan.pl?scan_id=$scan_id">$type</a> Scan from tick $tick</b></p>
- $scan}};
- }
-
- $BODY->param(Scans => \@scans);
- }
- $query = $DBH->prepare(q{SELECT x,y,
- size, size_gain, size_gain_day,
- score,score_gain,score_gain_day,
- value,value_gain,value_gain_day,
- xp,xp_gain,xp_gain_day,
- sizerank,sizerank_gain,sizerank_gain_day,
- scorerank,scorerank_gain,scorerank_gain_day,
- valuerank,valuerank_gain,valuerank_gain_day,
- xprank,xprank_gain,xprank_gain_day,
- planets,planets_gain,planets_gain_day
- FROM galaxies g
- WHERE tick = ( SELECT max(tick) AS max FROM galaxies)
- AND x = $1 AND y = $2
- });
- $query->execute($x,$y) or $ND::ERROR .= p($DBH->errstr);
-
- my @galaxies;
- $i = 0;
- while (my $galaxy = $query->fetchrow_hashref){
- for my $type (qw/planets size score xp value/){
- #$galaxy->{$type} = prettyValue($galaxy->{$type});
- next unless defined $galaxy->{"${type}_gain_day"};
- $galaxy->{"${type}img"} = 'stay';
- $galaxy->{"${type}img"} = 'up' if $galaxy->{"${type}_gain_day"} > 0;
- $galaxy->{"${type}img"} = 'down' if $galaxy->{"${type}_gain_day"} < 0;
- unless( $type eq 'planets'){
- $galaxy->{"${type}rankimg"} = 'stay';
- $galaxy->{"${type}rankimg"} = 'up' if $galaxy->{"${type}rank_gain_day"} < 0;
- $galaxy->{"${type}rankimg"} = 'down' if $galaxy->{"${type}rank_gain_day"} > 0;
- }
- for my $type ($type,"${type}_gain","${type}_gain_day"){
- $galaxy->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
- }
- }
- $i++;
- $galaxy->{ODD} = $i % 2;
- push @galaxies,$galaxy;
- }
- $BODY->param(Galaxies => \@galaxies);
-
- return $BODY;
-}
-
-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 ND::Web::Pages::CovOp;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{covop} = __PACKAGE__;
-
-sub parse {
- my ($uri) = @_;
- if ($uri =~ m{^/.*/(\w+)$}){
- param('list',$1);
- }
-}
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'CovOp Targets';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isHC;
-
- my $show = q{AND ((planet_status IS NULL OR NOT planet_status IN ('Friendly','NAP')) AND (relationship IS NULL OR NOT relationship IN ('Friendly','NAP')))};
- $show = '' if defined param('show') && param('show') eq 'all';
- if (defined param('covop') && param('covop') =~ /^(\d+)$/){
- my $update = $DBH->prepare('UPDATE covop_targets SET covop_by = ?, last_covop = tick() WHERE planet = ? ');
- $update->execute($ND::UID,$1);
- }
-
- my $list = '';
- my $where = '';
- if (defined param('list') && param('list') eq 'distwhores'){
- $list = '&list=distwhores';
- $where = qq{WHERE dists > 0 $show
- ORDER BY dists DESC,COALESCE(sec_centres::float/structures*100,0)ASC}
- }else{
- $where = qq{WHERE MaxResHack > 130000
- $show
- ORDER BY COALESCE(sec_centres::float/structures*100,0) ASC,MaxResHack DESC,metal+crystal+eonium DESC};
- }
-
- my $query = $DBH->prepare(qq{SELECT id, coords, metal, crystal, eonium, sec_centres::float/structures*100 AS secs, dists, last_covop, username, MaxResHack
- FROM (SELECT p.id,coords(x,y,z), metal,crystal,eonium,
- sec_centres,NULLIF(structures,0) AS structures,dists,last_covop,
- u.username,max_bank_hack(metal,crystal,eonium,p.value,(SELECT value FROM
- current_planet_stats WHERE id = ?)) AS MaxResHack, planet_status, relationship
- FROM covop_targets c JOIN current_planet_stats p ON p.id = c.planet
- LEFT OUTER JOIN users u ON u.uid = c.covop_by) AS foo
- $where});
- $query->execute($self->{PLANET});
-
- my @targets;
- my $i = 0;
- while (my ($id,$coords,$metal,$crystal,$eonium,$seccents,$dists,$lastcovop,$user,$max) = $query->fetchrow){
- $i++;
- push @targets,{Username => $user, Target => $id, Coords => $coords
- , Metal => $metal, Crystal => $crystal, Eonium => $eonium, SecCents => $seccents
- , Dists => $dists, MaxResHack => $max, LastCovOp => $lastcovop, List => $list, ODD => $i % 2};
- }
- $BODY->param(Targets => \@targets);
- return $BODY;
-}
-
-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 ND::Web::Pages::DefLeeches;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{defLeeches} = __PACKAGE__;
-
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Def Leeches';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isDC;
-
- my $query = $DBH->prepare(q{SELECT username,defense_points,count(id) AS calls, SUM(fleets) AS fleets, SUM(recalled) AS recalled
- FROM (SELECT username,defense_points,c.id,count(f.target) AS fleets, count(NULLIF(f.landing_tick + f.eta -1 = f.back,TRUE)) AS recalled
- FROM users u JOIN calls c ON c.member = u.uid LEFT OUTER JOIN fleets f ON u.planet = f.target AND c.landing_tick = f.landing_tick
- WHERE (f.mission = 'Defend') OR f.target IS NULL
- GROUP BY username,defense_points,c.id
- ) d
- GROUP BY username,defense_points ORDER BY fleets DESC, defense_points
- });
- $query->execute;
-
- my @members;
- my $i = 0;
- while ( my $member = $query->fetchrow_hashref){
- $member->{ODD} = $i++ % 2;
- push @members,$member;
- }
- $BODY->param(Members => \@members);
- return $BODY;
-}
-
-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 ND::Web::Pages::DefRequest;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{defrequest} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Request Defense';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isMember;
-
- my $error;
-
- if (defined param('cmd') && param('cmd') eq 'submit'){
- my $insert = $DBH->prepare('INSERT INTO defense_requests (uid,message) VALUES (?,?)');
- if($insert->execute($ND::UID,param('message'))){
- $BODY->param(Reply => param('message'));
- }else{
- $error .= "<b>".$DBH->errstr."</b>";
- }
- }
- $BODY->param(Error => $error);
- return $BODY;
-}
-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 ND::Web::Pages::EditRaid;
-use strict;
-use warnings FATAL => 'all';
-use ND::Include;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{editRaid} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Create/Edit Raids';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isBC;
- my $error;
-
- my @alliances = alliances();
- $BODY->param(Alliances => \@alliances);
-
- my $raid;
- if (defined param 'raid' and param('raid') =~ /^(\d+)$/){
- my $query = $DBH->prepare(q{SELECT id,tick,waves,message,released_coords,open FROM raids WHERE id = ?});
- $raid = $DBH->selectrow_hashref($query,undef,$1);
- }
- if (defined param('cmd') && param('cmd') eq 'submit'){
- my $query = $DBH->prepare(q{INSERT INTO raids (tick,waves,message) VALUES(?,?,'')});
- if ($query->execute(param('tick'),param('waves'))){
- $raid = $DBH->last_insert_id(undef,undef,undef,undef,"raids_id_seq");
- my $query = $DBH->prepare(q{SELECT id,tick,waves,message,released_coords,open FROM raids WHERE id = ?});
- $raid = $DBH->selectrow_hashref($query,undef,$raid);
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
-
- if ($raid && defined param('cmd')){
- if (param('cmd') eq 'remove'){
- $DBH->do(q{UPDATE raids SET open = FALSE, removed = TRUE WHERE id = ?},undef,$raid->{id});
- }elsif (param('cmd') eq 'Open'){
- if($DBH->do(q{UPDATE raids SET open = TRUE, removed = FALSE WHERE id = ?},undef,$raid->{id})){
- $raid->{open} = 1;
- $raid->{removed} = 0;
- }
- }elsif (param('cmd') eq 'Close'){
- if ($DBH->do(q{UPDATE raids SET open = FALSE WHERE id = ?},undef,$raid->{id})){
- $raid->{open} = 0;
- }
- }elsif (param('cmd') eq 'showcoords'){
- if($DBH->do(q{UPDATE raids SET released_coords = TRUE WHERE id = ?},undef,$raid->{id})){
- $raid->{released_coords} = 1;
- }
- }elsif (param('cmd') eq 'hidecoords'){
- if($DBH->do(q{UPDATE raids SET released_coords = FALSE WHERE id = ?},undef,$raid->{id})){
- $raid->{released_coords} = 0;
- }
- }elsif (param('cmd') eq 'comment'){
- $DBH->do(q{UPDATE raid_targets SET comment = ? WHERE id = ?}
- ,undef,escapeHTML(param('comment')),param('target'))
- or $error .= p($DBH->errstr);
-
- }elsif (param('cmd') eq 'change' || param('cmd') eq 'submit'){
- $DBH->begin_work;
- my $message = escapeHTML(param('message'));
- $raid->{message} = $message;
- $raid->{waves} = param('waves');
- $raid->{tick} = param('tick');
- unless ($DBH->do(qq{UPDATE raids SET message = ?, tick = ?, waves = ? WHERE id = ?}
- ,undef,$message,param('tick'),param('waves'),$raid->{id})){
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- my $sizelimit = '';
- if (param('sizelimit') =~ /^(\d+)$/){
- $sizelimit = "AND p.size >= $1";
- unless ($DBH->do(qq{DELETE FROM raid_targets WHERE id IN (SELECT t.id FROM current_planet_stats p
- JOIN raid_targets t ON p.id = t.planet WHERE p.size < ? AND t.raid = ?)},undef,$1,$raid->{id})){
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- my $targets = param('targets');
- my $addtarget = $DBH->prepare(qq{INSERT INTO raid_targets(raid,planet) (
- SELECT ?, id FROM current_planet_stats p WHERE x = ? AND y = ? AND COALESCE(z = ?,TRUE) $sizelimit)});
- while ($targets =~ m/(\d+):(\d+)(?::(\d+))?/g){
- unless ($addtarget->execute($raid->{id},$1,$2,$3)){
- $error .= "<p> Something went wrong when adding $1:$2".($3 ? ":$3" : '').": ".$DBH->errstr."</p>";
- }
- }
- if (param('alliance') =~ /^(\d+)$/ && $1 != 1){
- log_message $ND::UID,"BC adding alliance $1 to raid";
- my $addtarget = $DBH->prepare(qq{INSERT INTO raid_targets(raid,planet) (
- SELECT ?,id FROM current_planet_stats p WHERE alliance_id = ? $sizelimit)});
- unless ($addtarget->execute($raid->{id},$1)){
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- my $groups = $DBH->prepare('SELECT gid,groupname FROM groups WHERE attack');
- my $delgroup = $DBH->prepare(q{DELETE FROM raid_access WHERE raid = ? AND gid = ?});
- my $addgroup = $DBH->prepare(q{INSERT INTO raid_access (raid,gid) VALUES(?,?)});
- $groups->execute();
- while (my $group = $groups->fetchrow_hashref){
- my $query;
- next unless defined param $group->{gid};
- if (param($group->{gid}) eq 'remove'){
- $query = $delgroup;
- }elsif(param($group->{gid}) eq 'add'){
- $query = $addgroup;
- }
- if ($query){
- unless ($query->execute($raid->{id},$group->{gid})){
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- }
- unless ($DBH->commit){
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }elsif (param('cmd') eq 'targets'){
- $DBH->begin_work;
- my $comment = $DBH->prepare(q{UPDATE raid_targets SET comment = ? WHERE id = ?});
- my $unclaim = $DBH->prepare(q{DELETE FROM raid_claims WHERE target = ? AND wave = ?});
- my $block = $DBH->prepare(q{INSERT INTO raid_claims (target,uid,wave) VALUES(?,-2,?)});
- my $remove = $DBH->prepare(q{DELETE FROM raid_targets WHERE raid = ? AND id = ?});
- for $_ (param()){
- if (/^comment:(\d+)$/){
- $comment->execute(escapeHTML(param($_)),$1) or $error .= p($DBH->errstr);
- }elsif(/^unclaim:(\d+):(\d+)$/){
- $unclaim->execute($1,$2) or $error .= p($DBH->errstr);
- log_message $ND::UID,"BC unclaimed target $1 wave $2.";
- }elsif(/^block:(\d+):(\d+)$/){
- $block->execute($1,$2) or $error .= p($DBH->errstr);
- }elsif(/^remove:(\d+)$/){
- $remove->execute($raid->{id},$1) or $error .= p($DBH->errstr);
- }
- }
- $DBH->commit or $error .= p($DBH->errstr);
- }
- }
-
- my $groups = $DBH->prepare(q{SELECT g.gid,g.groupname,raid FROM groups g LEFT OUTER JOIN (SELECT gid,raid FROM raid_access WHERE raid = ?) AS ra ON g.gid = ra.gid WHERE g.attack});
- $groups->execute($raid ? $raid->{id} : undef);
-
- my @addgroups;
- my @remgroups;
- while (my $group = $groups->fetchrow_hashref){
- if ($group->{raid}){
- push @remgroups,{Id => $group->{gid}, Name => $group->{groupname}};
- }else{
- push @addgroups,{Id => $group->{gid}, Name => $group->{groupname}};
- }
- }
- $BODY->param(RemoveGroups => \@remgroups);
- $BODY->param(AddGroups => \@addgroups);
-
-
- if ($raid){
-
- $BODY->param(Raid => $raid->{id});
- if($raid->{open}){
- $BODY->param(Open => 'Close');
- }else{
- $BODY->param(Open => 'Open');
- }
- if($raid->{released_coords}){
- $BODY->param(ShowCoords => 'hidecoords');
- $BODY->param(ShowCoordsName => 'Hide');
- }else{
- $BODY->param(ShowCoords => 'showcoords');
- $BODY->param(ShowCoordsName => 'Show');
- }
- $BODY->param(Waves => $raid->{waves});
- $BODY->param(LandingTick => $raid->{tick});
- $BODY->param(Message => $raid->{message});
-
- my $order = "p.x,p.y,p.z";
- if (param('order') && param('order') =~ /^(score|size|value|xp|race)$/){
- $order = "$1 DESC";
- }
-
- my $targetquery = $DBH->prepare(qq{SELECT r.id,coords(x,y,z),comment,size,score,value,race,planet_status AS planetstatus,relationship,comment,r.planet
- FROM current_planet_stats p JOIN raid_targets r ON p.id = r.planet
- WHERE r.raid = ?
- ORDER BY $order});
- my $claims = $DBH->prepare(qq{ SELECT username,launched FROM raid_claims
- NATURAL JOIN users WHERE target = ? AND wave = ?});
- $targetquery->execute($raid->{id}) or $error .= $DBH->errstr;
- my @targets;
- while (my $target = $targetquery->fetchrow_hashref){
- my @waves;
- for my $i (1 .. $raid->{waves}){
- $claims->execute($target->{id},$i);
- my $claimers;
- if ($claims->rows != 0){
- my $owner = 0;
- my @claimers;
- while (my $claim = $claims->fetchrow_hashref){
- $claim->{username} .= '*' if ($claim->{launched});
- push @claimers,$claim->{username};
- }
- $claimers = join '/', @claimers;
- }
- push @waves,{Wave => $i, Claimers => $claimers};
- }
- $target->{waves} = \@waves;
-
- my $scans = $DBH->prepare(q{SELECT DISTINCT ON (type) type, tick, scan FROM scans
- WHERE planet = ? AND type ~ 'Unit|Planet|Advanced Unit|.* Analysis' AND tick + 24 > tick() AND scan is not null
- GROUP BY type, tick, scan ORDER BY type ,tick DESC});
- $scans->execute($target->{planet});
- delete $target->{planet};
- my %scans;
- while (my $scan = $scans->fetchrow_hashref){
- $scans{$scan->{type}} = $scan;
- }
-
- my @scans;
- for my $type ('Planet','Unit','Advanced Unit','Surface Analysis','Technology Analysis'){
- next unless exists $scans{$type};
- my $scan = $scans{$type};
- if ($self->{TICK} - $scan->{tick} > 5){
- $scan->{scan} =~ s{<table( cellpadding="\d+")?>}{<table class="old">};
- }
- if ($type eq 'Planet'){
- $target->{PlanetScan} = $scan->{scan};
- next;
- }
- push @scans,{Scan => $scan->{scan}};
- }
- $target->{Scans} = \@scans;
- push @targets,$target;
- }
- $BODY->param(Targets => \@targets);
- }else{
- $BODY->param(Waves => 3);
- my @time = gmtime;
- $BODY->param(LandingTick => $self->{TICK} + 24 - $time[2] + 12);
- }
- $BODY->param(Error => $error);
- return $BODY;
-}
-
-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 ND::Web::Pages::Forum;
-use strict;
-use warnings;
-use ND::Web::Forum;
-use CGI qw/:standard/;
-use ND::Web::Include;
-use ND::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{forum} = __PACKAGE__;
-
-sub parse {
- my $self = shift;
- if ($self->{URI} =~ m{^/.*/allUnread}){
- param('allUnread',1);
- }
-}
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Forum';
- my $DBH = $self->{DBH};
-
- $DBH->do(q{UPDATE users SET last_forum_visit = NOW() WHERE uid = $1},undef,$ND::UID) or $ND::ERROR .= p($DBH->errstr);
-
- my $board;
- if(param('b')){
- my $boards = $DBH->prepare(q{SELECT fb.fbid AS id,fb.board, bool_or(fa.post) AS post, bool_or(fa.moderate) AS moderate,fb.fcid
- FROM forum_boards fb NATURAL JOIN forum_access fa
- WHERE fb.fbid = $1 AND (gid = -1 OR gid IN (SELECT gid FROM groupmembers
- WHERE uid = $2))
- GROUP BY fb.fbid,fb.board,fb.fcid});
- $board = $DBH->selectrow_hashref($boards,undef,param('b'),$ND::UID) or $ND::ERROR .= p($DBH->errstr);
- }
- if (param('markAsRead')){
- my $threads = $DBH->prepare(q{SELECT ft.ftid AS id,ft.subject,count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,count(fp.fpid) AS posts, max(fp.time)::timestamp as last_post
- FROM forum_threads ft JOIN forum_posts fp USING (ftid) LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $2) ftv ON ftv.ftid = ft.ftid
- WHERE ((ft.fbid IS NULL AND $1 IS NULL) OR ft.fbid = $1) AND fp.time <= $3
- GROUP BY ft.ftid, ft.subject
- HAVING count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) >= 1
- });
-
- $threads->bind_param('$1',$board->{id},{TYPE => DBI::SQL_INTEGER }) or $ND::ERROR .= p($DBH->errstr);
- $threads->bind_param('$2',$ND::UID,{TYPE => DBI::SQL_INTEGER }) or $ND::ERROR .= p($DBH->errstr);
- $threads->bind_param('$3',param('markAsRead')) or $ND::ERROR .= p($DBH->errstr);
- $threads->execute or $ND::ERROR .= p($DBH->errstr);
- while (my $thread = $threads->fetchrow_hashref){
- markThreadAsRead $thread->{id};
- }
- }
-
- my $thread;
- my $findThread = $DBH->prepare(q{SELECT ft.ftid AS id,ft.subject, bool_or(fa.post) AS post, bool_or(fa.moderate) AS moderate,ft.fbid,fb.board,fb.fcid,ft.sticky
- FROM forum_boards fb NATURAL JOIN forum_access fa NATURAL JOIN forum_threads ft
- WHERE ft.ftid = $1 AND (gid = -1 OR gid IN (SELECT gid FROM groupmembers
- WHERE uid = $2))
- GROUP BY ft.ftid,ft.subject,ft.fbid,fb.board,fb.fcid,ft.sticky});
- if(param('t')){
- $thread = $DBH->selectrow_hashref($findThread,undef,param('t'),$ND::UID) or $ND::ERROR .= p($DBH->errstr);
- }
-
- if (defined param('cmd')){
- if(param('cmd') eq 'Submit' or param('cmd') eq 'Preview'){
- $DBH->begin_work;
- if ($board && $board->{post}){
- $thread = addForumThread $DBH,$board,$ND::UID,param('subject');
- }
- if (param('cmd') eq 'Submit' and $thread && $thread->{post}){
- addForumPost($DBH,$thread,$ND::UID,param('message'));
- $self->{RETURN} = 'REDIRECT';
- $self->{REDIR_LOCATION} = "/forum?t=$thread->{id}#NewPosts";
- }
- $DBH->commit or $ND::ERROR .= p($DBH->errstr);
- return if $self->{RETURN};
- }
- if(param('cmd') eq 'Move' && $board->{moderate}){
- $DBH->begin_work;
- my $moveThread = $DBH->prepare(q{UPDATE forum_threads SET fbid = $1 WHERE ftid = $2 AND fbid = $3});
- for my $param (param()){
- if ($param =~ /t:(\d+)/){
- $moveThread->execute(param('board'),$1,$board->{id}) or $ND::ERROR .= p($DBH->errstr);
- if ($moveThread->rows > 0){
- log_message $ND::UID, qq{Moved thread: $1 to board: }.param('board');
- }
- }
- }
- $DBH->commit or $ND::ERROR .= p($DBH->errstr);
- }
- if($thread && param('cmd') eq 'Sticky' && $thread->{moderate}){
- if ($DBH->do(q{UPDATE forum_threads SET sticky = TRUE WHERE ftid = ?}, undef,$thread->{id})){
- $thread->{sticky} = 1;
- }else{
- $ND::ERROR .= p($DBH->errstr);
- }
- }
- if($thread && param('cmd') eq 'Unsticky' && $thread->{moderate}){
- if ($DBH->do(q{UPDATE forum_threads SET sticky = FALSE WHERE ftid = ?}, undef,$thread->{id})){
- $thread->{sticky} = 0;
- }else{
- $ND::ERROR .= p($DBH->errstr);
- }
- }
- }
-
- my $categories = $DBH->prepare(q{SELECT fcid AS id,category FROM forum_categories ORDER BY fcid});
- my $boards = $DBH->prepare(q{SELECT fb.fbid AS id,fb.board, bool_or(fa.post) AS post
- FROM forum_boards fb NATURAL JOIN forum_access fa
- WHERE fb.fcid = $1 AND (gid = -1 OR gid IN (SELECT gid FROM groupmembers
- WHERE uid = $2))
- GROUP BY fb.fbid,fb.board
- ORDER BY fb.fbid
- });
- my $threads = $DBH->prepare(q{SELECT ft.ftid AS id,u.username,ft.subject,
- count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,count(fp.fpid) AS posts,
- date_trunc('seconds',max(fp.time)::timestamp) as last_post,
- min(fp.time)::date as posting_date, ft.sticky
- FROM forum_threads ft JOIN forum_posts fp USING (ftid)
- JOIN users u ON u.uid = ft.uid
- LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $2) ftv ON ftv.ftid = ft.ftid
- WHERE ft.fbid = $1
- GROUP BY ft.ftid, ft.subject,ft.sticky,u.username
- HAVING count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) >= $3
- ORDER BY sticky DESC,last_post DESC});
-
- if ($thread){ #Display the thread
- $BODY->param(Title => $thread->{subject});
- $BODY->param(FBID => $thread->{fbid});
- $BODY->param(Board => $thread->{board});
- $BODY->param(FTID => $thread->{id});
- $BODY->param(Moderate => $thread->{moderate});
- $BODY->param(Sticky => $thread->{sticky} ? 'Unsticky' : 'Sticky');
- $BODY->param(Thread => viewForumThread $thread);
- my ($category) = $DBH->selectrow_array(q{SELECT category FROM forum_categories WHERE fcid = $1}
- ,undef,$thread->{fcid}) or $ND::ERROR .= p($DBH->errstr);
- $BODY->param(Category => $category);
-
- }elsif(defined param('allUnread')){ #List threads in this board
- $BODY->param(AllUnread => 1);
- $BODY->param(Id => $board->{id});
- my ($time) = $DBH->selectrow_array('SELECT now()::timestamp',undef);
- $BODY->param(Date => $time);
- $categories->execute or $ND::ERROR .= p($DBH->errstr);
- my @categories;
- while (my $category = $categories->fetchrow_hashref){
- $boards->execute($category->{id},$ND::UID) or $ND::ERROR .= p($DBH->errstr);
- my @boards;
- while (my $board = $boards->fetchrow_hashref){
- next if $board->{id} < 0;
- $threads->execute($board->{id},$ND::UID,1) or $ND::ERROR .= p($DBH->errstr);
- my $i = 0;
- my @threads;
- while (my $thread = $threads->fetchrow_hashref){
- $i++;
- $thread->{Odd} = $i % 2;
- push @threads,$thread;
- }
- $board->{Threads} = \@threads;
- delete $board->{post};
- push @boards,$board if $i > 0;
- }
- $category->{Boards} = \@boards;
- delete $category->{id};
- push @categories,$category if @boards;
- }
- $BODY->param(Categories => \@categories);
-
- }elsif($board){ #List threads in this board
- $BODY->param(ViewBoard => 1);
- $BODY->param(Title => $board->{board});
- $BODY->param(Post => $board->{post});
- $BODY->param(Moderate => $board->{moderate});
- $BODY->param(Id => $board->{id});
- $BODY->param(FBID => $board->{id});
- $BODY->param(Board => $board->{board});
- my ($time) = $DBH->selectrow_array('SELECT now()::timestamp',undef);
- $BODY->param(Date => $time);
- $threads->execute($board->{id},$ND::UID,0) or $ND::ERROR .= p($DBH->errstr);
- my $i = 0;
- my @threads;
- while (my $thread = $threads->fetchrow_hashref){
- $i++;
- $thread->{Odd} = $i % 2;
- push @threads,$thread;
- }
- $BODY->param(Threads => \@threads);
-
- if ($board->{moderate}){
- $categories->execute or $ND::ERROR .= p($DBH->errstr);
- my @categories;
- while (my $category = $categories->fetchrow_hashref){
- $boards->execute($category->{id},$ND::UID) or $ND::ERROR .= p($DBH->errstr);
-
- my @boards;
- while (my $b = $boards->fetchrow_hashref){
- next if (not $b->{post} or $b->{id} == $board->{id});
- delete $b->{post};
- push @boards,$b;
- }
- $category->{Boards} = \@boards;
- delete $category->{id};
- push @categories,$category if @boards;
- }
- $BODY->param(Categories => \@categories);
- }
- my ($category) = $DBH->selectrow_array(q{SELECT category FROM forum_categories WHERE fcid = $1}
- ,undef,$board->{fcid}) or $ND::ERROR .= p($DBH->errstr);
- $BODY->param(Category => $category);
-
- }elsif($self->{URI} =~ m{^/.*/search/(.*)}){ #List threads in this board
- }else{ #List boards
- $BODY->param(Overview => 1);
- $categories->execute or $ND::ERROR .= p($DBH->errstr);
- my $boards = $DBH->prepare(q{SELECT fb.fbid AS id,fb.board,count(NULLIF(COALESCE(fp.fpid::boolean,FALSE) AND COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,date_trunc('seconds',max(fp.time)::timestamp) as last_post
- FROM forum_boards fb LEFT OUTER JOIN (forum_threads ft JOIN forum_posts fp USING (ftid)) ON fb.fbid = ft.fbid LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $2) ftv ON ftv.ftid = ft.ftid
- WHERE fb.fcid = $1 AND
- fb.fbid IN (SELECT fbid FROM forum_access WHERE gid IN (SELECT groups($2)))
- GROUP BY fb.fbid, fb.board
- ORDER BY fb.fbid });
- my @categories;
- while (my $category = $categories->fetchrow_hashref){
- $boards->execute($category->{id},$ND::UID) or $ND::ERROR .= p($DBH->errstr);
- my @boards;
- my $i = 0;
- while (my $board = $boards->fetchrow_hashref){
- $i++;
- $board->{Odd} = $i % 2;
- push @boards,$board;
- }
- $category->{Boards} = \@boards;
- delete $category->{id};
- push @categories,$category if $i > 0;
- }
- $BODY->param(Categories => \@categories);
-
- }
- return $BODY;
-}
-
-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 ND::Web::Pages::GalaxyRankings;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{galaxyrankings} = __PACKAGE__;
-
-sub parse {
- #TODO: Need to fix some links first
- #if ($uri =~ m{^/[^/]+/(\w+)}){
- # param('order',$1);
- #}
-}
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Top Galaxies';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isMember;
-
- my $error = '';
-
- $BODY->param(isHC => $self->isHC);
-
- my $offset = 0;
- if (defined param('offset') && param('offset') =~ /^(\d+)$/){
- $offset = $1;
- }
- $BODY->param(Offset => $offset);
- $BODY->param(PrevOffset => $offset - 100);
- $BODY->param(NextOffset => $offset + 100);
-
- my $order = 'scorerank';
- if (defined param('order') && param('order') =~ /^(scorerank|sizerank|planets|xprank|avgscore)$/){
- $order = $1;
- }
- $BODY->param(Order => $order);
- $order .= ' DESC' unless $order =~ /rank$/;
-
-
- #my $extra_columns = '';
- #if ($self->isHC){
- # $extra_columns = ",galaxy_status,hit_us, galaxy,relationship,nick";
- #}
- my $query = $DBH->prepare(qq{SELECT x,y,
- size, size_gain, size_gain_day,
- score,score_gain,score_gain_day,
- value,value_gain,value_gain_day,
- xp,xp_gain,xp_gain_day,
- sizerank,sizerank_gain,sizerank_gain_day,
- scorerank,scorerank_gain,scorerank_gain_day,
- valuerank,valuerank_gain,valuerank_gain_day,
- xprank,xprank_gain,xprank_gain_day,
- planets,planets_gain,planets_gain_day
- FROM galaxies g WHERE tick = ( SELECT max(tick) AS max FROM galaxies)
- ORDER BY $order LIMIT 100 OFFSET ?});
- $query->execute($offset) or $error .= p($DBH->errstr);
- my @galaxies;
- my $i = 0;
- while (my $galaxy = $query->fetchrow_hashref){
- for my $type (qw/planets size score xp value/){
- #$galaxy->{$type} = prettyValue($galaxy->{$type});
- next unless defined $galaxy->{"${type}_gain_day"};
- $galaxy->{"${type}img"} = 'stay';
- $galaxy->{"${type}img"} = 'up' if $galaxy->{"${type}_gain_day"} > 0;
- $galaxy->{"${type}img"} = 'down' if $galaxy->{"${type}_gain_day"} < 0;
- unless( $type eq 'planets'){
- $galaxy->{"${type}rankimg"} = 'stay';
- $galaxy->{"${type}rankimg"} = 'up' if $galaxy->{"${type}rank_gain_day"} < 0;
- $galaxy->{"${type}rankimg"} = 'down' if $galaxy->{"${type}rank_gain_day"} > 0;
- }
- for my $type ($type,"${type}_gain","${type}_gain_day"){
- $galaxy->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
- }
- }
- $i++;
- $galaxy->{ODD} = $i % 2;
- push @galaxies,$galaxy;
- }
- $BODY->param(Galaxies => \@galaxies);
- $BODY->param(Error => $error);
- return $BODY;
-}
-
-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 ND::Web::Pages::Graph;
-use strict;
-use warnings FATAL => 'all';
-use ND::Include;
-use ND::Web::Graph;
-use DBI qw(:sql_types);
-use DBD::Pg qw(:pg_types);
-
-
-use base qw/ND::Web::Image/;
-
-$ND::Web::Page::PAGES{graph} = 'ND::Web::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;
+++ /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 ND::Web::Pages::HostileAlliances;
-use strict;
-use warnings FATAL => 'all';
-use ND::Include;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{hostileAlliances} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Hostile Alliances';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isHC;
-
- my $begintick = 0;
- my $endtick = $self->{TICK};
- if (param('ticks')){
- $begintick = $endtick - param('ticks');
- }elsif(defined param('begintick') && defined param('endtick')){
- $begintick = param('begintick');
- $endtick = param('endtick');
-
- }
- my $query = $DBH->prepare(q{
- SELECT s.alliance_id AS id,s.alliance AS name,count(*) AS hostilecount
-FROM calls c
- JOIN incomings i ON i.call = c.id
- JOIN current_planet_stats s ON i.sender = s.id
-WHERE c.landing_tick - i.eta > $1 and c.landing_tick - i.eta < $2
-GROUP BY s.alliance_id,s.alliance
-ORDER BY hostilecount DESC
- })or $ND::ERROR .= $DBH->errstr;
- $query->execute($begintick,$endtick) or $ND::ERROR .= $DBH->errstr;
- my @alliances;
- my $i = 0;
- my $tick = $self->{TICK};
- while (my $alliance = $query->fetchrow_hashref){
- $i++;
- $alliance->{ODD} = $i % 2;
- push @alliances, $alliance;
- }
- $BODY->param(Alliances => \@alliances);
- $BODY->param(Ticks => $endtick - $begintick);
- $BODY->param(BeginTick =>$begintick);
- $BODY->param(EndTick =>$endtick);
- return $BODY;
-}
-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 ND::Web::Pages::Intel;
-use strict;
-use warnings FATAL => 'all';
-use ND::Web::Forum;
-use ND::Web::Include;
-use ND::Include;
-use CGI qw/:standard/;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{intel} = __PACKAGE__;
-
-sub parse {
- my $self = shift;
- if ($self->{URI} =~ m{^/.*/((\d+)(?: |:)(\d+)(?: |:)(\d+))$}){
- param('coords',$1);
- }
-}
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Intel';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isIntel || $self->isHC;
-
- my $error;
-
- my $planet;
- if (defined param('coords') && param('coords') =~ /^(\d+)(?: |:)(\d+)(?: |:)(\d+)$/){
- my $query = $DBH->prepare(q{SELECT x,y,z,coords(x,y,z),id, nick, alliance,alliance_id, planet_status,channel,ftid FROM current_planet_stats
- WHERE x = ? AND y = ? AND z = ?});
- $planet = $DBH->selectrow_hashref($query,undef,$1,$2,$3) or $ND::ERROR .= p $DBH->errstr;
- }
-
- my $showticks = 'AND (i.tick - i.eta) > (tick() - 48)';
- if (defined param('show')){
- if (param('show') eq 'all'){
- $showticks = '';
- }elsif (param('show') =~ /^(\d+)$/){
- $showticks = "AND (i.tick - i.eta) > (tick() - $1)";
- }
- }
-
- my $thread;
- if (defined $planet){
- $thread = $DBH->selectrow_hashref(q{SELECT ftid AS id, subject FROM forum_threads
- where ftid = $1},undef,$planet->{ftid}) or $ND::ERROR .= p($DBH->errstr);
- }
-
- if (defined param('cmd') && param('cmd') eq 'coords'){
- my $coords = param('coords');
- $DBH->do(q{CREATE TEMPORARY TABLE coordlist (
- x integer NOT NULL,
- y integer NOT NULL,
- z integer NOT NULL,
- PRIMARY KEY (x,y,z)
- )});
- my $insert = $DBH->prepare(q{INSERT INTO coordlist (x,y,z) VALUES(?,?,?)});
- while ($coords =~ m/(\d+):(\d+):(\d+)/g){
- $insert->execute($1,$2,$3);
- }
- my $planets = $DBH->prepare(q{SELECT (((p.x || ':') || p.y) || ':') || p.z AS coords, alliance FROM current_planet_stats p
- JOIN coordlist c ON p.x = c.x AND p.y = c.y AND p.z = c.z
- ORDER BY alliance, p.x, p.y, p.z});
- $planets->execute;
- my @planets;
- while (my $planet = $planets->fetchrow_hashref){
- push @planets,$planet;
- }
- $BODY->param(CoordList => \@planets);
- }
- if (defined $thread and defined param('cmd') and param('cmd') eq 'forumpost'){
- addForumPost($DBH,$thread,$ND::UID,param('message'));
- }
-
- if ($planet && defined param('cmd')){
- if (param('cmd') eq 'change'){
- $DBH->begin_work;
- if (param('cnick')){
- my $value = escapeHTML(param('nick'));
- if ($DBH->do(q{UPDATE planets SET nick = ? WHERE id =?}
- ,undef,$value,$planet->{id})){
- intel_log $ND::UID,$planet->{id},"Set nick to: $value";
- $planet->{nick} = $value;
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- if (param('cchannel')){
- my $value = escapeHTML(param('channel'));
- if ($DBH->do(q{UPDATE planets SET channel = ? WHERE id =?}
- ,undef,$value,$planet->{id})){
- intel_log $ND::UID,$planet->{id},"Set channel to: $value";
- $planet->{channel} = $value;
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- if (param('cstatus')){
- my $value = escapeHTML(param('status'));
- if ($DBH->do(q{UPDATE planets SET planet_status = ? WHERE id =?}
- ,undef,$value,$planet->{id})){
- intel_log $ND::UID,$planet->{id},"Set planet_status to: $value";
- $planet->{planet_status} = $value;
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- if (param('calliance')){
- if ($DBH->do(q{UPDATE planets SET alliance_id = NULLIF(?,-1) WHERE id =?}
- ,undef,param('alliance'),$planet->{id})){
- intel_log $ND::UID,$planet->{id},"Set alliance_id to: ".param('alliance');
- $planet->{alliance_id} = param('alliance');
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
-
- if (param('coords')){
- my $channel = param('coords');
- $channel = $planet->{channel} if ($planet);
- my $findchannel = $DBH->prepare('SELECT coords(x,y,z),alliance,nick,channel FROM current_planet_stats WHERE channel ILIKE ? ');
- $findchannel->execute($channel);
- my @channelusers;
- while (my $user = $findchannel->fetchrow_hashref){
- push @channelusers,$user;
- }
- $BODY->param(ChannelUsers => \@channelusers);
- }
-
- if ($planet){
- $BODY->param(Coords => $planet->{coords});
- $BODY->param(Planet => $planet->{id});
- $BODY->param(Nick => escapeHTML($planet->{nick}));
- $BODY->param(Channel => $planet->{channel});
- my @status;
- for my $status (" ","Friendly", "NAP", "Hostile"){
- push @status,{Status => $status, Selected => defined $planet->{planet_status} && $status eq $planet->{planet_status}}
- }
- $BODY->param(PlanetStatus => \@status);
- my @alliances = alliances($planet->{alliance_id});
- $BODY->param(Alliances => \@alliances);
-
- $BODY->param(Thread => viewForumThread $thread);
-
- my $query = $DBH->prepare(intelquery('o.alliance AS oalliance,coords(o.x,o.y,o.z) AS origin',"t.id = ? $showticks"));
- $query->execute($planet->{id}) or $error .= $DBH->errstr;
- my @intellists;
- my @incomings;
- my $i = 0;
- while (my $intel = $query->fetchrow_hashref){
- if ($intel->{ingal}){
- $intel->{missionclass} = 'ingal';
- }else{
- $intel->{missionclass} = $intel->{mission};
- }
- $i++;
- $intel->{ODD} = $i % 2;
- push @incomings,$intel;
- }
- push @intellists,{Message => 'Incoming fleets', Intel => \@incomings, Origin => 1};
-
- $query = $DBH->prepare(intelquery('t.alliance AS talliance,coords(t.x,t.y,t.z) AS target',"o.id = ? $showticks"));
- $query->execute($planet->{id}) or $error .= $DBH->errstr;
- my @outgoings;
- $i = 0;
- while (my $intel = $query->fetchrow_hashref){
- if ($intel->{ingal}){
- $intel->{missionclass} = 'ingal';
- }else{
- $intel->{missionclass} = $intel->{mission};
- }
- $i++;
- $intel->{ODD} = $i % 2;
- push @outgoings,$intel;
- }
- push @intellists,{Message => 'Outgoing Fleets', Intel => \@outgoings, Target => 1};
-
- $BODY->param(IntelLIsts => \@intellists);
-
- }elsif(!param('coords')){
- my $query = $DBH->prepare(intelquery('o.alliance AS oalliance,coords(o.x,o.y,o.z) AS origin, t.alliance AS talliance,coords(t.x,t.y,t.z) AS target',qq{not ingal
- AND ((( t.alliance_id != o.alliance_id OR t.alliance_id IS NULL OR o.alliance_id IS NULL) AND i.mission != 'Attack')
- OR ( t.alliance_id = o.alliance_id AND i.mission = 'Attack'))
- AND i.sender NOT IN (SELECT planet FROM users u NATURAL JOIN groupmembers gm WHERE gid = 8 AND planet IS NOT NULL)
- $showticks}));
- $query->execute() or $error .= $DBH->errstr;
-
- my @intellists;
- my @intel;
- my $i = 0;
- while (my $intel = $query->fetchrow_hashref){
- if ($intel->{ingal}){
- $intel->{missionclass} = 'ingal';
- }else{
- $intel->{missionclass} = $intel->{mission};
- }
- $i++;
- $intel->{ODD} = $i % 2;
- push @intel,$intel;
- }
- push @intellists,{Message => q{Intel where alliances doesn't match}, Intel => \@intel, Origin => 1, Target => 1};
- $BODY->param(IntelLIsts => \@intellists);
- }
- $BODY->param(Error => $error);
- return $BODY;
-}
-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 ND::Web::Pages::LaunchCoonfirmation;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-use ND::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{launchConfirmation} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Launch Confirmation';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isMember;
-
- my $error;
-
-
- if (defined param('cmd') && param('cmd') eq 'submit'){
- my $missions = param('mission');
- my $findplanet = $DBH->prepare("SELECT planetid(?,?,?,?)");
- my $findattacktarget = $DBH->prepare(q{SELECT c.target,c.wave,c.launched FROM raid_claims c
- JOIN raid_targets t ON c.target = t.id
- JOIN raids r ON t.raid = r.id
- WHERE c.uid = ? AND r.tick+c.wave-1 = ? AND t.planet = ?
- AND r.open AND not r.removed});
- my $finddefensetarget = $DBH->prepare(q{SELECT c.id FROM calls c JOIN users u ON c.member = u.uid WHERE u.planet = $1 AND c.landing_tick = $2});
- my $informDefChannel = $DBH->prepare(q{INSERT INTO defense_missions (fleet,call) VALUES (?,?)});
- my $addattackpoint = $DBH->prepare('UPDATE users SET attack_points = attack_points + 1 WHERE uid = ?');
- my $launchedtarget = $DBH->prepare('UPDATE raid_claims SET launched = True WHERE uid = ? AND target = ? AND wave = ?');
- my $addfleet = $DBH->prepare(qq{INSERT INTO fleets (uid,target,mission,landing_tick,fleet,eta,back) VALUES (?,?,?,?,(SELECT max(fleet)+1 from fleets WHERE uid = ?),?,?)});
- my $addships = $DBH->prepare('INSERT INTO fleet_ships (fleet,ship,amount) VALUES (?,?,?)');
-
- my $fleet = $DBH->prepare("SELECT id FROM fleets WHERE uid = ? AND fleet = 0");
- my ($basefleet) = $DBH->selectrow_array($fleet,undef,$ND::UID) or $ND::ERROR .= p $DBH->errstr;;
- unless ($basefleet){
- my $insert = $DBH->prepare(q{INSERT INTO fleets (uid,target,mission,landing_tick,fleet,eta,back) VALUES (?,?,'Full fleet',0,0,0,0)});
- $insert->execute($ND::UID,$self->{PLANET}) or $ND::ERROR .= p $DBH->errstr;;
- }
- my @missions;
- $DBH->begin_work;
- while ($missions =~ m/\S+\s+(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)\s+\((?:(\d+)\+)?(\d+)\).*?(?:\d+hrs\s+)?\d+mins?\s+(Attack|Defend|Return|Fake Attack|Fake Defend)(.*?)(?:Launching in tick (\d+), arrival in tick (\d+)|ETA: \d+, Return ETA: (\d+)|Return ETA: (\d+))/sg){
- my %mission;
- next if $9 eq 'Return';
-
- my $tick = $self->{TICK}+$8;
- $tick += $7 if defined $7;
- my $eta = $8;
- my $mission = $9;
- my $x = $4;
- my $y = $5;
- my $z = $6;
- if ($12){
- $tick = $12;
- }elsif ($13){
- $eta += $13;
- }
- $mission{Tick} = $tick;
- $mission{Mission} = $mission;
- $mission{Target} = "$x:$y:$z";
-
- my ($planet_id) = $DBH->selectrow_array($findplanet,undef,$x,$y,$z,$self->{TICK});
-
- my $findtarget = $finddefensetarget;
- if ($mission eq 'Attack'){
- $findtarget = $findattacktarget;
- $findtarget->execute($ND::UID,$tick,$planet_id) or $ND::ERROR .= p $DBH->errstr;;
- }elsif ($mission eq 'Defend'){
- $findtarget = $finddefensetarget;
- $findtarget->execute($planet_id,$tick) or $ND::ERROR .= p $DBH->errstr;;
- }
-
- $addfleet->execute($ND::UID,$planet_id,$mission,$tick,$ND::UID,$eta,$tick+$eta-1) or $error .= '<p>'.$DBH->errstr.'</p>';
- my $fleet = $DBH->last_insert_id(undef,undef,undef,undef,"fleets_id_seq");
- $mission{Fleet} = $fleet;
- $mission{Back} = $tick+$eta-1;
- my $ships = $10;
- my @ships;
- while ($ships =~ m/((?:\w+ )*\w+)\s+\w+\s+\w+\s+(?:Steal|Normal|Emp|Normal\s+Cloaked|Pod|Struc)\s+(\d+)/g){
- $addships->execute($fleet,$1,$2) or $ND::ERROR .= p $DBH->errstr;
- push @ships,{Ship => $1, Amount => $2};
- }
- $mission{Ships} = \@ships;
-
- if ($findtarget->rows == 0){
- $mission{Warning} = p b 'No matching target!';
- }elsif ($mission eq 'Attack'){
- my $claim = $findtarget->fetchrow_hashref;
- if ($claim->{launched}){
- $mission{Warning} = "Already launched on this target:$claim->{target},$claim->{wave},$claim->{launched}";
- }else{
- $addattackpoint->execute($ND::UID) or $ND::ERROR .= p $DBH->errstr;
- $launchedtarget->execute($ND::UID,$claim->{target},$claim->{wave}) or $ND::ERROR .= p $DBH->errstr;
- $mission{Warning} = "OK:$claim->{target},$claim->{wave},$claim->{launched}";
- log_message $ND::UID,"Gave attack point for confirmation on $mission mission to $x:$y:$z, landing tick $tick";
- }
- }elsif ($mission eq 'Defend'){
- my $call = $findtarget->fetchrow_hashref;
- $informDefChannel->execute($fleet,$call->{id}) or $ND::ERROR .= p $DBH->errstr;
- }
-
- log_message $ND::UID,"Pasted confirmation for $mission mission to $x:$y:$z, landing tick $tick";
- push @missions,\%mission;
- }
- $DBH->commit or $error .= '<p>'.$DBH->errstr.'</p>';
- $BODY->param(Missions => \@missions);
- }
- $BODY->param(Error => $error);
- return $BODY;
-}
-
-
-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 ND::Web::Pages::Mail;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use Mail::Sendmail;
-
-use ND::Web::Forum;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{mail} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
-
- my $DBH = $self->{DBH};
-
- $self->{TITLE} = 'Mail members';
-
- return $self->noAccess unless $self->isHC;
-
- my $groups = $DBH->prepare(q{SELECT gid,groupname FROM groups ORDER BY gid});
- $groups->execute;
- my @groups;
- while (my $group = $groups->fetchrow_hashref){
- push @groups,$group;
- }
- $BODY->param(Groups => \@groups);
-
- if (defined param('cmd')){
- my $emails = $DBH->prepare(q{SELECT email FROM users WHERE (uid IN (SELECT uid FROM groupmembers WHERE gid = $1) OR $1 = -1) AND email is not null});
- $emails->execute(param('group'));
- my @emails;
- while (my $email = $emails->fetchrow_hashref){
- push @emails,$email->{email};
- }
- $ND::ERROR .= p (join ', ',@emails);
-
- my %mail = (
- smtp => 'ruin.nu',
- BCC => (join ',',@emails),
- From => 'NewDawn Command <nd@ruin.nu>',
- 'Content-type' => 'text/plain; charset="UTF-8"',
- Subject => param('subject'),
- Message => param('message'),
- );
-
- if (sendmail %mail) {
- $ND::ERROR .= p "Mail sent OK.\n"
- }else {
- $ND::ERROR .= p $Mail::Sendmail::error;
- }
- }
- return $BODY;
-}
-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 ND::Web::Pages::Main;
-use strict;
-use warnings;
-use CGI qw/:standard/;
-use ND::Include;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{main} = 'ND::Web::Pages::Main';
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Main Page';
- my $DBH = $self->{DBH};
-
- my $error;
-
- if (defined param('cmd')){
- if (param('cmd') eq 'fleet'){
- $DBH->begin_work;
- my $fleet = $DBH->prepare("SELECT id FROM fleets WHERE uid = ? AND fleet = 0");
- my ($id) = $DBH->selectrow_array($fleet,undef,$ND::UID);
- unless ($id){
- my $insert = $DBH->prepare(q{INSERT INTO fleets (uid,target,mission,landing_tick,fleet,eta,back) VALUES (?,?,'Full fleet',0,0,0,0)});
- $insert->execute($ND::UID,$self->{PLANET});
- ($id) = $DBH->selectrow_array($fleet,undef,$ND::UID);
- }
- my $delete = $DBH->prepare("DELETE FROM fleet_ships WHERE fleet = ?");
- my $insert = $DBH->prepare('INSERT INTO fleet_ships (fleet,ship,amount) VALUES (?,?,?)');
- $fleet = param('fleet');
- $fleet =~ s/,//g;
- my $match = 0;
- while ($fleet =~ m/((?:[A-Z][a-z]+ )*[A-Z][a-z]+)\s+(\d+)/g){
- unless($match){
- $match = 1;
- $delete->execute($id);
- }
- $insert->execute($id,$1,$2) or $error .= '<p>'.$DBH->errstr.'</p>';
- }
- $fleet = $DBH->prepare('UPDATE fleets SET landing_tick = tick() WHERE id = ?');
- $fleet->execute($id) if $match;
- $DBH->commit;
- }elsif (param('cmd') eq 'Recall Fleets'){
- $DBH->begin_work;
- my $updatefleets = $DBH->prepare('UPDATE fleets SET back = tick() + (tick() - (landing_tick - eta)) WHERE uid = ? AND id = ?');
-
- for my $param (param()){
- if ($param =~ /^change:(\d+)$/){
- if($updatefleets->execute($ND::UID,$1)){
- log_message $ND::UID,"Member recalled fleet $1";
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- }
- $DBH->commit or $error .= '<p>'.$DBH->errstr.'</p>';
- }elsif (param('cmd') eq 'Change Fleets'){
- $DBH->begin_work;
- my $updatefleets = $DBH->prepare('UPDATE fleets SET back = ? WHERE uid = ? AND id = ?');
- for my $param (param()){
- if ($param =~ /^change:(\d+)$/){
- if($updatefleets->execute(param("back:$1"),$ND::UID,$1)){
- log_message $ND::UID,"Member set fleet $1 to be back tick: ".param("back:$1");
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- }
- $DBH->commit or $error .= '<p>'.$DBH->errstr.'</p>';
- }
- }
- if (param('sms')){
- my $query = $DBH->prepare('UPDATE users SET sms = ? WHERE uid = ?');
- $query->execute(escapeHTML(param('sms')),$ND::UID);
- }
- if (param('hostname')){
- my $query = $DBH->prepare('UPDATE users SET hostmask = ? WHERE uid = ?');
- $query->execute(escapeHTML(param('hostname')),$ND::UID);
- }
- if ($self->isMember() && !$self->{PLANET} && defined param('planet') && (param('planet') =~ m/(\d+)(?: |:)(\d+)(?: |:)(\d+)/)){
- my $query = $DBH->prepare(q{
- UPDATE users SET planet =
- (SELECT id from current_planet_stats where x = ? AND y = ? AND z = ?)
- WHERE uid = ? });
- $query->execute($1,$2,$3,$ND::UID);
- }
-
- my ($motd) = $DBH->selectrow_array("SELECT value FROM misc WHERE id='MOTD'");
-
- $BODY->param(MOTD => parseMarkup($motd));
- $BODY->param(Username => $self->{USER});
- $BODY->param(isMember => $self->isMember());
- $BODY->param(isHC => $self->isHC());
- my @groups = map {name => $_}, sort keys %{$self->{GROUPS}};
- $BODY->param(Groups => \@groups);
-
-
- my $query = $DBH->prepare(q{SELECT planet,defense_points,attack_points,scan_points,humor_points, (attack_points+defense_points+scan_points/20) as total_points, sms,rank,hostmask FROM users WHERE uid = ?});
-
- my ($planet,$defense_points,$attack_points,$scan_points,$humor_points,$total_points,$sms,$rank,$hostname) = $DBH->selectrow_array($query,undef,$ND::UID);
-
- $self->{PLANET} = $planet unless $self->{PLANET};
-
- $BODY->param(NDRank => $rank);
- $BODY->param(DefensePoints => $defense_points);
- $BODY->param(AttackPoints => $attack_points);
- $BODY->param(ScanPoints => $scan_points);
- $BODY->param(HumorPoints => $humor_points);
- $BODY->param(TotalPoints => $total_points);
-
- $BODY->param(Planet => $planet);
-
- $query = $DBH->prepare(qq{
- SELECT c.id, c.landing_tick, dc.username,c.covered,
- TRIM('/' FROM concat(p2.race||' /')) AS race, TRIM('/' FROM concat(i.amount||' /')) AS amount,
- TRIM('/' FROM concat(i.eta||' /')) AS eta, TRIM('/' FROM concat(i.shiptype||' /')) AS shiptype,
- (c.landing_tick - tick()) AS curreta,
- TRIM('/' FROM concat(coords(p2.x,p2.y,p2.z) ||' /')) AS attackers
- FROM calls c
- JOIN incomings i ON i.call = c.id
- JOIN current_planet_stats p2 ON i.sender = p2.id
- LEFT OUTER JOIN users dc ON c.dc = dc.uid
- WHERE c.member = ? AND (c.landing_tick - tick()) > 0
- GROUP BY c.id, c.landing_tick,dc.username,c.covered
- ORDER BY c.landing_tick DESC
- })or $error .= $DBH->errstr;
- $query->execute($ND::UIN) or $error .= $DBH->errstr;
-
- my $i = 0;
- my @calls;
- while (my $call = $query->fetchrow_hashref){
- $call->{attackers} =~ s{(\d+:\d+:\d+)}{<a href="/check?coords=$1">$1</a>}g;
- unless(defined $call->{username}){
- $call->{dc} = 'Hostile';
- $call->{username} = 'none';
- }
- if($call->{covered}){
- $call->{covered} = 'Friendly';
- }else{
- $call->{covered} = 'Hostile';
- }
- $i++;
- $call->{ODD} = $i % 2;
- $call->{shiptype} = escapeHTML($call->{shiptype});
- push @calls, $call;
- }
- $BODY->param(Calls => \@calls);
-
- my $planetstats= $DBH->selectrow_hashref(q{SELECT x,y,z, ((ruler || ' OF ') || p.planet) as planet,race,
- size, size_gain, size_gain_day,
- score,score_gain,score_gain_day,
- value,value_gain,value_gain_day,
- xp,xp_gain,xp_gain_day,
- sizerank,sizerank_gain,sizerank_gain_day,
- scorerank,scorerank_gain,scorerank_gain_day,
- valuerank,valuerank_gain,valuerank_gain_day,
- xprank,xprank_gain,xprank_gain_day
- from current_planet_stats_full p
- WHERE id = ?},undef,$planet) if $planet;
- if ($planetstats){
- my $planet = $planetstats;
- for my $type (qw/size score value xp/){
- $planet->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
- $planet->{"${type}img"} = 'stay';
- $planet->{"${type}img"} = 'up' if $planet->{"${type}_gain_day"} > 0;
- $planet->{"${type}img"} = 'down' if $planet->{"${type}_gain_day"} < 0;
- $planet->{"${type}rankimg"} = 'stay';
- $planet->{"${type}rankimg"} = 'up' if $planet->{"${type}rank_gain_day"} < 0;
- $planet->{"${type}rankimg"} = 'down' if $planet->{"${type}rank_gain_day"} > 0;
- for my $type ($type,"${type}_gain","${type}_gain_day"){
- $planet->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
- }
- }
- $BODY->param(Planets => [$planet]);
- $BODY->param(PlanetCoords => "$planet->{x}:$planet->{y}:$planet->{z}");
- }
-
-
- $query = $DBH->prepare(q{SELECT f.fleet,f.id, coords(x,y,z) AS target, mission, sum(fs.amount) AS amount, landing_tick, back
-FROM fleets f
-JOIN fleet_ships fs ON f.id = fs.fleet
-JOIN current_planet_stats p ON f.target = p.id
-WHERE f.uid = ? AND (f.fleet = 0 OR back >= ?)
-GROUP BY f.fleet,f.id, x,y,z, mission, landing_tick,back
-ORDER BY f.fleet
- });
-
- $query->execute($ND::UID,$self->{TICK}) or $error .= '<p>'.$DBH->errstr.'</p>';
- my @fleets;
- $i = 0;
- while (my $fleet = $query->fetchrow_hashref){
- $i++;
- $fleet->{ODD} = $i % 2;
- push @fleets,$fleet;
- }
- $BODY->param(Fleets => \@fleets);
-
- $BODY->param(SMS => $sms);
- $BODY->param(Hostname => $hostname);
- $BODY->param(Error => $error);
- return $BODY;
-}
-
-
-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 ND::Web::Pages::MemberIntel;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{memberIntel} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Member Intel';
- my $DBH = $self->{DBH};
- my $error;
-
- return $self->noAccess unless $self->isHC;
-
- my $showticks = 'AND i.tick > tick()';
- if (defined param('show')){
- if (param('show') eq 'all'){
- $showticks = '';
- }elsif (param('show') =~ /^(\d+)$/){
- $showticks = "AND (i.tick - i.eta) > (tick() - $1)";
- }
- }
-
-
- my $query = $DBH->prepare(intelquery('o.alliance AS oalliance,coords(o.x,o.y,o.z) AS origin, coords(t.x,t.y,t.z) AS target, t.nick',"t.alliance_id = 1 $showticks"));
- $query->execute() or $error .= $DBH->errstr;
- my @intellists;
- my @incomings;
- my $i = 0;
- while (my $intel = $query->fetchrow_hashref){
- if ($intel->{ingal}){
- $intel->{missionclass} = 'ingal';
- }else{
- $intel->{missionclass} = $intel->{mission};
- }
- $intel->{oalliance} = ' ' unless $intel->{oalliance};
- $i++;
- $intel->{ODD} = $i % 2;
- push @incomings,$intel;
- }
- push @intellists,{Message => 'Incoming fleets', Intel => \@incomings, Origin => 1};
-
- $query = $DBH->prepare(intelquery('o.nick,coords(o.x,o.y,o.z) AS origin,t.alliance AS talliance,coords(t.x,t.y,t.z) AS target',"o.alliance_id = 1 $showticks"));
- $query->execute() or $error .= $DBH->errstr;
- my @outgoings;
- $i = 0;
- while (my $intel = $query->fetchrow_hashref){
- if ($intel->{ingal}){
- $intel->{missionclass} = 'ingal';
- }else{
- $intel->{missionclass} = $intel->{mission};
- }
- $intel->{talliance} = ' ' unless $intel->{talliance};
- $i++;
- $intel->{ODD} = $i % 2;
- push @outgoings,$intel;
- }
- push @intellists,{Message => 'Outgoing Fleets', Intel => \@outgoings, Target => 1};
-
- $BODY->param(IntelLIsts => \@intellists);
-
- $BODY->param(Error => $error);
- return $BODY;
-}
-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 ND::Web::Pages::Motd;
-use strict;
-use warnings FATAL => 'all';
-use ND::Include;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{motd} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Edit MOTD';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isHC;
-
- if (defined param 'cmd' and param('cmd') eq 'change'){
- $DBH->begin_work;
- my $query = $DBH->prepare(q{UPDATE misc SET value= ? WHERE id='MOTD'});
- my $motd = escapeHTML(param('motd'));
- $query->execute($motd);
- log_message $ND::UID,"Updated MOTD";
- $DBH->commit;
- $BODY->param(MOTD => $motd);
- }else{
- my ($motd) = $DBH->selectrow_array(q{SELECT value FROM misc WHERE id='MOTD'});
- $BODY->param(MOTD => $motd);
- }
- return $BODY;
-}
-
-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 ND::Web::Pages::PlanetNaps;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{planetNaps} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'List planet naps';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isHC;
- my $error;
-
- my $query = $DBH->prepare(qq{Select coords(x,y,z), ((ruler || ' OF ') || p.planet) as planet,race, size, score, value, xp, sizerank, scorerank, valuerank, xprank, p.value - p.size*200 - coalesce(c.metal+c.crystal+c.eonium,0)/150 - coalesce(c.structures,(SELECT avg(structures) FROM covop_targets)::int)*1500 AS fleetvalue,(c.metal+c.crystal+c.eonium)/100 AS resvalue, planet_status,hit_us, alliance,relationship,nick from current_planet_stats p LEFT OUTER JOIN covop_targets c ON p.id = c.planet WHERE planet_status IN ('Friendly','NAP') order by x,y,z asc});
-
- $query->execute or $error .= p($DBH->errstr);
- my @planets;
- my $i = 0;
- while (my $planet = $query->fetchrow_hashref){
- $i++;
- $planet->{ODD} = $i % 2;
- push @planets,$planet;
- }
- $BODY->param(Planets => \@planets);
- $BODY->param(Error => $error);
- return $BODY;
-}
-
-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 ND::Web::Pages::PlanetRankings;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{planetrankings} = __PACKAGE__;
-
-sub parse {
- #TODO: Need to fix some links first
- #if ($uri =~ m{^/[^/]+/(\w+)}){
- # param('order',$1);
- #}
-}
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Top planets';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isMember;
-
- my $error = '';
-
- $BODY->param(isHC => $self->isHC);
-
- my $offset = 0;
- if (defined param('offset') && param('offset') =~ /^(\d+)$/){
- $offset = $1;
- }
- $BODY->param(Offset => $offset);
- $BODY->param(PrevOffset => $offset - 100);
- $BODY->param(NextOffset => $offset + 100);
-
- my $order = 'scorerank';
- if (defined param('order') && param('order') =~ /^(scorerank|sizerank|valuerank|xprank|hit_us)$/){
- $order = $1;
- }
- $BODY->param(Order => $order);
- $order .= ' DESC' if ($order eq 'hit_us');
-
-
- my $extra_columns = '';
- if ($self->isHC){
- $extra_columns = ",planet_status,hit_us, alliance,relationship,nick";
- }
- my $query = $DBH->prepare(qq{SELECT x,y,z,((ruler || ' OF ') || planet) as planet,race,
- size, size_gain, size_gain_day,
- score,score_gain,score_gain_day,
- value,value_gain,value_gain_day,
- xp,xp_gain,xp_gain_day,
- sizerank,sizerank_gain,sizerank_gain_day,
- scorerank,scorerank_gain,scorerank_gain_day,
- valuerank,valuerank_gain,valuerank_gain_day,
- xprank,xprank_gain,xprank_gain_day
- $extra_columns FROM current_planet_stats_full ORDER BY $order LIMIT 100 OFFSET ?});
- $query->execute($offset) or $error .= p($DBH->errstr);
- my @planets;
- my $i = 0;
- while (my $planet = $query->fetchrow_hashref){
- for my $type (qw/size score value xp/){
- #$planet->{$type} = prettyValue($planet->{$type});
- $planet->{"${type}img"} = 'stay';
- $planet->{"${type}img"} = 'up' if $planet->{"${type}_gain_day"} > 0;
- $planet->{"${type}img"} = 'down' if $planet->{"${type}_gain_day"} < 0;
- $planet->{"${type}rankimg"} = 'stay';
- $planet->{"${type}rankimg"} = 'up' if $planet->{"${type}rank_gain_day"} < 0;
- $planet->{"${type}rankimg"} = 'down' if $planet->{"${type}rank_gain_day"} > 0;
- for my $type ($type,"${type}_gain","${type}_gain_day"){
- $planet->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
- }
- }
- $i++;
- $planet->{ODD} = $i % 2;
- push @planets,$planet;
- }
- $BODY->param(Planets => \@planets);
- $BODY->param(Error => $error);
- return $BODY;
-}
-
-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 ND::Web::Pages::Points;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{points} = __PACKAGE__;
-
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Top Members';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isMember;
-
- my $type = "total";
- if (defined param('type') && param('type') =~ /^(defense|attack|total|humor|scan|rank|raid)$/){
- $type = $1;
- }
- $type .= '_points' unless ($type eq 'rank');
-
- my $order = 'DESC';
- $order = 'ASC' if ($type eq 'rank');
-
- my $limit = 'LIMIT 10';
- $limit = '' if $self->isHC;
-
- my $query = $DBH->prepare(qq{SELECT username,defense_points,attack_points,scan_points,humor_points
- ,(attack_points+defense_points+scan_points/20) as total_points, rank, count(NULLIF(rc.launched,FALSE)) AS raid_points
- FROM users u LEFT OUTER JOIN raid_claims rc USING (uid)
- WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 2)
- GROUP BY username,defense_points,attack_points,scan_points,humor_points,rank
- ORDER BY $type $order $limit});
- $query->execute;
-
- my @members;
- my $i = 0;
- while (my ($username,$defense,$attack,$scan,$humor,$total,$rank,$raid) = $query->fetchrow){
- $i++;
- push @members,{Username => $username, Defense => $defense, Attack => $attack, Raid => $raid
- , Scan => $scan, Humor => $humor, Total => $total, Rank => $rank, ODD => $i % 2};
- }
- $BODY->param(Members => \@members);
- return $BODY;
-}
-
-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 ND::Web::Pages::Raids;
-use strict;
-use warnings;
-use ND::Include;
-use POSIX;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{raids} = __PACKAGE__;
-
-sub process {
- my $self = shift;
- $self->{XML} = 1 if param('xml');
-}
-
-
-sub generateClaimXml : method {
- my $self = shift;
- my ($BODY,$raid, $from, $target) = @_;
- my $DBH = $self->{DBH};
-
- my ($timestamp) = $DBH->selectrow_array("SELECT MAX(modified)::timestamp AS modified FROM raid_targets");
- $BODY->param(Timestamp => $timestamp);
- if ($target){
- $target = "r.id = $target";
- $_ = $self->listTargets;
- $BODY->param(TargetList => $_);
- }else{
- $target = "r.raid = $raid->{id}";
- }
-
- if ($from){
- $from = "AND modified > '$from'";
- }else{
- $from = '';
- }
- my $targets = $DBH->prepare(qq{SELECT r.id,r.planet FROM raid_targets r WHERE $target $from});
- $targets->execute or print p($DBH->errstr);
- my $claims = $DBH->prepare(qq{ SELECT username,joinable,launched FROM raid_claims
- NATURAL JOIN users WHERE target = ? AND wave = ?});
- my @targets;
- while (my $target = $targets->fetchrow_hashref){
- my %target;
- $target{Id} = $target->{id};
- my @waves;
- for (my $i = 1; $i <= $raid->{waves}; $i++){
- my %wave;
- $wave{Id} = $i;
- $claims->execute($target->{id},$i);
- my $joinable = 0;
- my $claimers;
- if ($claims->rows != 0){
- my $owner = 0;
- my @claimers;
- while (my $claim = $claims->fetchrow_hashref){
- $owner = 1 if ($self->{USER} eq $claim->{username});
- $joinable = 1 if ($claim->{joinable});
- $claim->{username} .= '*' if ($claim->{launched});
- push @claimers,$claim->{username};
- }
- $claimers = join '/', @claimers;
- if ($owner){
- $wave{Command} = 'Unclaim';
- }elsif ($joinable){
- $wave{Command} = 'Join';
- }else{
- $wave{Command} = 'none';
- }
- }else{
- #if (!isset($planet) || ($target->value/$planet->value > 0.4 || $target->score/$planet->score > 0.4))
- $wave{Command} = 'Claim';
- }
- $wave{Claimers} = $claimers;
- $wave{Joinable} = $joinable;
- push @waves,\%wave;
- }
- $target{Waves} = \@waves;
- push @targets,\%target;
- }
- $BODY->param(Targets => \@targets);
- return $BODY;
-}
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Raids';
- my $DBH = $self->{DBH};
-
-
- my $raid;
- if (defined param('raid')){
- my $query = $DBH->prepare(q{SELECT id,tick,waves,message,released_coords FROM raids WHERE id = ? AND open AND not removed AND id IN (SELECT raid FROM raid_access NATURAL JOIN groupmembers WHERE uid = ?)});
- $raid = $DBH->selectrow_hashref($query,undef,param('raid'),$ND::UID);
- }
-
- if (defined param('cmd') && defined param('target') && defined param('wave') && param('target') =~ /^(\d+)$/ && param('wave') =~ /^(\d+)$/){
- my $target = param('target');
- my $wave = param('wave');
-
- my $findtarget = $DBH->prepare("SELECT rt.id FROM raid_targets rt NATURAL JOIN raid_access ra NATURAL JOIN groupmembers where uid = ? AND id = ?");
- my $result = $DBH->selectrow_array($findtarget,undef,$ND::UID,$target);
- if ($result != $target){
- return $self->noAccess;
- }
-
- $DBH->begin_work;
- if (param('cmd') eq 'Claim'){
- my $claims = $DBH->prepare(qq{SELECT username FROM raid_claims NATURAL JOIN users WHERE target = ? AND wave = ?});
- $claims->execute($target,$wave);
- if ($claims->rows == 0){
- my $query = $DBH->prepare(q{INSERT INTO raid_claims (target,uid,wave) VALUES(?,?,?)});
- if($query->execute($target,$ND::UID,$wave)){
- log_message $ND::UID,"Claimed target $target wave $wave.";
- }
- }
- }
- if (param('cmd') eq 'Join'){
- my $claims = $DBH->prepare(qq{SELECT username FROM raid_claims
- NATURAL JOIN users WHERE target = ? AND wave = ? AND
- joinable = TRUE});
- $claims->execute($target,$wave);
- if ($claims->rows != 0){
- my $query = $DBH->prepare(q{INSERT INTO raid_claims (target,uid,wave,joinable) VALUES(?,?,?,TRUE)});
- if($query->execute($target,$ND::UID,$wave)){
- log_message $ND::UID,"Joined target $target wave $wave.";
- }
- }
- }
- if (param('cmd') eq 'set' && defined param('joinable') && param('joinable') =~ /(TRUE|FALSE)/){
- my $claims = $DBH->prepare(qq{SELECT username FROM raid_claims NATURAL JOIN users WHERE target = ? AND wave = ? AND uid = ?});
- $claims->execute($target,$wave,$ND::UID);
- if ($claims->rows != 0){
- $DBH->do(q{UPDATE raid_claims SET joinable = ? WHERE target = ? AND wave = ?},undef,$1,$target,$wave)
- }
- }
- if (param('cmd') eq 'Unclaim'){
- my $query = $DBH->prepare(qq{DELETE FROM raid_claims WHERE target = ? AND uid = ? AND wave = ?});
- if ($query->execute($target,$ND::UID,$wave)){
- log_message $ND::UID,"Unclaimed target $target wave $wave.";
- }
- }
- $DBH->commit;
- if ($self->{XML} && $raid){
- return $self->generateClaimXml($BODY,$raid,undef,$target);
- }
- }
- if ($self->{XML} && $raid && param('cmd') eq 'update' ){
- my $from;
- if (param('from') =~ /^[-\d\ \:\.]+$/){
- $from = param('from');
- }
- return $self->generateClaimXml($BODY,$raid,$from);
- }
- if ($self->{XML} && param('cmd') eq 'gettargets' ){
- $_ = $self->listTargets();
- $BODY->param(TargetList => $_);
- }
-
- return $BODY if $self->{XML};
-
- if ($raid){#We have a raid, so list all targets
- $BODY->param(Raid => $raid->{id});
- $BODY->param(Ajax => $self->{AJAX});
- my $noingal = '';
- my $planet;
- if ($self->{PLANET}){
- my $query = $DBH->prepare("SELECT value, score,x,y FROM current_planet_stats WHERE id = ?");
- $planet = $DBH->selectrow_hashref($query,undef,$self->{PLANET});
- $noingal = "AND NOT (x = $planet->{x} AND y = $planet->{y})";
- }
- $BODY->param(Message => parseMarkup($raid->{message}));
- $BODY->param(LandingTick => $raid->{tick});
- my $targetquery = $DBH->prepare(qq{SELECT r.id, r.planet, size, score, value, p.x,p.y,p.z, race, p.value - p.size*200 -coalesce(c.metal+c.crystal+c.eonium,0)/150 - coalesce(c.structures,(SELECT avg(structures) FROM covop_targets)::int)*1500 AS fleetvalue,(c.metal+c.crystal+c.eonium)/100 AS resvalue, comment
- FROM current_planet_stats p
- JOIN raid_targets r ON p.id = r.planet
- LEFT OUTER JOIN covop_targets c ON p.id = c.planet
- WHERE r.raid = ?
- $noingal
- ORDER BY size});
- $targetquery->execute($raid->{id});
- my @targets;
- while (my $target = $targetquery->fetchrow_hashref){
- my %target;
- if ($planet){
- if ($planet->{x} == $target->{x}){
- $target{style} = 'incluster';
- }
- $target{ScoreBash} = 'bash' if ($target->{score}/$planet->{score} < 0.4);
- $target{ValueBash} = 'bash' if ($target->{value}/$planet->{value} < 0.4);
- #next if ($target->{score}/$planet->{score} < 0.4) && ($target->{value}/$planet->{value} < 0.4);
- }
- $target{Id} = $target->{id};
- $target{Race} = $target->{race};
- my $num = pow(10,length($target->{score})-2);
- $target{Score} = ceil($target->{score}/$num)*$num;
- $num = pow(10,length($target->{value})-2);
- $target{Value} = ceil($target->{value}/$num)*$num;
- $num = pow(10,length($target->{size})-2);
- $target{Size} = floor($target->{size}/$num)*$num;
- $num = pow(10,length($target->{fleetvalue})-2);
- $target{FleetValue} = floor($target->{fleetvalue}/$num)*$num;
- if (defined $target->{resvalue}){
- $num = pow(10,length($target->{resvalue})-2);
- $target{ResValue} = floor($target->{resvalue}/$num)*$num;
- }
- $target{comment} = parseMarkup($target->{comment}) if ($target->{comment});
-
- my $scans = $DBH->prepare(q{SELECT DISTINCT ON (type) type, tick, scan FROM scans
- WHERE planet = ? AND type ~ 'Unit|Planet|Advanced Unit|.* Analysis' AND tick + 24 > tick() AND scan is not null
- GROUP BY type, tick, scan ORDER BY type ,tick DESC});
- $scans->execute($target->{planet});
- my %scans;
- while (my $scan = $scans->fetchrow_hashref){
- $scans{$scan->{type}} = $scan;
- }
-
- my @scans;
- for my $type ('Planet','Unit','Advanced Unit','Surface Analysis','Technology Analysis'){
- next unless exists $scans{$type};
- my $scan = $scans{$type};
- if ($self->{TICK} - $scan->{tick} > 5){
- $scan->{scan} =~ s{<table( cellpadding="\d+")?>}{<table class="old">};
- }
- if ($type eq 'Planet'){
- $target{PlanetScan} = $scan->{scan};
- next;
- }
- push @scans,{Scan => $scan->{scan}};
- }
- $target{Scans} = \@scans;
-
-
- my @roids;
- my @claims;
- my $size = $target{Size};
- for (my $i = 1; $i <= $raid->{waves}; $i++){
- my $roids = floor(0.25*$size);
- $size -= $roids;
- my $xp = 0;
- if ($planet){
- $xp = pa_xp($roids,$planet->{score},$planet->{value},$target{Score},$target{Value});
- }
- push @roids,{Wave => $i, Roids => $roids, XP => $xp};
- if ($self->{AJAX}){
- push @claims,{Wave => $i, Target => $target{Id}}
- }else{
- push @claims,{Wave => $i, Target => $target{Id}, Command => 'Claim'
- , Owner => 1, Raid => $raid->{id}, Joinable => 0};
- }
- }
- $target{Roids} = \@roids;
- $target{Claims} = \@claims;
-
- push @targets,\%target;
- }
- @targets = sort {$b->{Roids}[0]{XP} <=> $a->{Roids}[0]{XP} or $b->{Size} <=> $a->{Size}} @targets;
-
- $BODY->param(Targets => \@targets);
- }else{#list raids if we haven't chosen one yet
- my $launched = 0;
- my $query = $DBH->prepare(q{SELECT r.id AS raid,released_coords AS releasedcoords,tick,waves*COUNT(DISTINCT rt.id) AS waves,
- COUNT(rc.uid) AS claims, COUNT(nullif(rc.launched,false)) AS launched,COUNT(NULLIF(rc.uid > 0,true)) AS blocked
- FROM raids r JOIN raid_targets rt ON r.id = rt.raid
- LEFT OUTER JOIN raid_claims rc ON rt.id = rc.target
- WHERE open AND not removed AND r.id
- IN (SELECT raid FROM raid_access NATURAL JOIN groupmembers WHERE uid = ?)
- GROUP BY r.id,released_coords,tick,waves});
- $query->execute($ND::UID);
- my @raids;
- while (my $raid = $query->fetchrow_hashref){
- $raid->{waves} -= $raid->{blocked};
- $raid->{claims} -= $raid->{blocked};
- delete $raid->{blocked};
- $launched += $raid->{launched};
- push @raids,$raid;
- }
- $BODY->param(Raids => \@raids);
-
- if ($self->isBC){
- $BODY->param(isBC => 1);
- my $query = $DBH->prepare(q{SELECT r.id AS raid,open ,tick,waves*COUNT(DISTINCT rt.id) AS waves,
- COUNT(rc.uid) AS claims, COUNT(nullif(rc.launched,false)) AS launched ,COUNT(NULLIF(uid > 0,true)) AS blocked
- FROM raids r JOIN raid_targets rt ON r.id = rt.raid
- LEFT OUTER JOIN raid_claims rc ON rt.id = rc.target
- WHERE not removed AND (not open
- OR r.id NOT IN (SELECT raid FROM raid_access NATURAL JOIN groupmembers WHERE uid = ?))
- GROUP BY r.id,open,tick,waves});
- $query->execute($ND::UID);
- my @raids;
- while (my $raid = $query->fetchrow_hashref){
- $raid->{waves} -= $raid->{blocked};
- $raid->{claims} -= $raid->{blocked};
- delete $raid->{blocked};
- $launched += $raid->{launched};
- push @raids,$raid;
- }
- $BODY->param(ClosedRaids => \@raids);
-
-
- $query = $DBH->prepare(q{SELECT r.id AS raid,tick,waves*COUNT(DISTINCT rt.id) AS waves,
- COUNT(rc.uid) AS claims, COUNT(nullif(rc.launched,false)) AS launched ,COUNT(NULLIF(uid > 0,true)) AS blocked
- FROM raids r JOIN raid_targets rt ON r.id = rt.raid
- LEFT OUTER JOIN raid_claims rc ON rt.id = rc.target
- WHERE removed
- GROUP BY r.id,tick,waves});
- $query->execute;
- my @oldraids;
- while (my $raid = $query->fetchrow_hashref){
- $raid->{waves} -= $raid->{blocked};
- $raid->{claims} -= $raid->{blocked};
- delete $raid->{blocked};
- $launched += $raid->{launched};
- push @oldraids,$raid;
- }
- $BODY->param(RemovedRaids => \@oldraids);
- $BODY->param(Launched => $launched);
- }
- }
- return $BODY;
-}
-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 ND::Web::Pages::Resources;
-use strict;
-use warnings FATAL => 'all';
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{resources} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Alliance Resources';
- my $DBH = $self->{DBH};
- my $error;
-
- return $self->noAccess unless $self->isHC;
-
- my $order = "respplanet DESC";
- if (defined param('order') && param('order') =~ /^(size|score|resources|respplanet|nscore|nscore2|nscore3)$/){
- $order = "$1 DESC";
- }
-
-
- my $query = $DBH->prepare(qq{
- SELECT a.id,a.name,a.relationship,s.members,s.score,s.size,r.resources,r.planets, resources/planets AS respplanet,
- resources / 300 AS scoregain, score + (resources / 300) AS nscore,
- (resources/planets*LEAST(members,60))/300 AS scoregain2, score + (resources/planets*LEAST(members,60))/300 AS nscore2,
- (s.size::int8*(1464-tick())*250)/100 + score + (resources/planets*LEAST(members,60))/300 AS nscore3,
- (s.size::int8*(1464-tick())*250)/100 AS scoregain3
- FROM (SELECT alliance_id AS id,sum(metal+crystal+eonium) AS resources, count(*) AS planets
- FROM planets p join covop_targets c ON p.id = c.planet GROUP by alliance_id) r
- NATURAL JOIN alliances a
- LEFT OUTER JOIN (SELECT * FROM alliance_stats WHERE tick = (SELECT max(tick) FROM alliance_stats)) s ON a.id = s.id
- ORDER BY $order
- });
- $query->execute;
- my @alliances;
- my $i = 0;
- while (my $alliance = $query->fetchrow_hashref){
- $i++;
- $alliance->{ODD} = $i % 2;
- push @alliances,$alliance;
- }
- $BODY->param(Alliances => \@alliances);
-
- $BODY->param(Error => $error);
- return $BODY;
-}
-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 ND::Web::Pages::Settings;
-use strict;
-use warnings FATAL => 'all';
-use ND::Include;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{settings} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Edit site preferences';
- my $DBH = $self->{DBH};
-
- if (defined param 'cmd'){
- if(param('cmd') eq 'stylesheet'){
- my $query = $DBH->prepare(q{UPDATE users SET css = NULLIF($2,'Default') WHERE uid = $1});
- $query->execute($ND::UID,escapeHTML(param 'stylesheet')) or $ND::ERROR .= p $DBH->errstr;
- }
- }
- if(param('oldpass') && param('pass')){
- my $query = $DBH->prepare('UPDATE users SET password = MD5(?) WHERE password = MD5(?) AND uid = ?');
- $query->execute(param('pass'),param('oldpass'),$ND::UID);
- }
- my ($css) = $DBH->selectrow_array(q{SELECT css FROM users WHERE uid = $1},undef,$ND::UID);
- my @stylesheets = ({Style => 'Default'});
- $css = '' unless defined $css;
- while (<stylesheets/*.css>){
- if(m{stylesheets/(\w+)\.css}){
- push @stylesheets,{Style => $1, Selected => $1 eq $css ? 1 : 0};
- }
- }
- $BODY->param(StyleSheets => \@stylesheets);
- return $BODY;
-}
-
-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 ND::Web::Pages::TargetList;
-use strict;
-use warnings FATAL => 'all';
-use ND::Include;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{targetList} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'NF Value';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isHC;
-
- my $order = 'nfvalue';
- if (local $_ = param('order')){
- if (/^(size|value|score|xp)$/){
- $order = "$1 DESC";
- }elsif (/^(nfvalue|nfvalue2)$/){
- $order = "$1 ASC";
- }
- }
-
- my $alliances = '15';
- if (param('alliances') && param('alliances') =~ /^([\d,]+)$/){
- $alliances = $1;
- }
- my $query = $DBH->prepare(qq{
-SELECT coords(p.x,p.y,p.z),p.alliance, p.score, p.value, p.size, p.xp,nfvalue, nfvalue - sum(pa.value) AS nfvalue2, p.race
-FROM current_planet_stats p
- JOIN (SELECT g.x,g.y, sum(p.value) AS nfvalue
- FROM galaxies g join current_planet_stats p on g.x = p.x AND g.y = p.y
- WHERE g.tick = (SELECT max(tick) from galaxies)
- AND ((planet_status IS NULL OR NOT planet_status IN ('Friendly','NAP')) AND (relationship IS NULL OR NOT relationship IN ('Friendly','NAP')))
- GROUP BY g.x,g.y
- ) g ON p.x = g.x AND p.y = g.y
- JOIN current_planet_stats pa ON pa.x = g.x AND pa.y = g.y
-WHERE p.alliance_id IN ($alliances)
- AND pa.alliance_id IN ($alliances)
-GROUP BY p.x,p.y,p.z,p.alliance, p.score, p.value, p.size, p.xp, nfvalue,p.race
-ORDER BY $order
- });
- $query->execute;
- my @alliances;
- my $i = 0;
- while (my $alliance = $query->fetchrow_hashref){
- $i++;
- $alliance->{ODD} = $i % 2;
- push @alliances,$alliance;
- }
- $BODY->param(Alliances => \@alliances);
-
- return $BODY;
-}
-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 ND::Web::Pages::Users;
-use strict;
-use warnings;
-use ND::Include;
-use CGI qw/:standard/;
-use ND::Web::Include;
-
-use base qw/ND::Web::XMLPage/;
-
-$ND::Web::Page::PAGES{users} = __PACKAGE__;
-
-sub render_body {
- my $self = shift;
- my ($BODY) = @_;
- $self->{TITLE} = 'Users';
- my $DBH = $self->{DBH};
-
- return $self->noAccess unless $self->isHC;
-
- my $error = '';
- my $user;
- if (defined param('user') && param('user') =~ /^(\d+)$/){
- my $query = $DBH->prepare(q{
- SELECT uid,username,hostmask,CASE WHEN u.planet IS NULL THEN '' ELSE coords(x,y,z) END AS planet,attack_points,defense_points,scan_points,humor_points,info
- FROM users u LEFT OUTER JOIN current_planet_stats p ON u.planet = p.id
- WHERE uid = ?;
- }) or $error .= "<p> Something went wrong: </p>";
- $user = $DBH->selectrow_hashref($query,undef,$1) or $error.= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
-
-
- if ($user && defined param('cmd') && param('cmd') eq 'change'){
- $DBH->begin_work;
- for my $param (param()){
- if ($param =~ /^c:(planet|\w+_points|hostmask|info|username)$/){
- my $column = $1;
- my $value = param($column);
- if ($column eq 'planet'){
- if ($value eq ''){
- $value = undef;
- }elsif($value =~ /^(\d+)\D+(\d+)\D+(\d+)$/){
- ($value) = $DBH->selectrow_array(q{SELECT id FROM
- current_planet_stats WHERE x = ? and y = ? and z =?}
- ,undef,$1,$2,$3);
- }
- }
- if ($DBH->do(qq{UPDATE users SET $column = ? WHERE uid = ? }
- ,undef,$value,$user->{uid})){
- $user->{$column} = param($column);
- log_message $ND::UID,"HC set $column to $value for user: $user->{uid}";
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- }
- my $groups = $DBH->prepare('SELECT gid,groupname FROM groups');
- my $delgroup = $DBH->prepare(q{DELETE FROM groupmembers WHERE uid = ? AND gid = ?});
- my $addgroup = $DBH->prepare(q{INSERT INTO groupmembers (uid,gid) VALUES(?,?)});
- $groups->execute();
- while (my $group = $groups->fetchrow_hashref){
- my $query;
- next unless defined param($group->{gid});
- if (param($group->{gid}) eq 'remove'){
- $query = $delgroup;
- }elsif(param($group->{gid}) eq 'add'){
- $query = $addgroup;
- }
- if ($query){
- if ($query->execute($user->{uid},$group->{gid})){
- my ($action,$a2) = ('added','to');
- ($action,$a2) = ('removed','from') if param($group->{gid}) eq 'remove';
- log_message $ND::UID,"HC $action user: $user->{uid} ($user->{username}) $a2 group: $group->{gid} ($group->{groupname})";
- }else{
- $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
- }
- }
- $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
- }
-
- if ($user){
- $BODY->param(User => $user->{uid});
- $BODY->param(Username => $user->{username});
- $BODY->param(Hostmask => $user->{hostmask});
- $BODY->param(Planet => $user->{planet});
- $BODY->param(Attack_points => $user->{attack_points});
- $BODY->param(Defense_points => $user->{defense_points});
- $BODY->param(Scan_points => $user->{scan_points});
- $BODY->param(humor_points => $user->{humor_points});
- $BODY->param(info => escapeHTML $user->{info});
-
- my $groups = $DBH->prepare(q{SELECT g.gid,g.groupname,uid FROM groups g LEFT OUTER JOIN (SELECT gid,uid FROM groupmembers WHERE uid = ?) AS gm ON g.gid = gm.gid});
- $groups->execute($user->{uid});
-
- my @addgroups;
- my @remgroups;
- while (my $group = $groups->fetchrow_hashref){
- if ($group->{uid}){
- push @remgroups,{Id => $group->{gid}, Name => $group->{groupname}};
- }else{
- push @addgroups,{Id => $group->{gid}, Name => $group->{groupname}};
- }
- }
- $BODY->param(RemoveGroups => \@remgroups);
- $BODY->param(AddGroups => \@addgroups);
-
- }else{
- my $query = $DBH->prepare(qq{SELECT u.uid,username,TRIM(',' FROM concat(g.groupname||',')) AS groups
- FROM users u LEFT OUTER JOIN (groupmembers gm NATURAL JOIN groups g) ON gm.uid = u.uid
- WHERE u.uid > 0
- GROUP BY u.uid,username
- ORDER BY lower(username)})or $error .= $DBH->errstr;
- $query->execute or $error .= $DBH->errstr;
- my @users;
- my $i = 0;
- while (my $user = $query->fetchrow_hashref){
- $i++;
- $user->{ODD} = $i % 2;
- push @users, $user;
- }
- $BODY->param(Users => \@users);
- }
- $BODY->param(Error => $error);
- return $BODY;
-}
-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 ND::Web::XMLPage;
-use strict;
-use warnings;
-use CGI qw/:standard/;
-use HTML::Template;
-
-use ND::Include;
-use ND::Web::Page;
-use ND::Web::Include;
-
-use base qw/ND::Web::Page/;
-
-sub noAccess () {
- HTML::Template->new(filename => 'templates/NoAccess.tmpl', global_vars => 1, cache => 1);
-};
-
-sub process : method {
-}
-
-sub listTargets () : method {
- my $self = shift;
- my $DBH = $self->{DBH};
- my $query = $DBH->prepare(qq{SELECT t.id, r.id AS raid, r.tick+c.wave-1 AS landingtick,
- (released_coords AND old_claim(timestamp)) AS released_coords, coords(x,y,z),c.launched,c.wave,c.joinable
-FROM raid_claims c
- JOIN raid_targets t ON c.target = t.id
- JOIN raids r ON t.raid = r.id
- JOIN current_planet_stats p ON t.planet = p.id
-WHERE c.uid = ? AND r.tick+c.wave > ? AND r.open AND not r.removed
-ORDER BY r.tick+c.wave,x,y,z});
- $query->execute($ND::UID,$self->{TICK});
- my @targets;
- while (my $target = $query->fetchrow_hashref){
- my $coords = "Target $target->{id}";
- $coords = $target->{coords} if $target->{released_coords};
- push @targets,{Coords => $coords, Launched => $target->{launched}, Raid => $target->{raid}
- , Target => $target->{id}, Tick => $target->{landingtick}, Wave => $target->{wave}
- , AJAX => $self->{AJAX}, JoinName => $target->{joinable} ? 'N' : 'J'
- , Joinable => $target->{joinable} ? 'FALSE' : 'TRUE', JoinableTitle => $target->{joinable} ? 'Disable join' : 'Make target joinable'};
- }
- my $template = HTML::Template->new(filename => "templates/targetlist.tmpl", cache => 1);
- $template->param(Targets => \@targets);
- return $template->output;
-}
-
-
-sub render : method {
- my $self = shift;
- my $DBH = $self->{DBH};
-
-
- chdir '/var/www/ndawn/code';
-
- my $template = HTML::Template->new(filename => 'templates/skel.tmpl', global_vars => 1, cache => 1);
-
- my $TICK = $self->{TICK};
- my $ATTACKER = $self->{ATTACKER};
-
- $self->{XML} = 0;
- $self->{AJAX} = 1;
-
- $self->process;
-
- my $type = 'text/html';
- if ($self->{HTTP_ACCEPT} =~ m{application/xhtml\+xml}){
- $type = 'application/xhtml+xml'
- }
- my $body;
- if ($self->{XML}){
- $type = 'text/xml';
- $template = HTML::Template->new(filename => "templates/xml.tmpl", cache => 1);
- $body = HTML::Template->new(filename => "templates/$self->{PAGE}.xml.tmpl", cache => 1);
- }else{
- $body = HTML::Template->new(filename => "templates/$self->{PAGE}.tmpl", global_vars => 1, cache => 1);
- $body->param(PAGE => $self->{PAGE});
- }
-
- $body = $self->render_body($body);
-
- unless ($body){
- return;
- }
-
- unless ($self->{XML}){
- my $fleetupdate = $DBH->selectrow_array('SELECT landing_tick FROM fleets WHERE uid = ? AND fleet = 0',undef,$self->{UID});
-
- $fleetupdate = 0 unless defined $fleetupdate;
-
- my ($last_forum_visit) = $DBH->selectrow_array(q{SELECT last_forum_visit FROM users WHERE uid = $1}
- ,undef,$self->{UID}) or $ND::ERROR .= p($DBH->errstr);
- my ($unread,$newposts) = $DBH->selectrow_array(unread_query(),undef,$self->{UID},$last_forum_visit)
- or $ND::ERROR .= p($DBH->errstr);
-
- $template->param(UnreadPosts => $unread);
- $template->param(NewPosts => $newposts);
- $template->param(Tick => $TICK);
- $template->param(isMember => (($TICK - $fleetupdate < 24) || $self->isScanner()) && $self->{PLANET} && $self->isMember);
- $template->param(isHC => $self->isHC);
- $template->param(isDC => $self->isDC());
- $template->param(isBC => $self->isBC());
- $template->param(isIntel => $self->isIntel());
- $template->param(isAttacker => $ATTACKER && (!$self->isMember() || ((($TICK - $fleetupdate < 24) || $self->isScanner()) && $self->{PLANET})));
- if ($ATTACKER && (!$self->isMember() || ((($TICK - $fleetupdate < 24) || $self->isScanner()) && $self->{PLANET}))){
- $template->param(Targets => $self->listTargets);
- }
- $template->param(Coords => param('coords') ? param('coords') : '1:1:1');
- my ($css) = $DBH->selectrow_array(q{SELECT css FROM users WHERE uid = $1},undef,$ND::UID);
- $template->param(CSS => $css);
- $template->param(TITLE => $self->{TITLE});
- }
- $template->param(Error => $ND::ERROR);
- $template->param(BODY => $body->output);
- my $output = $template->output;
- $output =~ s/[^\x{9}\x{A}\x{D}\x{20}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
- print header(-type=> $type, -charset => 'utf-8', -Content_Length => length $output);
- print $output;
-};
-
-1;
--- /dev/null
+#!/usr/bin/perl -w -T
+#**************************************************************************
+# 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::AuthHandler;
+use strict;
+use warnings FATAL => 'all';
+
+use ND::DB;
+use Apache2::Access ();
+
+sub handler {
+ my $r = shift;
+ my($res, $sent_pw) = $r->get_basic_auth_pw;
+ return $res if $res != Apache2::Const::OK;
+
+ my $dbh = ND::DB::DB();
+ my ($username) = $dbh->selectrow_array(q{SELECT username FROM users WHERE
+ lower(username) = lower(?) AND password = MD5(?)},undef,$r->user,$sent_pw);
+ $dbh->disconnect;
+ if ($username){
+ $r->user($username);
+ return Apache2::Const::OK;
+ }
+ $r->note_basic_auth_failure();
+ return Apache2::Const::AUTH_REQUIRED;
+}
+
+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 ND::Web::Forum;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw{:standard};
+use HTML::Template;
+use ND::Web::Include;
+require Exporter;
+
+our @ISA = qw/Exporter/;
+our @EXPORT = qw/viewForumThread addForumPost addForumThread markThreadAsRead/;
+
+sub viewForumThread {
+ my ($thread) = @_;
+
+ my $template = HTML::Template->new(filename => "templates/viewthread.tmpl", global_vars => 1, cache => 1);
+
+ $template->param(Id => $thread->{id});
+ $template->param(Post => $thread->{post});
+
+ my $posts = $ND::DBH->prepare(q{SELECT u.username,date_trunc('seconds',fp.time::timestamp) AS time,fp.message,COALESCE(fp.time > ftv.time,TRUE) AS unread
+FROM forum_threads ft JOIN forum_posts fp USING (ftid) JOIN users u ON u.uid = fp.uid LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $2) ftv ON ftv.ftid = ft.ftid
+WHERE ft.ftid = $1
+ORDER BY fp.time ASC
+});
+ $posts->execute($thread->{id},$ND::UID) or $ND::ERROR .= p($ND::DBH->errstr);
+ my @posts;
+ my $old = 1;
+ while (my $post = $posts->fetchrow_hashref){
+ if ($old && $post->{unread}){
+ $old = 0;
+ $post->{NewPosts} = 1;
+ }
+ $post->{message} = parseMarkup($post->{message});
+ push @posts,$post;
+ }
+
+ if (defined param('cmd') && param('cmd') eq 'Preview'){
+ my $text = parseMarkup(escapeHTML(param('message')));
+ $text .= p b $@ if $@;
+ push @posts,{message => $text, unread => 1, username => 'PREVIEW', Time => 'Not submitted yet', NewPosts => $old ? 1 : 0};
+
+ $text = escapeHTML param('message');
+ $text =~ s/\x{3}\d\d?//g; #mirc color TODO: possibly match until \x{0F} and change to [color] block
+ $text =~ s/[^\x{9}\x{A}\x{D}\x{20}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
+ $template->param(Message => $text);
+ }
+ $template->param(Posts => \@posts);
+
+ markThreadAsRead($thread->{id});
+
+ return $template->output;
+}
+
+sub addForumPost {
+ my ($dbh,$thread,$uid,$message) = @_;
+ my $insert = $dbh->prepare(q{INSERT INTO forum_posts (ftid,message,uid) VALUES($1,$2,$3)});
+ unless ($insert->execute($thread->{id},escapeHTML($message),$uid)){
+ $ND::ERROR .= p($dbh->errstr);
+ return 0;
+ }
+ return 1;
+}
+
+sub addForumThread {
+ my ($dbh,$board,$uid,$subject) = @_;
+
+ my $insert = $dbh->prepare(q{INSERT INTO forum_threads (fbid,subject,uid) VALUES($1,$2,$3)});
+
+ if ($insert->execute($board->{id},escapeHTML($subject),$uid)){
+ my $id = $dbh->last_insert_id(undef,undef,undef,undef,"forum_threads_ftid_seq");
+ return $dbh->selectrow_hashref(q{SELECT ftid AS id, subject, $2::boolean AS post FROM forum_threads WHERE ftid = $1}
+ ,undef,$id,$board->{post})
+ or $ND::ERROR .= p($dbh->errstr);
+ }else{
+ $ND::ERROR .= p($dbh->errstr);
+ }
+}
+
+sub markThreadAsRead {
+ my ($thread) = @_;
+ my $rows = $ND::DBH->do(q{UPDATE forum_thread_visits SET time = now()
+WHERE uid = $1 AND ftid = $2},undef,$ND::UID,$thread);
+ if ($rows == 0){
+ $ND::DBH->do(q{INSERT INTO forum_thread_visits (uid,ftid) VALUES ($1,$2)}
+ ,undef,$ND::UID,$thread) or $ND::ERROR .= p($ND::DBH->errstr);
+ }elsif(not defined $rows){
+ $ND::ERROR .= p($ND::DBH->errstr);
+ }
+}
+
+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 ND::Web::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 ND::Web::Image;
+use strict;
+use warnings;
+
+use base qw/ND::Web::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 ND::Web::Include;
+use strict;
+use warnings;
+use CGI qw{:standard};
+require Exporter;
+use BBCode::Parser;
+
+our @ISA = qw/Exporter/;
+
+our @EXPORT = qw/parseMarkup min max
+ alliances intelquery /;
+
+sub parseMarkup ($) {
+ my ($text) = @_;
+
+ #$text =~ s{\n}{\n<br/>}g;
+ #$text =~ s{\[B\](.*?)\[/B\]}{<b>$1</b>}gi;
+ #$text =~ s{\[I\](.*?)\[/I\]}{<i>$1</i>}gi;
+ #$text =~ s{\[url\](.*?)\[/url\]}{<a href="$1">$1</a>}gi;
+ #$text =~ s{\[PRE\](.*?)\[/PRE\]}{<pre>$1</pre>}sgi;
+ #$text =~ s{\[PRE\](.*?)\[/PRE\]}{<pre>$1</pre>}sgi;
+ #$1 =~ s{<br/>}{}g;
+
+ eval{
+ my $tree = BBCode::Parser->DEFAULT->parse($text);
+ $text = $tree->toHTML;
+ };
+ $text =~ s/\x{3}\d\d?//g; #mirc color TODO: possibly match until \x{0F} and change to [color] block
+ $text =~ s/[^\x{9}\x{A}\x{D}\x{20}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
+ return $text;
+}
+
+
+sub min {
+ my ($x,$y) = @_;
+ return ($x > $y ? $y : $x);
+}
+
+sub max {
+ my ($x,$y) = @_;
+ return ($x < $y ? $y : $x);
+}
+
+
+sub alliances {
+ my ($alliance) = @_;
+ my @alliances;
+ $alliance = -1 unless defined $alliance;
+ push @alliances,{Id => -1, Name => ' ', Selected => not $alliance};
+ my $query = $ND::DBH->prepare(q{SELECT id,name FROM alliances ORDER BY name});
+ $query->execute;
+ while (my $ally = $query->fetchrow_hashref){
+ push @alliances,{Id => $ally->{id}, Name => $ally->{name}, Selected => $alliance == $ally->{id}};
+ }
+ return @alliances;
+}
+
+sub intelquery {
+ my ($columns,$where) = @_;
+ return qq{
+SELECT $columns, i.mission, i.tick AS landingtick,MIN(i.eta) AS eta, i.amount, i.ingal, u.username
+FROM (intel i NATURAL JOIN users u)
+ JOIN current_planet_stats t ON i.target = t.id
+ JOIN current_planet_stats o ON i.sender = o.id
+WHERE $where
+GROUP BY i.tick,i.mission,t.x,t.y,t.z,o.x,o.y,o.z,i.amount,i.ingal,u.username,t.alliance,o.alliance,t.nick,o.nick
+ORDER BY i.tick DESC, i.mission};
+}
+
+
+
+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 ND::Web::Page;
+use strict;
+use warnings;
+use CGI qw/:standard/;
+
+our %PAGES;
+
+sub new {
+ my $invocant = shift;
+ my $class = ref($invocant) || $invocant;
+ my $self = {@_};
+ $self->{PAGE} = 'main' unless (defined $self->{PAGE} and exists $PAGES{$self->{PAGE}});
+ $class = $PAGES{$self->{PAGE}};
+ bless $self, $class;
+ $self->parse;
+ $self->initiate;
+ return $self;
+}
+
+sub initiate : method {
+ my $self = shift;
+ my $DBH = $self->{DBH};
+
+ $DBH->do(q{SET timezone = 'GMT'});
+
+ ($self->{UID},$self->{PLANET},$self->{USER}) = $DBH->selectrow_array('SELECT uid,planet,username FROM users WHERE username ILIKE ?'
+ ,undef,$ENV{'REMOTE_USER'});
+ $ND::UID = $self->{UID};
+
+ ($self->{TICK}) = $DBH->selectrow_array('SELECT tick()',undef);
+ $self->{TICK} = 0 unless defined $self->{TICK};
+
+
+ my $query = $DBH->prepare('SELECT groupname,attack,gid from groupmembers NATURAL JOIN groups WHERE uid = ?');
+ $query->execute($self->{UID});
+
+ while (my ($name,$attack,$gid) = $query->fetchrow()){
+ $self->{GROUPS}{$name} = $gid;
+ $self->{ATTACKER} = 1 if $attack;
+ }
+
+
+}
+
+sub parse : method {
+}
+
+sub render_body : method {
+ return "";
+}
+
+sub render : method {
+ my $self = shift;
+
+ print header;
+ print $self->render_body;
+}
+
+sub isInGroup ($) : method {
+ my $self = shift;
+ my $group = shift;
+ return exists $self->{GROUPS}{$group} || exists $self->{GROUPS}{Tech} || exists $self->{GROUPS}{HC};
+}
+
+sub isMember () : method {
+ my $self = shift;
+ $self->isInGroup('Members');
+}
+
+sub isHC () : method {
+ my $self = shift;
+ $self->isInGroup('HC');
+}
+
+sub isDC () : method {
+ $_[0]->isInGroup('DC');
+}
+
+sub isBC () : method {
+ $_[0]->isInGroup('BC');
+}
+
+sub isOfficer () : method {
+ $_[0]->isInGroup('Officers');
+}
+
+sub isScanner () : method {
+ $_[0]->isInGroup('Scanners');
+}
+
+sub isIntel () : method {
+ $_[0]->isInGroup('Intel');
+}
+
+sub isTech () : method {
+ $_[0]->isInGroup('Tech');
+}
+
+
+
+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 ND::Web::Pages::AddIntel;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Forum;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{addintel} = 'ND::Web::Pages::AddIntel';
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+
+ my $DBH = $self->{DBH};
+
+ $self->{TITLE} = 'Add Intel and Scans';
+
+ my $error;
+
+ return $self->noAccess unless $self->isMember;
+
+ if (defined param('cmd')){
+ if (param('cmd') eq 'submit' || param('cmd') eq 'submit_message'){
+ my $findscan = $DBH->prepare("SELECT scan_id FROM scans WHERE scan_id = ? AND tick >= tick() - 168");
+ my $addscan = $DBH->prepare('INSERT INTO scans (scan_id,tick,"type") VALUES (?,tick(),?)');
+ my $addpoint = $DBH->prepare('UPDATE users SET scan_points = scan_points + 1 WHERE uid = ? ');
+ my $intel = param('intel');
+ my @scans;
+ while ($intel =~ m/http:\/\/game.planetarion.com\/.+?scan(?:_id)?=(\d+)/g){
+ my %scan;
+ $scan{Scan} = $1;
+ $scan{Message} = "Scan $1: ";
+ $findscan->execute($1);
+ if ($findscan->rows == 0){
+ if ($addscan->execute($1,$ND::UID)){
+ $addpoint->execute($ND::UID);
+ $scan{Message} .= '<i>added</i>';
+ }else{
+ $scan{Message} .= "<b>something went wrong:</b> <i>$DBH->errstr</i>";
+ }
+ }else{
+ $scan{Message} .= '<b>already exists</b>';
+ }
+ push @scans,\%scan;
+ }
+ $BODY->param(Scans => \@scans);
+ my $tick = $self->{TICK};
+ $tick = param('tick') if $tick =~ /^(\d+)$/;
+ my $addintel = $DBH->prepare(qq{SELECT add_intel(?,?,?,?,?,?,?,?,?,?,?)});
+ while ($intel =~ m/(\d+):(\d+):(\d+)\*?\s+(\d+):(\d+):(\d+)\*?\s+.+(?:Ter|Cat|Xan|Zik|Etd)?\s+(\d+)\s+(Attack|Defend)\s+(\d+)/g){
+ $addintel->execute($tick,$9, $1,$2,$3,$4,$5,$6,$7,$8,$ND::UID) or $error .= $DBH->errstr;
+ }
+ }
+ if (param('cmd') eq 'submit_message'){
+ my $board = {id => 12};
+ my $subject = param('subject');
+ unless ($subject){
+ if (param('intel') =~ /(.*\w.*)/){
+ $subject = $1;
+ }
+
+ }
+ if (my $thread = addForumThread $DBH,$board,$ND::UID,$subject){
+ $error .= p 'Intel message added' if addForumPost $DBH,$thread,$ND::UID,param('intel')
+ }
+ }
+ }
+ $BODY->param(Tick => $self->{TICK});
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+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 ND::Web::Pages::AllianceRankings;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{alliancerankings} = __PACKAGE__;
+
+sub parse {
+ #TODO: Need to fix some links first
+ #if ($uri =~ m{^/[^/]+/(\w+)}){
+ # param('order',$1);
+ #}
+}
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Top Alliances';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isMember;
+
+ my $error = '';
+
+ $BODY->param(isHC => $self->isHC);
+
+ my $offset = 0;
+ if (defined param('offset') && param('offset') =~ /^(\d+)$/){
+ $offset = $1;
+ }
+ $BODY->param(Offset => $offset);
+ $BODY->param(PrevOffset => $offset - 100);
+ $BODY->param(NextOffset => $offset + 100);
+
+ my $order = 'scorerank';
+ if (defined param('order') && param('order') =~ /^(scorerank|sizerank|members|avgsize|avgscore)$/){
+ $order = $1;
+ }
+ $BODY->param(Order => $order);
+ $order .= ' DESC' unless $order =~ /rank$/;
+
+
+ #my $extra_columns = '';
+ #if ($self->isHC){
+ # $extra_columns = ",alliance_status,hit_us, alliance,relationship,nick";
+ #}
+ my $query = $DBH->prepare(qq{SELECT a.name,
+ size, size_gain, size_gain_day,
+ score,score_gain,score_gain_day,
+ avgsize,avgsize_gain,avgsize_gain_day,
+ avgscore,avgscore_gain,avgscore_gain_day,
+ sizerank,sizerank_gain,sizerank_gain_day,
+ scorerank,scorerank_gain,scorerank_gain_day,
+ members,members_gain,members_gain_day
+ FROM
+ ( SELECT id, members,members_gain,members_gain_day, size, score, (size/members) AS avgsize, (score/members) AS avgscore, sizerank, scorerank, size_gain, score_gain, (size_gain/members) AS avgsize_gain, (score_gain/members) AS avgscore_gain, sizerank_gain, scorerank_gain, size_gain_day, score_gain_day, (size_gain_day/members) AS avgsize_gain_day, (score_gain_day/members) AS avgscore_gain_day, sizerank_gain_day, scorerank_gain_day
+ FROM alliance_stats WHERE tick = (( SELECT max(tick) AS max FROM alliance_stats))) ast
+ NATURAL JOIN alliances a
+ ORDER BY $order LIMIT 100 OFFSET ?});
+ $query->execute($offset) or $error .= p($DBH->errstr);
+ my @alliances;
+ my $i = 0;
+ while (my $alliance = $query->fetchrow_hashref){
+ for my $type (qw/members size score avgsize avgscore/){
+ #$alliance->{$type} = prettyValue($alliance->{$type});
+ next unless defined $alliance->{"${type}_gain_day"};
+ $alliance->{"${type}img"} = 'stay';
+ $alliance->{"${type}img"} = 'up' if $alliance->{"${type}_gain_day"} > 0;
+ $alliance->{"${type}img"} = 'down' if $alliance->{"${type}_gain_day"} < 0;
+ if( $type eq 'size' || $type eq 'score'){
+ $alliance->{"${type}rankimg"} = 'stay';
+ $alliance->{"${type}rankimg"} = 'up' if $alliance->{"${type}rank_gain_day"} < 0;
+ $alliance->{"${type}rankimg"} = 'down' if $alliance->{"${type}rank_gain_day"} > 0;
+ }
+ for my $type ($type,"${type}_gain","${type}_gain_day"){
+ $alliance->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
+ }
+ }
+ $i++;
+ $alliance->{ODD} = $i % 2;
+ push @alliances,$alliance;
+ }
+ $BODY->param(Alliances => \@alliances);
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+
+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 ND::Web::Pages::Alliances;
+use strict;
+use warnings FATAL => 'all';
+use ND::Include;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{alliances} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Alliances';
+ my $DBH = $self->{DBH};
+ my $error;
+
+ return $self->noAccess unless $self->isHC;
+
+ my $alliance;
+ if (defined param('alliance') && param('alliance') =~ /^(\d+)$/){
+ my $query = $DBH->prepare(q{SELECT id,name, relationship FROM alliances WHERE id = ?});
+ $alliance = $DBH->selectrow_hashref($query,undef,$1);
+ }
+ if ($alliance && defined param('cmd') && param ('cmd') eq 'change'){
+ $DBH->begin_work;
+ if (param('crelationship')){
+ my $value = escapeHTML(param('relationship'));
+ if ($DBH->do(q{UPDATE alliances SET relationship = NULLIF(?,'') WHERE id =?}
+ ,undef,$value,$alliance->{id})){
+ $alliance->{relationship} = $value;
+ log_message $ND::UID,"HC set alliance: $alliance->{id} relationship: $value";
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ my $coords = param('coords');
+ my $findplanet = $DBH->prepare(q{SELECT id FROM current_planet_stats WHERE x = ? AND y = ? AND z = ?});
+ my $addplanet = $DBH->prepare(q{
+ UPDATE planets SET alliance_id = $2, nick = coalesce($3,nick)
+ WHERE id = $1;
+ });
+ while ($coords =~ m/(\d+):(\d+):(\d+)(?:\s+nick=(\S+))?/g){
+ my ($id) = $DBH->selectrow_array($findplanet,undef,$1,$2,$3) or $ND::ERROR .= p $DBH->errstr;
+ if ($addplanet->execute($id,$alliance->{id},$4)){
+ my $nick = '';
+ $nick = "(nick $4)" if defined $4;
+ $error .= "<p> Added planet $1:$2:$3 $nick to this alliance</p>";
+ intel_log $ND::UID,$id,"HC Added planet $1:$2:$3 $nick to alliance: $alliance->{id} ($alliance->{name})";
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+
+ if ($alliance){
+ $BODY->param(Alliance => $alliance->{name});
+ $BODY->param(Id => $alliance->{id});
+ my @relationships;
+ for my $relationship ("","Friendly", "NAP", "Hostile"){
+ push @relationships,{Rel => $relationship, Selected => defined $alliance->{relationship} && $relationship eq $alliance->{relationship}}
+ }
+ $BODY->param(Relationships => \@relationships);
+
+ my $order = "p.x,p.y,p.z";
+ if (defined param('order') && param('order') =~ /^(score|size|value|xp|hit_us|race)$/){
+ $order = "$1 DESC";
+ }
+ my $members = $DBH->prepare(qq{
+ SELECT coords(x,y,z), nick, ruler, planet, race, size, score, value, xp,
+ planet_status,hit_us, sizerank, scorerank, valuerank, xprank
+ FROM current_planet_stats p
+ WHERE p.alliance_id = ?
+ ORDER BY $order});
+ my @members;
+ $members->execute($alliance->{id});
+ my $i = 0;
+ while (my $member = $members->fetchrow_hashref){
+ $i++;
+ $member->{ODD} = $i % 2;
+ push @members,$member;
+ }
+ $BODY->param(Members => \@members);
+
+ my $query = $DBH->prepare(intelquery('o.alliance AS oalliance,coords(o.x,o.y,o.z) AS origin, t.alliance AS talliance,coords(t.x,t.y,t.z) AS target',q{not ingal AND (o.alliance_id = $1 OR t.alliance_id = $1)
+ AND (i.mission = 'Defend' OR i.mission = 'AllyDef')
+ AND ((( t.alliance_id != o.alliance_id OR t.alliance_id IS NULL OR o.alliance_id IS NULL)))
+ AND i.sender NOT IN (SELECT planet FROM users u NATURAL JOIN groupmembers gm WHERE gid = 8 AND planet IS NOT NULL)
+ }));
+ $query->execute($alliance->{id}) or $error .= $DBH->errstr;
+
+ my @intel;
+ $i = 0;
+ while (my $intel = $query->fetchrow_hashref){
+ if ($intel->{ingal}){
+ $intel->{missionclass} = 'ingal';
+ }else{
+ $intel->{missionclass} = $intel->{mission};
+ }
+ $i++;
+ $intel->{ODD} = $i % 2;
+ push @intel,$intel;
+ }
+ $BODY->param(Intel => \@intel);
+ }else{
+
+ my $order = "score DESC";
+ if (defined param('order') && param('order') =~ /^(score|kscore|size|ksize|members|kmem|kxp|kxp|scavg|kscavg|siavg|ksiavg|kxpavg|kvalue|kvalavg)$/){
+ $order = "$1 DESC";
+ }
+ my $query = $DBH->prepare(qq{
+ SELECT DISTINCT a.id,name,COALESCE(s.score,SUM(p.score)) AS score,COALESCE(s.size,SUM(p.size)) AS size,s.members,count(p.score) AS kmem,
+ COALESCE(SUM(p.score),-1) AS kscore, COALESCE(SUM(p.size),-1) AS ksize, COALESCE(SUM(p.xp),-1) AS kxp,COALESCE(SUM(p.value),-1) AS kvalue,
+ COALESCE(s.score/s.members,-1) AS scavg, COALESCE(AVG(p.score)::int,-1) AS kscavg, COALESCE(s.size/s.members,-1) AS siavg,
+ COALESCE(AVG(p.size)::int,-1) AS ksiavg, COALESCE(AVG(p.xp)::int,-1) AS kxpavg, COALESCE(AVG(p.value)::int,-1) AS kvalavg
+ FROM alliances a
+ LEFT OUTER JOIN (SELECT * FROM alliance_stats WHERE tick = (SELECT max(tick) FROM alliance_stats)) s ON s.id = a.id
+ LEFT OUTER JOIN current_planet_stats p ON p.alliance_id = a.id
+ GROUP BY a.id,a.name,s.score,s.size,s.members
+ ORDER BY $order
+ })or $error .= $DBH->errstr;
+ $query->execute or $error .= $DBH->errstr;
+ my @alliances;
+ my $i = 0;
+ while (my $alliance = $query->fetchrow_hashref){
+ next unless (defined $alliance->{score} || $alliance->{kscore} > 0);
+ $i++;
+ $alliance->{ODD} = $i % 2;
+ push @alliances, $alliance;
+ }
+ $BODY->param(Alliances => \@alliances);
+ }
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+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 ND::Web::Pages::Calls;
+use strict;
+use warnings FATAL => 'all';
+use ND::Include;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{calls} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Defense Calls';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isDC;
+
+ my $error;
+
+ my $call;
+ if (defined param('call') && param('call') =~ /^(\d+)$/){
+ my $query = $DBH->prepare(q{
+ SELECT c.id, coords(p.x,p.y,p.z), c.landing_tick, c.info, covered, open, dc.username AS dc, u.defense_points,c.member,u.planet
+ FROM calls c
+ JOIN users u ON c.member = u.uid
+ LEFT OUTER JOIN users dc ON c.dc = dc.uid
+ JOIN current_planet_stats p ON u.planet = p.id
+ WHERE c.id = ?});
+ $call = $DBH->selectrow_hashref($query,undef,$1);
+ }
+ if ($call && defined param('cmd')){
+ if (param('cmd') eq 'Submit'){
+ $DBH->begin_work;
+ if (param('ctick')){
+ if ($DBH->do(q{UPDATE calls SET landing_tick = ? WHERE id = ?}
+ ,undef,param('tick'),$call->{id})){
+ $call->{landing_tick} = param('tick');
+ log_message $ND::UID,"DC updated landing tick for call $call->{id}";
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ if (param('cinfo')){
+ if ($DBH->do(q{UPDATE calls SET info = ? WHERE id = ?}
+ ,undef,param('info'),$call->{id})){
+ $call->{info} = param('info');
+ log_message $ND::UID,"DC updated info for call $call->{id}";
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }elsif(param('cmd') =~ /^(Cover|Uncover|Ignore|Open|Take) call$/){
+ $error .= "test";
+ my $extra_vars = '';
+ if (param('cmd') eq 'Cover call'){
+ $extra_vars = ", covered = TRUE, open = FALSE";
+ }elsif (param('cmd') eq 'Uncover call'){
+ $extra_vars = ", covered = FALSE, open = TRUE";
+ }elsif (param('cmd') eq 'Ignore call'){
+ $extra_vars = ", covered = FALSE, open = FALSE";
+ }elsif (param('cmd') eq 'Open call'){
+ $extra_vars = ", covered = FALSE, open = TRUE";
+ }
+ if ($DBH->do(qq{UPDATE calls SET dc = ? $extra_vars WHERE id = ?},
+ ,undef,$ND::UID,$call->{id})){
+ $call->{covered} = (param('cmd') eq 'Cover call');
+ $call->{open} = (param('cmd') =~ /^(Uncover|Open) call$/);
+ $call->{DC} = $self->{USER};
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }elsif(param('cmd') eq 'Remove'){
+ $DBH->begin_work;
+ my $query = $DBH->prepare(q{DELETE FROM incomings WHERE id = ? AND call = ?});
+ for my $param (param()){
+ if ($param =~ /^change:(\d+)$/){
+ if($query->execute($1,$call->{id})){
+ log_message $ND::UID,"DC deleted fleet: $1, call $call->{id}";
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ }
+ $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }elsif(param('cmd') eq 'Change'){
+ $DBH->begin_work;
+ my $query = $DBH->prepare(q{UPDATE incomings SET shiptype = ? WHERE id = ? AND call = ?});
+ for my $param (param()){
+ if ($param =~ /^change:(\d+)$/){
+ my $shiptype = escapeHTML(param("shiptype:$1"));
+ if($query->execute($shiptype,$1,$call->{id})){
+ log_message $ND::UID,"DC set fleet: $1, call $call->{id} to: $shiptype";
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ }
+ $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+
+ if ($call){
+ $BODY->param(Call => $call->{id});
+ $BODY->param(Coords => $call->{coords});
+ $BODY->param(DefensePoints => $call->{defense_points});
+ $BODY->param(LandingTick => $call->{landing_tick});
+ $BODY->param(ETA => $call->{landing_tick}-$self->{TICK});
+ $BODY->param(Info => escapeHTML $call->{info});
+ $BODY->param(DC => $call->{dc});
+ if ($call->{covered}){
+ $BODY->param(Cover => 'Uncover');
+ }else{
+ $BODY->param(Cover => 'Cover');
+ }
+ if ($call->{open} && !$call->{covered}){
+ $BODY->param(Ignore => 'Ignore');
+ }else{
+ $BODY->param(Ignore => 'Open');
+ }
+ my $fleets = $DBH->prepare(q{
+ SELECT id,mission,landing_tick,eta, back FROM fleets WHERE uid = ? AND (fleet = 0 OR (back >= ? AND landing_tick - eta - 11 < ? ))
+ ORDER BY fleet ASC});
+ my $ships = $DBH->prepare('SELECT ship,amount FROM fleet_ships WHERE fleet = ?');
+ $fleets->execute($call->{member},$call->{landing_tick},$call->{landing_tick});
+ my @fleets;
+ while (my $fleet = $fleets->fetchrow_hashref){
+ if ($fleet->{back} == $call->{landing_tick}){
+ $fleet->{Fleetcatch} = 1;
+ }
+ $ships->execute($fleet->{id});
+ my @ships;
+ my $i = 0;
+ while (my $ship = $ships->fetchrow_hashref){
+ $i++;
+ $ship->{ODD} = $i % 2;
+ push @ships,$ship;
+ }
+ $fleet->{Ships} = \@ships;
+ push @fleets, $fleet;
+ }
+ $BODY->param(Fleets => \@fleets);
+
+
+ $fleets = $DBH->prepare(q{
+ SELECT username, id,back - (landing_tick + eta - 1) AS recalled FROM fleets f JOIN users u USING (uid) WHERE target = $1 and landing_tick = $2
+ });
+ $fleets->execute($call->{planet},$call->{landing_tick}) or $ND::ERROR .= p $DBH->errstr;
+ my @defenders;
+ while (my $fleet = $fleets->fetchrow_hashref){
+ $ships->execute($fleet->{id});
+ my @ships;
+ my $i = 0;
+ while (my $ship = $ships->fetchrow_hashref){
+ $i++;
+ $ship->{ODD} = $i % 2;
+ push @ships,$ship;
+ }
+ $fleet->{Ships} = \@ships;
+ delete $fleet->{id};
+ push @defenders, $fleet;
+ }
+ $BODY->param(Defenders => \@defenders);
+
+ my $attackers = $DBH->prepare(q{
+ SELECT coords(p.x,p.y,p.z), p.planet_status, p.race,i.eta,i.amount,i.fleet,i.shiptype,p.relationship,p.alliance,i.id
+ FROM incomings i
+ JOIN current_planet_stats p ON i.sender = p.id
+ WHERE i.call = ?
+ ORDER BY p.x,p.y,p.z});
+ $attackers->execute($call->{id});
+ my @attackers;
+ my $i = 0;
+ while(my $attacker = $attackers->fetchrow_hashref){
+ $i++;
+ $attacker->{ODD} = $i % 2;
+ push @attackers,$attacker;
+ }
+ $BODY->param(Attackers => \@attackers);
+ }else{
+ my $where = 'open AND c.landing_tick-6 > tick()';
+ if (defined param('show')){
+ if (param('show') eq 'covered'){
+ $where = 'covered';
+ }elsif (param('show') eq 'all'){
+ $where = 'true';
+ }elsif (param('show') eq 'uncovered'){
+ $where = 'not covered';
+ }
+ }
+ my $pointlimits = $DBH->prepare(q{SELECT value :: int FROM misc WHERE id = ?});
+ my ($minpoints) = $DBH->selectrow_array($pointlimits,undef,'DEFMIN');
+ my ($maxpoints) = $DBH->selectrow_array($pointlimits,undef,'DEFMAX');
+
+ my $query = $DBH->prepare(qq{
+ SELECT id,coords(x,y,z),defense_points,landing_tick,dc,curreta,fleets,
+ TRIM('/' FROM concat(DISTINCT race||' /')) AS race, TRIM('/' FROM concat(amount||' /')) AS amount,
+ TRIM('/' FROM concat(DISTINCT eta||' /')) AS eta, TRIM('/' FROM concat(DISTINCT shiptype||' /')) AS shiptype,
+ TRIM('/' FROM concat(DISTINCT alliance ||' /')) AS alliance,
+ TRIM('/' FROM concat(coords||' /')) AS attackers
+ FROM (SELECT c.id, p.x,p.y,p.z, u.defense_points, c.landing_tick, dc.username AS dc,
+ (c.landing_tick - tick()) AS curreta,p2.race, i.amount, i.eta, i.shiptype, p2.alliance,
+ coords(p2.x,p2.y,p2.z), COUNT(DISTINCT f.id) AS fleets
+ FROM calls c
+ JOIN incomings i ON i.call = c.id
+ JOIN users u ON c.member = u.uid
+ JOIN current_planet_stats p ON u.planet = p.id
+ JOIN current_planet_stats p2 ON i.sender = p2.id
+ LEFT OUTER JOIN users dc ON c.dc = dc.uid
+ LEFT OUTER JOIN fleets f ON f.target = u.planet AND f.landing_tick = c.landing_tick AND f.back = f.landing_tick + f.eta - 1
+ WHERE $where
+ GROUP BY c.id, p.x,p.y,p.z, c.landing_tick, u.defense_points,dc.username,p2.race,i.amount,i.eta,i.shiptype,p2.alliance,p2.x,p2.y,p2.z) a
+ GROUP BY id, x,y,z,landing_tick, defense_points,dc,curreta,fleets
+ ORDER BY landing_tick DESC
+ })or $error .= $DBH->errstr;
+ $query->execute or $error .= $DBH->errstr;
+ my @calls;
+ my $i = 0;
+ my $tick = $self->{TICK};
+ while (my $call = $query->fetchrow_hashref){
+ if ($call->{defense_points} < $minpoints){
+ $call->{DefPrio} = 'LowestPrio';
+ }elsif ($call->{defense_points} < $maxpoints){
+ $call->{DefPrio} = 'MediumPrio';
+ }else{
+ $call->{DefPrio} = 'HighestPrio';
+ }
+ while ($tick - 24 > $call->{landing_tick}){
+ $tick -= 24;
+ push @calls,{};
+ $i = 0;
+ }
+ $call->{attackers} =~ s{(\d+:\d+:\d+)}{<a href="/check?coords=$1">$1</a>}g;
+ $call->{dcstyle} = 'Hostile' unless defined $call->{dc};
+ $i++;
+ $call->{ODD} = $i % 2;
+ $call->{shiptype} = escapeHTML($call->{shiptype});
+ push @calls, $call;
+ }
+ $BODY->param(Calls => \@calls);
+ }
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+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 ND::Web::Pages::Check;
+use strict;
+use warnings FATAL => 'all';
+no warnings qw(uninitialized);
+use ND::Include;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{check} = __PACKAGE__;
+
+sub parse {
+ my $self = shift;
+ if ($self->{URI} =~ m{^/.*/((\d+)(?: |:)(\d+)(?:(?: |:)(\d+))?(?: |:(\d+))?)$}){
+ param('coords',$1);
+ }
+}
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Check planets and galaxies';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->{ATTACKER};
+
+ $BODY->param(isBC => $self->isMember && ($self->isOfficer || $self->isBC));
+
+ my ($x,$y,$z);
+ if (param('coords') =~ /(\d+)(?: |:)(\d+)(?:(?: |:)(\d+))?(?: |:(\d+))?/){
+ $x = $1;
+ $y = $2;
+ $z = $3;
+ $BODY->param(Coords => "$x:$y".(defined $z ? ":$z" : ''));
+ }else{
+ $ND::ERROR .= p b q{Couldn't parse coords};
+ return $BODY;
+ }
+
+ if ($self->isMember && param('cmd') eq 'arbiter'){
+ my $query = $DBH->prepare(q{SELECT count(*) AS friendlies FROM current_planet_stats WHERE x = ? AND y = ?
+ AND (planet_status IN ('Friendly','NAP') OR relationship IN ('Friendly','NAP'))});
+ my ($count) = $DBH->selectrow_array($query,undef,$x,$y);
+ if ($count > 0){
+ $BODY->param(Arbiter => '<b>DO NOT ATTACK THIS GAL</b>');
+ }else{
+ $BODY->param(Arbiter => '<b>KILL THESE BASTARDS</b>');
+ }
+ log_message $ND::UID,"Arbiter check on $x:$y";
+ }
+
+ my $where = '';
+ my $extra_columns = '';
+
+ $where = 'AND z = ?' if defined $z;
+ if ($self->isMember && $self->isOfficer){
+ $extra_columns = ",planet_status,hit_us, alliance,relationship,nick";
+ }elsif ($self->isMember && $self->isBC){
+ $extra_columns = ", planet_status,hit_us, alliance,relationship";
+ }
+
+ my $query = $DBH->prepare(qq{Select id,coords(x,y,z), ((ruler || ' OF ') || p.planet) as planet,race,
+ size, size_gain, size_gain_day,
+ score,score_gain,score_gain_day,
+ value,value_gain,value_gain_day,
+ xp,xp_gain,xp_gain_day,
+ sizerank,sizerank_gain,sizerank_gain_day,
+ scorerank,scorerank_gain,scorerank_gain_day,
+ valuerank,valuerank_gain,valuerank_gain_day,
+ xprank,xprank_gain,xprank_gain_day,
+ p.value - p.size*200 - coalesce(c.metal+c.crystal+c.eonium,0)/150 - coalesce(c.structures,(SELECT avg(structures) FROM covop_targets)::int)*1500 AS fleetvalue,(c.metal+c.crystal+c.eonium)/100 AS resvalue $extra_columns from current_planet_stats_full p LEFT OUTER JOIN covop_targets c ON p.id = c.planet where x = ? AND y = ? $where order by x,y,z asc});
+
+ if (defined $z){
+ $query->execute($x,$y,$z);
+ }else{
+ $query->execute($x,$y);
+ if ($self->isMember && ($self->isBC || $self->isOfficer) && !$self->isHC){
+ log_message $ND::UID,"BC browsing $x:$y";
+ }
+ }
+ my @planets;
+ my $planet_id = undef;
+ my $i = 0;
+ while (my $planet = $query->fetchrow_hashref){
+ $planet_id = $planet->{id};
+ for my $type (qw/size score value xp/){
+ $planet->{"${type}img"} = 'stay';
+ $planet->{"${type}img"} = 'up' if $planet->{"${type}_gain_day"} > 0;
+ $planet->{"${type}img"} = 'down' if $planet->{"${type}_gain_day"} < 0;
+ $planet->{"${type}rankimg"} = 'stay';
+ $planet->{"${type}rankimg"} = 'up' if $planet->{"${type}rank_gain_day"} < 0;
+ $planet->{"${type}rankimg"} = 'down' if $planet->{"${type}rank_gain_day"} > 0;
+ for my $type ($type,"${type}_gain","${type}_gain_day"){
+ $planet->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
+ }
+ }
+ if ($self->isMember && ($self->isOfficer || $self->isBC)){
+ if ($z && $planet->{alliance} eq 'NewDawn' && not ($self->isHC || $self->isOfficer)){
+ log_message $ND::UID,"BC browsing ND planet $planet->{coords} tick $self->{TICK}";
+ }
+ }
+ $i++;
+ $planet->{ODD} = $i % 2;
+ delete $planet->{id};
+ push @planets,$planet;
+ }
+ $BODY->param(GPlanets => \@planets);
+
+ if ($z && $planet_id){
+ $BODY->param(OnePlanet => 1);
+
+ my $query = $DBH->prepare(q{
+ SELECT i.mission, i.tick AS landingtick,MIN(eta) AS eta, i.amount, coords(p.x,p.y,p.z) AS target
+ FROM intel i
+ JOIN (planets
+ NATURAL JOIN planet_stats) p ON i.target = p.id
+ JOIN (planets
+ NATURAL JOIN planet_stats) p2 ON i.sender = p2.id
+ WHERE p.tick = ( SELECT max(tick) FROM planet_stats) AND i.tick > tick() AND i.uid = -1
+ AND p2.tick = p.tick AND p2.id = ?
+ GROUP BY p.x,p.y,p.z,p2.x,p2.y,p2.z,i.mission,i.tick,i.amount,i.ingal,i.uid
+ ORDER BY p.x,p.y,p.z});
+ $query->execute($planet_id);
+ my @missions;
+ while (my ($mission,$landingtick,$eta,$amount,$target) = $query->fetchrow){
+ push @missions,{Target => $target, Mission => $mission, LandingTick => $landingtick
+ , ETA => $eta, Amount => $amount};
+ }
+ $BODY->param(Missions => \@missions);
+
+ my @scans;
+ $query = $DBH->prepare(q{SELECT value,tick FROM planet_stats
+ WHERE id = ? AND tick > tick() - 24});
+ my $scan = q{
+ <p>Value the last 24 ticks</p>
+ <table><tr><th>Tick</th><th>Value</th><th>Difference</th></tr>};
+ my $old = 0;
+ $query->execute($planet_id);
+ while (my($value,$tick) = $query->fetchrow){
+ my $diff = $value-$old;
+ $old = $value;
+ my $class = 'Defend';
+ $class = 'Attack' if $diff < 0;
+ $scan .= qq{<tr><td>$tick</td><td>$value</td><td class="$class">$diff</td></tr>};
+ }
+ $scan .= q{</table>};
+ push @scans, {Scan => $scan};
+
+ $query = $DBH->prepare(q{SELECT DISTINCT ON (type) type,scan_id, tick, scan FROM scans WHERE planet = ?
+ GROUP BY type,scan_id, tick, scan ORDER BY type,tick DESC});
+ $query->execute($planet_id);
+ my %scans;
+ while (my($type,$scan_id,$tick,$scan) = $query->fetchrow){
+ $scans{$type} = [$scan_id,$tick,$scan];
+ }
+
+ $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>};
+ $query->execute($planet_id);
+ $x = $y = $z = 0;
+ while (my($nx,$ny,$nz,$tick) = $query->fetchrow){
+ if ($nx != $x || $ny != $y || $nz != $z){
+ $x = $nx;
+ $y = $ny;
+ $z = $nz;
+ $scan .= qq{<tr><td>$tick</td><td>$x:$y:$z</td></tr>};
+ }
+ }
+ $scan .= q{</table>};
+ $scan .= $scans{'Ship Classes'}->[2] if $scans{'Ship Classes'};
+ push @scans, {Scan => $scan};
+
+ for my $type ('Planet','Jumpgate','Unit','Advanced Unit','Surface Analysis','Technology Analysis','Fleet Analysis','News'){
+ next unless exists $scans{$type};
+ my $scan_id = $scans{$type}->[0];
+ my $tick = $scans{$type}->[1];
+ my $scan = $scans{$type}->[2];
+ if ($self->{TICK} - $tick > 10){
+ $scan =~ s{<table( cellpadding="\d+")?>}{<table$1 class="old">};
+ }
+ push @scans,{Scan => qq{
+ <p><b><a href="http://game.planetarion.com/showscan.pl?scan_id=$scan_id">$type</a> Scan from tick $tick</b></p>
+ $scan}};
+ }
+
+ $BODY->param(Scans => \@scans);
+ }
+ $query = $DBH->prepare(q{SELECT x,y,
+ size, size_gain, size_gain_day,
+ score,score_gain,score_gain_day,
+ value,value_gain,value_gain_day,
+ xp,xp_gain,xp_gain_day,
+ sizerank,sizerank_gain,sizerank_gain_day,
+ scorerank,scorerank_gain,scorerank_gain_day,
+ valuerank,valuerank_gain,valuerank_gain_day,
+ xprank,xprank_gain,xprank_gain_day,
+ planets,planets_gain,planets_gain_day
+ FROM galaxies g
+ WHERE tick = ( SELECT max(tick) AS max FROM galaxies)
+ AND x = $1 AND y = $2
+ });
+ $query->execute($x,$y) or $ND::ERROR .= p($DBH->errstr);
+
+ my @galaxies;
+ $i = 0;
+ while (my $galaxy = $query->fetchrow_hashref){
+ for my $type (qw/planets size score xp value/){
+ #$galaxy->{$type} = prettyValue($galaxy->{$type});
+ next unless defined $galaxy->{"${type}_gain_day"};
+ $galaxy->{"${type}img"} = 'stay';
+ $galaxy->{"${type}img"} = 'up' if $galaxy->{"${type}_gain_day"} > 0;
+ $galaxy->{"${type}img"} = 'down' if $galaxy->{"${type}_gain_day"} < 0;
+ unless( $type eq 'planets'){
+ $galaxy->{"${type}rankimg"} = 'stay';
+ $galaxy->{"${type}rankimg"} = 'up' if $galaxy->{"${type}rank_gain_day"} < 0;
+ $galaxy->{"${type}rankimg"} = 'down' if $galaxy->{"${type}rank_gain_day"} > 0;
+ }
+ for my $type ($type,"${type}_gain","${type}_gain_day"){
+ $galaxy->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
+ }
+ }
+ $i++;
+ $galaxy->{ODD} = $i % 2;
+ push @galaxies,$galaxy;
+ }
+ $BODY->param(Galaxies => \@galaxies);
+
+ return $BODY;
+}
+
+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 ND::Web::Pages::CovOp;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{covop} = __PACKAGE__;
+
+sub parse {
+ my ($uri) = @_;
+ if ($uri =~ m{^/.*/(\w+)$}){
+ param('list',$1);
+ }
+}
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'CovOp Targets';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isHC;
+
+ my $show = q{AND ((planet_status IS NULL OR NOT planet_status IN ('Friendly','NAP')) AND (relationship IS NULL OR NOT relationship IN ('Friendly','NAP')))};
+ $show = '' if defined param('show') && param('show') eq 'all';
+ if (defined param('covop') && param('covop') =~ /^(\d+)$/){
+ my $update = $DBH->prepare('UPDATE covop_targets SET covop_by = ?, last_covop = tick() WHERE planet = ? ');
+ $update->execute($ND::UID,$1);
+ }
+
+ my $list = '';
+ my $where = '';
+ if (defined param('list') && param('list') eq 'distwhores'){
+ $list = '&list=distwhores';
+ $where = qq{WHERE dists > 0 $show
+ ORDER BY dists DESC,COALESCE(sec_centres::float/structures*100,0)ASC}
+ }else{
+ $where = qq{WHERE MaxResHack > 130000
+ $show
+ ORDER BY COALESCE(sec_centres::float/structures*100,0) ASC,MaxResHack DESC,metal+crystal+eonium DESC};
+ }
+
+ my $query = $DBH->prepare(qq{SELECT id, coords, metal, crystal, eonium, sec_centres::float/structures*100 AS secs, dists, last_covop, username, MaxResHack
+ FROM (SELECT p.id,coords(x,y,z), metal,crystal,eonium,
+ sec_centres,NULLIF(structures,0) AS structures,dists,last_covop,
+ u.username,max_bank_hack(metal,crystal,eonium,p.value,(SELECT value FROM
+ current_planet_stats WHERE id = ?)) AS MaxResHack, planet_status, relationship
+ FROM covop_targets c JOIN current_planet_stats p ON p.id = c.planet
+ LEFT OUTER JOIN users u ON u.uid = c.covop_by) AS foo
+ $where});
+ $query->execute($self->{PLANET});
+
+ my @targets;
+ my $i = 0;
+ while (my ($id,$coords,$metal,$crystal,$eonium,$seccents,$dists,$lastcovop,$user,$max) = $query->fetchrow){
+ $i++;
+ push @targets,{Username => $user, Target => $id, Coords => $coords
+ , Metal => $metal, Crystal => $crystal, Eonium => $eonium, SecCents => $seccents
+ , Dists => $dists, MaxResHack => $max, LastCovOp => $lastcovop, List => $list, ODD => $i % 2};
+ }
+ $BODY->param(Targets => \@targets);
+ return $BODY;
+}
+
+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 ND::Web::Pages::DefLeeches;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{defLeeches} = __PACKAGE__;
+
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Def Leeches';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isDC;
+
+ my $query = $DBH->prepare(q{SELECT username,defense_points,count(id) AS calls, SUM(fleets) AS fleets, SUM(recalled) AS recalled
+ FROM (SELECT username,defense_points,c.id,count(f.target) AS fleets, count(NULLIF(f.landing_tick + f.eta -1 = f.back,TRUE)) AS recalled
+ FROM users u JOIN calls c ON c.member = u.uid LEFT OUTER JOIN fleets f ON u.planet = f.target AND c.landing_tick = f.landing_tick
+ WHERE (f.mission = 'Defend') OR f.target IS NULL
+ GROUP BY username,defense_points,c.id
+ ) d
+ GROUP BY username,defense_points ORDER BY fleets DESC, defense_points
+ });
+ $query->execute;
+
+ my @members;
+ my $i = 0;
+ while ( my $member = $query->fetchrow_hashref){
+ $member->{ODD} = $i++ % 2;
+ push @members,$member;
+ }
+ $BODY->param(Members => \@members);
+ return $BODY;
+}
+
+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 ND::Web::Pages::DefRequest;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{defrequest} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Request Defense';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isMember;
+
+ my $error;
+
+ if (defined param('cmd') && param('cmd') eq 'submit'){
+ my $insert = $DBH->prepare('INSERT INTO defense_requests (uid,message) VALUES (?,?)');
+ if($insert->execute($ND::UID,param('message'))){
+ $BODY->param(Reply => param('message'));
+ }else{
+ $error .= "<b>".$DBH->errstr."</b>";
+ }
+ }
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+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 ND::Web::Pages::EditRaid;
+use strict;
+use warnings FATAL => 'all';
+use ND::Include;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{editRaid} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Create/Edit Raids';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isBC;
+ my $error;
+
+ my @alliances = alliances();
+ $BODY->param(Alliances => \@alliances);
+
+ my $raid;
+ if (defined param 'raid' and param('raid') =~ /^(\d+)$/){
+ my $query = $DBH->prepare(q{SELECT id,tick,waves,message,released_coords,open FROM raids WHERE id = ?});
+ $raid = $DBH->selectrow_hashref($query,undef,$1);
+ }
+ if (defined param('cmd') && param('cmd') eq 'submit'){
+ my $query = $DBH->prepare(q{INSERT INTO raids (tick,waves,message) VALUES(?,?,'')});
+ if ($query->execute(param('tick'),param('waves'))){
+ $raid = $DBH->last_insert_id(undef,undef,undef,undef,"raids_id_seq");
+ my $query = $DBH->prepare(q{SELECT id,tick,waves,message,released_coords,open FROM raids WHERE id = ?});
+ $raid = $DBH->selectrow_hashref($query,undef,$raid);
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+
+ if ($raid && defined param('cmd')){
+ if (param('cmd') eq 'remove'){
+ $DBH->do(q{UPDATE raids SET open = FALSE, removed = TRUE WHERE id = ?},undef,$raid->{id});
+ }elsif (param('cmd') eq 'Open'){
+ if($DBH->do(q{UPDATE raids SET open = TRUE, removed = FALSE WHERE id = ?},undef,$raid->{id})){
+ $raid->{open} = 1;
+ $raid->{removed} = 0;
+ }
+ }elsif (param('cmd') eq 'Close'){
+ if ($DBH->do(q{UPDATE raids SET open = FALSE WHERE id = ?},undef,$raid->{id})){
+ $raid->{open} = 0;
+ }
+ }elsif (param('cmd') eq 'showcoords'){
+ if($DBH->do(q{UPDATE raids SET released_coords = TRUE WHERE id = ?},undef,$raid->{id})){
+ $raid->{released_coords} = 1;
+ }
+ }elsif (param('cmd') eq 'hidecoords'){
+ if($DBH->do(q{UPDATE raids SET released_coords = FALSE WHERE id = ?},undef,$raid->{id})){
+ $raid->{released_coords} = 0;
+ }
+ }elsif (param('cmd') eq 'comment'){
+ $DBH->do(q{UPDATE raid_targets SET comment = ? WHERE id = ?}
+ ,undef,escapeHTML(param('comment')),param('target'))
+ or $error .= p($DBH->errstr);
+
+ }elsif (param('cmd') eq 'change' || param('cmd') eq 'submit'){
+ $DBH->begin_work;
+ my $message = escapeHTML(param('message'));
+ $raid->{message} = $message;
+ $raid->{waves} = param('waves');
+ $raid->{tick} = param('tick');
+ unless ($DBH->do(qq{UPDATE raids SET message = ?, tick = ?, waves = ? WHERE id = ?}
+ ,undef,$message,param('tick'),param('waves'),$raid->{id})){
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ my $sizelimit = '';
+ if (param('sizelimit') =~ /^(\d+)$/){
+ $sizelimit = "AND p.size >= $1";
+ unless ($DBH->do(qq{DELETE FROM raid_targets WHERE id IN (SELECT t.id FROM current_planet_stats p
+ JOIN raid_targets t ON p.id = t.planet WHERE p.size < ? AND t.raid = ?)},undef,$1,$raid->{id})){
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ my $targets = param('targets');
+ my $addtarget = $DBH->prepare(qq{INSERT INTO raid_targets(raid,planet) (
+ SELECT ?, id FROM current_planet_stats p WHERE x = ? AND y = ? AND COALESCE(z = ?,TRUE) $sizelimit)});
+ while ($targets =~ m/(\d+):(\d+)(?::(\d+))?/g){
+ unless ($addtarget->execute($raid->{id},$1,$2,$3)){
+ $error .= "<p> Something went wrong when adding $1:$2".($3 ? ":$3" : '').": ".$DBH->errstr."</p>";
+ }
+ }
+ if (param('alliance') =~ /^(\d+)$/ && $1 != 1){
+ log_message $ND::UID,"BC adding alliance $1 to raid";
+ my $addtarget = $DBH->prepare(qq{INSERT INTO raid_targets(raid,planet) (
+ SELECT ?,id FROM current_planet_stats p WHERE alliance_id = ? $sizelimit)});
+ unless ($addtarget->execute($raid->{id},$1)){
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ my $groups = $DBH->prepare('SELECT gid,groupname FROM groups WHERE attack');
+ my $delgroup = $DBH->prepare(q{DELETE FROM raid_access WHERE raid = ? AND gid = ?});
+ my $addgroup = $DBH->prepare(q{INSERT INTO raid_access (raid,gid) VALUES(?,?)});
+ $groups->execute();
+ while (my $group = $groups->fetchrow_hashref){
+ my $query;
+ next unless defined param $group->{gid};
+ if (param($group->{gid}) eq 'remove'){
+ $query = $delgroup;
+ }elsif(param($group->{gid}) eq 'add'){
+ $query = $addgroup;
+ }
+ if ($query){
+ unless ($query->execute($raid->{id},$group->{gid})){
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ }
+ unless ($DBH->commit){
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }elsif (param('cmd') eq 'targets'){
+ $DBH->begin_work;
+ my $comment = $DBH->prepare(q{UPDATE raid_targets SET comment = ? WHERE id = ?});
+ my $unclaim = $DBH->prepare(q{DELETE FROM raid_claims WHERE target = ? AND wave = ?});
+ my $block = $DBH->prepare(q{INSERT INTO raid_claims (target,uid,wave) VALUES(?,-2,?)});
+ my $remove = $DBH->prepare(q{DELETE FROM raid_targets WHERE raid = ? AND id = ?});
+ for $_ (param()){
+ if (/^comment:(\d+)$/){
+ $comment->execute(escapeHTML(param($_)),$1) or $error .= p($DBH->errstr);
+ }elsif(/^unclaim:(\d+):(\d+)$/){
+ $unclaim->execute($1,$2) or $error .= p($DBH->errstr);
+ log_message $ND::UID,"BC unclaimed target $1 wave $2.";
+ }elsif(/^block:(\d+):(\d+)$/){
+ $block->execute($1,$2) or $error .= p($DBH->errstr);
+ }elsif(/^remove:(\d+)$/){
+ $remove->execute($raid->{id},$1) or $error .= p($DBH->errstr);
+ }
+ }
+ $DBH->commit or $error .= p($DBH->errstr);
+ }
+ }
+
+ my $groups = $DBH->prepare(q{SELECT g.gid,g.groupname,raid FROM groups g LEFT OUTER JOIN (SELECT gid,raid FROM raid_access WHERE raid = ?) AS ra ON g.gid = ra.gid WHERE g.attack});
+ $groups->execute($raid ? $raid->{id} : undef);
+
+ my @addgroups;
+ my @remgroups;
+ while (my $group = $groups->fetchrow_hashref){
+ if ($group->{raid}){
+ push @remgroups,{Id => $group->{gid}, Name => $group->{groupname}};
+ }else{
+ push @addgroups,{Id => $group->{gid}, Name => $group->{groupname}};
+ }
+ }
+ $BODY->param(RemoveGroups => \@remgroups);
+ $BODY->param(AddGroups => \@addgroups);
+
+
+ if ($raid){
+
+ $BODY->param(Raid => $raid->{id});
+ if($raid->{open}){
+ $BODY->param(Open => 'Close');
+ }else{
+ $BODY->param(Open => 'Open');
+ }
+ if($raid->{released_coords}){
+ $BODY->param(ShowCoords => 'hidecoords');
+ $BODY->param(ShowCoordsName => 'Hide');
+ }else{
+ $BODY->param(ShowCoords => 'showcoords');
+ $BODY->param(ShowCoordsName => 'Show');
+ }
+ $BODY->param(Waves => $raid->{waves});
+ $BODY->param(LandingTick => $raid->{tick});
+ $BODY->param(Message => $raid->{message});
+
+ my $order = "p.x,p.y,p.z";
+ if (param('order') && param('order') =~ /^(score|size|value|xp|race)$/){
+ $order = "$1 DESC";
+ }
+
+ my $targetquery = $DBH->prepare(qq{SELECT r.id,coords(x,y,z),comment,size,score,value,race,planet_status AS planetstatus,relationship,comment,r.planet
+ FROM current_planet_stats p JOIN raid_targets r ON p.id = r.planet
+ WHERE r.raid = ?
+ ORDER BY $order});
+ my $claims = $DBH->prepare(qq{ SELECT username,launched FROM raid_claims
+ NATURAL JOIN users WHERE target = ? AND wave = ?});
+ $targetquery->execute($raid->{id}) or $error .= $DBH->errstr;
+ my @targets;
+ while (my $target = $targetquery->fetchrow_hashref){
+ my @waves;
+ for my $i (1 .. $raid->{waves}){
+ $claims->execute($target->{id},$i);
+ my $claimers;
+ if ($claims->rows != 0){
+ my $owner = 0;
+ my @claimers;
+ while (my $claim = $claims->fetchrow_hashref){
+ $claim->{username} .= '*' if ($claim->{launched});
+ push @claimers,$claim->{username};
+ }
+ $claimers = join '/', @claimers;
+ }
+ push @waves,{Wave => $i, Claimers => $claimers};
+ }
+ $target->{waves} = \@waves;
+
+ my $scans = $DBH->prepare(q{SELECT DISTINCT ON (type) type, tick, scan FROM scans
+ WHERE planet = ? AND type ~ 'Unit|Planet|Advanced Unit|.* Analysis' AND tick + 24 > tick() AND scan is not null
+ GROUP BY type, tick, scan ORDER BY type ,tick DESC});
+ $scans->execute($target->{planet});
+ delete $target->{planet};
+ my %scans;
+ while (my $scan = $scans->fetchrow_hashref){
+ $scans{$scan->{type}} = $scan;
+ }
+
+ my @scans;
+ for my $type ('Planet','Unit','Advanced Unit','Surface Analysis','Technology Analysis'){
+ next unless exists $scans{$type};
+ my $scan = $scans{$type};
+ if ($self->{TICK} - $scan->{tick} > 5){
+ $scan->{scan} =~ s{<table( cellpadding="\d+")?>}{<table class="old">};
+ }
+ if ($type eq 'Planet'){
+ $target->{PlanetScan} = $scan->{scan};
+ next;
+ }
+ push @scans,{Scan => $scan->{scan}};
+ }
+ $target->{Scans} = \@scans;
+ push @targets,$target;
+ }
+ $BODY->param(Targets => \@targets);
+ }else{
+ $BODY->param(Waves => 3);
+ my @time = gmtime;
+ $BODY->param(LandingTick => $self->{TICK} + 24 - $time[2] + 12);
+ }
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+
+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 ND::Web::Pages::Forum;
+use strict;
+use warnings;
+use ND::Web::Forum;
+use CGI qw/:standard/;
+use ND::Web::Include;
+use ND::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{forum} = __PACKAGE__;
+
+sub parse {
+ my $self = shift;
+ if ($self->{URI} =~ m{^/.*/allUnread}){
+ param('allUnread',1);
+ }
+}
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Forum';
+ my $DBH = $self->{DBH};
+
+ $DBH->do(q{UPDATE users SET last_forum_visit = NOW() WHERE uid = $1},undef,$ND::UID) or $ND::ERROR .= p($DBH->errstr);
+
+ my $board;
+ if(param('b')){
+ my $boards = $DBH->prepare(q{SELECT fb.fbid AS id,fb.board, bool_or(fa.post) AS post, bool_or(fa.moderate) AS moderate,fb.fcid
+ FROM forum_boards fb NATURAL JOIN forum_access fa
+ WHERE fb.fbid = $1 AND (gid = -1 OR gid IN (SELECT gid FROM groupmembers
+ WHERE uid = $2))
+ GROUP BY fb.fbid,fb.board,fb.fcid});
+ $board = $DBH->selectrow_hashref($boards,undef,param('b'),$ND::UID) or $ND::ERROR .= p($DBH->errstr);
+ }
+ if (param('markAsRead')){
+ my $threads = $DBH->prepare(q{SELECT ft.ftid AS id,ft.subject,count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,count(fp.fpid) AS posts, max(fp.time)::timestamp as last_post
+ FROM forum_threads ft JOIN forum_posts fp USING (ftid) LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $2) ftv ON ftv.ftid = ft.ftid
+ WHERE ((ft.fbid IS NULL AND $1 IS NULL) OR ft.fbid = $1) AND fp.time <= $3
+ GROUP BY ft.ftid, ft.subject
+ HAVING count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) >= 1
+ });
+
+ $threads->bind_param('$1',$board->{id},{TYPE => DBI::SQL_INTEGER }) or $ND::ERROR .= p($DBH->errstr);
+ $threads->bind_param('$2',$ND::UID,{TYPE => DBI::SQL_INTEGER }) or $ND::ERROR .= p($DBH->errstr);
+ $threads->bind_param('$3',param('markAsRead')) or $ND::ERROR .= p($DBH->errstr);
+ $threads->execute or $ND::ERROR .= p($DBH->errstr);
+ while (my $thread = $threads->fetchrow_hashref){
+ markThreadAsRead $thread->{id};
+ }
+ }
+
+ my $thread;
+ my $findThread = $DBH->prepare(q{SELECT ft.ftid AS id,ft.subject, bool_or(fa.post) AS post, bool_or(fa.moderate) AS moderate,ft.fbid,fb.board,fb.fcid,ft.sticky
+ FROM forum_boards fb NATURAL JOIN forum_access fa NATURAL JOIN forum_threads ft
+ WHERE ft.ftid = $1 AND (gid = -1 OR gid IN (SELECT gid FROM groupmembers
+ WHERE uid = $2))
+ GROUP BY ft.ftid,ft.subject,ft.fbid,fb.board,fb.fcid,ft.sticky});
+ if(param('t')){
+ $thread = $DBH->selectrow_hashref($findThread,undef,param('t'),$ND::UID) or $ND::ERROR .= p($DBH->errstr);
+ }
+
+ if (defined param('cmd')){
+ if(param('cmd') eq 'Submit' or param('cmd') eq 'Preview'){
+ $DBH->begin_work;
+ if ($board && $board->{post}){
+ $thread = addForumThread $DBH,$board,$ND::UID,param('subject');
+ }
+ if (param('cmd') eq 'Submit' and $thread && $thread->{post}){
+ addForumPost($DBH,$thread,$ND::UID,param('message'));
+ $self->{RETURN} = 'REDIRECT';
+ $self->{REDIR_LOCATION} = "/forum?t=$thread->{id}#NewPosts";
+ }
+ $DBH->commit or $ND::ERROR .= p($DBH->errstr);
+ return if $self->{RETURN};
+ }
+ if(param('cmd') eq 'Move' && $board->{moderate}){
+ $DBH->begin_work;
+ my $moveThread = $DBH->prepare(q{UPDATE forum_threads SET fbid = $1 WHERE ftid = $2 AND fbid = $3});
+ for my $param (param()){
+ if ($param =~ /t:(\d+)/){
+ $moveThread->execute(param('board'),$1,$board->{id}) or $ND::ERROR .= p($DBH->errstr);
+ if ($moveThread->rows > 0){
+ log_message $ND::UID, qq{Moved thread: $1 to board: }.param('board');
+ }
+ }
+ }
+ $DBH->commit or $ND::ERROR .= p($DBH->errstr);
+ }
+ if($thread && param('cmd') eq 'Sticky' && $thread->{moderate}){
+ if ($DBH->do(q{UPDATE forum_threads SET sticky = TRUE WHERE ftid = ?}, undef,$thread->{id})){
+ $thread->{sticky} = 1;
+ }else{
+ $ND::ERROR .= p($DBH->errstr);
+ }
+ }
+ if($thread && param('cmd') eq 'Unsticky' && $thread->{moderate}){
+ if ($DBH->do(q{UPDATE forum_threads SET sticky = FALSE WHERE ftid = ?}, undef,$thread->{id})){
+ $thread->{sticky} = 0;
+ }else{
+ $ND::ERROR .= p($DBH->errstr);
+ }
+ }
+ }
+
+ my $categories = $DBH->prepare(q{SELECT fcid AS id,category FROM forum_categories ORDER BY fcid});
+ my $boards = $DBH->prepare(q{SELECT fb.fbid AS id,fb.board, bool_or(fa.post) AS post
+ FROM forum_boards fb NATURAL JOIN forum_access fa
+ WHERE fb.fcid = $1 AND (gid = -1 OR gid IN (SELECT gid FROM groupmembers
+ WHERE uid = $2))
+ GROUP BY fb.fbid,fb.board
+ ORDER BY fb.fbid
+ });
+ my $threads = $DBH->prepare(q{SELECT ft.ftid AS id,u.username,ft.subject,
+ count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,count(fp.fpid) AS posts,
+ date_trunc('seconds',max(fp.time)::timestamp) as last_post,
+ min(fp.time)::date as posting_date, ft.sticky
+ FROM forum_threads ft JOIN forum_posts fp USING (ftid)
+ JOIN users u ON u.uid = ft.uid
+ LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $2) ftv ON ftv.ftid = ft.ftid
+ WHERE ft.fbid = $1
+ GROUP BY ft.ftid, ft.subject,ft.sticky,u.username
+ HAVING count(NULLIF(COALESCE(fp.time > ftv.time,TRUE),FALSE)) >= $3
+ ORDER BY sticky DESC,last_post DESC});
+
+ if ($thread){ #Display the thread
+ $BODY->param(Title => $thread->{subject});
+ $BODY->param(FBID => $thread->{fbid});
+ $BODY->param(Board => $thread->{board});
+ $BODY->param(FTID => $thread->{id});
+ $BODY->param(Moderate => $thread->{moderate});
+ $BODY->param(Sticky => $thread->{sticky} ? 'Unsticky' : 'Sticky');
+ $BODY->param(Thread => viewForumThread $thread);
+ my ($category) = $DBH->selectrow_array(q{SELECT category FROM forum_categories WHERE fcid = $1}
+ ,undef,$thread->{fcid}) or $ND::ERROR .= p($DBH->errstr);
+ $BODY->param(Category => $category);
+
+ }elsif(defined param('allUnread')){ #List threads in this board
+ $BODY->param(AllUnread => 1);
+ $BODY->param(Id => $board->{id});
+ my ($time) = $DBH->selectrow_array('SELECT now()::timestamp',undef);
+ $BODY->param(Date => $time);
+ $categories->execute or $ND::ERROR .= p($DBH->errstr);
+ my @categories;
+ while (my $category = $categories->fetchrow_hashref){
+ $boards->execute($category->{id},$ND::UID) or $ND::ERROR .= p($DBH->errstr);
+ my @boards;
+ while (my $board = $boards->fetchrow_hashref){
+ next if $board->{id} < 0;
+ $threads->execute($board->{id},$ND::UID,1) or $ND::ERROR .= p($DBH->errstr);
+ my $i = 0;
+ my @threads;
+ while (my $thread = $threads->fetchrow_hashref){
+ $i++;
+ $thread->{Odd} = $i % 2;
+ push @threads,$thread;
+ }
+ $board->{Threads} = \@threads;
+ delete $board->{post};
+ push @boards,$board if $i > 0;
+ }
+ $category->{Boards} = \@boards;
+ delete $category->{id};
+ push @categories,$category if @boards;
+ }
+ $BODY->param(Categories => \@categories);
+
+ }elsif($board){ #List threads in this board
+ $BODY->param(ViewBoard => 1);
+ $BODY->param(Title => $board->{board});
+ $BODY->param(Post => $board->{post});
+ $BODY->param(Moderate => $board->{moderate});
+ $BODY->param(Id => $board->{id});
+ $BODY->param(FBID => $board->{id});
+ $BODY->param(Board => $board->{board});
+ my ($time) = $DBH->selectrow_array('SELECT now()::timestamp',undef);
+ $BODY->param(Date => $time);
+ $threads->execute($board->{id},$ND::UID,0) or $ND::ERROR .= p($DBH->errstr);
+ my $i = 0;
+ my @threads;
+ while (my $thread = $threads->fetchrow_hashref){
+ $i++;
+ $thread->{Odd} = $i % 2;
+ push @threads,$thread;
+ }
+ $BODY->param(Threads => \@threads);
+
+ if ($board->{moderate}){
+ $categories->execute or $ND::ERROR .= p($DBH->errstr);
+ my @categories;
+ while (my $category = $categories->fetchrow_hashref){
+ $boards->execute($category->{id},$ND::UID) or $ND::ERROR .= p($DBH->errstr);
+
+ my @boards;
+ while (my $b = $boards->fetchrow_hashref){
+ next if (not $b->{post} or $b->{id} == $board->{id});
+ delete $b->{post};
+ push @boards,$b;
+ }
+ $category->{Boards} = \@boards;
+ delete $category->{id};
+ push @categories,$category if @boards;
+ }
+ $BODY->param(Categories => \@categories);
+ }
+ my ($category) = $DBH->selectrow_array(q{SELECT category FROM forum_categories WHERE fcid = $1}
+ ,undef,$board->{fcid}) or $ND::ERROR .= p($DBH->errstr);
+ $BODY->param(Category => $category);
+
+ }elsif($self->{URI} =~ m{^/.*/search/(.*)}){ #List threads in this board
+ }else{ #List boards
+ $BODY->param(Overview => 1);
+ $categories->execute or $ND::ERROR .= p($DBH->errstr);
+ my $boards = $DBH->prepare(q{SELECT fb.fbid AS id,fb.board,count(NULLIF(COALESCE(fp.fpid::boolean,FALSE) AND COALESCE(fp.time > ftv.time,TRUE),FALSE)) AS unread,date_trunc('seconds',max(fp.time)::timestamp) as last_post
+ FROM forum_boards fb LEFT OUTER JOIN (forum_threads ft JOIN forum_posts fp USING (ftid)) ON fb.fbid = ft.fbid LEFT OUTER JOIN (SELECT * FROM forum_thread_visits WHERE uid = $2) ftv ON ftv.ftid = ft.ftid
+ WHERE fb.fcid = $1 AND
+ fb.fbid IN (SELECT fbid FROM forum_access WHERE gid IN (SELECT groups($2)))
+ GROUP BY fb.fbid, fb.board
+ ORDER BY fb.fbid });
+ my @categories;
+ while (my $category = $categories->fetchrow_hashref){
+ $boards->execute($category->{id},$ND::UID) or $ND::ERROR .= p($DBH->errstr);
+ my @boards;
+ my $i = 0;
+ while (my $board = $boards->fetchrow_hashref){
+ $i++;
+ $board->{Odd} = $i % 2;
+ push @boards,$board;
+ }
+ $category->{Boards} = \@boards;
+ delete $category->{id};
+ push @categories,$category if $i > 0;
+ }
+ $BODY->param(Categories => \@categories);
+
+ }
+ return $BODY;
+}
+
+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 ND::Web::Pages::GalaxyRankings;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{galaxyrankings} = __PACKAGE__;
+
+sub parse {
+ #TODO: Need to fix some links first
+ #if ($uri =~ m{^/[^/]+/(\w+)}){
+ # param('order',$1);
+ #}
+}
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Top Galaxies';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isMember;
+
+ my $error = '';
+
+ $BODY->param(isHC => $self->isHC);
+
+ my $offset = 0;
+ if (defined param('offset') && param('offset') =~ /^(\d+)$/){
+ $offset = $1;
+ }
+ $BODY->param(Offset => $offset);
+ $BODY->param(PrevOffset => $offset - 100);
+ $BODY->param(NextOffset => $offset + 100);
+
+ my $order = 'scorerank';
+ if (defined param('order') && param('order') =~ /^(scorerank|sizerank|planets|xprank|avgscore)$/){
+ $order = $1;
+ }
+ $BODY->param(Order => $order);
+ $order .= ' DESC' unless $order =~ /rank$/;
+
+
+ #my $extra_columns = '';
+ #if ($self->isHC){
+ # $extra_columns = ",galaxy_status,hit_us, galaxy,relationship,nick";
+ #}
+ my $query = $DBH->prepare(qq{SELECT x,y,
+ size, size_gain, size_gain_day,
+ score,score_gain,score_gain_day,
+ value,value_gain,value_gain_day,
+ xp,xp_gain,xp_gain_day,
+ sizerank,sizerank_gain,sizerank_gain_day,
+ scorerank,scorerank_gain,scorerank_gain_day,
+ valuerank,valuerank_gain,valuerank_gain_day,
+ xprank,xprank_gain,xprank_gain_day,
+ planets,planets_gain,planets_gain_day
+ FROM galaxies g WHERE tick = ( SELECT max(tick) AS max FROM galaxies)
+ ORDER BY $order LIMIT 100 OFFSET ?});
+ $query->execute($offset) or $error .= p($DBH->errstr);
+ my @galaxies;
+ my $i = 0;
+ while (my $galaxy = $query->fetchrow_hashref){
+ for my $type (qw/planets size score xp value/){
+ #$galaxy->{$type} = prettyValue($galaxy->{$type});
+ next unless defined $galaxy->{"${type}_gain_day"};
+ $galaxy->{"${type}img"} = 'stay';
+ $galaxy->{"${type}img"} = 'up' if $galaxy->{"${type}_gain_day"} > 0;
+ $galaxy->{"${type}img"} = 'down' if $galaxy->{"${type}_gain_day"} < 0;
+ unless( $type eq 'planets'){
+ $galaxy->{"${type}rankimg"} = 'stay';
+ $galaxy->{"${type}rankimg"} = 'up' if $galaxy->{"${type}rank_gain_day"} < 0;
+ $galaxy->{"${type}rankimg"} = 'down' if $galaxy->{"${type}rank_gain_day"} > 0;
+ }
+ for my $type ($type,"${type}_gain","${type}_gain_day"){
+ $galaxy->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
+ }
+ }
+ $i++;
+ $galaxy->{ODD} = $i % 2;
+ push @galaxies,$galaxy;
+ }
+ $BODY->param(Galaxies => \@galaxies);
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+
+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 ND::Web::Pages::Graph;
+use strict;
+use warnings FATAL => 'all';
+use ND::Include;
+use ND::Web::Graph;
+use DBI qw(:sql_types);
+use DBD::Pg qw(:pg_types);
+
+
+use base qw/ND::Web::Image/;
+
+$ND::Web::Page::PAGES{graph} = 'ND::Web::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;
--- /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 ND::Web::Pages::HostileAlliances;
+use strict;
+use warnings FATAL => 'all';
+use ND::Include;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{hostileAlliances} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Hostile Alliances';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isHC;
+
+ my $begintick = 0;
+ my $endtick = $self->{TICK};
+ if (param('ticks')){
+ $begintick = $endtick - param('ticks');
+ }elsif(defined param('begintick') && defined param('endtick')){
+ $begintick = param('begintick');
+ $endtick = param('endtick');
+
+ }
+ my $query = $DBH->prepare(q{
+ SELECT s.alliance_id AS id,s.alliance AS name,count(*) AS hostilecount
+FROM calls c
+ JOIN incomings i ON i.call = c.id
+ JOIN current_planet_stats s ON i.sender = s.id
+WHERE c.landing_tick - i.eta > $1 and c.landing_tick - i.eta < $2
+GROUP BY s.alliance_id,s.alliance
+ORDER BY hostilecount DESC
+ })or $ND::ERROR .= $DBH->errstr;
+ $query->execute($begintick,$endtick) or $ND::ERROR .= $DBH->errstr;
+ my @alliances;
+ my $i = 0;
+ my $tick = $self->{TICK};
+ while (my $alliance = $query->fetchrow_hashref){
+ $i++;
+ $alliance->{ODD} = $i % 2;
+ push @alliances, $alliance;
+ }
+ $BODY->param(Alliances => \@alliances);
+ $BODY->param(Ticks => $endtick - $begintick);
+ $BODY->param(BeginTick =>$begintick);
+ $BODY->param(EndTick =>$endtick);
+ return $BODY;
+}
+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 ND::Web::Pages::Intel;
+use strict;
+use warnings FATAL => 'all';
+use ND::Web::Forum;
+use ND::Web::Include;
+use ND::Include;
+use CGI qw/:standard/;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{intel} = __PACKAGE__;
+
+sub parse {
+ my $self = shift;
+ if ($self->{URI} =~ m{^/.*/((\d+)(?: |:)(\d+)(?: |:)(\d+))$}){
+ param('coords',$1);
+ }
+}
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Intel';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isIntel || $self->isHC;
+
+ my $error;
+
+ my $planet;
+ if (defined param('coords') && param('coords') =~ /^(\d+)(?: |:)(\d+)(?: |:)(\d+)$/){
+ my $query = $DBH->prepare(q{SELECT x,y,z,coords(x,y,z),id, nick, alliance,alliance_id, planet_status,channel,ftid FROM current_planet_stats
+ WHERE x = ? AND y = ? AND z = ?});
+ $planet = $DBH->selectrow_hashref($query,undef,$1,$2,$3) or $ND::ERROR .= p $DBH->errstr;
+ }
+
+ my $showticks = 'AND (i.tick - i.eta) > (tick() - 48)';
+ if (defined param('show')){
+ if (param('show') eq 'all'){
+ $showticks = '';
+ }elsif (param('show') =~ /^(\d+)$/){
+ $showticks = "AND (i.tick - i.eta) > (tick() - $1)";
+ }
+ }
+
+ my $thread;
+ if (defined $planet){
+ $thread = $DBH->selectrow_hashref(q{SELECT ftid AS id, subject FROM forum_threads
+ where ftid = $1},undef,$planet->{ftid}) or $ND::ERROR .= p($DBH->errstr);
+ }
+
+ if (defined param('cmd') && param('cmd') eq 'coords'){
+ my $coords = param('coords');
+ $DBH->do(q{CREATE TEMPORARY TABLE coordlist (
+ x integer NOT NULL,
+ y integer NOT NULL,
+ z integer NOT NULL,
+ PRIMARY KEY (x,y,z)
+ )});
+ my $insert = $DBH->prepare(q{INSERT INTO coordlist (x,y,z) VALUES(?,?,?)});
+ while ($coords =~ m/(\d+):(\d+):(\d+)/g){
+ $insert->execute($1,$2,$3);
+ }
+ my $planets = $DBH->prepare(q{SELECT (((p.x || ':') || p.y) || ':') || p.z AS coords, alliance FROM current_planet_stats p
+ JOIN coordlist c ON p.x = c.x AND p.y = c.y AND p.z = c.z
+ ORDER BY alliance, p.x, p.y, p.z});
+ $planets->execute;
+ my @planets;
+ while (my $planet = $planets->fetchrow_hashref){
+ push @planets,$planet;
+ }
+ $BODY->param(CoordList => \@planets);
+ }
+ if (defined $thread and defined param('cmd') and param('cmd') eq 'forumpost'){
+ addForumPost($DBH,$thread,$ND::UID,param('message'));
+ }
+
+ if ($planet && defined param('cmd')){
+ if (param('cmd') eq 'change'){
+ $DBH->begin_work;
+ if (param('cnick')){
+ my $value = escapeHTML(param('nick'));
+ if ($DBH->do(q{UPDATE planets SET nick = ? WHERE id =?}
+ ,undef,$value,$planet->{id})){
+ intel_log $ND::UID,$planet->{id},"Set nick to: $value";
+ $planet->{nick} = $value;
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ if (param('cchannel')){
+ my $value = escapeHTML(param('channel'));
+ if ($DBH->do(q{UPDATE planets SET channel = ? WHERE id =?}
+ ,undef,$value,$planet->{id})){
+ intel_log $ND::UID,$planet->{id},"Set channel to: $value";
+ $planet->{channel} = $value;
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ if (param('cstatus')){
+ my $value = escapeHTML(param('status'));
+ if ($DBH->do(q{UPDATE planets SET planet_status = ? WHERE id =?}
+ ,undef,$value,$planet->{id})){
+ intel_log $ND::UID,$planet->{id},"Set planet_status to: $value";
+ $planet->{planet_status} = $value;
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ if (param('calliance')){
+ if ($DBH->do(q{UPDATE planets SET alliance_id = NULLIF(?,-1) WHERE id =?}
+ ,undef,param('alliance'),$planet->{id})){
+ intel_log $ND::UID,$planet->{id},"Set alliance_id to: ".param('alliance');
+ $planet->{alliance_id} = param('alliance');
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+
+ if (param('coords')){
+ my $channel = param('coords');
+ $channel = $planet->{channel} if ($planet);
+ my $findchannel = $DBH->prepare('SELECT coords(x,y,z),alliance,nick,channel FROM current_planet_stats WHERE channel ILIKE ? ');
+ $findchannel->execute($channel);
+ my @channelusers;
+ while (my $user = $findchannel->fetchrow_hashref){
+ push @channelusers,$user;
+ }
+ $BODY->param(ChannelUsers => \@channelusers);
+ }
+
+ if ($planet){
+ $BODY->param(Coords => $planet->{coords});
+ $BODY->param(Planet => $planet->{id});
+ $BODY->param(Nick => escapeHTML($planet->{nick}));
+ $BODY->param(Channel => $planet->{channel});
+ my @status;
+ for my $status (" ","Friendly", "NAP", "Hostile"){
+ push @status,{Status => $status, Selected => defined $planet->{planet_status} && $status eq $planet->{planet_status}}
+ }
+ $BODY->param(PlanetStatus => \@status);
+ my @alliances = alliances($planet->{alliance_id});
+ $BODY->param(Alliances => \@alliances);
+
+ $BODY->param(Thread => viewForumThread $thread);
+
+ my $query = $DBH->prepare(intelquery('o.alliance AS oalliance,coords(o.x,o.y,o.z) AS origin',"t.id = ? $showticks"));
+ $query->execute($planet->{id}) or $error .= $DBH->errstr;
+ my @intellists;
+ my @incomings;
+ my $i = 0;
+ while (my $intel = $query->fetchrow_hashref){
+ if ($intel->{ingal}){
+ $intel->{missionclass} = 'ingal';
+ }else{
+ $intel->{missionclass} = $intel->{mission};
+ }
+ $i++;
+ $intel->{ODD} = $i % 2;
+ push @incomings,$intel;
+ }
+ push @intellists,{Message => 'Incoming fleets', Intel => \@incomings, Origin => 1};
+
+ $query = $DBH->prepare(intelquery('t.alliance AS talliance,coords(t.x,t.y,t.z) AS target',"o.id = ? $showticks"));
+ $query->execute($planet->{id}) or $error .= $DBH->errstr;
+ my @outgoings;
+ $i = 0;
+ while (my $intel = $query->fetchrow_hashref){
+ if ($intel->{ingal}){
+ $intel->{missionclass} = 'ingal';
+ }else{
+ $intel->{missionclass} = $intel->{mission};
+ }
+ $i++;
+ $intel->{ODD} = $i % 2;
+ push @outgoings,$intel;
+ }
+ push @intellists,{Message => 'Outgoing Fleets', Intel => \@outgoings, Target => 1};
+
+ $BODY->param(IntelLIsts => \@intellists);
+
+ }elsif(!param('coords')){
+ my $query = $DBH->prepare(intelquery('o.alliance AS oalliance,coords(o.x,o.y,o.z) AS origin, t.alliance AS talliance,coords(t.x,t.y,t.z) AS target',qq{not ingal
+ AND ((( t.alliance_id != o.alliance_id OR t.alliance_id IS NULL OR o.alliance_id IS NULL) AND i.mission != 'Attack')
+ OR ( t.alliance_id = o.alliance_id AND i.mission = 'Attack'))
+ AND i.sender NOT IN (SELECT planet FROM users u NATURAL JOIN groupmembers gm WHERE gid = 8 AND planet IS NOT NULL)
+ $showticks}));
+ $query->execute() or $error .= $DBH->errstr;
+
+ my @intellists;
+ my @intel;
+ my $i = 0;
+ while (my $intel = $query->fetchrow_hashref){
+ if ($intel->{ingal}){
+ $intel->{missionclass} = 'ingal';
+ }else{
+ $intel->{missionclass} = $intel->{mission};
+ }
+ $i++;
+ $intel->{ODD} = $i % 2;
+ push @intel,$intel;
+ }
+ push @intellists,{Message => q{Intel where alliances doesn't match}, Intel => \@intel, Origin => 1, Target => 1};
+ $BODY->param(IntelLIsts => \@intellists);
+ }
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+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 ND::Web::Pages::LaunchCoonfirmation;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+use ND::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{launchConfirmation} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Launch Confirmation';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isMember;
+
+ my $error;
+
+
+ if (defined param('cmd') && param('cmd') eq 'submit'){
+ my $missions = param('mission');
+ my $findplanet = $DBH->prepare("SELECT planetid(?,?,?,?)");
+ my $findattacktarget = $DBH->prepare(q{SELECT c.target,c.wave,c.launched FROM raid_claims c
+ JOIN raid_targets t ON c.target = t.id
+ JOIN raids r ON t.raid = r.id
+ WHERE c.uid = ? AND r.tick+c.wave-1 = ? AND t.planet = ?
+ AND r.open AND not r.removed});
+ my $finddefensetarget = $DBH->prepare(q{SELECT c.id FROM calls c JOIN users u ON c.member = u.uid WHERE u.planet = $1 AND c.landing_tick = $2});
+ my $informDefChannel = $DBH->prepare(q{INSERT INTO defense_missions (fleet,call) VALUES (?,?)});
+ my $addattackpoint = $DBH->prepare('UPDATE users SET attack_points = attack_points + 1 WHERE uid = ?');
+ my $launchedtarget = $DBH->prepare('UPDATE raid_claims SET launched = True WHERE uid = ? AND target = ? AND wave = ?');
+ my $addfleet = $DBH->prepare(qq{INSERT INTO fleets (uid,target,mission,landing_tick,fleet,eta,back) VALUES (?,?,?,?,(SELECT max(fleet)+1 from fleets WHERE uid = ?),?,?)});
+ my $addships = $DBH->prepare('INSERT INTO fleet_ships (fleet,ship,amount) VALUES (?,?,?)');
+
+ my $fleet = $DBH->prepare("SELECT id FROM fleets WHERE uid = ? AND fleet = 0");
+ my ($basefleet) = $DBH->selectrow_array($fleet,undef,$ND::UID) or $ND::ERROR .= p $DBH->errstr;;
+ unless ($basefleet){
+ my $insert = $DBH->prepare(q{INSERT INTO fleets (uid,target,mission,landing_tick,fleet,eta,back) VALUES (?,?,'Full fleet',0,0,0,0)});
+ $insert->execute($ND::UID,$self->{PLANET}) or $ND::ERROR .= p $DBH->errstr;;
+ }
+ my @missions;
+ $DBH->begin_work;
+ while ($missions =~ m/\S+\s+(\d+):(\d+):(\d+)\s+(\d+):(\d+):(\d+)\s+\((?:(\d+)\+)?(\d+)\).*?(?:\d+hrs\s+)?\d+mins?\s+(Attack|Defend|Return|Fake Attack|Fake Defend)(.*?)(?:Launching in tick (\d+), arrival in tick (\d+)|ETA: \d+, Return ETA: (\d+)|Return ETA: (\d+))/sg){
+ my %mission;
+ next if $9 eq 'Return';
+
+ my $tick = $self->{TICK}+$8;
+ $tick += $7 if defined $7;
+ my $eta = $8;
+ my $mission = $9;
+ my $x = $4;
+ my $y = $5;
+ my $z = $6;
+ if ($12){
+ $tick = $12;
+ }elsif ($13){
+ $eta += $13;
+ }
+ $mission{Tick} = $tick;
+ $mission{Mission} = $mission;
+ $mission{Target} = "$x:$y:$z";
+
+ my ($planet_id) = $DBH->selectrow_array($findplanet,undef,$x,$y,$z,$self->{TICK});
+
+ my $findtarget = $finddefensetarget;
+ if ($mission eq 'Attack'){
+ $findtarget = $findattacktarget;
+ $findtarget->execute($ND::UID,$tick,$planet_id) or $ND::ERROR .= p $DBH->errstr;;
+ }elsif ($mission eq 'Defend'){
+ $findtarget = $finddefensetarget;
+ $findtarget->execute($planet_id,$tick) or $ND::ERROR .= p $DBH->errstr;;
+ }
+
+ $addfleet->execute($ND::UID,$planet_id,$mission,$tick,$ND::UID,$eta,$tick+$eta-1) or $error .= '<p>'.$DBH->errstr.'</p>';
+ my $fleet = $DBH->last_insert_id(undef,undef,undef,undef,"fleets_id_seq");
+ $mission{Fleet} = $fleet;
+ $mission{Back} = $tick+$eta-1;
+ my $ships = $10;
+ my @ships;
+ while ($ships =~ m/((?:\w+ )*\w+)\s+\w+\s+\w+\s+(?:Steal|Normal|Emp|Normal\s+Cloaked|Pod|Struc)\s+(\d+)/g){
+ $addships->execute($fleet,$1,$2) or $ND::ERROR .= p $DBH->errstr;
+ push @ships,{Ship => $1, Amount => $2};
+ }
+ $mission{Ships} = \@ships;
+
+ if ($findtarget->rows == 0){
+ $mission{Warning} = p b 'No matching target!';
+ }elsif ($mission eq 'Attack'){
+ my $claim = $findtarget->fetchrow_hashref;
+ if ($claim->{launched}){
+ $mission{Warning} = "Already launched on this target:$claim->{target},$claim->{wave},$claim->{launched}";
+ }else{
+ $addattackpoint->execute($ND::UID) or $ND::ERROR .= p $DBH->errstr;
+ $launchedtarget->execute($ND::UID,$claim->{target},$claim->{wave}) or $ND::ERROR .= p $DBH->errstr;
+ $mission{Warning} = "OK:$claim->{target},$claim->{wave},$claim->{launched}";
+ log_message $ND::UID,"Gave attack point for confirmation on $mission mission to $x:$y:$z, landing tick $tick";
+ }
+ }elsif ($mission eq 'Defend'){
+ my $call = $findtarget->fetchrow_hashref;
+ $informDefChannel->execute($fleet,$call->{id}) or $ND::ERROR .= p $DBH->errstr;
+ }
+
+ log_message $ND::UID,"Pasted confirmation for $mission mission to $x:$y:$z, landing tick $tick";
+ push @missions,\%mission;
+ }
+ $DBH->commit or $error .= '<p>'.$DBH->errstr.'</p>';
+ $BODY->param(Missions => \@missions);
+ }
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+
+
+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 ND::Web::Pages::Mail;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use Mail::Sendmail;
+
+use ND::Web::Forum;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{mail} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+
+ my $DBH = $self->{DBH};
+
+ $self->{TITLE} = 'Mail members';
+
+ return $self->noAccess unless $self->isHC;
+
+ my $groups = $DBH->prepare(q{SELECT gid,groupname FROM groups ORDER BY gid});
+ $groups->execute;
+ my @groups;
+ while (my $group = $groups->fetchrow_hashref){
+ push @groups,$group;
+ }
+ $BODY->param(Groups => \@groups);
+
+ if (defined param('cmd')){
+ my $emails = $DBH->prepare(q{SELECT email FROM users WHERE (uid IN (SELECT uid FROM groupmembers WHERE gid = $1) OR $1 = -1) AND email is not null});
+ $emails->execute(param('group'));
+ my @emails;
+ while (my $email = $emails->fetchrow_hashref){
+ push @emails,$email->{email};
+ }
+ $ND::ERROR .= p (join ', ',@emails);
+
+ my %mail = (
+ smtp => 'ruin.nu',
+ BCC => (join ',',@emails),
+ From => 'NewDawn Command <nd@ruin.nu>',
+ 'Content-type' => 'text/plain; charset="UTF-8"',
+ Subject => param('subject'),
+ Message => param('message'),
+ );
+
+ if (sendmail %mail) {
+ $ND::ERROR .= p "Mail sent OK.\n"
+ }else {
+ $ND::ERROR .= p $Mail::Sendmail::error;
+ }
+ }
+ return $BODY;
+}
+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 ND::Web::Pages::Main;
+use strict;
+use warnings;
+use CGI qw/:standard/;
+use ND::Include;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{main} = 'ND::Web::Pages::Main';
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Main Page';
+ my $DBH = $self->{DBH};
+
+ my $error;
+
+ if (defined param('cmd')){
+ if (param('cmd') eq 'fleet'){
+ $DBH->begin_work;
+ my $fleet = $DBH->prepare("SELECT id FROM fleets WHERE uid = ? AND fleet = 0");
+ my ($id) = $DBH->selectrow_array($fleet,undef,$ND::UID);
+ unless ($id){
+ my $insert = $DBH->prepare(q{INSERT INTO fleets (uid,target,mission,landing_tick,fleet,eta,back) VALUES (?,?,'Full fleet',0,0,0,0)});
+ $insert->execute($ND::UID,$self->{PLANET});
+ ($id) = $DBH->selectrow_array($fleet,undef,$ND::UID);
+ }
+ my $delete = $DBH->prepare("DELETE FROM fleet_ships WHERE fleet = ?");
+ my $insert = $DBH->prepare('INSERT INTO fleet_ships (fleet,ship,amount) VALUES (?,?,?)');
+ $fleet = param('fleet');
+ $fleet =~ s/,//g;
+ my $match = 0;
+ while ($fleet =~ m/((?:[A-Z][a-z]+ )*[A-Z][a-z]+)\s+(\d+)/g){
+ unless($match){
+ $match = 1;
+ $delete->execute($id);
+ }
+ $insert->execute($id,$1,$2) or $error .= '<p>'.$DBH->errstr.'</p>';
+ }
+ $fleet = $DBH->prepare('UPDATE fleets SET landing_tick = tick() WHERE id = ?');
+ $fleet->execute($id) if $match;
+ $DBH->commit;
+ }elsif (param('cmd') eq 'Recall Fleets'){
+ $DBH->begin_work;
+ my $updatefleets = $DBH->prepare('UPDATE fleets SET back = tick() + (tick() - (landing_tick - eta)) WHERE uid = ? AND id = ?');
+
+ for my $param (param()){
+ if ($param =~ /^change:(\d+)$/){
+ if($updatefleets->execute($ND::UID,$1)){
+ log_message $ND::UID,"Member recalled fleet $1";
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ }
+ $DBH->commit or $error .= '<p>'.$DBH->errstr.'</p>';
+ }elsif (param('cmd') eq 'Change Fleets'){
+ $DBH->begin_work;
+ my $updatefleets = $DBH->prepare('UPDATE fleets SET back = ? WHERE uid = ? AND id = ?');
+ for my $param (param()){
+ if ($param =~ /^change:(\d+)$/){
+ if($updatefleets->execute(param("back:$1"),$ND::UID,$1)){
+ log_message $ND::UID,"Member set fleet $1 to be back tick: ".param("back:$1");
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ }
+ $DBH->commit or $error .= '<p>'.$DBH->errstr.'</p>';
+ }
+ }
+ if (param('sms')){
+ my $query = $DBH->prepare('UPDATE users SET sms = ? WHERE uid = ?');
+ $query->execute(escapeHTML(param('sms')),$ND::UID);
+ }
+ if (param('hostname')){
+ my $query = $DBH->prepare('UPDATE users SET hostmask = ? WHERE uid = ?');
+ $query->execute(escapeHTML(param('hostname')),$ND::UID);
+ }
+ if ($self->isMember() && !$self->{PLANET} && defined param('planet') && (param('planet') =~ m/(\d+)(?: |:)(\d+)(?: |:)(\d+)/)){
+ my $query = $DBH->prepare(q{
+ UPDATE users SET planet =
+ (SELECT id from current_planet_stats where x = ? AND y = ? AND z = ?)
+ WHERE uid = ? });
+ $query->execute($1,$2,$3,$ND::UID);
+ }
+
+ my ($motd) = $DBH->selectrow_array("SELECT value FROM misc WHERE id='MOTD'");
+
+ $BODY->param(MOTD => parseMarkup($motd));
+ $BODY->param(Username => $self->{USER});
+ $BODY->param(isMember => $self->isMember());
+ $BODY->param(isHC => $self->isHC());
+ my @groups = map {name => $_}, sort keys %{$self->{GROUPS}};
+ $BODY->param(Groups => \@groups);
+
+
+ my $query = $DBH->prepare(q{SELECT planet,defense_points,attack_points,scan_points,humor_points, (attack_points+defense_points+scan_points/20) as total_points, sms,rank,hostmask FROM users WHERE uid = ?});
+
+ my ($planet,$defense_points,$attack_points,$scan_points,$humor_points,$total_points,$sms,$rank,$hostname) = $DBH->selectrow_array($query,undef,$ND::UID);
+
+ $self->{PLANET} = $planet unless $self->{PLANET};
+
+ $BODY->param(NDRank => $rank);
+ $BODY->param(DefensePoints => $defense_points);
+ $BODY->param(AttackPoints => $attack_points);
+ $BODY->param(ScanPoints => $scan_points);
+ $BODY->param(HumorPoints => $humor_points);
+ $BODY->param(TotalPoints => $total_points);
+
+ $BODY->param(Planet => $planet);
+
+ $query = $DBH->prepare(qq{
+ SELECT c.id, c.landing_tick, dc.username,c.covered,
+ TRIM('/' FROM concat(p2.race||' /')) AS race, TRIM('/' FROM concat(i.amount||' /')) AS amount,
+ TRIM('/' FROM concat(i.eta||' /')) AS eta, TRIM('/' FROM concat(i.shiptype||' /')) AS shiptype,
+ (c.landing_tick - tick()) AS curreta,
+ TRIM('/' FROM concat(coords(p2.x,p2.y,p2.z) ||' /')) AS attackers
+ FROM calls c
+ JOIN incomings i ON i.call = c.id
+ JOIN current_planet_stats p2 ON i.sender = p2.id
+ LEFT OUTER JOIN users dc ON c.dc = dc.uid
+ WHERE c.member = ? AND (c.landing_tick - tick()) > 0
+ GROUP BY c.id, c.landing_tick,dc.username,c.covered
+ ORDER BY c.landing_tick DESC
+ })or $error .= $DBH->errstr;
+ $query->execute($ND::UIN) or $error .= $DBH->errstr;
+
+ my $i = 0;
+ my @calls;
+ while (my $call = $query->fetchrow_hashref){
+ $call->{attackers} =~ s{(\d+:\d+:\d+)}{<a href="/check?coords=$1">$1</a>}g;
+ unless(defined $call->{username}){
+ $call->{dc} = 'Hostile';
+ $call->{username} = 'none';
+ }
+ if($call->{covered}){
+ $call->{covered} = 'Friendly';
+ }else{
+ $call->{covered} = 'Hostile';
+ }
+ $i++;
+ $call->{ODD} = $i % 2;
+ $call->{shiptype} = escapeHTML($call->{shiptype});
+ push @calls, $call;
+ }
+ $BODY->param(Calls => \@calls);
+
+ my $planetstats= $DBH->selectrow_hashref(q{SELECT x,y,z, ((ruler || ' OF ') || p.planet) as planet,race,
+ size, size_gain, size_gain_day,
+ score,score_gain,score_gain_day,
+ value,value_gain,value_gain_day,
+ xp,xp_gain,xp_gain_day,
+ sizerank,sizerank_gain,sizerank_gain_day,
+ scorerank,scorerank_gain,scorerank_gain_day,
+ valuerank,valuerank_gain,valuerank_gain_day,
+ xprank,xprank_gain,xprank_gain_day
+ from current_planet_stats_full p
+ WHERE id = ?},undef,$planet) if $planet;
+ if ($planetstats){
+ my $planet = $planetstats;
+ for my $type (qw/size score value xp/){
+ $planet->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
+ $planet->{"${type}img"} = 'stay';
+ $planet->{"${type}img"} = 'up' if $planet->{"${type}_gain_day"} > 0;
+ $planet->{"${type}img"} = 'down' if $planet->{"${type}_gain_day"} < 0;
+ $planet->{"${type}rankimg"} = 'stay';
+ $planet->{"${type}rankimg"} = 'up' if $planet->{"${type}rank_gain_day"} < 0;
+ $planet->{"${type}rankimg"} = 'down' if $planet->{"${type}rank_gain_day"} > 0;
+ for my $type ($type,"${type}_gain","${type}_gain_day"){
+ $planet->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
+ }
+ }
+ $BODY->param(Planets => [$planet]);
+ $BODY->param(PlanetCoords => "$planet->{x}:$planet->{y}:$planet->{z}");
+ }
+
+
+ $query = $DBH->prepare(q{SELECT f.fleet,f.id, coords(x,y,z) AS target, mission, sum(fs.amount) AS amount, landing_tick, back
+FROM fleets f
+JOIN fleet_ships fs ON f.id = fs.fleet
+JOIN current_planet_stats p ON f.target = p.id
+WHERE f.uid = ? AND (f.fleet = 0 OR back >= ?)
+GROUP BY f.fleet,f.id, x,y,z, mission, landing_tick,back
+ORDER BY f.fleet
+ });
+
+ $query->execute($ND::UID,$self->{TICK}) or $error .= '<p>'.$DBH->errstr.'</p>';
+ my @fleets;
+ $i = 0;
+ while (my $fleet = $query->fetchrow_hashref){
+ $i++;
+ $fleet->{ODD} = $i % 2;
+ push @fleets,$fleet;
+ }
+ $BODY->param(Fleets => \@fleets);
+
+ $BODY->param(SMS => $sms);
+ $BODY->param(Hostname => $hostname);
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+
+
+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 ND::Web::Pages::MemberIntel;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{memberIntel} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Member Intel';
+ my $DBH = $self->{DBH};
+ my $error;
+
+ return $self->noAccess unless $self->isHC;
+
+ my $showticks = 'AND i.tick > tick()';
+ if (defined param('show')){
+ if (param('show') eq 'all'){
+ $showticks = '';
+ }elsif (param('show') =~ /^(\d+)$/){
+ $showticks = "AND (i.tick - i.eta) > (tick() - $1)";
+ }
+ }
+
+
+ my $query = $DBH->prepare(intelquery('o.alliance AS oalliance,coords(o.x,o.y,o.z) AS origin, coords(t.x,t.y,t.z) AS target, t.nick',"t.alliance_id = 1 $showticks"));
+ $query->execute() or $error .= $DBH->errstr;
+ my @intellists;
+ my @incomings;
+ my $i = 0;
+ while (my $intel = $query->fetchrow_hashref){
+ if ($intel->{ingal}){
+ $intel->{missionclass} = 'ingal';
+ }else{
+ $intel->{missionclass} = $intel->{mission};
+ }
+ $intel->{oalliance} = ' ' unless $intel->{oalliance};
+ $i++;
+ $intel->{ODD} = $i % 2;
+ push @incomings,$intel;
+ }
+ push @intellists,{Message => 'Incoming fleets', Intel => \@incomings, Origin => 1};
+
+ $query = $DBH->prepare(intelquery('o.nick,coords(o.x,o.y,o.z) AS origin,t.alliance AS talliance,coords(t.x,t.y,t.z) AS target',"o.alliance_id = 1 $showticks"));
+ $query->execute() or $error .= $DBH->errstr;
+ my @outgoings;
+ $i = 0;
+ while (my $intel = $query->fetchrow_hashref){
+ if ($intel->{ingal}){
+ $intel->{missionclass} = 'ingal';
+ }else{
+ $intel->{missionclass} = $intel->{mission};
+ }
+ $intel->{talliance} = ' ' unless $intel->{talliance};
+ $i++;
+ $intel->{ODD} = $i % 2;
+ push @outgoings,$intel;
+ }
+ push @intellists,{Message => 'Outgoing Fleets', Intel => \@outgoings, Target => 1};
+
+ $BODY->param(IntelLIsts => \@intellists);
+
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+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 ND::Web::Pages::Motd;
+use strict;
+use warnings FATAL => 'all';
+use ND::Include;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{motd} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Edit MOTD';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isHC;
+
+ if (defined param 'cmd' and param('cmd') eq 'change'){
+ $DBH->begin_work;
+ my $query = $DBH->prepare(q{UPDATE misc SET value= ? WHERE id='MOTD'});
+ my $motd = escapeHTML(param('motd'));
+ $query->execute($motd);
+ log_message $ND::UID,"Updated MOTD";
+ $DBH->commit;
+ $BODY->param(MOTD => $motd);
+ }else{
+ my ($motd) = $DBH->selectrow_array(q{SELECT value FROM misc WHERE id='MOTD'});
+ $BODY->param(MOTD => $motd);
+ }
+ return $BODY;
+}
+
+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 ND::Web::Pages::PlanetNaps;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{planetNaps} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'List planet naps';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isHC;
+ my $error;
+
+ my $query = $DBH->prepare(qq{Select coords(x,y,z), ((ruler || ' OF ') || p.planet) as planet,race, size, score, value, xp, sizerank, scorerank, valuerank, xprank, p.value - p.size*200 - coalesce(c.metal+c.crystal+c.eonium,0)/150 - coalesce(c.structures,(SELECT avg(structures) FROM covop_targets)::int)*1500 AS fleetvalue,(c.metal+c.crystal+c.eonium)/100 AS resvalue, planet_status,hit_us, alliance,relationship,nick from current_planet_stats p LEFT OUTER JOIN covop_targets c ON p.id = c.planet WHERE planet_status IN ('Friendly','NAP') order by x,y,z asc});
+
+ $query->execute or $error .= p($DBH->errstr);
+ my @planets;
+ my $i = 0;
+ while (my $planet = $query->fetchrow_hashref){
+ $i++;
+ $planet->{ODD} = $i % 2;
+ push @planets,$planet;
+ }
+ $BODY->param(Planets => \@planets);
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+
+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 ND::Web::Pages::PlanetRankings;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{planetrankings} = __PACKAGE__;
+
+sub parse {
+ #TODO: Need to fix some links first
+ #if ($uri =~ m{^/[^/]+/(\w+)}){
+ # param('order',$1);
+ #}
+}
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Top planets';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isMember;
+
+ my $error = '';
+
+ $BODY->param(isHC => $self->isHC);
+
+ my $offset = 0;
+ if (defined param('offset') && param('offset') =~ /^(\d+)$/){
+ $offset = $1;
+ }
+ $BODY->param(Offset => $offset);
+ $BODY->param(PrevOffset => $offset - 100);
+ $BODY->param(NextOffset => $offset + 100);
+
+ my $order = 'scorerank';
+ if (defined param('order') && param('order') =~ /^(scorerank|sizerank|valuerank|xprank|hit_us)$/){
+ $order = $1;
+ }
+ $BODY->param(Order => $order);
+ $order .= ' DESC' if ($order eq 'hit_us');
+
+
+ my $extra_columns = '';
+ if ($self->isHC){
+ $extra_columns = ",planet_status,hit_us, alliance,relationship,nick";
+ }
+ my $query = $DBH->prepare(qq{SELECT x,y,z,((ruler || ' OF ') || planet) as planet,race,
+ size, size_gain, size_gain_day,
+ score,score_gain,score_gain_day,
+ value,value_gain,value_gain_day,
+ xp,xp_gain,xp_gain_day,
+ sizerank,sizerank_gain,sizerank_gain_day,
+ scorerank,scorerank_gain,scorerank_gain_day,
+ valuerank,valuerank_gain,valuerank_gain_day,
+ xprank,xprank_gain,xprank_gain_day
+ $extra_columns FROM current_planet_stats_full ORDER BY $order LIMIT 100 OFFSET ?});
+ $query->execute($offset) or $error .= p($DBH->errstr);
+ my @planets;
+ my $i = 0;
+ while (my $planet = $query->fetchrow_hashref){
+ for my $type (qw/size score value xp/){
+ #$planet->{$type} = prettyValue($planet->{$type});
+ $planet->{"${type}img"} = 'stay';
+ $planet->{"${type}img"} = 'up' if $planet->{"${type}_gain_day"} > 0;
+ $planet->{"${type}img"} = 'down' if $planet->{"${type}_gain_day"} < 0;
+ $planet->{"${type}rankimg"} = 'stay';
+ $planet->{"${type}rankimg"} = 'up' if $planet->{"${type}rank_gain_day"} < 0;
+ $planet->{"${type}rankimg"} = 'down' if $planet->{"${type}rank_gain_day"} > 0;
+ for my $type ($type,"${type}_gain","${type}_gain_day"){
+ $planet->{$type} =~ s/(^[-+]?\d+?(?=(?>(?:\d{3})+)(?!\d))|\G\d{3}(?=\d))/$1,/g; #Add comma for ever 3 digits, i.e. 1000 => 1,000
+ }
+ }
+ $i++;
+ $planet->{ODD} = $i % 2;
+ push @planets,$planet;
+ }
+ $BODY->param(Planets => \@planets);
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+
+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 ND::Web::Pages::Points;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{points} = __PACKAGE__;
+
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Top Members';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isMember;
+
+ my $type = "total";
+ if (defined param('type') && param('type') =~ /^(defense|attack|total|humor|scan|rank|raid)$/){
+ $type = $1;
+ }
+ $type .= '_points' unless ($type eq 'rank');
+
+ my $order = 'DESC';
+ $order = 'ASC' if ($type eq 'rank');
+
+ my $limit = 'LIMIT 10';
+ $limit = '' if $self->isHC;
+
+ my $query = $DBH->prepare(qq{SELECT username,defense_points,attack_points,scan_points,humor_points
+ ,(attack_points+defense_points+scan_points/20) as total_points, rank, count(NULLIF(rc.launched,FALSE)) AS raid_points
+ FROM users u LEFT OUTER JOIN raid_claims rc USING (uid)
+ WHERE uid IN (SELECT uid FROM groupmembers WHERE gid = 2)
+ GROUP BY username,defense_points,attack_points,scan_points,humor_points,rank
+ ORDER BY $type $order $limit});
+ $query->execute;
+
+ my @members;
+ my $i = 0;
+ while (my ($username,$defense,$attack,$scan,$humor,$total,$rank,$raid) = $query->fetchrow){
+ $i++;
+ push @members,{Username => $username, Defense => $defense, Attack => $attack, Raid => $raid
+ , Scan => $scan, Humor => $humor, Total => $total, Rank => $rank, ODD => $i % 2};
+ }
+ $BODY->param(Members => \@members);
+ return $BODY;
+}
+
+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 ND::Web::Pages::Raids;
+use strict;
+use warnings;
+use ND::Include;
+use POSIX;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{raids} = __PACKAGE__;
+
+sub process {
+ my $self = shift;
+ $self->{XML} = 1 if param('xml');
+}
+
+
+sub generateClaimXml : method {
+ my $self = shift;
+ my ($BODY,$raid, $from, $target) = @_;
+ my $DBH = $self->{DBH};
+
+ my ($timestamp) = $DBH->selectrow_array("SELECT MAX(modified)::timestamp AS modified FROM raid_targets");
+ $BODY->param(Timestamp => $timestamp);
+ if ($target){
+ $target = "r.id = $target";
+ $_ = $self->listTargets;
+ $BODY->param(TargetList => $_);
+ }else{
+ $target = "r.raid = $raid->{id}";
+ }
+
+ if ($from){
+ $from = "AND modified > '$from'";
+ }else{
+ $from = '';
+ }
+ my $targets = $DBH->prepare(qq{SELECT r.id,r.planet FROM raid_targets r WHERE $target $from});
+ $targets->execute or print p($DBH->errstr);
+ my $claims = $DBH->prepare(qq{ SELECT username,joinable,launched FROM raid_claims
+ NATURAL JOIN users WHERE target = ? AND wave = ?});
+ my @targets;
+ while (my $target = $targets->fetchrow_hashref){
+ my %target;
+ $target{Id} = $target->{id};
+ my @waves;
+ for (my $i = 1; $i <= $raid->{waves}; $i++){
+ my %wave;
+ $wave{Id} = $i;
+ $claims->execute($target->{id},$i);
+ my $joinable = 0;
+ my $claimers;
+ if ($claims->rows != 0){
+ my $owner = 0;
+ my @claimers;
+ while (my $claim = $claims->fetchrow_hashref){
+ $owner = 1 if ($self->{USER} eq $claim->{username});
+ $joinable = 1 if ($claim->{joinable});
+ $claim->{username} .= '*' if ($claim->{launched});
+ push @claimers,$claim->{username};
+ }
+ $claimers = join '/', @claimers;
+ if ($owner){
+ $wave{Command} = 'Unclaim';
+ }elsif ($joinable){
+ $wave{Command} = 'Join';
+ }else{
+ $wave{Command} = 'none';
+ }
+ }else{
+ #if (!isset($planet) || ($target->value/$planet->value > 0.4 || $target->score/$planet->score > 0.4))
+ $wave{Command} = 'Claim';
+ }
+ $wave{Claimers} = $claimers;
+ $wave{Joinable} = $joinable;
+ push @waves,\%wave;
+ }
+ $target{Waves} = \@waves;
+ push @targets,\%target;
+ }
+ $BODY->param(Targets => \@targets);
+ return $BODY;
+}
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Raids';
+ my $DBH = $self->{DBH};
+
+
+ my $raid;
+ if (defined param('raid')){
+ my $query = $DBH->prepare(q{SELECT id,tick,waves,message,released_coords FROM raids WHERE id = ? AND open AND not removed AND id IN (SELECT raid FROM raid_access NATURAL JOIN groupmembers WHERE uid = ?)});
+ $raid = $DBH->selectrow_hashref($query,undef,param('raid'),$ND::UID);
+ }
+
+ if (defined param('cmd') && defined param('target') && defined param('wave') && param('target') =~ /^(\d+)$/ && param('wave') =~ /^(\d+)$/){
+ my $target = param('target');
+ my $wave = param('wave');
+
+ my $findtarget = $DBH->prepare("SELECT rt.id FROM raid_targets rt NATURAL JOIN raid_access ra NATURAL JOIN groupmembers where uid = ? AND id = ?");
+ my $result = $DBH->selectrow_array($findtarget,undef,$ND::UID,$target);
+ if ($result != $target){
+ return $self->noAccess;
+ }
+
+ $DBH->begin_work;
+ if (param('cmd') eq 'Claim'){
+ my $claims = $DBH->prepare(qq{SELECT username FROM raid_claims NATURAL JOIN users WHERE target = ? AND wave = ?});
+ $claims->execute($target,$wave);
+ if ($claims->rows == 0){
+ my $query = $DBH->prepare(q{INSERT INTO raid_claims (target,uid,wave) VALUES(?,?,?)});
+ if($query->execute($target,$ND::UID,$wave)){
+ log_message $ND::UID,"Claimed target $target wave $wave.";
+ }
+ }
+ }
+ if (param('cmd') eq 'Join'){
+ my $claims = $DBH->prepare(qq{SELECT username FROM raid_claims
+ NATURAL JOIN users WHERE target = ? AND wave = ? AND
+ joinable = TRUE});
+ $claims->execute($target,$wave);
+ if ($claims->rows != 0){
+ my $query = $DBH->prepare(q{INSERT INTO raid_claims (target,uid,wave,joinable) VALUES(?,?,?,TRUE)});
+ if($query->execute($target,$ND::UID,$wave)){
+ log_message $ND::UID,"Joined target $target wave $wave.";
+ }
+ }
+ }
+ if (param('cmd') eq 'set' && defined param('joinable') && param('joinable') =~ /(TRUE|FALSE)/){
+ my $claims = $DBH->prepare(qq{SELECT username FROM raid_claims NATURAL JOIN users WHERE target = ? AND wave = ? AND uid = ?});
+ $claims->execute($target,$wave,$ND::UID);
+ if ($claims->rows != 0){
+ $DBH->do(q{UPDATE raid_claims SET joinable = ? WHERE target = ? AND wave = ?},undef,$1,$target,$wave)
+ }
+ }
+ if (param('cmd') eq 'Unclaim'){
+ my $query = $DBH->prepare(qq{DELETE FROM raid_claims WHERE target = ? AND uid = ? AND wave = ?});
+ if ($query->execute($target,$ND::UID,$wave)){
+ log_message $ND::UID,"Unclaimed target $target wave $wave.";
+ }
+ }
+ $DBH->commit;
+ if ($self->{XML} && $raid){
+ return $self->generateClaimXml($BODY,$raid,undef,$target);
+ }
+ }
+ if ($self->{XML} && $raid && param('cmd') eq 'update' ){
+ my $from;
+ if (param('from') =~ /^[-\d\ \:\.]+$/){
+ $from = param('from');
+ }
+ return $self->generateClaimXml($BODY,$raid,$from);
+ }
+ if ($self->{XML} && param('cmd') eq 'gettargets' ){
+ $_ = $self->listTargets();
+ $BODY->param(TargetList => $_);
+ }
+
+ return $BODY if $self->{XML};
+
+ if ($raid){#We have a raid, so list all targets
+ $BODY->param(Raid => $raid->{id});
+ $BODY->param(Ajax => $self->{AJAX});
+ my $noingal = '';
+ my $planet;
+ if ($self->{PLANET}){
+ my $query = $DBH->prepare("SELECT value, score,x,y FROM current_planet_stats WHERE id = ?");
+ $planet = $DBH->selectrow_hashref($query,undef,$self->{PLANET});
+ $noingal = "AND NOT (x = $planet->{x} AND y = $planet->{y})";
+ }
+ $BODY->param(Message => parseMarkup($raid->{message}));
+ $BODY->param(LandingTick => $raid->{tick});
+ my $targetquery = $DBH->prepare(qq{SELECT r.id, r.planet, size, score, value, p.x,p.y,p.z, race, p.value - p.size*200 -coalesce(c.metal+c.crystal+c.eonium,0)/150 - coalesce(c.structures,(SELECT avg(structures) FROM covop_targets)::int)*1500 AS fleetvalue,(c.metal+c.crystal+c.eonium)/100 AS resvalue, comment
+ FROM current_planet_stats p
+ JOIN raid_targets r ON p.id = r.planet
+ LEFT OUTER JOIN covop_targets c ON p.id = c.planet
+ WHERE r.raid = ?
+ $noingal
+ ORDER BY size});
+ $targetquery->execute($raid->{id});
+ my @targets;
+ while (my $target = $targetquery->fetchrow_hashref){
+ my %target;
+ if ($planet){
+ if ($planet->{x} == $target->{x}){
+ $target{style} = 'incluster';
+ }
+ $target{ScoreBash} = 'bash' if ($target->{score}/$planet->{score} < 0.4);
+ $target{ValueBash} = 'bash' if ($target->{value}/$planet->{value} < 0.4);
+ #next if ($target->{score}/$planet->{score} < 0.4) && ($target->{value}/$planet->{value} < 0.4);
+ }
+ $target{Id} = $target->{id};
+ $target{Race} = $target->{race};
+ my $num = pow(10,length($target->{score})-2);
+ $target{Score} = ceil($target->{score}/$num)*$num;
+ $num = pow(10,length($target->{value})-2);
+ $target{Value} = ceil($target->{value}/$num)*$num;
+ $num = pow(10,length($target->{size})-2);
+ $target{Size} = floor($target->{size}/$num)*$num;
+ $num = pow(10,length($target->{fleetvalue})-2);
+ $target{FleetValue} = floor($target->{fleetvalue}/$num)*$num;
+ if (defined $target->{resvalue}){
+ $num = pow(10,length($target->{resvalue})-2);
+ $target{ResValue} = floor($target->{resvalue}/$num)*$num;
+ }
+ $target{comment} = parseMarkup($target->{comment}) if ($target->{comment});
+
+ my $scans = $DBH->prepare(q{SELECT DISTINCT ON (type) type, tick, scan FROM scans
+ WHERE planet = ? AND type ~ 'Unit|Planet|Advanced Unit|.* Analysis' AND tick + 24 > tick() AND scan is not null
+ GROUP BY type, tick, scan ORDER BY type ,tick DESC});
+ $scans->execute($target->{planet});
+ my %scans;
+ while (my $scan = $scans->fetchrow_hashref){
+ $scans{$scan->{type}} = $scan;
+ }
+
+ my @scans;
+ for my $type ('Planet','Unit','Advanced Unit','Surface Analysis','Technology Analysis'){
+ next unless exists $scans{$type};
+ my $scan = $scans{$type};
+ if ($self->{TICK} - $scan->{tick} > 5){
+ $scan->{scan} =~ s{<table( cellpadding="\d+")?>}{<table class="old">};
+ }
+ if ($type eq 'Planet'){
+ $target{PlanetScan} = $scan->{scan};
+ next;
+ }
+ push @scans,{Scan => $scan->{scan}};
+ }
+ $target{Scans} = \@scans;
+
+
+ my @roids;
+ my @claims;
+ my $size = $target{Size};
+ for (my $i = 1; $i <= $raid->{waves}; $i++){
+ my $roids = floor(0.25*$size);
+ $size -= $roids;
+ my $xp = 0;
+ if ($planet){
+ $xp = pa_xp($roids,$planet->{score},$planet->{value},$target{Score},$target{Value});
+ }
+ push @roids,{Wave => $i, Roids => $roids, XP => $xp};
+ if ($self->{AJAX}){
+ push @claims,{Wave => $i, Target => $target{Id}}
+ }else{
+ push @claims,{Wave => $i, Target => $target{Id}, Command => 'Claim'
+ , Owner => 1, Raid => $raid->{id}, Joinable => 0};
+ }
+ }
+ $target{Roids} = \@roids;
+ $target{Claims} = \@claims;
+
+ push @targets,\%target;
+ }
+ @targets = sort {$b->{Roids}[0]{XP} <=> $a->{Roids}[0]{XP} or $b->{Size} <=> $a->{Size}} @targets;
+
+ $BODY->param(Targets => \@targets);
+ }else{#list raids if we haven't chosen one yet
+ my $launched = 0;
+ my $query = $DBH->prepare(q{SELECT r.id AS raid,released_coords AS releasedcoords,tick,waves*COUNT(DISTINCT rt.id) AS waves,
+ COUNT(rc.uid) AS claims, COUNT(nullif(rc.launched,false)) AS launched,COUNT(NULLIF(rc.uid > 0,true)) AS blocked
+ FROM raids r JOIN raid_targets rt ON r.id = rt.raid
+ LEFT OUTER JOIN raid_claims rc ON rt.id = rc.target
+ WHERE open AND not removed AND r.id
+ IN (SELECT raid FROM raid_access NATURAL JOIN groupmembers WHERE uid = ?)
+ GROUP BY r.id,released_coords,tick,waves});
+ $query->execute($ND::UID);
+ my @raids;
+ while (my $raid = $query->fetchrow_hashref){
+ $raid->{waves} -= $raid->{blocked};
+ $raid->{claims} -= $raid->{blocked};
+ delete $raid->{blocked};
+ $launched += $raid->{launched};
+ push @raids,$raid;
+ }
+ $BODY->param(Raids => \@raids);
+
+ if ($self->isBC){
+ $BODY->param(isBC => 1);
+ my $query = $DBH->prepare(q{SELECT r.id AS raid,open ,tick,waves*COUNT(DISTINCT rt.id) AS waves,
+ COUNT(rc.uid) AS claims, COUNT(nullif(rc.launched,false)) AS launched ,COUNT(NULLIF(uid > 0,true)) AS blocked
+ FROM raids r JOIN raid_targets rt ON r.id = rt.raid
+ LEFT OUTER JOIN raid_claims rc ON rt.id = rc.target
+ WHERE not removed AND (not open
+ OR r.id NOT IN (SELECT raid FROM raid_access NATURAL JOIN groupmembers WHERE uid = ?))
+ GROUP BY r.id,open,tick,waves});
+ $query->execute($ND::UID);
+ my @raids;
+ while (my $raid = $query->fetchrow_hashref){
+ $raid->{waves} -= $raid->{blocked};
+ $raid->{claims} -= $raid->{blocked};
+ delete $raid->{blocked};
+ $launched += $raid->{launched};
+ push @raids,$raid;
+ }
+ $BODY->param(ClosedRaids => \@raids);
+
+
+ $query = $DBH->prepare(q{SELECT r.id AS raid,tick,waves*COUNT(DISTINCT rt.id) AS waves,
+ COUNT(rc.uid) AS claims, COUNT(nullif(rc.launched,false)) AS launched ,COUNT(NULLIF(uid > 0,true)) AS blocked
+ FROM raids r JOIN raid_targets rt ON r.id = rt.raid
+ LEFT OUTER JOIN raid_claims rc ON rt.id = rc.target
+ WHERE removed
+ GROUP BY r.id,tick,waves});
+ $query->execute;
+ my @oldraids;
+ while (my $raid = $query->fetchrow_hashref){
+ $raid->{waves} -= $raid->{blocked};
+ $raid->{claims} -= $raid->{blocked};
+ delete $raid->{blocked};
+ $launched += $raid->{launched};
+ push @oldraids,$raid;
+ }
+ $BODY->param(RemovedRaids => \@oldraids);
+ $BODY->param(Launched => $launched);
+ }
+ }
+ return $BODY;
+}
+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 ND::Web::Pages::Resources;
+use strict;
+use warnings FATAL => 'all';
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{resources} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Alliance Resources';
+ my $DBH = $self->{DBH};
+ my $error;
+
+ return $self->noAccess unless $self->isHC;
+
+ my $order = "respplanet DESC";
+ if (defined param('order') && param('order') =~ /^(size|score|resources|respplanet|nscore|nscore2|nscore3)$/){
+ $order = "$1 DESC";
+ }
+
+
+ my $query = $DBH->prepare(qq{
+ SELECT a.id,a.name,a.relationship,s.members,s.score,s.size,r.resources,r.planets, resources/planets AS respplanet,
+ resources / 300 AS scoregain, score + (resources / 300) AS nscore,
+ (resources/planets*LEAST(members,60))/300 AS scoregain2, score + (resources/planets*LEAST(members,60))/300 AS nscore2,
+ (s.size::int8*(1464-tick())*250)/100 + score + (resources/planets*LEAST(members,60))/300 AS nscore3,
+ (s.size::int8*(1464-tick())*250)/100 AS scoregain3
+ FROM (SELECT alliance_id AS id,sum(metal+crystal+eonium) AS resources, count(*) AS planets
+ FROM planets p join covop_targets c ON p.id = c.planet GROUP by alliance_id) r
+ NATURAL JOIN alliances a
+ LEFT OUTER JOIN (SELECT * FROM alliance_stats WHERE tick = (SELECT max(tick) FROM alliance_stats)) s ON a.id = s.id
+ ORDER BY $order
+ });
+ $query->execute;
+ my @alliances;
+ my $i = 0;
+ while (my $alliance = $query->fetchrow_hashref){
+ $i++;
+ $alliance->{ODD} = $i % 2;
+ push @alliances,$alliance;
+ }
+ $BODY->param(Alliances => \@alliances);
+
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+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 ND::Web::Pages::Settings;
+use strict;
+use warnings FATAL => 'all';
+use ND::Include;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{settings} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Edit site preferences';
+ my $DBH = $self->{DBH};
+
+ if (defined param 'cmd'){
+ if(param('cmd') eq 'stylesheet'){
+ my $query = $DBH->prepare(q{UPDATE users SET css = NULLIF($2,'Default') WHERE uid = $1});
+ $query->execute($ND::UID,escapeHTML(param 'stylesheet')) or $ND::ERROR .= p $DBH->errstr;
+ }
+ }
+ if(param('oldpass') && param('pass')){
+ my $query = $DBH->prepare('UPDATE users SET password = MD5(?) WHERE password = MD5(?) AND uid = ?');
+ $query->execute(param('pass'),param('oldpass'),$ND::UID);
+ }
+ my ($css) = $DBH->selectrow_array(q{SELECT css FROM users WHERE uid = $1},undef,$ND::UID);
+ my @stylesheets = ({Style => 'Default'});
+ $css = '' unless defined $css;
+ while (<stylesheets/*.css>){
+ if(m{stylesheets/(\w+)\.css}){
+ push @stylesheets,{Style => $1, Selected => $1 eq $css ? 1 : 0};
+ }
+ }
+ $BODY->param(StyleSheets => \@stylesheets);
+ return $BODY;
+}
+
+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 ND::Web::Pages::TargetList;
+use strict;
+use warnings FATAL => 'all';
+use ND::Include;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{targetList} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'NF Value';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isHC;
+
+ my $order = 'nfvalue';
+ if (local $_ = param('order')){
+ if (/^(size|value|score|xp)$/){
+ $order = "$1 DESC";
+ }elsif (/^(nfvalue|nfvalue2)$/){
+ $order = "$1 ASC";
+ }
+ }
+
+ my $alliances = '15';
+ if (param('alliances') && param('alliances') =~ /^([\d,]+)$/){
+ $alliances = $1;
+ }
+ my $query = $DBH->prepare(qq{
+SELECT coords(p.x,p.y,p.z),p.alliance, p.score, p.value, p.size, p.xp,nfvalue, nfvalue - sum(pa.value) AS nfvalue2, p.race
+FROM current_planet_stats p
+ JOIN (SELECT g.x,g.y, sum(p.value) AS nfvalue
+ FROM galaxies g join current_planet_stats p on g.x = p.x AND g.y = p.y
+ WHERE g.tick = (SELECT max(tick) from galaxies)
+ AND ((planet_status IS NULL OR NOT planet_status IN ('Friendly','NAP')) AND (relationship IS NULL OR NOT relationship IN ('Friendly','NAP')))
+ GROUP BY g.x,g.y
+ ) g ON p.x = g.x AND p.y = g.y
+ JOIN current_planet_stats pa ON pa.x = g.x AND pa.y = g.y
+WHERE p.alliance_id IN ($alliances)
+ AND pa.alliance_id IN ($alliances)
+GROUP BY p.x,p.y,p.z,p.alliance, p.score, p.value, p.size, p.xp, nfvalue,p.race
+ORDER BY $order
+ });
+ $query->execute;
+ my @alliances;
+ my $i = 0;
+ while (my $alliance = $query->fetchrow_hashref){
+ $i++;
+ $alliance->{ODD} = $i % 2;
+ push @alliances,$alliance;
+ }
+ $BODY->param(Alliances => \@alliances);
+
+ return $BODY;
+}
+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 ND::Web::Pages::Users;
+use strict;
+use warnings;
+use ND::Include;
+use CGI qw/:standard/;
+use ND::Web::Include;
+
+use base qw/ND::Web::XMLPage/;
+
+$ND::Web::Page::PAGES{users} = __PACKAGE__;
+
+sub render_body {
+ my $self = shift;
+ my ($BODY) = @_;
+ $self->{TITLE} = 'Users';
+ my $DBH = $self->{DBH};
+
+ return $self->noAccess unless $self->isHC;
+
+ my $error = '';
+ my $user;
+ if (defined param('user') && param('user') =~ /^(\d+)$/){
+ my $query = $DBH->prepare(q{
+ SELECT uid,username,hostmask,CASE WHEN u.planet IS NULL THEN '' ELSE coords(x,y,z) END AS planet,attack_points,defense_points,scan_points,humor_points,info
+ FROM users u LEFT OUTER JOIN current_planet_stats p ON u.planet = p.id
+ WHERE uid = ?;
+ }) or $error .= "<p> Something went wrong: </p>";
+ $user = $DBH->selectrow_hashref($query,undef,$1) or $error.= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+
+
+ if ($user && defined param('cmd') && param('cmd') eq 'change'){
+ $DBH->begin_work;
+ for my $param (param()){
+ if ($param =~ /^c:(planet|\w+_points|hostmask|info|username)$/){
+ my $column = $1;
+ my $value = param($column);
+ if ($column eq 'planet'){
+ if ($value eq ''){
+ $value = undef;
+ }elsif($value =~ /^(\d+)\D+(\d+)\D+(\d+)$/){
+ ($value) = $DBH->selectrow_array(q{SELECT id FROM
+ current_planet_stats WHERE x = ? and y = ? and z =?}
+ ,undef,$1,$2,$3);
+ }
+ }
+ if ($DBH->do(qq{UPDATE users SET $column = ? WHERE uid = ? }
+ ,undef,$value,$user->{uid})){
+ $user->{$column} = param($column);
+ log_message $ND::UID,"HC set $column to $value for user: $user->{uid}";
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ }
+ my $groups = $DBH->prepare('SELECT gid,groupname FROM groups');
+ my $delgroup = $DBH->prepare(q{DELETE FROM groupmembers WHERE uid = ? AND gid = ?});
+ my $addgroup = $DBH->prepare(q{INSERT INTO groupmembers (uid,gid) VALUES(?,?)});
+ $groups->execute();
+ while (my $group = $groups->fetchrow_hashref){
+ my $query;
+ next unless defined param($group->{gid});
+ if (param($group->{gid}) eq 'remove'){
+ $query = $delgroup;
+ }elsif(param($group->{gid}) eq 'add'){
+ $query = $addgroup;
+ }
+ if ($query){
+ if ($query->execute($user->{uid},$group->{gid})){
+ my ($action,$a2) = ('added','to');
+ ($action,$a2) = ('removed','from') if param($group->{gid}) eq 'remove';
+ log_message $ND::UID,"HC $action user: $user->{uid} ($user->{username}) $a2 group: $group->{gid} ($group->{groupname})";
+ }else{
+ $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+ }
+ }
+ $DBH->commit or $error .= "<p> Something went wrong: ".$DBH->errstr."</p>";
+ }
+
+ if ($user){
+ $BODY->param(User => $user->{uid});
+ $BODY->param(Username => $user->{username});
+ $BODY->param(Hostmask => $user->{hostmask});
+ $BODY->param(Planet => $user->{planet});
+ $BODY->param(Attack_points => $user->{attack_points});
+ $BODY->param(Defense_points => $user->{defense_points});
+ $BODY->param(Scan_points => $user->{scan_points});
+ $BODY->param(humor_points => $user->{humor_points});
+ $BODY->param(info => escapeHTML $user->{info});
+
+ my $groups = $DBH->prepare(q{SELECT g.gid,g.groupname,uid FROM groups g LEFT OUTER JOIN (SELECT gid,uid FROM groupmembers WHERE uid = ?) AS gm ON g.gid = gm.gid});
+ $groups->execute($user->{uid});
+
+ my @addgroups;
+ my @remgroups;
+ while (my $group = $groups->fetchrow_hashref){
+ if ($group->{uid}){
+ push @remgroups,{Id => $group->{gid}, Name => $group->{groupname}};
+ }else{
+ push @addgroups,{Id => $group->{gid}, Name => $group->{groupname}};
+ }
+ }
+ $BODY->param(RemoveGroups => \@remgroups);
+ $BODY->param(AddGroups => \@addgroups);
+
+ }else{
+ my $query = $DBH->prepare(qq{SELECT u.uid,username,TRIM(',' FROM concat(g.groupname||',')) AS groups
+ FROM users u LEFT OUTER JOIN (groupmembers gm NATURAL JOIN groups g) ON gm.uid = u.uid
+ WHERE u.uid > 0
+ GROUP BY u.uid,username
+ ORDER BY lower(username)})or $error .= $DBH->errstr;
+ $query->execute or $error .= $DBH->errstr;
+ my @users;
+ my $i = 0;
+ while (my $user = $query->fetchrow_hashref){
+ $i++;
+ $user->{ODD} = $i % 2;
+ push @users, $user;
+ }
+ $BODY->param(Users => \@users);
+ }
+ $BODY->param(Error => $error);
+ return $BODY;
+}
+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 ND::Web::XMLPage;
+use strict;
+use warnings;
+use CGI qw/:standard/;
+use HTML::Template;
+
+use ND::Include;
+use ND::Web::Page;
+use ND::Web::Include;
+
+use base qw/ND::Web::Page/;
+
+sub noAccess () {
+ HTML::Template->new(filename => 'templates/NoAccess.tmpl', global_vars => 1, cache => 1);
+};
+
+sub process : method {
+}
+
+sub listTargets () : method {
+ my $self = shift;
+ my $DBH = $self->{DBH};
+ my $query = $DBH->prepare(qq{SELECT t.id, r.id AS raid, r.tick+c.wave-1 AS landingtick,
+ (released_coords AND old_claim(timestamp)) AS released_coords, coords(x,y,z),c.launched,c.wave,c.joinable
+FROM raid_claims c
+ JOIN raid_targets t ON c.target = t.id
+ JOIN raids r ON t.raid = r.id
+ JOIN current_planet_stats p ON t.planet = p.id
+WHERE c.uid = ? AND r.tick+c.wave > ? AND r.open AND not r.removed
+ORDER BY r.tick+c.wave,x,y,z});
+ $query->execute($ND::UID,$self->{TICK});
+ my @targets;
+ while (my $target = $query->fetchrow_hashref){
+ my $coords = "Target $target->{id}";
+ $coords = $target->{coords} if $target->{released_coords};
+ push @targets,{Coords => $coords, Launched => $target->{launched}, Raid => $target->{raid}
+ , Target => $target->{id}, Tick => $target->{landingtick}, Wave => $target->{wave}
+ , AJAX => $self->{AJAX}, JoinName => $target->{joinable} ? 'N' : 'J'
+ , Joinable => $target->{joinable} ? 'FALSE' : 'TRUE', JoinableTitle => $target->{joinable} ? 'Disable join' : 'Make target joinable'};
+ }
+ my $template = HTML::Template->new(filename => "templates/targetlist.tmpl", cache => 1);
+ $template->param(Targets => \@targets);
+ return $template->output;
+}
+
+
+sub render : method {
+ my $self = shift;
+ my $DBH = $self->{DBH};
+
+
+ chdir '/var/www/ndawn/code';
+
+ my $template = HTML::Template->new(filename => 'templates/skel.tmpl', global_vars => 1, cache => 1);
+
+ my $TICK = $self->{TICK};
+ my $ATTACKER = $self->{ATTACKER};
+
+ $self->{XML} = 0;
+ $self->{AJAX} = 1;
+
+ $self->process;
+
+ my $type = 'text/html';
+ if ($self->{HTTP_ACCEPT} =~ m{application/xhtml\+xml}){
+ $type = 'application/xhtml+xml'
+ }
+ my $body;
+ if ($self->{XML}){
+ $type = 'text/xml';
+ $template = HTML::Template->new(filename => "templates/xml.tmpl", cache => 1);
+ $body = HTML::Template->new(filename => "templates/$self->{PAGE}.xml.tmpl", cache => 1);
+ }else{
+ $body = HTML::Template->new(filename => "templates/$self->{PAGE}.tmpl", global_vars => 1, cache => 1);
+ $body->param(PAGE => $self->{PAGE});
+ }
+
+ $body = $self->render_body($body);
+
+ unless ($body){
+ return;
+ }
+
+ unless ($self->{XML}){
+ my $fleetupdate = $DBH->selectrow_array('SELECT landing_tick FROM fleets WHERE uid = ? AND fleet = 0',undef,$self->{UID});
+
+ $fleetupdate = 0 unless defined $fleetupdate;
+
+ my ($last_forum_visit) = $DBH->selectrow_array(q{SELECT last_forum_visit FROM users WHERE uid = $1}
+ ,undef,$self->{UID}) or $ND::ERROR .= p($DBH->errstr);
+ my ($unread,$newposts) = $DBH->selectrow_array(unread_query(),undef,$self->{UID},$last_forum_visit)
+ or $ND::ERROR .= p($DBH->errstr);
+
+ $template->param(UnreadPosts => $unread);
+ $template->param(NewPosts => $newposts);
+ $template->param(Tick => $TICK);
+ $template->param(isMember => (($TICK - $fleetupdate < 24) || $self->isScanner()) && $self->{PLANET} && $self->isMember);
+ $template->param(isHC => $self->isHC);
+ $template->param(isDC => $self->isDC());
+ $template->param(isBC => $self->isBC());
+ $template->param(isIntel => $self->isIntel());
+ $template->param(isAttacker => $ATTACKER && (!$self->isMember() || ((($TICK - $fleetupdate < 24) || $self->isScanner()) && $self->{PLANET})));
+ if ($ATTACKER && (!$self->isMember() || ((($TICK - $fleetupdate < 24) || $self->isScanner()) && $self->{PLANET}))){
+ $template->param(Targets => $self->listTargets);
+ }
+ $template->param(Coords => param('coords') ? param('coords') : '1:1:1');
+ my ($css) = $DBH->selectrow_array(q{SELECT css FROM users WHERE uid = $1},undef,$ND::UID);
+ $template->param(CSS => $css);
+ $template->param(TITLE => $self->{TITLE});
+ }
+ $template->param(Error => $ND::ERROR);
+ $template->param(BODY => $body->output);
+ my $output = $template->output;
+ $output =~ s/[^\x{9}\x{A}\x{D}\x{20}-\x{D7FF}\x{E000}-\x{FFFD}\x{10000}-\x{10FFFF}]//g;
+ print header(-type=> $type, -charset => 'utf-8', -Content_Length => length $output);
+ print $output;
+};
+
+1;
projects / ndwebbie.git / commitdiff