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
 237         $query = "UPDATE $table SET ".
 238                 join(' AND ', @keyval).
 239                 " WHERE ".$where;
 240     } else {
 241         foreach (keys %{$phref}) {
 242             push(@keys, $_);
 243             push(@vals, &dbQuote($phref->{$_}) );
 244         }
 245
 246         $query = sprintf("INSERT INTO $table (%s) VALUES (%s)",
 247                 join(',',@keys), join(',',@vals) );
 248     }
 249
 250     &dbRaw("Set", $query);
 251
 252     return 1;
 253 }
 254
 255 #####
 256 # Usage: &dbUpdate($table, $primkey, $primval, %hash);
 257 #  Note: dbUpdate does dbQuote.
 258 sub dbUpdate {
 259     my ($table, $primkey, $primval, %hash) = @_;
 260     my (@array);
 261
 262     foreach (keys %hash) {
 263         push(@array, "$_=".&dbQuote($hash{$_}) );
 264     }
 265
 266     &dbRaw("Update", "UPDATE $table SET ".join(', ', @array).
 267                 " WHERE $primkey=".&dbQuote($primval)
 268     );
 269
 270     return 1;
 271 }
 272
 273 #####
 274 # Usage: &dbInsert($table, $primkey, %hash);
 275 #  Note: dbInsert does dbQuote.
 276 sub dbInsert {
 277     my ($table, $primkey, %hash, $delay) = @_;
 278     my (@keys, @vals);
 279     my $p       = "";
 280
 281     if ($delay) {
 282         &DEBUG("dbI: delay => $delay");
 283         $p      = " DELAYED";
 284     }
 285
 286     foreach (keys %hash) {
 287         push(@keys, $_);
 288         push(@vals, &dbQuote($hash{$_}));
 289     }
 290
 291     &dbRaw("Insert($table)", "INSERT $p INTO $table (".join(',',@keys).
 292                 ") VALUES (".join(',',@vals).")"
 293     );
 294
 295     return 1;
 296 }
 297
 298 #####
 299 # Usage: &dbReplace($table, $key, %hash);
 300 #  Note: dbReplace does optional dbQuote.
 301 sub dbReplace {
 302     my ($table, $key, %hash) = @_;
 303     my (@keys, @vals);
 304
 305     foreach (keys %hash) {
 306         if (s/^-//) {   # as is.
 307             push(@keys, $_);
 308             push(@vals, $hash{'-'.$_});
 309         } else {
 310             push(@keys, $_);
 311             push(@vals, &dbQuote($hash{$_}));
 312         }
 313     }
 314
 315     if (0) {
 316         &DEBUG("REPLACE INTO $table (".join(',',@keys).
 317                 ") VALUES (". join(',',@vals). ")" );
 318     }
 319
 320     &dbRaw("Replace($table)", "REPLACE INTO $table (".join(',',@keys).
 321                 ") VALUES (". join(',',@vals). ")"
 322     );
 323
 324     return 1;
 325 }
 326
 327 #####
 328 # Usage: &dbSetRow($table, $vref, $delay);
 329 #  Note: dbSetRow does dbQuote.
 330 sub dbSetRow ($@$) {
 331     my ($table, $vref, $delay) = @_;
 332     my $p       = ($delay) ? " DELAYED " : "";
 333
 334     # see 'perldoc perlreftut'
 335     my @values;
 336     foreach (@{ $vref }) {
 337         push(@values, &dbQuote($_) );
 338     }
 339
 340     if (!scalar @values) {
 341         &WARN("dbSetRow: values array == NULL.");
 342         return;
 343     }
 344
 345     return &dbRaw("SetRow", "INSERT $p INTO $table VALUES (".
 346         join(",", @values) .")" );
 347 }
 348
 349 #####
 350 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 351 #  Note: dbDel does dbQuote
 352 sub dbDel {
 353     my ($table, $primkey, $primval, $key) = @_;
 354
 355     &dbRaw("Del", "DELETE FROM $table WHERE $primkey=".
 356                 &dbQuote($primval)
 357     );
 358
 359     return 1;
 360 }
 361
 362 # Usage: &dbRaw($prefix,$rawquery);
 363 sub dbRaw {
 364     my ($prefix,$query) = @_;
 365     my $sth;
 366
 367     if (!($sth = $dbh->prepare($query))) {
 368         &ERROR("Raw($prefix): $DBI::errstr");
 369         return 0;
 370     }
 371
 372     &SQLDebug($query);
 373     if (!$sth->execute) {
 374         &ERROR("Raw($prefix): => '$query'");
 375         # $DBI::errstr is printed as warning automatically.
 376         $sth->finish;
 377         return 0;
 378     }
 379
 380     $sth->finish;
 381
 382     return 1;
 383 }
 384
 385 # Usage: &dbRawReturn($rawquery);
 386 sub dbRawReturn {
 387     my ($query) = @_;
 388     my @retval;
 389
 390     my $sth = $dbh->prepare($query);
 391     &SQLDebug($query);
 392     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 393     while (my @row = $sth->fetchrow_array) {
 394         push(@retval, $row[0]);
 395     }
 396     $sth->finish;
 397
 398     return @retval;
 399 }
 400
 401 ####################################################################
 402 ##### Misc DBI stuff...
 403 #####
 404
 405 #####
 406 # Usage: &countKeys($table, [$col]);
 407 sub countKeys {
 408     my ($table, $col) = @_;
 409     $col ||= "*";
 410     &DEBUG("&countKeys($table, $col)");
 411
 412     return (&dbRawReturn("SELECT count($col) FROM $table"))[0];
 413 }
 414
 415 # Usage: &sumKey($table, $col);
 416 sub sumKey {
 417     my ($table, $col) = @_;
 418
 419     return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
 420 }
 421
 422 #####
 423 # Usage: &randKey($table, $select);
 424 sub randKey {
 425     my ($table, $select) = @_;
 426     my $rand    = int(rand(&countKeys($table) - 1));
 427     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 428
 429     my $sth     = $dbh->prepare($query);
 430     &SQLDebug($query);
 431     &WARN("randKey($query)") unless $sth->execute;
 432     my @retval  = $sth->fetchrow_array;
 433     $sth->finish;
 434
 435     return @retval;
 436 }
 437
 438 #####
 439 # Usage: &deleteTable($table);
 440 sub deleteTable {
 441     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 442 }
 443
 444 #####
 445 # Usage: &searchTable($table, $select, $key, $str);
 446 #  Note: searchTable does dbQuote.
 447 sub searchTable {
 448     my($table, $select, $key, $str) = @_;
 449     my $origStr = $str;
 450     my @results;
 451
 452     # allow two types of wildcards.
 453     if ($str =~ /^\^(.*)\$$/) {
 454         &DEBUG("searchTable: should use dbGet(), heh.");
 455         $str = $1;
 456     } else {
 457         $str .= "%"     if ($str =~ s/^\^//);
 458         $str = "%".$str if ($str =~ s/\$$//);
 459         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 460     }
 461
 462     $str =~ s/\_/\\_/g;
 463     $str =~ s/\?/_/g;   # '.' should be supported, too.
 464     $str =~ s/\*/%/g;   # for sqlite.
 465     # end of string fix.
 466
 467     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 468                 &dbQuote($str);
 469     my $sth = $dbh->prepare($query);
 470     &SQLDebug($query);
 471     if (!$sth->execute) {
 472         &WARN("Search($query)");
 473         return;
 474     }
 475
 476     while (my @row = $sth->fetchrow_array) {
 477         push(@results, $row[0]);
 478     }
 479     $sth->finish;
 480
 481     return @results;
 482 }
 483
 484 sub dbCreateTable {
 485     my($table)  = @_;
 486     my(@path)   = ($bot_data_dir, ".","..","../..");
 487     my $found   = 0;
 488     my $data;
 489
 490     foreach (@path) {
 491         my $file = "$_/setup/$table.sql";
 492         &DEBUG("dbCT: file => $file");
 493         next unless ( -f $file );
 494
 495         &DEBUG("dbCT: found!!!");
 496
 497         open(IN, $file);
 498         while (<IN>) {
 499             chop;
 500             $data .= $_;
 501         }
 502
 503         $found++;
 504         last;
 505     }
 506
 507     if (!$found) {
 508         return 0;
 509     } else {
 510         &dbRaw("createTable($table)", $data);
 511         return 1;
 512     }
 513 }
 514
 515 sub checkTables {
 516     # retrieve a list of tables's from the server.
 517     my %db;
 518     foreach (&dbRawReturn("SELECT name FROM sqlite_master WHERE type='table'"))
 519     {
 520         $db{$_} = 1;
 521     }
 522
 523     foreach ("factoids", "freshmeat", "rootwarn", "seen", "stats") {
 524         next if (exists $db{$_});
 525         &status("checkTables: creating $_...");
 526
 527         &dbCreateTable($_);
 528     }
 529 }
 530
 531 1;