src/FROGS/Util.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 #
  25 #  Here we gather some utility-functions
  26 #
  27
  28 use strict;
  29 use FROGS::DataBase;
  30 use FROGS::Config qw ($conf);
  31
  32 package Util;
  33 use Data::Dumper;
  34
  35 # parse the command-line (or any other string-array)
  36 # and overwrites $::conf with the new values
  37 # example: ./scheduler.pl -DURATION-PRAY=1000 -MANA-BLESS_PRIEST=10
  38 sub overwrite_config{
  39   my @arr = @_;
  40   for my $arg (@arr){
  41     my ($left,$right) = split /=/,$arg;
  42     my @parts = split /-/, $left;
  43
  44     # TODO: generalization
  45     if($parts[2]){
  46       $::conf->{"-$parts[1]"}->{"-$parts[2]"} = $right;
  47     }else{
  48       $::conf->{"-$parts[1]"} = $right;
  49     }
  50   }
  51 }
  52
  53 # returns 1 if $scalar is in @list
  54 sub is_in{
  55   my ($scalar, @list) = @_;
  56
  57   for my $le (@list) {
  58     return 1 if $le eq $scalar;
  59   }
  60   return 0;
  61 }
  62
  63 # returns all elements of @$A which are _not_ in @$B
  64 # in an array reference
  65 sub without{
  66   my ($A, $B) = @_;
  67
  68   my %h = ();
  69   for my $b (@$B){
  70     $h{$b} = 1;
  71   }
  72
  73   my @A_without_B = ();
  74   for my $a (@$A){
  75     push @A_without_B, $a unless exists $h{$a};
  76   }
  77   return \@A_without_B;
  78 }
  79
  80 sub log{
  81   my ($string,$level) = @_;
  82
  83   my $abslevel = $level;
  84   my $do = 0;
  85
  86   # TODO: dirty hack, use caller() instead
  87   if($0 eq '-e'){
  88     $string .= "<p>";
  89     $do = 1 if $::conf->{-EPL_DEBUG} >= $abslevel;
  90   }else{
  91     $do = 1 if $::conf->{-DEBUG} >= $abslevel;
  92
  93     if($::conf->{-FULL_DEBUG_FILE}){
  94       # FULL_LOG in file
  95       if($level >= 0){
  96         print FULL_LOG "$string\n";
  97       }else{
  98         print FULL_LOG "$string";
  99       }
 100     }
 101   }
 102   # negativ values for level prints no newline
 103   if($do){
 104     if($level >= 0){
 105       print "$string\n";
 106     }else{
 107       print "$string";
 108     }
 109   }
 110 }
 111
 112 sub open_log{
 113   my $file = $::conf->{-FULL_DEBUG_FILE};
 114   open(FULL_LOG,">$file") or die "can't open $file: $!";
 115 }
 116
 117 sub close_log{
 118   close FULL_LOG;
 119 }
 120
 121 sub min{
 122   my @list = @_;
 123
 124   my $min = 99999999;
 125   for my $elem (@list){
 126     $min = $elem if $elem < $min;
 127   }
 128   return $min;
 129 }
 130
 131 sub max{
 132   my @list = @_;
 133
 134   my $max = -99999999;
 135   for my $elem (@list){
 136     $max = $elem if $elem > $max;
 137   }
 138   return $max;
 139 }
 140
 141 # returns a shuffled list
 142 sub shuffle {
 143   my $array_ref = shift;
 144
 145   my @shuffled = sort { int(rand(3)) - 1 } @$array_ref;
 146
 147   return \@shuffled;
 148 }
 149
 150 1;
 151