src/check.pl

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