src/FROGS/Game.pm

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