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 # Generell database methods are gathered here.
30 use FROGS::Config qw($conf);
32 use Date::Parse qw(str2time);
33 use Date::Calc qw(Time_to_Date Delta_DHMS);
37 # the constructor connects to the DB
39 my ($class,$dbh) = @_;
44 $self->{-dbh} = DBI->connect("dbi:$::conf->{-DB_SOURCE}",
46 $::conf->{-DB_PASSWD},
47 {'RaiseError' => 1, 'AutoCommit' => 0}
50 #TODO: should specify iso date and time format explicitly for the session!!
52 $self->{-lang} = $self->{-dbh}->quote($::conf->{-DEFAULT_LANGUAGE});
59 unless(defined $self->{-nowrite}){
60 $self->{-dbh}->commit();
61 Util::log('committed.',2);
67 Util::log("DataBase: nowrite activated!",1);
68 $self->{-nowrite} = 1;
71 # automaticly called destructor
74 $self->{-dbh}->disconnect();
77 # wrapper for database functions:
80 my ($self, $text) = @_;
81 return $self->{-dbh}->quote($text);
85 my ($self, @plain) = @_;
88 push @quoted, $self->{-dbh}->quote($s);
93 # this does not support any possible SQL-conditions
95 # TODO: this function is really ugly :-(
96 # TODO: just use an escape-character in calls to mark, which fields should be
99 my ($self, $cond) = @_;
101 Util::log("condition: $cond",2);
103 my @bracket = ('(',')');
104 my @bool = ('AND', 'OR');
105 my @ops = ('=', '!=');
106 my @noops = ('<'); # forbidden substrings of pairs. ugly workaround for "time < now()"
108 # split string at boolean operators
109 my $splitstring = '';
110 for my $bool (@bool){
111 $splitstring .= '\b'.$bool.'\b|';
113 $splitstring =~ s/(.*)\|/$1/;
115 #Util::log("splitstring: $splitstring\n",2);
117 my @pairs = split /\s$splitstring\s/, $cond;
119 Util::log("pairs: @pairs",2);
125 $opstring =~ s/(.*)\|/$1/;
129 $noopstring .= "$no|";
131 $noopstring =~ s/(.*)\|/$1/;
133 # quote right hand of operator if necessary
134 for my $pair (@pairs){
135 next if $pair =~ /$noopstring/;
136 my ($left,$right) = split /$opstring/, $pair;
137 #Util::log("1 left: $left, right: $right",2);
138 $right =~ s/^\(*-?([\w\s].*)$/$1/; # remove leading brackets
139 #Util::log("2 left: $left, right: $right",2);
140 $right =~ s/-?(.*[\w\s])\)*$/$1/; # remove trailing brackets
141 #Util::log("3 left: $left, right: $right",2);
142 $right =~ s/^\s*-?(\S.*)/$1/; # remove leading whitespace
143 #Util::log("4 left: $left, right: $right",2);
144 $right =~ s/(.*\S)\s*$/$1/; # remove trailing whitespace
145 #Util::log("5 left: $left, right: $right",2);
147 next if $right =~ /^\d+$/;
148 # this could be misfunctional in some SQL-Dialect. We assume single-quotes
149 my $qright = ($right =~ /^\'.*\'/) ? $right : $self->quote($right);
151 # Util::log("qright: $qright",2);
152 next if $cond =~ /$qright/;
153 $cond =~ s/($opstring\s*)$right/$1$qright/;
155 Util::log("new condition: $cond",2);
159 # assumes that a single row is returned from database
160 # returns a list of selected columns
162 my ($self,$stmt) = @_;
164 Util::log("single_select: $stmt",2);
165 my $dat = $self->{-dbh}->selectall_arrayref($stmt);
166 return () if not defined $dat or not defined $dat->[0];
170 sub single_hash_select{
171 my ($self,$table,$cond) = @_;
173 $cond = $self->quote_condition($cond);
174 my $stmt = "SELECT * FROM $table where $cond";
175 Util::log("single_hash_select: $stmt",2);
176 return $self->{-dbh}->selectrow_hashref($stmt);
180 my ($self, $table, $key, $fields, $cond) = @_;
182 my $stmt = $fields ? "SELECT $key, $fields FROM $table"
183 : "SELECT $key FROM $table";
184 $stmt .= " WHERE $cond" if $cond;
185 return $self->{-dbh}->selectall_hashref($stmt, $key);
189 my ($self, $table, $fields, $cond, $order) = @_;
190 my $stmt = "SELECT $fields FROM $table";
192 $cond = $self->quote_condition($cond);
193 $stmt .= " WHERE $cond";
195 $stmt .= " ORDER BY $order";
199 Util::log("select_array: $stmt",2);
200 return $self->{-dbh}->selectall_arrayref($stmt);
203 # returns number of fields with given condition
205 my ($self, $table, $cond) = @_;
206 my $array = $self->select_array($table,'*',$cond);
209 Util::log("counted $cond in $table: $count",1);
213 # insert a row in one table of the database
216 # table: the database-table we work on
217 # hash: give here a hash with the new values
218 # noquote: if hash, than dont quote all keys which are in this hash,
219 # if no hash but defined, than we dont quote all the new values
220 # (useful for things simmilar to COUNT = COUNT + 1)
222 my ($self, $table, $hash,$noquote) = @_;
223 my $noquote_type = ref($noquote);
224 my $noquote_global = 1 if defined $noquote and not $noquote_type eq 'HASH';
225 my $noquote_hash = 1 if $noquote_type eq 'HASH';
227 my $insert = "INSERT INTO $table (";
228 for my $key (keys %$hash){
229 # $key = $self->{-dbh}->quote_identifier($key);
233 $insert .=") VALUES (";
234 while( my ($k,$val) = each %$hash){
235 $val = $self->quote($val) if not $noquote_global or
236 ($noquote_hash and exists $noquote->{$k});
242 Util::log("INSERT: $insert",2);
243 my $h = $self->{-dbh}->prepare($insert);
248 # parameter: see insert_hash() and update_hash()
249 sub insert_or_update_hash{
250 my ($self, $table, $cond, $hash, $noquote) = @_;
251 $cond = $self->quote_condition($cond);
252 my @row = $self->single_select("SELECT * FROM $table WHERE $cond");
255 $self->update_hash($table,$cond,$hash,$noquote);
257 $self->insert_hash($table,$hash,$noquote);
261 # update a set of rows in one table of the database
264 # table: the database-table we work on
265 # cond: only rows are effected, which evaluates this condition as true
266 # hash: give here a hash with the new values
267 # noquote: if hash, than dont quote all keys which are in this hash,
268 # if no hash but defined, than we dont quote all the new values
269 # (useful for things simmilar to COUNT = COUNT + 1)
271 my ($self, $table, $cond, $hash, $noquote) = @_;
272 my $noquote_type = ref($noquote);
273 my $noquote_global = 1 if defined $noquote and not $noquote_type eq 'HASH';
274 my $noquote_hash = 1 if $noquote_type eq 'HASH';
276 my $stmt = "UPDATE $table SET ";
277 while( my ($k,$v) = each %$hash){
278 $v = $self->quote($v) if not $noquote_global or
279 ($noquote_hash and exists $noquote->{$k});
284 $stmt .= " WHERE ". $self->quote_condition($cond);
286 Util::log("update_hash: $stmt",2);
287 my $h = $self->{-dbh}->prepare($stmt);
293 my ($self,$table,$cond) = @_;
295 die "do you really want to delete a complete table?" unless $cond;
297 my $sql = "DELETE FROM $table";
299 $cond = $self->quote_condition($cond);
300 $sql .= " WHERE $cond";
303 my $dbh = $self->{-dbh};
304 my $h = $dbh->prepare($sql);
310 my ($self,$table,$field) = @_;
312 my $t = $self->select_array($table, $field);
313 my @ids = sort {$a <=> $b} (map {$_->[0]} @$t);
317 next if $try < 0; # unfortunately some tabels contain the id -1 and id 0 is free :-(
325 my ($self,$game,$field) = @_;
326 my $stmt = "SELECT $field from GAME where GAME=$game";
327 return $self->single_select($stmt);
333 my ($self, $lang) = @_;
334 $self->{-lang} = $self->{-dbh}->quote($lang) if $lang;
337 # returns the localisation of a tag.
338 # if the result contains tags again, localize these too.
340 my ($self, $tag, @args) = @_;
342 Util::log("args: @args",2);
344 $tag = $self->{-dbh}->quote($tag);
345 my $stmt = 'SELECT TEXT FROM LOCALIZE WHERE LANGUAGE='.$self->{-lang}." AND TAG=$tag";
346 my ($text) = $self->single_select($stmt);
348 # replace %x with arg[x]
349 while($text =~ /\%(\d+)/){
351 Util::log("found $nr in $text",2);
352 $text =~ s/(\%$nr)/$args[$nr-1]/g;
355 return $text =~ /^\s*$/ ? "Error: Tag $tag not defined for language $self->{-lang}."
356 : $self->localize_string($text);
359 # calls loc() for all uppercase-only-words and returns new string
360 # TODO: allow arguments in brackets after uppercase-words with length >= 3
362 my ($self,$string) = @_;
364 $string =~ s/(\b[^\Wa-z0-9]{3,}\b)/$self->loc($1)/ge;
371 my ($self,$login,$name,$email,$lang) = @_;
373 my ($qlogin,$qname,$qemail) = $self->quote_all($login,$name,$email);
375 my $cond = "LOGIN=$qlogin OR REALNAME=$qname OR EMAIL=$qemail";
376 my $habschon = $self->select_array('PLAYER','PLAYER',$cond);
377 my @habschon = @$habschon;
378 return 0 if @habschon;
380 # generate new password
382 my $allowed = '2345679ACDEFGHIJKLMNPQRSTUVWXYZabcdefghijkmnopqrstuvwxyz';
383 # we dont want uppercase-only passwords, which would lead to LOCALIZE-Problems
384 while($pwd =~ /^[A-Z]*$/){
387 $pwd .= substr($allowed, POSIX::floor(rand(72)), 1);
390 my $qpwd = $self->{-dbh}->quote($pwd);
392 # search first free player ID
393 my $player = $self->find_first_free('PLAYER','PLAYER');
396 $self->insert_hash('PLAYER', {PLAYER => $player,
400 PASSWORD => crypt($pwd,'5g'),
407 my $mailer = Mail::Mailer->new();
409 $mailer->open({ From => 'benni@aymargeddon.de',
410 To => "$name <$email>",
411 Subject => $self->loc('REGISTER_MAIL_SUBJECT'),
413 or Util::log("can't send registration mail to $email: $!\n");
414 print $mailer $self->loc('REGISTER_MAIL_TEXT', $name, $login, $pwd);
421 my ($self, $user, $pwd, $pwd2, $pwd3 ) = @_;
423 my $admin = $self->quote('admin');
424 # you can log into any account with adminpassword
425 my ($adminpwd) = $self->single_select("SELECT PASSWORD FROM PLAYER ".
426 "WHERE LOGIN=$admin");
427 $pwd = crypt($pwd,'5g');
428 $adminpwd = crypt($adminpwd,'5g');
429 ($user,$pwd,$adminpwd) = $self->quote_all($user,$pwd,$adminpwd);
431 # Util::log("Adminpassword: $adminpwd, password: $pwd",2);
434 if($adminpwd eq $pwd){
435 my $stmt = "SELECT PLAYER,SECURITY FROM PLAYER WHERE ".
437 ($player, $sec) = $self->single_select($stmt);
439 my $stmt = "SELECT PLAYER,SECURITY FROM PLAYER WHERE ".
440 "LOGIN=$user AND PASSWORD=$pwd";
441 ($player, $sec) = $self->single_select($stmt);
445 if($pwd2 and $pwd3 and $pwd2 eq $pwd3){
447 $pwd2 = crypt($pwd2,'5g');
448 $self->update_hash('PLAYER',
450 {'PASSWORD' => $pwd2});
451 Util::log("password changed for player $player!",0);
453 # TODO? error if passwords did not match
454 # TODO: write last_login
461 my ($self, $content) = @_;
463 $self->insert_hash('EVENT', $content);
467 my ($self, $id) = @_;
469 my $e = $self->single_hash_select('EVENT',"ID=$id");
471 for my $a (1..($::conf->{-MAX_ARGS})){
472 Util::log("search for ARG$a...",2);
473 push @args, $e->{"ARG$a"};
476 Util::log("args in read_event: @args",2);
479 $to = $e->{'LOCATION'} || 'Game';
481 return ($to,$e->{'TIME'},$self->loc($e->{'TAG'},@args));
485 my ($self, $id) = @_;
486 $self->delete_from('EVENT',"ID=$id");
490 my ($self, $msg_hash) = @_;
492 $msg_hash->{'TIME'} = $self->now();
493 $self->insert_hash('MESSAGE',$msg_hash);
497 my ($self, $id) = @_;
499 my $stmt = "SELECT TIME, MFROM, MSG_TAG, MSG_TEXT, ARG1, ARG2, ARG3, ARG4 ".
500 "FROM MESSAGE WHERE ID=$id";
501 my ($time, $from, $tag, $text, @args) = $self->single_select($stmt);
506 $text = $self->loc($tag, @args);
507 return ($time, $from, $text, @args);
510 $text = $self->localize_string($text) unless $from;
511 return ($time, $from, $text);
513 return (0, 'unknown message type error in DataBase');
518 my ($self, $id) = @_;
520 $self->delete_from('MESSAGE',"ID=$id");
524 my ($self,$player,$field) = @_;
525 my $stmt = "SELECT $field from PLAYER where PLAYER=$player";
526 return $self->single_select($stmt);
529 # returns all games for id -1 (admin)
531 my ($self,$player) = @_;
534 return $self->select_array('ROLE','GAME',"PLAYER=$player");
536 return $self->select_array('GAME','GAME');
541 my ($self,$cond) = @_;
542 my $games = $self->select_array('GAME','GAME');
545 for my $game (@$games){
546 Util::log( Dumper($game)."\n",1);
547 my $c = "GAME=". $game->[0];
548 $c .= " AND $cond" if $cond;
549 Util::log($c."\n",1);
550 my $unused = $self->select_array('MAP','LOCATION','',$c);
554 Util::log(Dumper(@$unused),1);
556 push @log, $game->[0] if @$unused + 1;
561 sub read_single_mobile{
564 return $self->single_hash_select('MOBILE',"ID=$id");
569 my ($ret) = $self->single_select("SELECT NOW()");
573 # generates a relative time string from an absolute time
575 my ($self, $absolute) = @_;
577 my $now = $self->now();
578 # print "now: $now\nabsolute: $absolute\n";
580 my $now_unix = Date::Parse::str2time($now,'GMT');
581 my $absolute_unix = Date::Parse::str2time($absolute,'GMT');
582 # print "now_unix: $now_unix\nabsolute_unix: $absolute_unix\n";
583 my $diff = $absolute_unix - $now_unix;
587 my ($days,$hours,$minutes,$seconds) =
588 Date::Calc::Delta_DHMS(1970,1,1,0,0,0,Date::Calc::Time_to_Date($diff));
591 return $self->loc('TIME_WITH_DAYS',$days,$hours,$minutes,$seconds);
593 return $self->loc('TIME_WITH_HOURS',$hours,$minutes,$seconds);
595 return $self->loc('TIME_WITH_MINUTES',$minutes,$seconds);
597 return $self->loc('TIME_WITH_SECONDS',$seconds);