1 ##########################################################################
3 # Copyright (c) 2003-2012 Aymargeddon Development Team
5 # This file is part of "Last days of Aymargeddon" - a massive multi player
6 # online 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
186 # returns a hash with all data wich is affected from the command
190 my $aff = $self->{-affected};
191 for my $field (@{$aff->{-fields}}){
192 #TODO? build field data
198 # returns a JSON-Object with all new infos which should displayd from client
199 sub first_phase_ajax{
202 my $ret = $self->first_phase();
203 #TODO: which part of the logic in execute() is needed here?
205 my $aff = $self->affected();
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().
219 $self->{-duration} = shift;
223 # get command duration in units
225 return $self->{-duration};
228 sub getDurationInSec{
229 # get command duration in secs according to the *current* gamespeed
232 my $ret = $self->getDuration() * $self->{-speed};
234 Util::log("Duration in sec: $ret",1) unless defined $self->{-duration_logged};
235 $self->{-duration_logged} = 1;
237 $self->{-end_of_game} = 1 unless $ret >= 0;
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.
246 if ($self->getDuration() == 0 || $self->isSecond() ) {
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);
257 #############################################
259 # Tools to be used by concrete commands
262 # TODO: Bug mit messages
264 my ( $self, $arg_string ) = @_;
266 my @key_value_pairs = split /,/, $arg_string; # TODO: wrong for messages
268 # remove leading/trailing whitespace
269 @key_value_pairs = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } @key_value_pairs;
272 for my $kv (@key_value_pairs) {
273 my ( $k, $v ) = split /=/, $kv; # TODO: wrong for messages
275 # remove leading/trailing whitespace again
276 ( $k, $v ) = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } ( $k, $v );
280 # use Data::Dumper; print Dumper \%hash;
285 my ( $self, $args, @ra ) = @_;
288 unless ( exists $args->{$a} ) {
289 Util::log("We need argument $a",1);
298 # general testfunction.
299 # sends error message and return false
300 # unless &$cond() gives true
303 my ($self, $cond, $tag, @args) = @_;
306 # (@args) = $self->{-db}->quote_all(@args);
308 my $sendhash = {'MFROM' => 0,
310 # TODO: localize command-strings!
311 $sendhash->{'ARG1'} = $self->{-class};
312 for my $a (1..($#args+1)){
313 $sendhash->{"ARG$a"} = $args[$a-1];
316 $self->{-context}->send_message_to($self->{-player},$sendhash);
318 Util::log("Test failed: $tag, args @args",1);
326 # my ($self, @all) = @_;
328 # if($self->test_without_done(@all)){
331 # # delete me from database
337 # set a mobilehash if available, sends errormessage otherwise
339 my ($self,$mob_id) = @_;
341 my $mob = $self->{-db}->read_single_mobile($mob_id);
344 if($self->{-phase} == 1){
345 return 0 unless $self->test(sub {defined $mob},
346 'MSG_NO_SUCH_MOBILE',
349 $self->{-mob} = $mob;
353 # errormessage unless one of valid roles
355 my ($self, @valid_roles) = @_;
357 return 1 if $self->{-player} < 0;
359 Util::log("validate_role($self->{-role})",2);
361 unless(Util::is_in($self->{-role},@valid_roles)){
362 return 0 unless $self->test(sub {0},
370 sub validate_this_role{
371 my($self,$player,@valid_roles) = @_;
374 my $role = $self->{-role};
375 my ($id,$r) = $self->{-context}->read_role($player,'PLAYER,ROLE');
377 my $ret = $self->validate_role(@valid_roles);
378 $self->{-role} = $role;
379 return 0 unless $ret;
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
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).
392 my ($self, $mob, $count, $diff, $available) = @_;
393 my $db = $self->{-db};
394 Util::log(ref($self).": split mobile $mob->{'ID'}",1);
398 my $newmob = \%newmob;
399 $newmob->{'ID'} = $self->{-db}->find_first_free('MOBILE','ID');
400 my $newid = $newmob->{'ID'};
402 %$mob = (%$mob,%$diff);
403 # print Dumper $mob; exit;
404 # %$newmob = (%$oldmob, %$newmob);
406 # calculate new count and available
407 $mob->{'COUNT'} = $count;
408 $mob->{'AVAILABLE'} = $available ? 'Y' : 'N';
410 my $id = $mob->{'ID'};
413 $self->{-db}->update_hash('MOBILE',"ID=$id",$mob);
414 Util::log("mobile $id updated",1);
416 # reduce count of old one
417 $newmob->{'COUNT'} -= $count;
419 # print Dumper $newmob;
420 $self->{-db}->insert_hash('MOBILE',$newmob);
421 Util::log("new mobile $newid",1);
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) = @_;
432 # print "count: $count\n";
435 my $db = $self->{-db};
437 # split it, if neccessary
438 if($count < $mob->{'COUNT'}){
440 return $self->split_mobile($mob,$count,$diff,$available);
442 }elsif($count == $mob->{'COUNT'}){
443 $diff->{'AVAILABLE'} = $available ? 'Y' : 'N';
444 $db->update_hash('MOBILE',
449 Util::log("SPLIT MOBILE: Error! impossible case. not enough mobiles. ".
450 "we need $count and have only $mob->{'COUNT'}",0);
456 my ($self, $loc, $tag, @args) = @_;
458 # read execution time
459 my $exec_time = $self->getPhase2exec();
462 my $cmd = $self->{-db}->single_hash_select('COMMAND',
463 "ID=$self->{-dbhash}->{'ID'}");
464 $exec_time = $cmd->{'EXEC'};
467 my $event = {'TAG' => $tag,
469 'GAME' => $self->{-game},
470 'TIME' => $exec_time,
471 'COMMAND_ID' => $self->{-dbhash}->{'ID'},
473 $event->{'ARG1'} = $self->{-context}->charname($self->{-player});
474 for my $a (0..$#args){
475 $event->{'ARG'.($a+2)} = $args[$a];
477 $self->{-db}->write_event($event);
480 # this function re-inserts the same command in the queue again
482 my ($self,$arguments) = @_;
484 my $now = $self->{-db}->now();
486 delete $self->{-dbhash}->{'ID'};
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};
499 # rearrange hash into string
502 while (($key,$value) = each %$hash){
503 $new_string .= "$key=$value, ";
505 $new_string =~ s/, $//;
506 $self->{-dbhash}->{'ARGUMENTS'} = $new_string;
508 # write new command to database
509 $self->{-db}->insert_hash('COMMAND', $self->{-dbhash});