1 ##########################################################################
3 # Copyright (c) 2003-2012 Aymargeddon Development Team
5 # This file is part of "Last days of Aymargeddon" - a massive multi player
6 # onine game of strategy
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.
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.
17 # See the GNU Affero General Public License for more details.
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/>.
22 ###########################################################################
26 # basic command object used by the scheduler
28 use Date::Parse qw(str2time);
29 use Date::Calc qw(Time_to_Date);
31 use FROGS::Config qw ($conf);
32 require "$::conf->{-GAME_NAME}.pm";
38 my ($type, $dbhash, $dbobj) = @_;
40 Util::log("$type->new()",2);
42 my $self = {-dbhash => $dbhash,
44 -player => $dbhash->{'PLAYER'},
45 -game => $dbhash->{'GAME'},
46 -id => $dbhash->{'ID'},
47 -location => $dbhash->{'LOCATION'},
50 bless( $self, $type );
52 # create an GAME_NAME context object
53 $self->{-context} = $::conf->{-GAME_NAME}->new($dbhash->{'GAME'},
57 $self->{-speed} = $self->{-context}->get_speed();
60 if($self->{-speed} < 0){
61 Util::log("Game over, no commands anymore!",1);
66 # set language according to PLAYER.LANGUAGE
67 my ($lang) = $dbobj->read_player($self->{-player},'LANGUAGE');
68 $dbobj->set_language($lang);
70 $self->{-args} = $self->parse_args( $self->{-dbhash}->{'ARGUMENTS'} );
72 if (defined $self->{-dbhash}->{'ACK'} and
73 $self->{-dbhash}->{'ACK'} ne '0000-00-00 00:00:00'){
77 $self->{-duration} = $::conf->{-DURATION}->{"-$type"} || 0;
80 if(not $::conf->{-MESSAGE_IN_LOG} and $type eq 'SEND_MSG'){
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);
97 my ($self, @required_args) = @_;
99 # all arguments avaiable?
100 # TODO PERFORMANCE: maybe this check only in phase1?
101 return 0 unless $self->required_args($self->{-args}, @required_args);
103 # does the player still exists?
104 if($self->{-player} == -1){
105 $self->{-role} = $self->{-context}->charname(-1);
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);
112 # set role for later use
113 # print "ROLE(is_valid): $role\n";
114 $self->{-role} = $role;
121 return 2 == $self->{-phase};
126 return 1 == $self->{-phase};
133 #if($self->{-speed} < 0){
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();
143 if ($self->getDuration() > 0 and $ret > 0) {
144 my $exec = $self->getPhase2exec();
145 if($self->{-end_of_game}){
148 $db->update_hash("COMMAND",
149 "ID = $self->{-dbhash}->{'ID'}",
150 { 'EXEC' => $exec });
152 }elsif ($self->getDuration() == 0 or $ret == 0){
155 # in this case the command has set its EXEC by itself. we do nothing
156 $self->done() if $self->{-end_of_game};
158 } elsif ($self->isSecond() ) {
159 $self->second_phase();
162 Util::log("command->execute ($self->{-class}) : Unknown or undefined Command phase",0);
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)
175 my $id = $self->{-id};
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
183 # TODO?: send messages
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().
194 $self->{-duration} = shift;
198 # get command duration in units
200 return $self->{-duration};
203 sub getDurationInSec{
204 # get command duration in secs according to the *current* gamespeed
207 my $ret = $self->getDuration() * $self->{-speed};
209 Util::log("Duration in sec: $ret",1) unless defined $self->{-duration_logged};
210 $self->{-duration_logged} = 1;
212 $self->{-end_of_game} = 1 unless $ret >= 0;
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.
221 if ($self->getDuration() == 0 || $self->isSecond() ) {
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);
232 #############################################
234 # Tools to be used by concrete commands
237 # TODO: Bug mit messages
239 my ( $self, $arg_string ) = @_;
241 my @key_value_pairs = split /,/, $arg_string; # TODO: wrong for messages
243 # remove leading/trailing whitespace
244 @key_value_pairs = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } @key_value_pairs;
247 for my $kv (@key_value_pairs) {
248 my ( $k, $v ) = split /=/, $kv; # TODO: wrong for messages
250 # remove leading/trailing whitespace again
251 ( $k, $v ) = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } ( $k, $v );
255 # use Data::Dumper; print Dumper \%hash;
260 my ( $self, $args, @ra ) = @_;
263 unless ( exists $args->{$a} ) {
264 Util::log("We need argument $a",1);
273 # general testfunction.
274 # sends error message and return false
275 # unless &$cond() gives true
278 my ($self, $cond, $tag, @args) = @_;
281 # (@args) = $self->{-db}->quote_all(@args);
283 my $sendhash = {'MFROM' => 0,
285 # TODO: localize command-strings!
286 $sendhash->{'ARG1'} = $self->{-class};
287 for my $a (1..($#args+1)){
288 $sendhash->{"ARG$a"} = $args[$a-1];
291 $self->{-context}->send_message_to($self->{-player},$sendhash);
293 Util::log("Test failed: $tag, args @args",1);
301 # my ($self, @all) = @_;
303 # if($self->test_without_done(@all)){
306 # # delete me from database
312 # set a mobilehash if available, sends errormessage otherwise
314 my ($self,$mob_id) = @_;
316 my $mob = $self->{-db}->read_single_mobile($mob_id);
319 if($self->{-phase} == 1){
320 return 0 unless $self->test(sub {defined $mob},
321 'MSG_NO_SUCH_MOBILE',
324 $self->{-mob} = $mob;
328 # errormessage unless one of valid roles
330 my ($self, @valid_roles) = @_;
332 return 1 if $self->{-player} < 0;
334 Util::log("validate_role($self->{-role})",2);
336 unless(Util::is_in($self->{-role},@valid_roles)){
337 return 0 unless $self->test(sub {0},
345 sub validate_this_role{
346 my($self,$player,@valid_roles) = @_;
349 my $role = $self->{-role};
350 my ($id,$r) = $self->{-context}->read_role($player,'PLAYER,ROLE');
352 my $ret = $self->validate_role(@valid_roles);
353 $self->{-role} = $role;
354 return 0 unless $ret;
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
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).
367 my ($self, $mob, $count, $diff, $available) = @_;
368 my $db = $self->{-db};
369 Util::log(ref($self).": split mobile $mob->{'ID'}",1);
373 my $newmob = \%newmob;
374 $newmob->{'ID'} = $self->{-db}->find_first_free('MOBILE','ID');
375 my $newid = $newmob->{'ID'};
377 %$mob = (%$mob,%$diff);
378 # print Dumper $mob; exit;
379 # %$newmob = (%$oldmob, %$newmob);
381 # calculate new count and available
382 $mob->{'COUNT'} = $count;
383 $mob->{'AVAILABLE'} = $available ? 'Y' : 'N';
385 my $id = $mob->{'ID'};
388 $self->{-db}->update_hash('MOBILE',"ID=$id",$mob);
389 Util::log("mobile $id updated",1);
391 # reduce count of old one
392 $newmob->{'COUNT'} -= $count;
394 # print Dumper $newmob;
395 $self->{-db}->insert_hash('MOBILE',$newmob);
396 Util::log("new mobile $newid",1);
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) = @_;
407 # print "count: $count\n";
410 my $db = $self->{-db};
412 # split it, if neccessary
413 if($count < $mob->{'COUNT'}){
415 return $self->split_mobile($mob,$count,$diff,$available);
417 }elsif($count == $mob->{'COUNT'}){
418 $diff->{'AVAILABLE'} = $available ? 'Y' : 'N';
419 $db->update_hash('MOBILE',
424 Util::log("SPLIT MOBILE: Error! impossible case. not enough mobiles. ".
425 "we need $count and have only $mob->{'COUNT'}",0);
431 my ($self, $loc, $tag, @args) = @_;
433 # read execution time
434 my $exec_time = $self->getPhase2exec();
437 my $cmd = $self->{-db}->single_hash_select('COMMAND',
438 "ID=$self->{-dbhash}->{'ID'}");
439 $exec_time = $cmd->{'EXEC'};
442 my $event = {'TAG' => $tag,
444 'GAME' => $self->{-game},
445 'TIME' => $exec_time,
446 'COMMAND_ID' => $self->{-dbhash}->{'ID'},
448 $event->{'ARG1'} = $self->{-context}->charname($self->{-player});
449 for my $a (0..$#args){
450 $event->{'ARG'.($a+2)} = $args[$a];
452 $self->{-db}->write_event($event);
455 # this function re-inserts the same command in the queue again
457 my ($self,$arguments) = @_;
459 my $now = $self->{-db}->now();
461 delete $self->{-dbhash}->{'ID'};
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};
474 # rearrange hash into string
477 while (($key,$value) = each %$hash){
478 $new_string .= "$key=$value, ";
480 $new_string =~ s/, $//;
481 $self->{-dbhash}->{'ARGUMENTS'} = $new_string;
483 # write new command to database
484 $self->{-db}->insert_hash('COMMAND', $self->{-dbhash});