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 #    &DEBUG("query => '$query'.");
 373
 374     &SQLDebug($query);
 375     if (!$sth->execute) {
 376         &ERROR("Raw($prefix): => '$query'");
 377         # $DBI::errstr is printed as warning automatically.
 378         $sth->finish;
 379         return 0;
 380     }
 381
 382     $sth->finish;
 383
 384     return 1;
 385 }
 386
 387 # Usage: &dbRawReturn($rawquery);
 388 sub dbRawReturn {
 389     my ($query) = @_;
 390     my @retval;
 391
 392     my $sth = $dbh->prepare($query);
 393     &SQLDebug($query);
 394     &ERROR("RawReturn => '$query'.") unless $sth->execute;
 395     while (my @row = $sth->fetchrow_array) {
 396         push(@retval, $row[0]);
 397     }
 398     $sth->finish;
 399
 400     return @retval;
 401 }
 402
 403 ####################################################################
 404 ##### Misc DBI stuff...
 405 #####
 406
 407 #####
 408 # Usage: &countKeys($table, [$col]);
 409 sub countKeys {
 410     my ($table, $col) = @_;
 411     $col ||= "*";
 412     &DEBUG("&countKeys($table, $col)");
 413
 414     return (&dbRawReturn("SELECT count($col) FROM $table"))[0];
 415 }
 416
 417 # Usage: &sumKey($table, $col);
 418 sub sumKey {
 419     my ($table, $col) = @_;
 420
 421     return (&dbRawReturn("SELECT sum($col) FROM $table"))[0];
 422 }
 423
 424 #####
 425 # Usage: &randKey($table, $select);
 426 sub randKey {
 427     my ($table, $select) = @_;
 428     my $rand    = int(rand(&countKeys($table) - 1));
 429     my $query   = "SELECT $select FROM $table LIMIT $rand,1";
 430
 431     my $sth     = $dbh->prepare($query);
 432     &SQLDebug($query);
 433     &WARN("randKey($query)") unless $sth->execute;
 434     my @retval  = $sth->fetchrow_array;
 435     $sth->finish;
 436
 437     return @retval;
 438 }
 439
 440 #####
 441 # Usage: &deleteTable($table);
 442 sub deleteTable {
 443     &dbRaw("deleteTable($_[0])", "DELETE FROM $_[0]");
 444 }
 445
 446 #####
 447 # Usage: &searchTable($table, $select, $key, $str);
 448 #  Note: searchTable does dbQuote.
 449 sub searchTable {
 450     my($table, $select, $key, $str) = @_;
 451     my $origStr = $str;
 452     my @results;
 453
 454     # allow two types of wildcards.
 455     if ($str =~ /^\^(.*)\$$/) {
 456         &DEBUG("searchTable: should use dbGet(), heh.");
 457         $str = $1;
 458     } else {
 459         $str .= "%"     if ($str =~ s/^\^//);
 460         $str = "%".$str if ($str =~ s/\$$//);
 461         $str = "%".$str."%" if ($str eq $origStr);      # el-cheapo fix.
 462     }
 463
 464     $str =~ s/\_/\\_/g;
 465     $str =~ s/\?/_/g;   # '.' should be supported, too.
 466     $str =~ s/\*/%/g;   # for sqlite.
 467     # end of string fix.
 468
 469     my $query = "SELECT $select FROM $table WHERE $key LIKE ".
 470                 &dbQuote($str);
 471     my $sth = $dbh->prepare($query);
 472     &DEBUG("query => '$query'.");
 473     &SQLDebug($query);
 474     if (!$sth->execute) {
 475         &WARN("Search($query)");
 476         return;
 477     }
 478
 479     while (my @row = $sth->fetchrow_array) {
 480         push(@results, $row[0]);
 481     }
 482     $sth->finish;
 483
 484     return @results;
 485 }
 486
 487 sub dbCreateTable {
 488     my($table)  = @_;
 489     my(@path)   = ($bot_data_dir, ".","..","../..");
 490     my $found   = 0;
 491     my $data;
 492
 493     foreach (@path) {
 494         my $file = "$_/setup/$table.sql";
 495         &DEBUG("dbCT: file => $file");
 496         next unless ( -f $file );
 497
 498         &DEBUG("dbCT: found!!!");
 499
 500         open(IN, $file);
 501         while (<IN>) {
 502             chop;
 503             $data .= $_;
 504         }
 505
 506         $found++;
 507         last;
 508     }
 509
 510     if (!$found) {
 511         return 0;
 512     } else {
 513         &dbRaw("createTable($table)", $data);
 514         return 1;
 515     }
 516 }
 517
 518 sub checkTables {
 519     # retrieve a list of tables's from the server.
 520     my %db;
 521     foreach (&dbRawReturn("SELECT name FROM sqlite_master WHERE type='table'"))
 522     {
 523         $db{$_} = 1;
 524     }
 525
 526     foreach ("factoids", "freshmeat", "rootwarn", "seen", "stats") {
 527         next if (exists $db{$_});
 528         &status("checkTables: creating $_...");
 529
 530         &dbCreateTable($_);
 531     }
 532 }
 533
 534 1;