src/FROGS/Command.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 #   online 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 #
  26 #  basic command object used by the scheduler
  27 use strict;
  28 use Date::Parse qw(str2time);
  29 use Date::Calc qw(Time_to_Date);
  30 use FROGS::DataBase;
  31 use FROGS::Config qw ($conf);
  32 require "$::conf->{-GAME_NAME}.pm";
  33
  34 package Command;
  35 use Data::Dumper;
  36
  37 sub new {
  38   my ($type, $dbhash, $dbobj)  = @_;
  39
  40   Util::log("$type->new()",2);
  41
  42   my $self = {-dbhash => $dbhash,
  43               -db => $dbobj,
  44               -player => $dbhash->{'PLAYER'},
  45               -game => $dbhash->{'GAME'},
  46               -id => $dbhash->{'ID'},
  47               -location => $dbhash->{'LOCATION'},
  48               -class => $type,
  49              };
  50   bless( $self, $type );
  51
  52   # create an GAME_NAME context object
  53   $self->{-context} = $::conf->{-GAME_NAME}->new($dbhash->{'GAME'},
  54                                                  $dbhash->{'PLAYER'},
  55                                                  $dbobj);
  56
  57   $self->{-speed} = $self->{-context}->get_speed();
  58
  59   # end of the game?
  60   if($self->{-speed} < 0){
  61     Util::log("Game over, no commands anymore!",1);
  62     $self->done();
  63     return 0;
  64   }
  65
  66   # set language according to PLAYER.LANGUAGE
  67   my ($lang) = $dbobj->read_player($self->{-player},'LANGUAGE');
  68   $dbobj->set_language($lang);
  69
  70   $self->{-args} = $self->parse_args( $self->{-dbhash}->{'ARGUMENTS'} );
  71
  72   if (defined  $self->{-dbhash}->{'ACK'} and
  73       $self->{-dbhash}->{'ACK'} ne '0000-00-00 00:00:00'){
  74     $self->{-phase} = 2;
  75   }else{
  76     $self->{-phase} = 1;
  77     $self->{-duration} = $::conf->{-DURATION}->{"-$type"} || 0;
  78   }
  79
  80   if(not $::conf->{-MESSAGE_IN_LOG} and $type eq 'SEND_MSG'){
  81     Util::log('',1);
  82   }else{
  83     my $logstring = "\nCommand $type (ID: $self->{-dbhash}->{'ID'}): ".
  84       "Phase $self->{-phase}, ".
  85         "Player $self->{-dbhash}->{'PLAYER'}, ".
  86           "Game $self->{-dbhash}->{'GAME'}, ".
  87             "Arguments $self->{-dbhash}->{'ARGUMENTS'}";
  88     $logstring .= ", Location $self->{-dbhash}->{'LOCATION'}, "
  89       if defined $self->{-dbhash}->{'LOCATION'};
  90     Util::log($logstring,1);
  91   }
  92
  93   return $self;
  94 }
  95
  96 sub is_valid {
  97   my ($self, @required_args) = @_;
  98
  99   # all arguments avaiable?
 100   # TODO PERFORMANCE: maybe this check only in phase1?
 101   return 0 unless $self->required_args($self->{-args}, @required_args);
 102
 103   # does the player still exists?
 104   if($self->{-player} == -1){
 105     $self->{-role} = $self->{-context}->charname(-1);
 106   }else{
 107     my ($id,$role) = $self->{-context}->read_role($self->{-player},'PLAYER,ROLE');
 108     if($id != $self->{-player}){
 109       Util::log("COMMAND->is_valid: Player $self->{-player} does not exist!\n",0);
 110       return 0;
 111     }
 112     # set role for later use
 113     # print "ROLE(is_valid): $role\n";
 114     $self->{-role} = $role;
 115   }
 116   return 1;
 117 }
 118
 119 sub isSecond {
 120         my $self = shift;
 121         return 2 == $self->{-phase};
 122 }
 123
 124 sub isFirst {
 125         my $self = shift;
 126         return 1 == $self->{-phase};
 127 }
 128
 129 sub execute {
 130   my $self = shift;
 131   my $db=$self->{-db};
 132
 133   #if($self->{-speed} < 0){
 134   #  Util::log('*',-1);
 135   #  $self->done();
 136   #  return;
 137   #}
 138   # determine phase of command and do it.
 139   if ($self->isFirst() ) {
 140     $db->update_hash("COMMAND","ID = $self->{-dbhash}->{'ID'}",{ 'ACK' => $db->now() });
 141     my $ret = $self->first_phase();
 142
 143     if ($self->getDuration() > 0 and $ret > 0) {
 144       my $exec = $self->getPhase2exec();
 145       if($self->{-end_of_game}){
 146         $self->done();
 147       }else{
 148         $db->update_hash("COMMAND",
 149                          "ID = $self->{-dbhash}->{'ID'}",
 150                          { 'EXEC' => $exec });
 151       }
 152     }elsif ($self->getDuration() == 0 or $ret == 0){
 153       $self->done();
 154     } else {
 155       # in this case the command has set its EXEC by itself. we do nothing
 156       $self->done() if $self->{-end_of_game};
 157     }
 158   } elsif ($self->isSecond() ) {
 159     $self->second_phase();
 160     $self->done();
 161   } else {
 162     Util::log("command->execute ($self->{-class}) : Unknown or undefined Command phase",0);
 163     die;
 164   }
 165 }
 166
 167 sub done {
 168 # a command will use this func to declare it's terminated
 169 # it is called by Scheduler after secondPhase anyway, so a
 170 # command has to use it only explicitley in a member if it wants to
 171 # terminate NOW! (but still have to exit action for itself)
 172   my $self = shift;
 173   my $db=$self->{-db};
 174
 175   my $id = $self->{-id};
 176
 177   $db->update_hash("COMMAND","ID = $id",{ 'DONE' => $db->now() });
 178   if ($::conf->{-DEBUG} == 0 or $::conf->{-DELETE_OLD_COMMANDS}) {
 179     $db->delete_from("COMMAND","ID=$id");
 180     Util::log(ref($self)."-Command $id deleted.",1);
 181     # TODO: dont delete PRODUCE-Command if game not runnning, but waiting
 182   }
 183   # TODO?: send messages
 184 }
 185
 186 sub setDuration {
 187 # sets the duration of the command in units. Sheduler will schedule
 188 # the Phase 2 then for gametime+units*pace(game).
 189 # this function will have to be called explicitely during phase 1 by the
 190 # implementation of the command
 191 # If it is not called at least once (or set to 0), Scheduler will assume the command has
 192 # no second phase and will call done() after completion of firstPhase().
 193         my $self = shift;
 194         $self->{-duration} = shift;
 195 }
 196
 197 sub getDuration {
 198 # get command duration in units
 199         my $self = shift;
 200         return $self->{-duration};
 201 }
 202
 203 sub getDurationInSec{
 204 # get command duration in secs according to the *current* gamespeed
 205         my $self = shift;
 206
 207         my $ret = $self->getDuration() *  $self->{-speed};
 208
 209         Util::log("Duration in sec: $ret",1) unless defined $self->{-duration_logged};
 210         $self->{-duration_logged} = 1;
 211
 212         $self->{-end_of_game} = 1 unless $ret >= 0;
 213         return $ret;
 214 }
 215
 216 sub getPhase2exec {
 217         # only valid during phase 1 returns start of phase 2 in game
 218         # time, GMT (YYYY-MM-DD HH:MM:SS). If Duration wasn't set, or
 219         # phase is wrong it returns undef.
 220         my $self = shift;
 221         if ($self->getDuration() == 0 || $self->isSecond() ) {
 222                 return undef;
 223         }
 224         my $firstExecTimeUnix = &::str2time($self->{-dbhash}->{'EXEC'},'GMT');
 225 #       my $firstExecTimeUnix = &::str2time($self->{-dbhash}->{'EXEC'});
 226         $firstExecTimeUnix += $self->getDurationInSec();
 227         my ($year,$month,$day, $hour,$min,$sec) = &::Time_to_Date($firstExecTimeUnix);
 228         return  sprintf ("%04u-%02u-%02u %02u:%02u:%02u",$year,$month,$day, $hour,$min,$sec);
 229 }
 230
 231
 232 #############################################
 233 #
 234 # Tools to be used by concrete commands
 235 #
 236
 237 # TODO: Bug mit messages
 238 sub parse_args {
 239         my ( $self, $arg_string ) = @_;
 240
 241         my @key_value_pairs = split /,/, $arg_string; # TODO: wrong for messages
 242
 243         # remove leading/trailing whitespace
 244         @key_value_pairs = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } @key_value_pairs;
 245
 246         my %hash;
 247         for my $kv (@key_value_pairs) {
 248                 my ( $k, $v ) = split /=/, $kv; # TODO: wrong for messages
 249
 250                 # remove leading/trailing whitespace again
 251                 ( $k, $v ) = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } ( $k, $v );
 252
 253                 $hash{$k} = $v;
 254         }
 255         # use Data::Dumper; print Dumper \%hash;
 256         return \%hash;
 257 }
 258
 259 sub required_args {
 260   my ( $self, $args, @ra ) = @_;
 261
 262   for my $a (@ra) {
 263     unless ( exists $args->{$a} ) {
 264       Util::log("We need argument $a",1);
 265       return 0;
 266     }
 267   }
 268   return 1;
 269 }
 270
 271
 272
 273 # general testfunction.
 274 # sends error message and return false
 275 # unless &$cond() gives true
 276
 277 sub test{
 278   my ($self, $cond, $tag, @args) = @_;
 279
 280   unless(&$cond()){
 281     # (@args) = $self->{-db}->quote_all(@args);
 282
 283     my $sendhash = {'MFROM' => 0,
 284                     'MSG_TAG' => $tag};
 285     # TODO: localize command-strings!
 286     $sendhash->{'ARG1'} = $self->{-class};
 287     for my $a (1..($#args+1)){
 288       $sendhash->{"ARG$a"} = $args[$a-1];
 289     }
 290
 291     $self->{-context}->send_message_to($self->{-player},$sendhash);
 292
 293     Util::log("Test failed: $tag, args @args",1);
 294
 295     return 0;
 296   }
 297   return 1;
 298 }
 299
 300 #sub test{
 301 #  my ($self, @all) = @_;
 302 #
 303 #  if($self->test_without_done(@all)){
 304 #    return 1;
 305 #  }else{
 306 #    # delete me from database
 307 #    $self->done();
 308 #    return 0;
 309 #  }
 310 #}
 311
 312 # set a mobilehash if available, sends errormessage otherwise
 313 sub validate_mobile{
 314   my ($self,$mob_id) = @_;
 315
 316   my $mob = $self->{-db}->read_single_mobile($mob_id);
 317
 318   # mobile correct?
 319   if($self->{-phase} == 1){
 320     return 0 unless $self->test(sub {defined $mob},
 321                                 'MSG_NO_SUCH_MOBILE',
 322                                 $mob_id);
 323   }
 324   $self->{-mob} = $mob;
 325   return 1;
 326 }
 327
 328 # errormessage unless one of valid roles
 329 sub validate_role{
 330   my ($self, @valid_roles) = @_;
 331
 332   return 1 if $self->{-player} < 0;
 333
 334   Util::log("validate_role($self->{-role})",2);
 335
 336   unless(Util::is_in($self->{-role},@valid_roles)){
 337     return 0 unless $self->test(sub {0},
 338                                 'MSG_ROLE_CANT_DO',
 339                                 $self->{-role},
 340                                 ref($self));
 341   }
 342   return 1;
 343 }
 344
 345 sub validate_this_role{
 346   my($self,$player,@valid_roles) = @_;
 347
 348   # fake identity
 349   my $role = $self->{-role};
 350   my ($id,$r) = $self->{-context}->read_role($player,'PLAYER,ROLE');
 351   $self->{-role} = $r;
 352   my $ret = $self->validate_role(@valid_roles);
 353   $self->{-role} = $role;
 354   return 0 unless $ret;
 355   return 1;
 356 }
 357
 358 # takes a mobile_hash, a count and a diff_hash. creates another mobile
 359 # with count members in the database with the different fields given
 360 # in diff_hash. if $available, than the new mob is available
 361
 362 #  returns
 363 # ID of newmob (newmob is in some sense really the old mob, because
 364 # diff is apllied to old mob) , returns the new ID (of the old mob).
 365
 366 sub split_mobile{
 367   my ($self, $mob, $count, $diff, $available) = @_;
 368   my $db = $self->{-db};
 369   Util::log(ref($self).": split mobile $mob->{'ID'}",1);
 370
 371   # create new mobile
 372   my %newmob = %$mob;
 373   my $newmob = \%newmob;
 374   $newmob->{'ID'} = $self->{-db}->find_first_free('MOBILE','ID');
 375   my $newid = $newmob->{'ID'};
 376
 377   %$mob = (%$mob,%$diff);
 378   # print Dumper $mob; exit;
 379   # %$newmob = (%$oldmob, %$newmob);
 380
 381   # calculate new count and available
 382   $mob->{'COUNT'} = $count;
 383   $mob->{'AVAILABLE'} = $available ? 'Y' : 'N';
 384
 385   my $id = $mob->{'ID'};
 386   delete $mob->{'ID'};
 387   # print Dumper $mob;
 388   $self->{-db}->update_hash('MOBILE',"ID=$id",$mob);
 389   Util::log("mobile $id updated",1);
 390
 391   # reduce count of old one
 392   $newmob->{'COUNT'} -= $count;
 393
 394   # print Dumper $newmob;
 395   $self->{-db}->insert_hash('MOBILE',$newmob);
 396   Util::log("new mobile $newid",1);
 397
 398   return $newid;
 399 }
 400
 401 # this function splits a mobile if it necessary, update else.
 402 # usage of parameters: see split_mobile
 403 # returns the new ID of the old mob (see split_mobile)
 404 sub conditional_split_mobile{
 405   my ($self, $mob, $count, $diff, $available) = @_;
 406
 407   # print "count: $count\n";
 408   # print Dumper $mob;
 409
 410   my $db = $self->{-db};
 411
 412   # split it, if neccessary
 413   if($count < $mob->{'COUNT'}){
 414
 415     return $self->split_mobile($mob,$count,$diff,$available);
 416
 417   }elsif($count == $mob->{'COUNT'}){
 418     $diff->{'AVAILABLE'} = $available ? 'Y' : 'N';
 419     $db->update_hash('MOBILE',
 420                      "ID=$mob->{'ID'}",
 421                      $diff);
 422     return $mob->{'ID'};
 423   }else{
 424     Util::log("SPLIT MOBILE: Error! impossible case. not enough mobiles. ".
 425               "we need $count and have only $mob->{'COUNT'}",0);
 426     return 0;
 427   }
 428 }
 429
 430 sub event{
 431   my ($self, $loc, $tag, @args) = @_;
 432
 433   # read execution time
 434   my $exec_time = $self->getPhase2exec();
 435
 436   unless($exec_time){
 437     my $cmd = $self->{-db}->single_hash_select('COMMAND',
 438                                                "ID=$self->{-dbhash}->{'ID'}");
 439     $exec_time = $cmd->{'EXEC'};
 440   }
 441
 442   my $event = {'TAG' => $tag,
 443                'LOCATION' => $loc,
 444                'GAME' => $self->{-game},
 445                'TIME' => $exec_time,
 446                'COMMAND_ID' => $self->{-dbhash}->{'ID'},
 447                };
 448   $event->{'ARG1'} = $self->{-context}->charname($self->{-player});
 449   for my $a (0..$#args){
 450     $event->{'ARG'.($a+2)} = $args[$a];
 451   }
 452   $self->{-db}->write_event($event);
 453 }
 454
 455 # this function re-inserts the same command in the queue again
 456 sub do_it_again{
 457   my ($self,$arguments) = @_;
 458
 459   my $now = $self->{-db}->now();
 460   # we need a new ID
 461   delete $self->{-dbhash}->{'ID'};
 462   # reset timestamps
 463   $self->{-dbhash}->{'SUBMIT'} = $now;
 464   $self->{-dbhash}->{'EXEC'} = $now;
 465   $self->{-dbhash}->{'ACK'} = 'NULL'; # TODO: wrong way to insert NULL?
 466   $self->{-dbhash}->{'DONE'} = 'NULL';
 467   if (defined $arguments){
 468     # these arguments are allready there in the database
 469     my $hash = $self->parse_args($self->{-dbhash}->{'ARGUMENTS'});
 470     # we put some additional ones into hash
 471     for my $k (keys %$arguments){
 472       $hash->{$k} = $arguments->{$k};
 473     }
 474     # rearrange hash into string
 475     my $new_string = '';
 476     my ($key,$value);
 477     while (($key,$value) = each %$hash){
 478       $new_string .= "$key=$value, ";
 479     }
 480     $new_string =~ s/, $//;
 481     $self->{-dbhash}->{'ARGUMENTS'} = $new_string;
 482   }
 483   # write new command to database
 484   $self->{-db}->insert_hash('COMMAND', $self->{-dbhash});
 485 }
 486
 487 1;