src/FROGS/Check.pm

   1 ##########################################################################
   2 #
   3 #   Copyright (c) 2003 Aymargeddon Development Team
   4 #
   5 #   This file is part of
   6 #   "FROGS" = Framework for Realtime Online Games of Strategy
   7 #
   8 #   FROGS 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 #   FROGS 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 use strict;
  25 use FROGS::DataBase;
  26
  27 #
  28 # Here some generell functionality to check the integrity of
  29 # the underlying database is checked.
  30
  31 package Check;
  32 use Data::Dumper;
  33
  34 sub new{
  35   my $class = shift;
  36   my $self = {};
  37   $self->{-db} = DataBase->new(@_);
  38   bless ($self,$class);
  39 }
  40
  41 # do a check, there can be different TYPE of checks:
  42 # A_IN_B, LOGIC, UNIVERSAL
  43 #
  44 # - A in B checks if corresponding fields in different tables exists
  45 #
  46 # - LOGIC checks with a function for some fields in a table
  47 #
  48 # - UNIVERSAL checks with an arbitrary function
  49 #
  50 # - TODO: LOCATION should check with a function for every location
  51
  52 sub check_all{
  53   my $self = shift;
  54   my $checks = shift;
  55
  56   my $db = $self->{-db};
  57
  58   while(my ($k,$v) = each %$checks){
  59     print "check $k... ";
  60     my $type = $v->[0];
  61     if($type eq 'A_IN_B'){
  62       my $table_A = $v->[1]->[0];
  63       my $field_A = $v->[1]->[1];
  64       my $table_B = $v->[1]->[2];
  65       my $field_B = $v->[1]->[3];
  66
  67       # TODO BUG: dont use single_select!
  68       my @data = $db->single_select("select distinct $field_A from $table_A");
  69       my @datb = $db->single_select("select distinct $field_B from $table_B");
  70
  71       print Dumper \@datb;
  72       my %schnitt;
  73       for my $d (@datb){
  74         print "hab $d\n";
  75         $schnitt{$d} = 1;
  76       }
  77       my $failed = 0;
  78       for my $d (@data){
  79         if(not exists($schnitt{$d})){
  80           print "FAILED with $field_A = $d!\n";
  81           $failed = 1;
  82           last;
  83         }
  84       }
  85       next if $failed;
  86       print "OK.\n";
  87     }elsif($type eq 'LOGIC'){
  88       my $table = $v->[1]->[0];
  89       my $fields = $v->[1]->[1];
  90       my $function = $v->[1]->[2];
  91       local $" = ', ';
  92       my $command = "select @$fields from $table";
  93       # TODO: single_select correct? we need the whole table and
  94       # TODO: there is no condition???
  95       my @dat = $db->single_select($command);
  96       # print Dumper $dat;
  97
  98       my $failed = 0;
  99       for my $d (@dat){
 100         my $ret = &$function($d);
 101         $failed = 1 unless $ret;
 102       }
 103       $failed ? print "FAILED!\n" : print "OK.\n";
 104     }elsif($type eq 'UNIVERSAL'){
 105       my $function = $v->[1];
 106       my $ret = &$function($db);
 107       $ret ? print "FAILED: $ret\n" : print "OK.\n";
 108     }else{
 109       print "FAILED (Type of check - $type - not avaiable)\n";
 110     }
 111   }
 112 }
 113
 114 1;
 115
 116