1 ##########################################################################
3 # Copyright (c) 2003 Aymargeddon Development Team
6 # "FROGS" = Framework for Realtime Online Games of Strategy
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)
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
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.
21 ###########################################################################
25 # basic command object used by the scheduler
27 use Date::Parse qw(str2time);
28 use Date::Calc qw(Time_to_Date);
30 use FROGS::Config qw ($conf);
31 require "$::conf->{-GAME_NAME}.pm";
37 my ($type, $dbhash, $dbobj) = @_;
39 Util::log("$type->new()",2);
41 my $self = {-dbhash => $dbhash,
43 -player => $dbhash->{'PLAYER'},
44 -game => $dbhash->{'GAME'},
45 -id => $dbhash->{'ID'},
46 -location => $dbhash->{'LOCATION'},
49 bless( $self, $type );
51 # create an GAME_NAME context object
52 $self->{-context} = $::conf->{-GAME_NAME}->new($dbhash->{'GAME'},
56 $self->{-speed} = $self->{-context}->get_speed();
59 if($self->{-speed} < 0){
60 Util::log("Game over, no commands anymore!",1);
65 # set language according to PLAYER.LANGUAGE
66 my ($lang) = $dbobj->read_player($self->{-player},'LANGUAGE');
67 $dbobj->set_language($lang);
69 $self->{-args} = $self->parse_args( $self->{-dbhash}->{'ARGUMENTS'} );
71 if (defined $self->{-dbhash}->{'ACK'} and
72 $self->{-dbhash}->{'ACK'} ne '0000-00-00 00:00:00'){
76 $self->{-duration} = $::conf->{-DURATION}->{"-$type"} || 0;
79 if(not $::conf->{-MESSAGE_IN_LOG} and $type eq 'SEND_MSG'){
82 my $logstring = "\nCommand $type (ID: $self->{-dbhash}->{'ID'}): ".
83 "Phase $self->{-phase}, ".
84 "Player $self->{-dbhash}->{'PLAYER'}, ".
85 "Game $self->{-dbhash}->{'GAME'}, ".
86 "Arguments $self->{-dbhash}->{'ARGUMENTS'}";
87 $logstring .= ", Location $self->{-dbhash}->{'LOCATION'}, "
88 if defined $self->{-dbhash}->{'LOCATION'};
89 Util::log($logstring,1);
96 my ($self, @required_args) = @_;
98 # all arguments avaiable?
99 # TODO PERFORMANCE: maybe this check only in phase1?
100 return 0 unless $self->required_args($self->{-args}, @required_args);
102 # does the player still exists?
103 if($self->{-player} == -1){
104 $self->{-role} = $self->{-context}->charname(-1);
106 my ($id,$role) = $self->{-context}->read_role($self->{-player},'PLAYER,ROLE');
107 if($id != $self->{-player}){
108 Util::log("COMMAND->is_valid: Player $self->{-player} does not exist!\n",0);
111 # set role for later use
112 # print "ROLE(is_valid): $role\n";
113 $self->{-role} = $role;
120 return 2 == $self->{-phase};
125 return 1 == $self->{-phase};
132 #if($self->{-speed} < 0){
137 # determine phase of command and do it.
138 if ($self->isFirst() ) {
139 $db->update_hash("COMMAND","ID = $self->{-dbhash}->{'ID'}",{ 'ACK' => $db->now() });
140 my $ret = $self->first_phase();
142 if ($self->getDuration() > 0 and $ret > 0) {
143 my $exec = $self->getPhase2exec();
144 if($self->{-end_of_game}){
147 $db->update_hash("COMMAND",
148 "ID = $self->{-dbhash}->{'ID'}",
149 { 'EXEC' => $exec });
151 }elsif ($self->getDuration() == 0 or $ret == 0){
154 # in this case the command has set its EXEC by itself. we do nothing
155 $self->done() if $self->{-end_of_game};
157 } elsif ($self->isSecond() ) {
158 $self->second_phase();
161 Util::log("command->execute ($self->{-class}) : Unknown or undefined Command phase",0);
167 # a command will use this func to declare it's terminated
168 # it is called by Scheduler after secondPhase anyway, so a
169 # command has to use it only explicitley in a member if it wants to
170 # terminate NOW! (but still have to exit action for itself)
174 my $id = $self->{-id};
176 $db->update_hash("COMMAND","ID = $id",{ 'DONE' => $db->now() });
177 if ($::conf->{-DEBUG} == 0 or $::conf->{-DELETE_OLD_COMMANDS}) {
178 $db->delete_from("COMMAND","ID=$id");
179 Util::log(ref($self)."-Command $id deleted.",1);
180 # TODO: dont delete PRODUCE-Command if game not runnning, but waiting
182 # TODO?: send messages
186 # sets the duration of the command in units. Sheduler will schedule
187 # the Phase 2 then for gametime+units*pace(game).
188 # this function will have to be called explicitely during phase 1 by the
189 # implementation of the command
190 # If it is not called at least once (or set to 0), Scheduler will assume the command has
191 # no second phase and will call done() after completion of firstPhase().
193 $self->{-duration} = shift;
197 # get command duration in units
199 return $self->{-duration};
202 sub getDurationInSec{
203 # get command duration in secs according to the *current* gamespeed
206 my $ret = $self->getDuration() * $self->{-speed};
208 Util::log("Duration in sec: $ret",1) unless defined $self->{-duration_logged};
209 $self->{-duration_logged} = 1;
211 $self->{-end_of_game} = 1 unless $ret >= 0;
216 # only valid during phase 1 returns start of phase 2 in game
217 # time, GMT (YYYY-MM-DD HH:MM:SS). If Duration wasn't set, or
218 # phase is wrong it returns undef.
220 if ($self->getDuration() == 0 || $self->isSecond() ) {
223 my $firstExecTimeUnix = &::str2time($self->{-dbhash}->{'EXEC'},'GMT');
224 # my $firstExecTimeUnix = &::str2time($self->{-dbhash}->{'EXEC'});
225 $firstExecTimeUnix += $self->getDurationInSec();
226 my ($year,$month,$day, $hour,$min,$sec) = &::Time_to_Date($firstExecTimeUnix);
227 return sprintf ("%04u-%02u-%02u %02u:%02u:%02u",$year,$month,$day, $hour,$min,$sec);
231 #############################################
233 # Tools to be used by concrete commands
236 # TODO: Bug mit messages
238 my ( $self, $arg_string ) = @_;
240 my @key_value_pairs = split /,/, $arg_string; # TODO: wrong for messages
242 # remove leading/trailing whitespace
243 @key_value_pairs = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } @key_value_pairs;
246 for my $kv (@key_value_pairs) {
247 my ( $k, $v ) = split /=/, $kv; # TODO: wrong for messages
249 # remove leading/trailing whitespace again
250 ( $k, $v ) = map { $_ =~ s/^\s*(\S*)\s*$/$1/; $_ } ( $k, $v );
254 # use Data::Dumper; print Dumper \%hash;
259 my ( $self, $args, @ra ) = @_;
262 unless ( exists $args->{$a} ) {
263 Util::log("We need argument $a",1);
272 # general testfunction.
273 # sends error message and return false
274 # unless &$cond() gives true
277 my ($self, $cond, $tag, @args) = @_;
280 # (@args) = $self->{-db}->quote_all(@args);
282 my $sendhash = {'MFROM' => 0,
284 # TODO: localize command-strings!
285 $sendhash->{'ARG1'} = $self->{-class};
286 for my $a (1..($#args+1)){
287 $sendhash->{"ARG$a"} = $args[$a-1];
290 $self->{-context}->send_message_to($self->{-player},$sendhash);
292 Util::log("Test failed: $tag, args @args",1);
300 # my ($self, @all) = @_;
302 # if($self->test_without_done(@all)){
305 # # delete me from database
311 # set a mobilehash if available, sends errormessage otherwise
313 my ($self,$mob_id) = @_;
315 my $mob = $self->{-db}->read_single_mobile($mob_id);
318 if($self->{-phase} == 1){
319 return 0 unless $self->test(sub {defined $mob},
320 'MSG_NO_SUCH_MOBILE',
323 $self->{-mob} = $mob;
327 # errormessage unless one of valid roles
329 my ($self, @valid_roles) = @_;
331 return 1 if $self->{-player} < 0;
333 Util::log("validate_role($self->{-role})",2);
335 unless(Util::is_in($self->{-role},@valid_roles)){
336 return 0 unless $self->test(sub {0},
344 sub validate_this_role{
345 my($self,$player,@valid_roles) = @_;
348 my $role = $self->{-role};
349 my ($id,$r) = $self->{-context}->read_role($player,'PLAYER,ROLE');
351 my $ret = $self->validate_role(@valid_roles);
352 $self->{-role} = $role;
353 return 0 unless $ret;
357 # takes a mobile_hash, a count and a diff_hash. creates another mobile
358 # with count members in the database with the different fields given
359 # in diff_hash. if $available, than the new mob is available
362 # ID of newmob (newmob is in some sense really the old mob, because
363 # diff is apllied to old mob) , returns the new ID (of the old mob).
366 my ($self, $mob, $count, $diff, $available) = @_;
367 my $db = $self->{-db};
368 Util::log(ref($self).": split mobile $mob->{'ID'}",1);
372 my $newmob = \%newmob;
373 $newmob->{'ID'} = $self->{-db}->find_first_free('MOBILE','ID');
374 my $newid = $newmob->{'ID'};
376 %$mob = (%$mob,%$diff);
377 # print Dumper $mob; exit;
378 # %$newmob = (%$oldmob, %$newmob);
380 # calculate new count and available
381 $mob->{'COUNT'} = $count;
382 $mob->{'AVAILABLE'} = $available ? 'Y' : 'N';
384 my $id = $mob->{'ID'};
387 $self->{-db}->update_hash('MOBILE',"ID=$id",$mob);
388 Util::log("mobile $id updated",1);
390 # reduce count of old one
391 $newmob->{'COUNT'} -= $count;
393 # print Dumper $newmob;
394 $self->{-db}->insert_hash('MOBILE',$newmob);
395 Util::log("new mobile $newid",1);
400 # this function splits a mobile if it necessary, update else.
401 # usage of parameters: see split_mobile
402 # returns the new ID of the old mob (see split_mobile)
403 sub conditional_split_mobile{
404 my ($self, $mob, $count, $diff, $available) = @_;
406 # print "count: $count\n";
409 my $db = $self->{-db};
411 # split it, if neccessary
412 if($count < $mob->{'COUNT'}){
414 return $self->split_mobile($mob,$count,$diff,$available);
416 }elsif($count == $mob->{'COUNT'}){
417 $diff->{'AVAILABLE'} = $available ? 'Y' : 'N';
418 $db->update_hash('MOBILE',
423 Util::log("SPLIT MOBILE: Error! impossible case. not enough mobiles. ".
424 "we need $count and have only $mob->{'COUNT'}",0);
430 my ($self, $loc, $tag, @args) = @_;
432 # read execution time
433 my $exec_time = $self->getPhase2exec();
436 my $cmd = $self->{-db}->single_hash_select('COMMAND',
437 "ID=$self->{-dbhash}->{'ID'}");
438 $exec_time = $cmd->{'EXEC'};
441 my $event = {'TAG' => $tag,
443 'GAME' => $self->{-game},
444 'TIME' => $exec_time,
445 'COMMAND_ID' => $self->{-dbhash}->{'ID'},
447 $event->{'ARG1'} = $self->{-context}->charname($self->{-player});
448 for my $a (0..$#args){
449 $event->{'ARG'.($a+2)} = $args[$a];
451 $self->{-db}->write_event($event);
454 # this function re-inserts the same command in the queue again
456 my ($self,$arguments) = @_;
458 my $now = $self->{-db}->now();
460 delete $self->{-dbhash}->{'ID'};
462 $self->{-dbhash}->{'SUBMIT'} = $now;
463 $self->{-dbhash}->{'EXEC'} = $now;
464 $self->{-dbhash}->{'ACK'} = 'NULL'; # TODO: wrong way to insert NULL?
465 $self->{-dbhash}->{'DONE'} = 'NULL';
466 if (defined $arguments){
467 # these arguments are allready there in the database
468 my $hash = $self->parse_args($self->{-dbhash}->{'ARGUMENTS'});
469 # we put some additional ones into hash
470 for my $k (keys %$arguments){
471 $hash->{$k} = $arguments->{$k};
473 # rearrange hash into string
476 while (($key,$value) = each %$hash){
477 $new_string .= "$key=$value, ";
479 $new_string =~ s/, $//;
480 $self->{-dbhash}->{'ARGUMENTS'} = $new_string;
482 # write new command to database
483 $self->{-db}->insert_hash('COMMAND', $self->{-dbhash});