lib/NDWeb/Controller/Alliances.pm

   1 package NDWeb::Controller::Alliances;
   2
   3 use strict;
   4 use warnings;
   5 use parent 'Catalyst::Controller';
   6
   7 =head1 NAME
   8
   9 NDWeb::Controller::Alliances - Catalyst Controller
  10
  11 =head1 DESCRIPTION
  12
  13 Catalyst Controller.
  14
  15 =head1 METHODS
  16
  17 =cut
  18
  19
  20 =head2 index
  21
  22 =cut
  23
  24 sub index :Path :Args(0) {
  25     my ( $self, $c ) = @_;
  26
  27     $c->response->body('Matched NDWeb::Controller::Alliances in Alliances.');
  28 }
  29
  30 sub hostile : Local {
  31     my ( $self, $c, $order ) = @_;
  32         my $dbh = $c->model;
  33
  34         my $begintick = 0;
  35         my $endtick = $c->stash->{TICK};
  36         if ($c->req->param('ticks')){
  37                 $begintick = $endtick - $c->req->param('ticks');
  38         }elsif(defined $c->req->param('begintick') && defined $c->req->param('endtick')){
  39                 $begintick = $c->req->param('begintick');
  40                 $endtick = $c->req->param('endtick');
  41         }
  42
  43         my $query = $dbh->prepare(q{
  44                 SELECT s.alliance_id AS id,s.alliance AS name,count(*) AS hostile_count
  45 FROM calls c
  46         JOIN incomings i ON i.call = c.id
  47         JOIN current_planet_stats s ON i.sender = s.id
  48 WHERE c.landing_tick - i.eta > $1 and c.landing_tick - i.eta < $2
  49 GROUP BY s.alliance_id,s.alliance
  50 ORDER BY hostile_count DESC
  51                 });
  52         $query->execute($begintick,$endtick);
  53         $c->stash(alliances => $query->fetchall_arrayref({}) );
  54         $c->stash(ticks => $endtick - $begintick);
  55         $c->stash(begin_tick => $begintick);
  56         $c->stash(end_tick => $endtick);
  57 }
  58
  59 sub resources : Local {
  60     my ( $self, $c, $order ) = @_;
  61         my $dbh = $c->model;
  62
  63         if (defined $order && $order =~ /^(size|score|resources|hidden|resplanet|hidplanet|nscore|nscore2|nscore3)$/){
  64                 $order = "$1 DESC";
  65         }else{
  66                 $order = "resplanet DESC";
  67         }
  68
  69         my $query = $dbh->prepare(qq{
  70                 SELECT a.id,a.name,a.relationship,s.members,s.score,s.size
  71                 ,r.resources,r.hidden,r.planets
  72                 ,(resources/planets)::bigint AS resplanet
  73                 ,(hidden/planets)::bigint AS hidplanet
  74                 ,((resources / 300) + (hidden / 100))::bigint AS scoregain
  75                 ,(score + (resources / 300) + (hidden / 100))::bigint AS nscore
  76                 ,((resources/planets*scoremem)/300 + (hidden/planets*scoremem)/100)::bigint AS scoregain2
  77                 ,(score + (resources/planets*scoremem)/300
  78                         + (hidden/planets*scoremem)/100)::bigint AS nscore2
  79                 ,((s.size::int8*(1400-tick())*250)/100 + score + (resources/planets*scoremem)/300
  80                         + (hidden/planets*scoremem)/100)::bigint AS nscore3
  81                 ,(s.size::int8*(1400-tick())*250)/100 AS scoregain3
  82                 FROM (SELECT alliance_id AS id,sum(metal+crystal+eonium) AS resources, sum(hidden) AS hidden, count(*) AS planets
  83                 FROM planets p join planet_scans c ON p.id = c.planet GROUP by alliance_id) r
  84                         NATURAL JOIN alliances a
  85                         LEFT OUTER JOIN (SELECT *,LEAST(members,60) AS scoremem FROM alliance_stats
  86                                 WHERE tick = (SELECT max(tick) FROM alliance_stats)) s ON a.id = s.id
  87                 ORDER BY $order
  88                 });
  89         $query->execute;
  90         my @alliances;
  91         while (my $alliance = $query->fetchrow_hashref){
  92                 push @alliances,$alliance;
  93         }
  94         $c->stash(alliances => \@alliances);
  95 }
  96
  97
  98 =head1 AUTHOR
  99
 100 A clever guy
 101
 102 =head1 LICENSE
 103
 104 This library is free software, you can redistribute it and/or modify
 105 it under the same terms as Perl itself.
 106
 107 =cut
 108
 109 1;