src/check.pl

   1 #!/usr/bin/perl -w
   2 ##########################################################################
   3 #
   4 #   Copyright (c) 2003-2012 Aymargeddon Development Team
   5 #
   6 #   This file is part of "Last days of Aymargeddon" - a massive multi player
   7 #   onine game of strategy
   8 #
   9 #        This program is free software: you can redistribute it and/or modify
  10 #        it under the terms of the GNU Affero General Public License as
  11 #        published by the Free Software Foundation, either version 3 of the
  12 #        License, or (at your option) any later version.
  13 #
  14 #        This program is distributed in the hope that it will be useful,
  15 #        but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 #        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  17 #
  18 #    See the GNU Affero General Public License for more details.
  19 #
  20 #    You should have received a copy of the GNU Affero General Public License
  21 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22 #
  23 ###########################################################################
  24 #
  25
  26 #
  27 #
  28 # checks the integrity of the database.
  29 #
  30 # usage: ./check.pl [-l] [list of checks]
  31 # no args: do all checks
  32 # -l: lists all avaiable checks
  33 # -h: help
  34 # list of checks: do only this checks
  35
  36 use strict;
  37 $|=1;
  38 use DBI;
  39 use Data::Dumper;
  40 use POSIX qw(floor ceil);
  41 use Term::ReadLine;
  42
  43 use FROGS::HexTorus;
  44 use FROGS::Check;
  45 use FROGS::Config;
  46
  47 $::conf->{-FULL_DEBUG_FILE} = 0;
  48 # Util::open_log();
  49
  50 #
  51 # Aymargeddon-specific behaviour
  52 #
  53
  54 # TODO: should also check, if the location is valid in this map
  55 my $location_wellformed_check = sub {
  56   my $loc = shift;
  57   my $wf = Location::is_wellformed($loc);
  58   print "$loc is in bad form! " unless $wf;
  59   return $wf;
  60 };
  61
  62 my $fight_and_occupant = sub {
  63   my $db = shift;
  64   my $dbh = $db->{-dbh};
  65
  66   my $stmt = 'SELECT GAME,LOCATION,OCCUPANT,ATTACKER,TERRAIN,HOME FROM MAP WHERE 1';
  67   my $map = $dbh->selectall_arrayref($stmt);
  68
  69   # for every field in MAP
  70   for my $field (@$map){
  71     my ($game,$loc,$occ,$att,$terrain,$home) = @$field;
  72     Util::log("testing field $loc, game $game: occupant $occ, attacker: $att",1);
  73
  74     # read all earthling mobiles in field
  75     my $cond = "LOCATION='$loc' AND GAME=$game AND AVAILABLE='Y'".
  76       " AND (TYPE='WARRIOR' OR TYPE='PRIEST' OR TYPE='HERO' OR TYPE='PROPHET')";
  77     # my $qcond = $db->quote_condition($cond);
  78     $stmt = "SELECT OWNER FROM MOBILE WHERE $cond";
  79     my $mobiles = $dbh->selectall_arrayref($stmt);
  80
  81     #   search for earthlings
  82     my @earthlings = ();
  83     my $earthlings = {};
  84     for my $mob (@$mobiles){
  85       my ($own) = @$mob;
  86       next if exists $earthlings->{$own};
  87       $earthlings->{$own} = 1;
  88       push @earthlings, $own;
  89     }
  90     # print Dumper \@earthlings;
  91
  92     if($occ){
  93       return "game $game: no earthlings in field $loc with occupant $occ.\n"
  94         if ($#earthlings == -1 and not ($terrain eq 'CITY' and $home));
  95     }else{
  96       return "game $game: earthlings in field $loc without occupant.\n"
  97         if $#earthlings > -1;
  98     }
  99
 100     if($att){
 101       return "game $game: only one earthling in field $loc from $occ, ".
 102         "attacked from $att\n" if $#earthlings == 0;
 103     }else{
 104       return "game $game: more than one earthling in peaceful field $loc."
 105         if $#earthlings > 0;
 106       next if $#earthlings < 0;
 107       return "game $game: occupant $occ is not the only earthling $earthlings[0]".
 108         " in field $loc"
 109         if $occ != $earthlings[0];
 110     }
 111   }
 112   return 0;
 113 };
 114
 115
 116 # list of checks
 117 # every check consists of ID,behaviour
 118 # behaviour is one of A_IN_B, LOGIK or UNIVERSAL
 119
 120 my $check = {
 121              -GAME_EXISTS_FOR_MAP =>
 122              ['A_IN_B', ['MAP','GAME','GAME','GAME']],
 123              -GAME_EXISTS_FOR_ALLIANCE =>
 124              ['A_IN_B', ['ALLIANCE','GAME','GAME','GAME']],
 125              -GAME_EXISTS_FOR_COMMAND =>
 126              ['A_IN_B', ['COMMAND','GAME','GAME','GAME']],
 127              -GAME_EXISTS_FOR_GOD =>
 128              ['A_IN_B', ['GOD','GAME','GAME','GAME']],
 129              -GAME_EXISTS_FOR_GOD =>
 130              ['A_IN_B', ['GOD','GAME','GAME','GAME']],
 131              -GAME_EXISTS_FOR_MESSAGE =>
 132              ['A_IN_B', ['MESSAGE','GAME','GAME','GAME']],
 133              -GAME_EXISTS_FOR_ROLE =>
 134              ['A_IN_B', ['ROLE','GAME','GAME','GAME']],
 135              -GAME_EXISTS_FOR_MOBILE =>
 136              ['A_IN_B', ['MOBILE','GAME','GAME','GAME']],
 137
 138              -LOCATION_WELLFORMED_IN_MAP =>
 139              ['LOGIC',['MAP',['LOCATION'],$location_wellformed_check]],
 140              -LOCATION_WELLFORMED_IN_MOBILE =>
 141              ['LOGIC',['MOBILE',['LOCATION'],$location_wellformed_check]],
 142              # TODO?: implement write last_temple
 143              # -LAST_TEMPLE_WELLFORMED_IN_GAME =>
 144              # ['LOGIC',['GAME',['LAST_TEMPLE'],$location_wellformed_check]],
 145
 146              -FIGHT_AND_OCCUPANT =>
 147              ['UNIVERSAL', $fight_and_occupant],
 148
 149             };
 150
 151 my $checker = Check->new();
 152 $checker->check_all($check);
 153
 154