-affected in BUILD_ARK gesetzt
[aymargeddon/current.git] / src / FROGS / Check.pm
1 ##########################################################################
2 #
3 #   Copyright (c) 2003-2012 Aymargeddon Development Team
4 #
5 #   This file is part of "Last days of Aymargeddon" - a massive multi player
6 #   onine game of strategy      
7 #   
8 #        This program is free software: you can redistribute it and/or modify
9 #        it under the terms of the GNU Affero General Public License as
10 #        published by the Free Software Foundation, either version 3 of the
11 #        License, or (at your option) any later version.
12 #    
13 #        This program is distributed in the hope that it will be useful,
14 #        but WITHOUT ANY WARRANTY; without even the implied warranty of
15 #        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
16 #
17 #    See the GNU Affero General Public License for more details.
18 #    
19 #    You should have received a copy of the GNU Affero General Public License
20 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
21 #    
22 ###########################################################################
23 #
24
25 use strict;
26 use FROGS::DataBase;
27
28 #
29 # Here some generell functionality to check the integrity of
30 # the underlying database is checked.
31
32 package Check;
33 use Data::Dumper;
34
35 sub new{
36   my $class = shift;
37   my $self = {};
38   $self->{-db} = DataBase->new(@_);
39   bless ($self,$class);
40 }
41
42 # do a check, there can be different TYPE of checks:
43 # A_IN_B, LOGIC, UNIVERSAL
44 #
45 # - A in B checks if corresponding fields in different tables exists
46 #
47 # - LOGIC checks with a function for some fields in a table
48 #
49 # - UNIVERSAL checks with an arbitrary function
50 #
51 # - TODO: LOCATION should check with a function for every location
52
53 sub check_all{
54   my $self = shift;
55   my $checks = shift;
56
57   my $db = $self->{-db};
58
59   while(my ($k,$v) = each %$checks){
60     print "check $k... ";
61     my $type = $v->[0];
62     if($type eq 'A_IN_B'){
63       my $table_A = $v->[1]->[0];
64       my $field_A = $v->[1]->[1];
65       my $table_B = $v->[1]->[2];
66       my $field_B = $v->[1]->[3];
67
68       # TODO BUG: dont use single_select!
69       my @data = $db->single_select("select distinct $field_A from $table_A");
70       my @datb = $db->single_select("select distinct $field_B from $table_B");
71
72       print Dumper \@datb;
73       my %schnitt;
74       for my $d (@datb){
75         print "hab $d\n";
76         $schnitt{$d} = 1;
77       }
78       my $failed = 0;
79       for my $d (@data){
80         if(not exists($schnitt{$d})){
81           print "FAILED with $field_A = $d!\n";
82           $failed = 1;
83           last;
84         }
85       }
86       next if $failed;
87       print "OK.\n";
88     }elsif($type eq 'LOGIC'){
89       my $table = $v->[1]->[0];
90       my $fields = $v->[1]->[1];
91       my $function = $v->[1]->[2];
92       local $" = ', ';
93       my $command = "select @$fields from $table";
94       # TODO: single_select correct? we need the whole table and
95       # TODO: there is no condition???
96       my @dat = $db->single_select($command);
97       # print Dumper $dat;
98
99       my $failed = 0;
100       for my $d (@dat){
101         my $ret = &$function($d);
102         $failed = 1 unless $ret;
103       }
104       $failed ? print "FAILED!\n" : print "OK.\n";
105     }elsif($type eq 'UNIVERSAL'){
106       my $function = $v->[1];
107       my $ret = &$function($db);
108       $ret ? print "FAILED: $ret\n" : print "OK.\n";
109     }else{
110       print "FAILED (Type of check - $type - not avaiable)\n";
111     }
112   }
113 }
114
115 1;
116
117