?
[aymargeddon/current.git] / 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