src/FROGS/Game.pm

   1 #!/usr/bin/perl -w
   2 ##########################################################################
   3 #
   4 #   Copyright (c) 2003-2012 Aymargeddon Development Team
   5 #
   6 #   This file is part of "Last days of Aymargeddon" - a massive multi player
   7 #   onine game of strategy
   8 #
   9 #        This program is free software: you can redistribute it and/or modify
  10 #        it under the terms of the GNU Affero General Public License as
  11 #        published by the Free Software Foundation, either version 3 of the
  12 #        License, or (at your option) any later version.
  13 #
  14 #        This program is distributed in the hope that it will be useful,
  15 #        but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 #        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  17 #
  18 #    See the GNU Affero General Public License for more details.
  19 #
  20 #    You should have received a copy of the GNU Affero General Public License
  21 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  22 #
  23 ###########################################################################
  24 #
  25
  26 # generell Game-specific functions
  27 #
  28
  29 use strict;
  30 use FROGS::DataBase;
  31 use FROGS::Util;
  32
  33 package Game;
  34 use Data::Dumper;
  35
  36 sub new{
  37   my ($class,$game,$user,$db) = @_;
  38
  39   my $self = {};
  40
  41   # create database-object, if not given with call
  42   if (defined $db) {
  43     $self->{-db} = $db;
  44   } else {
  45     $self->{-db} = DataBase->new();
  46   }
  47   # $db->set_language($lang);
  48
  49   $self->{-game} = $game;
  50   $self->{-user} = $user;
  51
  52   bless($self,$class);
  53 }
  54
  55 sub insert_command{
  56   my ($self,$cmd,$args,$loc,$player,$exec) = @_;
  57   $player = $self->{-user} unless defined $player;
  58   my $db = $self->{-db};
  59
  60   my ($now) = $db->single_select("SELECT NOW()");
  61
  62   # insert MOBILE Argument in the database-field if any
  63   my $mobile = 0;
  64   if($args =~ /MOBILE\s*=\s*(\d+)/){
  65     $mobile = $1;
  66   }
  67
  68   my $hash = {'GAME' => $self->{-game},
  69               'SUBMIT' => $now,
  70               'PLAYER' => $player,
  71               'COMMAND' => $cmd,
  72               'ARGUMENTS' => $args,
  73               'MOBILE' => $mobile,
  74              };
  75   if(defined $exec){
  76     # insert a phase-2 command
  77     $hash->{'EXEC'} = $exec;
  78     $hash->{'ACK'} = $now;
  79   }else{
  80     $hash->{'EXEC'} = $now;
  81   }
  82   $hash->{'LOCATION'} = $loc if defined $loc;
  83   $db->insert_hash('COMMAND',$hash);
  84   Util::log("command inserted: $cmd, $args, $loc, $player",1);
  85 }
  86
  87 sub read_map{
  88   my ($self, $fields) = @_;
  89   # $fields should NOT be empty
  90   return $self->{-db}->select_array('MAP',"LOCATION,$fields","GAME=$self->{-game}");
  91 }
  92
  93 #
  94 # Message handling
  95 #
  96
  97 sub read_messages{
  98   my ($self, $fields) = @_;
  99   $fields = ','.$fields if $fields;
 100   $fields = 'ID'.$fields;
 101   my $cond = "GAME=$self->{-game} AND (MTO=0 OR MTO=$self->{-user})";
 102   return $self->{-db}->select_array('MESSAGE', $fields, $cond, 'TIME desc');
 103 }
 104
 105 # sends a raw text, if $hash is not a hash. if it is one, it generates
 106 # a tag with arguments usable by DataBase::long_loc()
 107 sub send_message_to{
 108   my($self,$user,$hash) = @_;
 109
 110   $hash->{'MTO'} = $user;
 111   $hash->{'GAME'} = $self->{-game};
 112
 113   $self->{-db}->send_message($hash);
 114
 115 }
 116
 117 sub send_message_to_me{
 118   my ($self,$hash) = @_;
 119
 120   $self->send_message_to($self->{-user},$hash);
 121 }
 122
 123 sub send_message_to_list{
 124   my ($self,$msg_hash,@list) = @_;
 125
 126   Util::log("send_message_to_list(@list)",2);
 127
 128   for my $user (@list) {
 129     my %copy = (%$msg_hash);
 130     $self->send_message_to($user,\%copy);
 131   }
 132 }
 133
 134 sub send_message_to_all{
 135   my ($self,$hash) = @_;
 136
 137   my @roles = $self->get_all_roles();
 138   $self->send_message_to_list($hash,@roles);
 139 }
 140
 141 sub show_message{
 142   my ($self,$id) = @_;
 143
 144   my ($time, $from, $text, @args) = $self->{-db}->read_message($id);
 145
 146   my $other = $from;
 147   # lookup sender
 148   $from = $from == 0 ? "Server" : $self->charname($from);
 149
 150   my $return = "<strong>$from $time:</strong> $text";
 151   $return .= ' <a href="player.epl?cmd=SEND_MSG&other='.$other
 152     .'">reply</a>' unless $other == 0;
 153   return $return;
 154 }
 155
 156 sub delete_all_messages{
 157   my ($self,$time) = @_;
 158   # $::conf->{-EPL_DEBUG} = 2;
 159   # print "time: $time<p>";
 160   $self->{-db}->delete_from('MESSAGE',"GAME=$self->{-game} AND MTO=$self->{-user}".
 161                             " AND TIME < '$time'");
 162   # $::conf->{-EPL_DEBUG} = 0;
 163 }
 164
 165 # send message to all players, who see this field
 166 sub send_message_to_field{
 167   my($self,$loc,$hash) = @_;
 168
 169   return unless $::conf->{-SEND_MESSAGE_TO_FIELD};
 170
 171   my @players = $self->player_see_field($loc);
 172   $self->send_message_to_list($hash,@players);
 173 }
 174
 175 #
 176 # events
 177 #
 178
 179 # returns a ref to a list of Event-IDs for a role
 180 # it includes all game-events and all events on locations seen by the role
 181 # TODO: accept additional parameter N to return the N newest events
 182 sub role_events{
 183   my $self = shift;
 184
 185   my $db = $self->{-db};
 186   my @loc = $self->seen_locations();
 187
 188   my $k = $db->select_hash('EVENT','LOCATION','ID',"GAME=$self->{-game}");
 189
 190   my @ret = ();
 191   for my $l (@loc) {
 192     push @ret, $k->{$l}    if (defined $k->{$l});
 193
 194   }
 195   # print "@ret";
 196   return \@ret;
 197 }
 198 # returns a ref to a list of Event-IDs for a field
 199 # it includes all events on locations
 200 sub field_events{
 201   my ($self, $loc) = @_;
 202   my $db = $self->{-db};
 203   my $qloc = $db->quote($loc);
 204   return $db->select_hash('EVENT','ID',0,"GAME=$self->{-game} AND LOCATION=$qloc");
 205 }
 206
 207 sub show_event{
 208   my ($self, $id, $show_field) = @_;
 209
 210   $show_field = 1 unless defined $show_field and $show_field == 0;
 211
 212   my ($from, $time, $text, @args) = $self->{-db}->read_event($id);
 213
 214   # lookup sender
 215   if ($from != 'Game') {
 216     $from = '<a href ="mapframe.epl?field='.$from.'">'."$from</a>";
 217   }
 218
 219
 220   $time = $self->{-db}->relative($time);
 221   $from = "" unless $show_field;
 222   return "<strong>$from $time:</strong> $text";
 223 }
 224
 225 sub search_event{
 226   my ($self,$tag,$location) = @_;
 227
 228   $tag = 'EVENT_' . $tag;
 229   ($tag,$location) = $self->{-db}->quote_all($tag,$location);
 230   return $self->{-db}->single_hash_select('EVENT',"TAG=$tag and LOCATION=$location");
 231 }
 232
 233 #
 234 #
 235 #
 236
 237 # Should be overloaded by derived class
 238 sub seen_locations{
 239   my ($self) = @_;
 240   return ();
 241 }
 242
 243 sub read_field{
 244   my ($self,$field,$loc) = @_;
 245   $loc = $self->{-db}->quote($loc);
 246   my $stmt = "SELECT $field from MAP where GAME=$self->{-game} AND LOCATION=$loc";
 247   return $self->{-db}->single_select($stmt);
 248 }
 249
 250 sub read_player_relations{
 251   my ($self, $user) = @_;
 252   $user = $self->{-user} unless defined $user;
 253
 254   # print "user: $user\n";
 255   my $r = $self->{-db}->select_hash('ALLIANCE', 'OTHER', 'STATUS',
 256                                     "GAME=$self->{-game} AND PLAYER=$user");
 257   # print Dumper $r;
 258   return $r;
 259 }
 260
 261 sub read_single_relation{
 262   my ($self,$me,$you) = @_;
 263   my $hash = $self->{-db}->single_hash_select('ALLIANCE',
 264                                               "GAME=$self->{-game} AND ".
 265                                               "PLAYER=$me AND ".
 266                                               "OTHER=$you");
 267   my $ret = $hash->{'STATUS'};
 268   return $ret ? $ret : 'NEUTRAL';
 269 }
 270
 271
 272 sub reverse_player_relations{
 273   my ($self) = @_;
 274   return $self->{-db}->select_hash('ALLIANCE', 'PLAYER', 'STATUS',
 275                                    "GAME=$self->{-game} AND OTHER=$self->{-user}");
 276 }
 277
 278 sub read_mobile {
 279   my ($self,$fields,$type,$loc,$only_available) = @_;
 280   $only_available = 0 unless defined $only_available;
 281   #  print "read_mobile($fields,$type,$loc,$only_available)\n";
 282   my $cond = "GAME=$self->{-game} AND LOCATION=$loc";
 283   if ($only_available > 0) {
 284     $cond .= " AND AVAILABLE=Y";
 285   } elsif ($only_available < 0) {
 286     $cond .= " AND AVAILABLE=N";
 287   }
 288   $cond .= " AND TYPE=$type" if $type;
 289   return $self->{-db}->select_array('MOBILE', $fields, $cond);
 290 }
 291
 292 sub read_mobile_condition{
 293   my ($self,$fields,$cond,$loc) = @_;
 294   $cond = "GAME=$self->{-game} AND $cond";
 295   $cond .= " AND LOCATION=$loc" if defined $loc;
 296   $self->{-db}->select_array('MOBILE',$fields,$cond);
 297 }
 298
 299 # counts available mobiles of TYPE and OWNER (or all owners) in LOCATION
 300 # TODO: we can do this in SQL with "select sum(COUNT) from MOBILE where ..."
 301 sub count_mobile{
 302   my ($self,$type,$loc,$owner) = @_;
 303
 304   my $mobs = $self->read_mobile('COUNT,OWNER',$type,$loc,1);
 305   my $count = 0;
 306   for my $mob (@$mobs) {
 307     my $nr = $mob->[0];
 308     if (defined $owner) {
 309       $count += $nr if $mob->[1] == $owner;
 310     } else {
 311       $count += $nr;
 312     }
 313   }
 314   return $count;
 315 }
 316
 317 # count all people in $loc from $player
 318 sub count_people{
 319   my($self,$loc,$player) = @_;
 320   $player = $self->{-user} unless defined $player;
 321
 322   my $cond =  $self->{-db}->quote_condition("GAME=$self->{-game} ".
 323                                             "AND OWNER=$player ".
 324                                             "AND AVAILABLE=Y ".
 325                                             "AND LOCATION=$loc");
 326   my $stmt = "select sum(COUNT) from MOBILE where $cond";
 327   my ($ret) = $self->{-db}->single_select($stmt);
 328   return $ret;
 329 }
 330   # stupid, GAME not necessary: ID is unique between different games
 331 sub get_mobile_info {
 332   my ($self, $mob_id, $fields) = @_;
 333   my $stmt = "SELECT $fields from MOBILE where GAME=$self->{-game} AND ID=$mob_id";
 334   return $self->{-db}->single_select($stmt);
 335 }
 336
 337 # WARNING: in Aymargeddon, this is overloaded in Aymargeddon.pm
 338 sub own_in_mobile{
 339   my($self,$loc,$player,$active) = @_;
 340   # $loc = $self->{-db}->quote($loc);
 341   my $cond = "GAME=$self->{-game} AND LOCATION=$loc".
 342     " AND (OWNER=$player OR ADORING=$player)";
 343   if (defined $active) {
 344     # my $y = $self->{-db}->quote('Y');
 345     $cond .= " AND AVAILABLE=Y";
 346   }
 347   return $self->{-db}->select_array('MOBILE','ID',$cond);
 348 }
 349
 350 sub read_role{
 351   my ($self,$player,$field) = @_;
 352   my $stmt = "SELECT $field from ROLE where GAME=$self->{-game} AND PLAYER=$player";
 353   return $self->{-db}->single_select($stmt);
 354 }
 355
 356 sub get_all_roles{
 357   my ($self,$role) = @_;
 358
 359   my $cond = "GAME=$self->{-game}";
 360   if (defined $role) {
 361     # $role = $self->{-db}->quote($role);
 362     $cond .= " AND ROLE=$role";
 363   }
 364   my @roles = @{$self->{-db}->select_array('ROLE','PLAYER',$cond)};
 365   for my $i (0..$#roles) {
 366     $roles[$i] = $roles[$i]->[0];
 367   }
 368   return @roles;
 369 }
 370
 371 sub get_speed {
 372   my $self = shift;
 373   my ($ret,$run) =  $self->{-db}->single_select("select SPEED, RUNNING from GAME".
 374                                                 " where GAME = $self->{-game} ");
 375   return $run eq 'Y' ? $ret : - $ret;
 376 }
 377
 378 sub charname{
 379   my ($self,$player,$do) = @_;
 380   return $self->{-db}->loc('UNASSIGNED') if $player < 1;
 381   my @list = $self->read_role($player, 'NICKNAME');
 382   return $list[0];
 383 }
 384
 385 sub role{
 386   my ($self,$player) = @_;
 387   return 'OBSERVER' if $player < 1;
 388   my @role = $self->read_role($player, 'ROLE');
 389   return $role[0];
 390 }
 391
 392 1;