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