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 # returns a hash with all data wich is affected from the command
 187 sub affected{
 188     my $self = shift;
 189
 190     my $aff = $self->{-affected};
 191     for my $field (@{$aff->{-fields}}){
 192         #TODO? build field data
 193     }
 194
 195     return $aff;
 196 }
 197
 198 # returns a JSON-Object with all new infos which should displayd from client
 199 sub first_phase_ajax{
 200     my $self = shift;
 201
 202     my $ret = $self->first_phase();
 203     #TODO: which part of the logic in execute() is needed here?
 204
 205     my $aff = $self->affected();
 206     use JSON;
 207     return encode_json($aff);
 208
 209 }
 210
 211 sub setDuration {
 212 # sets the duration of the command in units. Sheduler will schedule
 213 # the Phase 2 then for gametime+units*pace(game).
 214 # this function will have to be called explicitely during phase 1 by the
 215 # implementation of the command
 216 # If it is not called at least once (or set to 0), Scheduler will assume the command has
 217 # no second phase and will call done() after completion of firstPhase().
 218         my $self = shift;
 219         $self->{-duration} = shift;
 220 }
 221
 222 sub getDuration {
 223 # get command duration in units
 224         my $self = shift;
 225         return $self->{-duration};
 226 }
 227
 228 sub getDurationInSec{
 229 # get command duration in secs according to the *current* gamespeed
 230         my $self = shift;
 231
 232         my $ret = $self->getDuration() *  $self->{-speed};
 233
 234         Util::log("Duration in sec: $ret",1) unless defined $self->{-duration_logged};
 235         $self->{-duration_logged} = 1;
 236
 237         $self->{-end_of_game} = 1 unless $ret >= 0;
 238         return $ret;
 239 }
 240
 241 sub getPhase2exec {
 242         # only valid during phase 1 returns start of phase 2 in game
 243         # time, GMT (YYYY-MM-DD HH:MM:SS). If Duration wasn't set, or
 244         # phase is wrong it returns undef.
 245         my $self = shift;
 246         if ($self->getDuration() == 0 || $self->isSecond() ) {
 247                 return undef;
 248         }
 249         my $firstExecTimeUnix = &::str2time($self->{-dbhash}->{'EXEC'},'GMT');
 250 #       my $firstExecTimeUnix = &::str2time($self->{-dbhash}->{'EXEC'});
 251         $firstExecTimeUnix += $self->getDurationInSec();
 252         my ($year,$month,$day, $hour,$min,$sec) = &::Time_to_Date($firstExecTimeUnix);
 253         return  sprintf ("%04u-%02u-%02u %02u:%02u:%02u",$year,$month,$day, $hour,$min,$sec);
 254 }
 255
 256
 257 #############################################
 258 #
 259 # Tools to be used by concrete commands
 260 #
 261
 262 # TODO: Bug mit messages
 263 sub parse_args {
 264         my ( $self, $arg_string ) = @_;
 265
 266         my @key_value_pairs = split /,/, $arg_string; # TODO: wrong for messages
 267
 268         # remove leading/trailing whitespace
 269         @key_value_pairs = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } @key_value_pairs;
 270
 271         my %hash;
 272         for my $kv (@key_value_pairs) {
 273                 my ( $k, $v ) = split /=/, $kv; # TODO: wrong for messages
 274
 275                 # remove leading/trailing whitespace again
 276                 ( $k, $v ) = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } ( $k, $v );
 277
 278                 $hash{$k} = $v;
 279         }
 280         # use Data::Dumper; print Dumper \%hash;
 281         return \%hash;
 282 }
 283
 284 sub required_args {
 285   my ( $self, $args, @ra ) = @_;
 286
 287   for my $a (@ra) {
 288     unless ( exists $args->{$a} ) {
 289       Util::log("We need argument $a",1);
 290       return 0;
 291     }
 292   }
 293   return 1;
 294 }
 295
 296
 297
 298 # general testfunction.
 299 # sends error message and return false
 300 # unless &$cond() gives true
 301
 302 sub test{
 303   my ($self, $cond, $tag, @args) = @_;
 304
 305   unless(&$cond()){
 306     # (@args) = $self->{-db}->quote_all(@args);
 307
 308     my $sendhash = {'MFROM' => 0,
 309                     'MSG_TAG' => $tag};
 310     # TODO: localize command-strings!
 311     $sendhash->{'ARG1'} = $self->{-class};
 312     for my $a (1..($#args+1)){
 313       $sendhash->{"ARG$a"} = $args[$a-1];
 314     }
 315
 316     $self->{-context}->send_message_to($self->{-player},$sendhash);
 317
 318     Util::log("Test failed: $tag, args @args",1);
 319
 320     return 0;
 321   }
 322   return 1;
 323 }
 324
 325 #sub test{
 326 #  my ($self, @all) = @_;
 327 #
 328 #  if($self->test_without_done(@all)){
 329 #    return 1;
 330 #  }else{
 331 #    # delete me from database
 332 #    $self->done();
 333 #    return 0;
 334 #  }
 335 #}
 336
 337 # set a mobilehash if available, sends errormessage otherwise
 338 sub validate_mobile{
 339   my ($self,$mob_id) = @_;
 340
 341   my $mob = $self->{-db}->read_single_mobile($mob_id);
 342
 343   # mobile correct?
 344   if($self->{-phase} == 1){
 345     return 0 unless $self->test(sub {defined $mob},
 346                                 'MSG_NO_SUCH_MOBILE',
 347                                 $mob_id);
 348   }
 349   $self->{-mob} = $mob;
 350   return 1;
 351 }
 352
 353 # errormessage unless one of valid roles
 354 sub validate_role{
 355   my ($self, @valid_roles) = @_;
 356
 357   return 1 if $self->{-player} < 0;
 358
 359   Util::log("validate_role($self->{-role})",2);
 360
 361   unless(Util::is_in($self->{-role},@valid_roles)){
 362     return 0 unless $self->test(sub {0},
 363                                 'MSG_ROLE_CANT_DO',
 364                                 $self->{-role},
 365                                 ref($self));
 366   }
 367   return 1;
 368 }
 369
 370 sub validate_this_role{
 371   my($self,$player,@valid_roles) = @_;
 372
 373   # fake identity
 374   my $role = $self->{-role};
 375   my ($id,$r) = $self->{-context}->read_role($player,'PLAYER,ROLE');
 376   $self->{-role} = $r;
 377   my $ret = $self->validate_role(@valid_roles);
 378   $self->{-role} = $role;
 379   return 0 unless $ret;
 380   return 1;
 381 }
 382
 383 # takes a mobile_hash, a count and a diff_hash. creates another mobile
 384 # with count members in the database with the different fields given
 385 # in diff_hash. if $available, than the new mob is available
 386
 387 #  returns
 388 # ID of newmob (newmob is in some sense really the old mob, because
 389 # diff is apllied to old mob) , returns the new ID (of the old mob).
 390
 391 sub split_mobile{
 392   my ($self, $mob, $count, $diff, $available) = @_;
 393   my $db = $self->{-db};
 394   Util::log(ref($self).": split mobile $mob->{'ID'}",1);
 395
 396   # create new mobile
 397   my %newmob = %$mob;
 398   my $newmob = \%newmob;
 399   $newmob->{'ID'} = $self->{-db}->find_first_free('MOBILE','ID');
 400   my $newid = $newmob->{'ID'};
 401
 402   %$mob = (%$mob,%$diff);
 403   # print Dumper $mob; exit;
 404   # %$newmob = (%$oldmob, %$newmob);
 405
 406   # calculate new count and available
 407   $mob->{'COUNT'} = $count;
 408   $mob->{'AVAILABLE'} = $available ? 'Y' : 'N';
 409
 410   my $id = $mob->{'ID'};
 411   delete $mob->{'ID'};
 412   # print Dumper $mob;
 413   $self->{-db}->update_hash('MOBILE',"ID=$id",$mob);
 414   Util::log("mobile $id updated",1);
 415
 416   # reduce count of old one
 417   $newmob->{'COUNT'} -= $count;
 418
 419   # print Dumper $newmob;
 420   $self->{-db}->insert_hash('MOBILE',$newmob);
 421   Util::log("new mobile $newid",1);
 422
 423   return $newid;
 424 }
 425
 426 # this function splits a mobile if it necessary, update else.
 427 # usage of parameters: see split_mobile
 428 # returns the new ID of the old mob (see split_mobile)
 429 sub conditional_split_mobile{
 430   my ($self, $mob, $count, $diff, $available) = @_;
 431
 432   # print "count: $count\n";
 433   # print Dumper $mob;
 434
 435   my $db = $self->{-db};
 436
 437   # split it, if neccessary
 438   if($count < $mob->{'COUNT'}){
 439
 440     return $self->split_mobile($mob,$count,$diff,$available);
 441
 442   }elsif($count == $mob->{'COUNT'}){
 443     $diff->{'AVAILABLE'} = $available ? 'Y' : 'N';
 444     $db->update_hash('MOBILE',
 445                      "ID=$mob->{'ID'}",
 446                      $diff);
 447     return $mob->{'ID'};
 448   }else{
 449     Util::log("SPLIT MOBILE: Error! impossible case. not enough mobiles. ".
 450               "we need $count and have only $mob->{'COUNT'}",0);
 451     return 0;
 452   }
 453 }
 454
 455 sub event{
 456   my ($self, $loc, $tag, @args) = @_;
 457
 458   # read execution time
 459   my $exec_time = $self->getPhase2exec();
 460
 461   unless($exec_time){
 462     my $cmd = $self->{-db}->single_hash_select('COMMAND',
 463                                                "ID=$self->{-dbhash}->{'ID'}");
 464     $exec_time = $cmd->{'EXEC'};
 465   }
 466
 467   my $event = {'TAG' => $tag,
 468                'LOCATION' => $loc,
 469                'GAME' => $self->{-game},
 470                'TIME' => $exec_time,
 471                'COMMAND_ID' => $self->{-dbhash}->{'ID'},
 472                };
 473   $event->{'ARG1'} = $self->{-context}->charname($self->{-player});
 474   for my $a (0..$#args){
 475     $event->{'ARG'.($a+2)} = $args[$a];
 476   }
 477   $self->{-db}->write_event($event);
 478 }
 479
 480 # this function re-inserts the same command in the queue again
 481 sub do_it_again{
 482   my ($self,$arguments) = @_;
 483
 484   my $now = $self->{-db}->now();
 485   # we need a new ID
 486   delete $self->{-dbhash}->{'ID'};
 487   # reset timestamps
 488   $self->{-dbhash}->{'SUBMIT'} = $now;
 489   $self->{-dbhash}->{'EXEC'} = $now;
 490   $self->{-dbhash}->{'ACK'} = 'NULL'; # TODO: wrong way to insert NULL?
 491   $self->{-dbhash}->{'DONE'} = 'NULL';
 492   if (defined $arguments){
 493     # these arguments are allready there in the database
 494     my $hash = $self->parse_args($self->{-dbhash}->{'ARGUMENTS'});
 495     # we put some additional ones into hash
 496     for my $k (keys %$arguments){
 497       $hash->{$k} = $arguments->{$k};
 498     }
 499     # rearrange hash into string
 500     my $new_string = '';
 501     my ($key,$value);
 502     while (($key,$value) = each %$hash){
 503       $new_string .= "$key=$value, ";
 504     }
 505     $new_string =~ s/, $//;
 506     $self->{-dbhash}->{'ARGUMENTS'} = $new_string;
 507   }
 508   # write new command to database
 509   $self->{-db}->insert_hash('COMMAND', $self->{-dbhash});
 510 }
 511
 512 1;