src/db_sqlite.pl

   1 #
   2 # db_sqlite.pl: SQLite database frontend.
   3 #      Author: Tim Riker <Tim@Rikers.org>
   4 #     Version: 0.1 (20021101)
   5 #     Created: 20021101
   6 #
   7
   8 #package main;
   9 eval "use DBI";
  10
  11 if (&::IsParam("useStrict")) { use strict; }
  12
  13 #####
  14 # &openDB($dbname, $sqluser, $sqlpass, $nofail);
  15 sub openDB {
  16     my ($db, $user, $pass, $no_fail) = @_;
  17     my $dsn = "DBI:SQLite:dbname=$db.sqlite";
  18     $dbh = DBI->connect($dsn,$user,$pass);
  19
  20     if ($dbh) {
  21         &::status("Opened SQLite connection $dsn");
  22     } else {
  23         &::ERROR("cannot connect $dsn.");
  24         &::ERROR("since SQLite is not available, shutting down bot!");
  25         &closePID();
  26         &closeSHM($shm);
  27         &closeLog();
  28
  29         return if ($no_fail);
  30
  31         exit 1;
  32     }
  33 }
  34
  35 sub closeDB {
  36     return 0 unless ($dbh);
  37
  38     my $hoststr = "";
  39     $hoststr = " to $param{'SQLHost'}" if (exists $param{'SQLHost'});
  40
  41     &::status("Closed SQLite connection$hoststr.");
  42     $dbh->disconnect();
  43
  44     return 1;
  45 }
  46
  47 #####
  48 # Usage: &dbQuote($str);
  49 sub dbQuote {
  50     return $dbh->quote($_[0]);
  51 }
  52
  53 #####
  54 # Usage: &dbGet($table, $select, $where);
  55 sub dbGet {
  56     my ($table, $select, $where) = @_;
  57     my $query   = "SELECT $select FROM $table";
  58     $query      .= " WHERE $where" if ($where);
  59
  60     if (!defined $select or $select =~ /^\s*$/) {
  61         &::WARN("dbGet: select == NULL.");
  62         return;
  63     }
  64
  65     if (!defined $table or $table =~ /^\s*$/) {
  66         &::WARN("dbGet: table == NULL.");
  67         return;
  68     }
  69
  70     my $sth;
  71     if (!($sth = $dbh->prepare($query))) {
  72         &::ERROR("Get: prepare: $DBI::errstr");
  73         return;
  74     }
  75
  76     &::SQLDebug($query);
  77     if (!$sth->execute) {
  78         &::ERROR("Get: execute: '$query'");
  79         $sth->finish;
  80         return 0;
  81     }
  82
  83     my @retval = $sth->fetchrow_array;
  84
  85     $sth->finish;
  86
  87     if (scalar @retval > 1) {
  88         return @retval;
  89     } elsif (scalar @retval == 1) {
  90         return $retval[0];
  91     } else {
  92         return;
  93     }
  94 }
  95
  96 #####
  97 # Usage: &dbGetCol($table, $select, $where, [$type]);
  98 sub dbGetCol {
  99     my ($table, $select, $where, $type) = @_;
 100     my $query   = "SELECT $select FROM $table";
 101     $query      .= " WHERE ".$where if ($where);
 102     my %retval;
 103
 104     my $sth = $dbh->prepare($query);
 105     &::SQLDebug($query);
 106     if (!$sth->execute) {
 107         &::ERROR("GetCol: execute: '$query'");
 108         $sth->finish;
 109         return;
 110     }
 111
 112     if (defined $type and $type == 2) {
 113         &DEBUG("dbgetcol: type 2!");
 114         while (my @row = $sth->fetchrow_array) {
 115             $retval{$row[0]} = join(':', $row[1..$#row]);
 116         }
 117         &DEBUG("dbgetcol: count => ".scalar(keys %retval) );
 118
 119     } elsif (defined $type and $type == 1) {
 120         while (my @row = $sth->fetchrow_array) {
 121             # reverse it to make it easier to count.
 122             if (scalar @row == 2) {
 123                 $retval{$row[1]}{$row[0]} = 1;
 124             } elsif (scalar @row == 3) {
 125                 $retval{$row[1]}{$row[0]} = 1;
 126             }
 127             # what to do if there's only one or more than 3?
 128         }
 129
 130     } else {
 131         while (my @row = $sth->fetchrow_array) {
 132             $retval{$row[0]} = $row[1];
 133         }
 134     }
 135
 136     $sth->finish;
 137
 138     return %retval;
 139 }
 140
 141 #####
 142 # Usage: &dbGetColNiceHash($table, $select, $where);
 143 sub dbGetColNiceHash {
 144     my ($table, $select, $where) = @_;
 145     $select     ||= "*";
 146     my $query   = "SELECT $select FROM $table";
 147     $query      .= " WHERE ".$where if ($where);
 148     my %retval;
 149
 150     my $sth = $dbh->prepare($query);
 151     &::SQLDebug($query);
 152     if (!$sth->execute) {
 153         &::ERROR("GetColNiceHash: execute: '$query'");
 154 #       &::ERROR("GetCol => $DBI::errstr");
 155         $sth->finish;
 156         return;
 157     }
 158
 159     %retval = %{ $sth->fetchrow_hashref() };
 160
 161     $sth->finish;
 162
 163     return %retval;
 164 }
 165
 166 ####
 167 # Usage: &dbGetColInfo($table);
 168 sub dbGetColInfo {
 169     my ($table) = @_;
 170
 171     my $query = "SHOW COLUMNS from $table";
 172     my %retval;
 173
 174     my $sth = $dbh->prepare($query);
 175     &::SQLDebug($query);
 176     if (!$sth->execute) {
 177         &::ERROR("GRI => '$query'");
 178         &::ERROR("GRI => $DBI::errstr");
 179         $sth->finish;
 180         return;
 181     }
 182
 183     my @cols;
 184     while (my @row = $sth->fetchrow_array) {
 185         push(@cols, $row[0]);
 186     }
 187     $sth->finish;
 188
 189     return @cols;
 190 }
 191
 192 #####
 193 # Usage: &dbSet($table, $primhash_ref, $hash_ref);
 194 #  Note: dbSet does dbQuote.
 195 sub dbSet {
 196     my ($table, $phref, $href) = @_;
 197     my $where = join(' AND ', map {
 198                 $_."=".&dbQuote($phref->{$_})
 199         } keys %{$phref}
 200     );
 201
 202     if (!defined $phref) {
 203         &::WARN("dbset: phref == NULL.");
 204         return;
 205     }
 206
 207     if (!defined $href) {
 208         &::WARN("dbset: href == NULL.");
 209         return;
 210     }
 211
 212     if (!defined $table) {
 213         &::WARN("dbset: table == NULL.");
 214         return;
 215     }
 216
 217     my $result = &dbGet($table, join(',', keys %{$phref}), $where);
 218
 219     my(@keys,@vals);
 220     foreach (keys %{$href}) {
 221         push(@keys, $_);
 222         push(@vals, &dbQuote($href->{$_}) );
 223     }
 224
 225     if (!@keys or !@vals) {
 226         &::WARN("dbset: keys or vals is NULL.");
 227         return;
 228     }
 229
 230     my $query;
 231     if (defined $result) {
 232         my @keyval;
 233         for(my$i=0; $i<scalar @keys; $i++) {
 234             push(@keyval, $keys[$i]."=".$vals[$i] );
 235         }
 236         $query = "UPDATE $table SET " . join(', ', @keyval) . " WHERE ".$where;
 237         &dbRaw("Update", $query);
 238
 239     } else {
 240         foreach (keys %{$phref}) {
 241             push(@keys, $_);
 242             push(@vals, &dbQuote($phref->{$_}) );
 243         }
 244
 245         $query = sprintf("INSERT INTO $table (%s) VALUES (%s)",
 246                 join(',',@keys), join(',',@vals) );
 247         &dbRaw("Set", $query);
 248     }
 249
 250     return 1;
 251 }
 252
 253 #####
 254 # Usage: &dbUpdate($table, $primkey, $primval, %hash);
 255 #  Note: dbUpdate does dbQuote.
 256 sub dbUpdate {
 257     my ($table, $primkey, $primval, %hash) = @_;
 258     my (@keyval);
 259
 260     foreach (keys %hash) {
 261         push(@keyval, "$_=".&dbQuote($hash{$_}) );
 262     }
 263
 264     &dbRaw("Update", "UPDATE $table SET ".join(', ', @keyval).
 265                 " WHERE $primkey=".&dbQuote($primval)
 266     );
 267
 268     return 1;
 269 }
 270
 271 #####
 272 # Usage: &dbInsert($table, $primkey, %hash);
 273 #  Note: dbInsert does dbQuote.
 274 sub dbInsert {
 275     my ($table, $primkey, %hash, $delay) = @_;
 276     my (@keys, @vals);
 277     my $p       = "";
 278
 279     if ($delay) {
 280         &DEBUG("dbI: delay => $delay");
 281         $p      = " DELAYED";
 282     }
 283
 284     foreach (keys %hash) {
 285         push(@keys, $_);
 286         push(@vals, &dbQuote($hash{$_}));
 287     }
 288
 289     &dbRaw("Insert($table)", "INSERT $p INTO $table (".join(',',@keys).
 290                 ") VALUES (".join(',',@vals).")"
 291     );
 292
 293     return 1;
 294 }
 295
 296 #####
 297 # Usage: &dbReplace($table, $key, %hash);
 298 #  Note: dbReplace does optional dbQuote.
 299 sub dbReplace {
 300     my ($table, $key, %hash) = @_;
 301     my (@keys, @vals);
 302
 303     foreach (keys %hash) {
 304         if (s/^-//) {   # as is.
 305             push(@keys, $_);
 306             push(@vals, $hash{'-'.$_});
 307         } else {
 308             push(@keys, $_);
 309             push(@vals, &dbQuote($hash{$_}));
 310         }
 311     }
 312
 313     if (0) {
 314         &DEBUG("REPLACE INTO $table (".join(',',@keys).
 315                 ") VALUES (". join(',',@vals). ")" );
 316     }
 317
 318     &dbRaw("Replace($table)", "REPLACE INTO $table (".join(',',@keys).
 319                 ") VALUES (". join(',',@vals). ")"
 320     );
 321
 322     return 1;
 323 }
 324
 325 #####
 326 # Usage: &dbSetRow($table, $vref, $delay);
 327 #  Note: dbSetRow does dbQuote.
 328 sub dbSetRow ($@$) {
 329     my ($table, $vref, $delay) = @_;
 330     my $p       = ($delay) ? " DELAYED " : "";
 331
 332     # see 'perldoc perlreftut'
 333     my @values;
 334     foreach (@{ $vref }) {
 335         push(@values, &dbQuote($_) );
 336     }
 337
 338     if (!scalar @values) {
 339         &::WARN("dbSetRow: values array == NULL.");
 340         return;
 341     }
 342
 343     return &dbRaw("SetRow", "INSERT $p INTO $table VALUES (".
 344         join(",", @values) .")" );
 345 }
 346
 347 #####
 348 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 349 #  Note: dbDel does dbQuote
 350 sub dbDel {
 351     my ($table, $primkey, $primval, $key) = @_;
 352
 353     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 354                 &dbQuote($primval)
 355     );
 356
 357     return 1;
 358 }
 359
 360 # Usage: &dbRaw($prefix,$rawquery);
 361 sub dbRaw {
 362     my ($prefix,$query) = @_;
 363     my $sth;
 364
 365     if (!($sth = $dbh->prepare($query))) {
 366         &::ERROR("Raw($prefix): $DBI::errstr");
 367         return 0;
 368     }
 369
 370     &::SQLDebug($query);
 371     if (!$sth->execute) {
 372         &::ERROR("Raw($prefix): => '$query'");
 373         # $DBI::errstr is printed as warning automatically.
 374         $sth->finish;
 375         return 0;
 376     }
 377
 378     $sth->finish;
 379
 380     return 1;
 381 }
 382
 383 # Usage: &dbRawReturn($rawquery);
 384 sub dbRawReturn {
 385     my ($query) = @_;
 386     my @retval;
 387
 388     my $sth = $dbh->prepare($query);
 389     &::SQLDebug($query);
 390     &::ERROR("RawReturn => '$query'.") unless $sth->execute;
 391     while (my @row = $sth->fetchrow_array) {
 392         push(@retval, $row[0]);
 393     }
 394     $sth->finish;
 395
 396     return @retval;
 397 }
 398
 399 ####################################################################
 400 ##### Misc DBI stuff...
 401 #####
 402
 403 #####
 404 # Usage: &countKeys($table, [$col]);
 405 sub countKeys {
 406     my ($table, $col) = @_;
 407     $col ||= "*";
 408     &DEBUG("&countKeys($table, $col)");
 409
 410     return (&dbRawReturn("SELECT count($col) FROM $table"))[0];
 411 }
 412
 413 # Usage: &sumKey($table, $col);
 414 sub sumKey {
 415     my ($table, $col) = @_;
 416
 417     return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
 418 }
 419
 420 #####
 421 # Usage: &randKey($table, $select);
 422 sub randKey {
 423     my ($table, $select) = @_;
 424     my $rand    = int(rand(&countKeys($table) - 1));
 425     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 426
 427     my $sth     = $dbh->prepare($query);
 428     &::SQLDebug($query);
 429     &::WARN("randKey($query)") unless $sth->execute;
 430     my @retval  = $sth->fetchrow_array;
 431     $sth->finish;
 432
 433     return @retval;
 434 }
 435
 436 #####
 437 # Usage: &deleteTable($table);
 438 sub deleteTable {
 439     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 440 }
 441
 442 #####
 443 # Usage: &searchTable($table, $select, $key, $str);
 444 #  Note: searchTable does dbQuote.
 445 sub searchTable {
 446     my($table, $select, $key, $str) = @_;
 447     my $origStr = $str;
 448     my @results;
 449
 450     # allow two types of wildcards.
 451     if ($str =~ /^\^(.*)\$$/) {
 452         &DEBUG("searchTable: should use dbGet(), heh.");
 453         $str = $1;
 454     } else {
 455         $str .= "%"     if ($str =~ s/^\^//);
 456         $str = "%".$str if ($str =~ s/\$$//);
 457         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 458     }
 459
 460     $str =~ s/\_/\\_/g;
 461     $str =~ s/\?/_/g;   # '.' should be supported, too.
 462     $str =~ s/\*/%/g;   # for sqlite.
 463     # end of string fix.
 464
 465     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 466                 &dbQuote($str);
 467     my $sth = $dbh->prepare($query);
 468     &::SQLDebug($query);
 469     if (!$sth->execute) {
 470         &::WARN("Search($query)");
 471         return;
 472     }
 473
 474     while (my @row = $sth->fetchrow_array) {
 475         push(@results, $row[0]);
 476     }
 477     $sth->finish;
 478
 479     return @results;
 480 }
 481
 482 sub dbCreateTable {
 483     my($table)  = @_;
 484     my(@path)   = ($bot_data_dir, ".","..","../..");
 485     my $found   = 0;
 486     my $data;
 487
 488     foreach (@path) {
 489         my $file = "$_/setup/$table.sql";
 490         &DEBUG("dbCT: file => $file");
 491         next unless ( -f $file );
 492
 493         &DEBUG("dbCT: found!!!");
 494
 495         open(IN, $file);
 496         while (<IN>) {
 497             chop;
 498             $data .= $_;
 499         }
 500
 501         $found++;
 502         last;
 503     }
 504
 505     if (!$found) {
 506         return 0;
 507     } else {
 508         &dbRaw("createTable($table)", $data);
 509         return 1;
 510     }
 511 }
 512
 513 sub checkTables {
 514     # retrieve a list of tables's from the server.
 515     my %db;
 516     foreach (&dbRawReturn("SELECT name FROM sqlite_master WHERE type='table'"))
 517     {
 518         $db{$_} = 1;
 519     }
 520
 521     foreach ("factoids", "freshmeat", "rootwarn", "seen", "stats") {
 522         next if (exists $db{$_});
 523         &::status("checkTables: creating $_...");
 524
 525         &dbCreateTable($_);
 526     }
 527 }
 528
 529 1;