$c->res->redirect("http://game.planetarion.com/bcalc.pl?$query");
}
+sub retal : Local {
+ my ($self, $c) = @_;
+ my $dbh = $c->model;
+
+ my $incs = $dbh->prepare(q{
+SELECT coords(x,y,z),pid,race,size,score,value,alliance
+ ,array_agg(i.eta) AS eta,array_agg(amount) AS amount
+ ,array_agg(shiptype) AS type,array_agg(fleet) AS name
+ ,array_agg(c.landing_tick) AS landing
+FROM calls c
+ JOIN incomings i USING (call)
+ JOIN current_planet_stats p USING (pid)
+WHERE c.status <> 'Covered' AND c.landing_tick BETWEEN tick() AND tick() + 6
+ AND c.landing_tick + GREATEST(i.eta,7) > tick() + 10
+GROUP BY pid,race,x,y,z,size,score,value,alliance
+ORDER BY size DESC
+ });
+ $incs->execute;
+ $c->stash(planets => $incs->fetchall_arrayref({}));
+
+}
+
+sub postcreateretal : Local {
+ my ($self, $c) = @_;
+ my $dbh = $c->model;
+
+ $dbh->begin_work;
+ my $query = $dbh->prepare(q{INSERT INTO raids (tick,waves,message) VALUES(?,?,?) RETURNING (id)});
+ $query->execute($c->req->param('tick'),$c->req->param('waves')
+ ,html_escape $c->req->param('message'));
+ my $raid = $query->fetchrow_array;
+ $c->forward('log',[$raid,"Created retal raid landing at tick: ".$c->req->param('tick')]);
+
+ if ($c->req->param('target')) {
+ my @targets = $c->req->param('target');
+
+ my $addtarget = $dbh->prepare(q{
+INSERT INTO raid_targets(raid,pid,comment) (
+ SELECT $1,pid,array_to_string(array_agg(
+ fleet || ': eta=' || eta || ', amount=' || amount || ', type=' || shiptype
+ || ' landing=' || landing_tick || 'back=' || landing_tick + eta
+ ),'\n')
+ FROM calls c
+ JOIN incomings i USING (call)
+ JOIN current_planet_stats p USING (pid)
+ WHERE c.status <> 'Covered' AND c.landing_tick BETWEEN tick() AND tick() + 6
+ AND c.landing_tick + GREATEST(i.eta,7) > tick() + 10
+ AND pid = ANY ($2)
+ GROUP BY pid
+ )
+ });
+ $addtarget->execute($raid,\@targets);
+ $c->forward('log',[$raid,"BC added planets (@targets) to retal_raid"]);
+ }
+ $dbh->do(q{INSERT INTO raid_access (raid,gid) VALUES(?,'M')}
+ ,undef,$raid);
+ $dbh->commit;
+
+ $c->res->redirect($c->uri_for('edit',$raid));
+}
+
sub listAlliances : Private {
my ($self, $c) = @_;
<ul class="linkbar">
<li><a href="/raids/create">Create raid</a></li>
<li><a href="/raids/targetlist">Find targets</a></li>
+ <li><a href="/raids/retal">Find retals</a></li>
</ul>
[% END %]
[% IF c.check_user_roles("dc_menu") %]
--- /dev/null
+<form action="[% c.uri_for('postcreateretal') %]" method="post">
+<table class="stats">
+ <tr>
+ <th>Coords</th>
+ <th>Alliance</th>
+ <th>Race</th>
+ <th>Size</th>
+ <th>Score</th>
+ <th>Value</th>
+ <th>Fleets out</th>
+ <th>Add to raid</th>
+ </tr>
+[% FOR p IN planets %]
+ <tr class="[% loop.count % 2 == 0 ? 'even' : 'odd ' %]">
+ <td><a href="[% c.uri_for('/stats/planet',p.pid) %]">[% p.coords %]</a></td>
+ <td>[% p.alliance %]</td>
+ <td>[% p.race %]</td>
+ <td>[% p.size | commify %]</td>
+ <td>[% p.score | commify %]</td>
+ <td>[% p.value | commify %]</td>
+ <td>[% FOR eta IN p.eta %]
+ [%
+ name = p.name.shift;
+ amount = p.amount.shift;
+ type = p.type.shift;
+ tick = p.landing.shift;
+ back = tick + eta;
+ %]
+ <p>[% name %]: eta=[% eta %] amount=[% amount | commify %] type=[% type | html %]
+ landing=[% tick %] back=[%back%]</p>
+ [% END %]</td>
+ <td><input type="checkbox" name="target" value="[% p.pid %]"></td>
+ </tr>
+[% END %]
+</table>
+<p>Landing tick: <input type="text" name="tick" value="[% TICK + 10 %]"></p>
+<p>Number of waves: <input type="text" name="waves" value="3"></p>
+<p>Raid message here</p>
+<p><textarea rows="15" cols="40" name="message">Retal Raid</textarea></p>
+<p><input type="submit" value="Create raid"></p>
+</form>
+++ /dev/null
-#!/usr/bin/perl
-q{
-/***************************************************************************
- * 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. *
- ***************************************************************************/
-};
-
-use strict;
-use warnings;
-use DBI;
-use DBD::Pg qw(:pg_types);
-
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-
-use ND::DB;
-
-our $dbh = ND::DB::DB();
-
-$dbh->begin_work;
-
-my $query = $dbh->prepare(q{INSERT INTO raids (tick,waves,message)
- VALUES(tick() + 10,3,'Retal raid') RETURNING (id)});
-$query->execute;
-my $raid = $query->fetchrow_array;
-
-$query->finish;
-
-print "$raid\n";
-
-$dbh->do(q{INSERT INTO raid_access (raid,gid) VALUES(?,'M')}
- ,undef,$raid);
-
-my $addtarget = $dbh->prepare(q{INSERT INTO raid_targets(raid,pid,comment)
- VALUES($1,$2,$3)});
-
-my $incs = $dbh->prepare(q{SELECT pid,array_agg(i.eta) AS eta,array_agg(amount) AS amount
- ,array_agg(shiptype) AS type,array_agg(fleet) AS name,array_agg(c.landing_tick) AS landing
- FROM calls c
- JOIN incomings i USING (call)
- WHERE c.status <> 'Covered' AND c.landing_tick BETWEEN tick() AND tick() + 6
- AND c.landing_tick + GREATEST(i.eta,7) > tick() + 10
- GROUP BY pid
- });
-$incs->execute;
-
-while (my $inc = $incs->fetchrow_hashref){
- my $comment = '';
- for my $eta (@{$inc->{eta}}){
- my $amount = shift @{$inc->{amount}};
- my $type = shift @{$inc->{type}};
- my $name = shift @{$inc->{name}};
- my $landing = shift @{$inc->{landing}};
- my $back = $landing + $eta;
- $comment .= "$name: ETA=$eta Amount=$amount Type:'$type' Landing tick=$landing Estimated back:$back\n";
- }
- $addtarget->execute($raid,$inc->{pid},$comment);
-}
-
-$dbh->commit;
-#$dbh->rollback;
-
-$dbh->disconnect;