src/db_dbm.pl

   1 #
   2 #   db_dbm.pl: Extension on the factoid database.
   3 #  OrigAuthor: Kevin Lenzo  (c) 1997
   4 #  CurrAuthor: dms <dms@users.sourceforge.net>
   5 #     Version: v0.6 (20000707)
   6 #   FModified: 19991020
   7 #
   8
   9 package main;
  10
  11 if (&IsParam('useStrict')) { use strict;}
  12
  13 use vars qw(%factoids %freshmeat %seen %rootwarn);      # db hash.
  14
  15
  16 {
  17     my %formats = (
  18         'factoids', [
  19             'factoid_key',
  20             'factoid_value',
  21             'created_by',
  22             'created_time',
  23             'modified_by',
  24             'modified_time',
  25             'requested_by',
  26             'requested_time',
  27             'requested_count',
  28             'locked_by',
  29             'locked_time'
  30         ],
  31         'freshmeat', [
  32             'name',
  33             'stable',
  34             'devel',
  35             'section',
  36             'license',
  37             'homepage',
  38             'download',
  39             'changelog',
  40             'deb',
  41             'rpm',
  42             'link',
  43             'oneliner'
  44         ],
  45         'rootwarn', [
  46             'nick',
  47             'attempt',
  48             'time',
  49             'host',
  50             'channel'
  51         ],
  52         'seen', [
  53             'nick',
  54             'time',
  55             'channel',
  56             'host',
  57             'messagecount',
  58             'hehcount',
  59             'karma',
  60             'message'
  61         ],
  62         'stats', [
  63             'nick',
  64             'type',
  65             'counter',
  66             'time'
  67         ]
  68     );
  69
  70     sub openDB {
  71         use DB_File;
  72         foreach (keys %formats) {
  73             next unless (&IsParam($_));
  74
  75             my $file = "$param{'DBName'}-$_";
  76
  77             if (dbmopen(%{ $_ }, $file, 0666)) {
  78                 &status("Opened DBM $_ ($file).");
  79             } else {
  80                 &ERROR("Failed open to DBM $_ ($file).");
  81                 &shutdown();
  82                 exit 1;
  83             }
  84         }
  85     }
  86
  87     sub closeDB {
  88         foreach (keys %formats) {
  89             next unless (&IsParam($_));
  90
  91             if (dbmclose(%{ $_ })) {
  92                 &status("Closed DBM $_ successfully.");
  93                 next;
  94             }
  95             &ERROR("Failed closing DBM $_.");
  96         }
  97     }
  98
  99     #####
 100     # Usage: &dbGetColInfo($table);
 101     sub dbGetColInfo {
 102         my ($table) = @_;
 103
 104         if (scalar @{$formats{$table}}) {
 105             return @{$formats{$table}};
 106         } else {
 107             &ERROR("dbGCI: no format for table ($table).");
 108             return;
 109         }
 110     }
 111 }
 112
 113 #####
 114 # Usage: &dbQuote($str);
 115 sub dbQuote {
 116     return $_[0];
 117 }
 118
 119 #####
 120 # Usage: &dbGet($table, $select, $where);
 121 sub dbGet {
 122     my ($table, $select, $where) = @_;
 123     my ($key, $val) = split('=',$where) if $where =~ /=/;
 124     my $found = 0;
 125     my @retval;
 126     my $i;
 127     &DEBUG("dbGet($table, $select, $where);");
 128     return unless $key;
 129
 130     my @format = &dbGetColInfo($table);
 131     if (!scalar @format) {
 132         return;
 133     }
 134
 135     if (!defined ${ "$table" }{lc $val}) {      # dbm hash exception.
 136         &DEBUG("dbGet: '$val' does not exist in $table.");
 137         return;
 138     }
 139
 140     # return the whole row.
 141     if ($select eq "*") {
 142         @retval = split $;, ${"$table"}{lc $val};
 143         unshift(@retval,$key);
 144         return(@retval);
 145     }
 146
 147     &DEBUG("dbGet: select => '$select'.");
 148     my @array = split "$;", ${"$table"}{lc $val};
 149     unshift(@array,$key);
 150     for (0 .. $#format) {
 151         my $str = $format[$_];
 152         next unless (grep /^$str$/, split(/\,/, $select));
 153         $array[$_] ||= '';
 154         &DEBUG("dG: pushing $format[$_]=>'$array[$_]'.");
 155         push(@retval, $array[$_]);
 156     }
 157
 158     if (scalar @retval > 1) {
 159         return @retval;
 160     } elsif (scalar @retval == 1) {
 161         return $retval[0];
 162     } else {
 163         return;
 164     }
 165 }
 166
 167 #####
 168 # Usage: &dbGetCol();
 169 # Usage: &dbGetCol($table, $select, $where, [$type]);
 170 sub dbGetCol {
 171     my ($table, $select, $where, $type) = @_;
 172     &FIXME("STUB: &dbGetCol($table, $select, $where, $type);");
 173 }
 174
 175 #####
 176 # Usage: &dbGetColNiceHash($table, $select, $where);
 177 sub dbGetColNiceHash {
 178     my ($table, $select, $where) = @_;
 179     &DEBUG("dbGetColNiceHash($table, $select, $where);");
 180     my ($key, $val) = split('=',$where) if $where =~ /=/;
 181     return unless ${$table}{lc $val};
 182     my (%hash) = ();
 183     $hash{lc $key} = $val;
 184     my (@format) = &dbGetColInfo($table);
 185     shift @format;
 186     @hash{@format} = split $;, ${$table}{lc $val};
 187     return %hash;
 188 }
 189
 190 #####
 191 # Usage: &dbInsert($table, $primkey, %hash);
 192 #  Note: dbInsert should do dbQuote.
 193 sub dbInsert {
 194     my ($table, $primkey, %hash) = @_;
 195     my $found = 0;
 196     &DEBUG("dbInsert($table, $primkey, ...)");
 197
 198     my $info = ${$table}{lc $primkey} || '';    # primkey or primval?
 199
 200     my @format = &dbGetColInfo($table);
 201     if (!scalar @format) {
 202         return 0;
 203     }
 204
 205     my $i;
 206     my @array = split $;, $info;
 207     delete $hash{$format[0]};
 208     for $i (1 .. $#format) {
 209         my $col = $format[$i];
 210         $array[$i - 1]=$hash{$col};
 211         $array[$i - 1]='' unless $array[$i - 1];
 212         delete $hash{$col};
 213         &DEBUG("dbI: setting $table->$primkey\{$col\} => '$array[$i - 1]'.");
 214     }
 215
 216     if (scalar keys %hash) {
 217         &ERROR("dbI: not added...");
 218         foreach (keys %hash) {
 219             &ERROR("dbI:   '$_' => '$hash{$_}'");
 220         }
 221         return 0;
 222     }
 223
 224     ${$table}{lc $primkey}      = join $;, @array;
 225
 226     return 1;
 227 }
 228
 229 sub dbUpdate {
 230     &FIXME("STUB: &dbUpdate(@_); => somehow use dbInsert!");
 231 }
 232
 233 #####
 234 # Usage: &dbSetRow($table, @values);
 235 sub dbSetRow {
 236     my ($table, @values) = @_;
 237     &DEBUG("dbSetRow(@_);");
 238     my $key = lc $values[0];
 239
 240     my @format = &dbGetColInfo($table);
 241     if (!scalar @format) {
 242         return 0;
 243     }
 244
 245     if (defined ${$table}{$key}) {
 246         &WARN("dbSetRow: $table {$key} already exists?");
 247     }
 248
 249     if (scalar @values != scalar @format) {
 250         &WARN("dbSetRow: scalar values != scalar ${table} format.");
 251     }
 252
 253     for (0 .. $#format) {
 254         if (defined $array[$_] and $array[$_] ne "") {
 255             &DEBUG("dbSetRow: array[$_] != NULL($array[$_]).");
 256         }
 257         $array[$_] = $values[$_];
 258     }
 259
 260     ${$table}{$key}     = join $;, @array;
 261 }
 262
 263 #####
 264 # Usage: &dbDel($table, $primkey, $primval, [$key]);
 265 sub dbDel {
 266     my ($table, $primkey, $primval, $key) = @_;
 267     &DEBUG("dbDel($table, $primkey, $primval);");
 268
 269     if (!defined ${$table}{lc $primval}) {
 270         &WARN("dbDel: lc $primval does not exist in $table.");
 271     } else {
 272         delete ${$table}{lc $primval};
 273     }
 274
 275     return '';
 276 }
 277
 278 #####
 279 # Usage: &dbReplace($table, $key, %hash);
 280 #  Note: dbReplace does optional dbQuote.
 281 sub dbReplace {
 282     my ($table, $key, %hash) = @_;
 283     &DEBUG("dbReplace($table, $key, %hash);");
 284
 285     &dbDel($table, $key, $hash{$key}, %hash);
 286     &dbInsert($table, $hash{$key}, %hash);
 287     return 1;
 288 }
 289
 290 #####
 291 # Usage: &dbSet($table, $primhash_ref, $hash_ref);
 292 sub dbSet {
 293     my ($table, $phref, $href) = @_;
 294     &DEBUG("dbSet(@_)");
 295     my ($key) = keys %{$phref};
 296     my $where = $key . "=" . $phref->{$key};
 297
 298     my %hash = &dbGetColNiceHash($table, "*", $where);
 299     foreach (keys %{$href}) {
 300         &DEBUG("dbSet: setting $_=${$href}{$_}");
 301         $hash{$_} = ${$href}{$_};
 302     }
 303     &dbReplace($table, $key, %hash);
 304     return 1;
 305 }
 306
 307 sub dbRaw {
 308     &FIXME("STUB: &dbRaw(@_);");
 309 }
 310
 311 sub dbRawReturn {
 312     &FIXME("STUB: &dbRawReturn(@_);");
 313 }
 314
 315
 316
 317 ####################################################################
 318 ##### Factoid related stuff...
 319 #####
 320
 321 sub countKeys {
 322     return scalar keys %{$_[0]};
 323 }
 324
 325 sub getKeys {
 326     &FIXME("STUB: &getKeys(@_); -- REDUNDANT");
 327 }
 328
 329 sub randKey {
 330     &FIXME("STUB: &randKey(@_);");
 331 }
 332
 333 ##### $select is misleading???
 334 # Usage: &searchTable($table, $returnkey, $primkey, $str);
 335 sub searchTable {
 336     my ($table, $primkey, $key, $str) = @_;
 337     &FIXME("STUB: searchTable($table, $primkey, $key, $str)");
 338     return;
 339     &DEBUG("searchTable($table, $primkey, $key, $str)");
 340
 341     if (!scalar &dbGetColInfo($table)) {
 342         return;
 343     }
 344
 345     my @results;
 346     foreach (keys %{$table}) {
 347         my $val = &dbGet($table, "NULL", $_, $key) || '';
 348         next unless ($val =~ /\Q$str\E/);
 349         push(@results, $_);
 350     }
 351
 352     &DEBUG("sT: ".scalar(@results) );
 353
 354     @results;
 355 }
 356
 357 #####
 358 # Usage: &getFactInfo($faqtoid, $type);
 359 sub getFactInfo {
 360     my ($faqtoid, $type) = @_;
 361
 362     my @format = &dbGetColInfo("factoids");
 363     if (!scalar @format) {
 364         return;
 365     }
 366
 367     if (!defined $factoids{$faqtoid}) { # dbm hash exception.
 368         return;
 369     }
 370
 371     if ($type eq "*") {         # all.
 372         return split /$;/, $factoids{$faqtoid};
 373     }
 374
 375     # specific.
 376     if (!grep /^$type$/, @format) {
 377         &ERROR("gFI: type '$type' not valid for factoids.");
 378         return;
 379     }
 380
 381     my @array   = split /$;/, $factoids{$faqtoid};
 382     for (0 .. $#format) {
 383         next unless ($type eq $format[$_]);
 384         return $array[$_];
 385     }
 386
 387     &ERROR("gFI: should never happen.");
 388 }
 389
 390 #####
 391 # Usage: &getFactoid($faqtoid);
 392 sub getFactoid {
 393     my ($faqtoid) = @_;
 394
 395     if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
 396         &WARN("getF: faqtoid == NULL.");
 397         return;
 398     }
 399
 400     if (defined $factoids{$faqtoid}) {  # dbm hash exception.
 401         # we assume 1 unfortunately.
 402         ### TODO: use &getFactInfo() instead?
 403         my $retval = (split $;, $factoids{$faqtoid})[1];
 404
 405         if (defined $retval) {
 406             &DEBUG("getF: returning '$retval' for '$faqtoid'.");
 407         } else {
 408             &DEBUG("getF: returning NULL for '$faqtoid'.");
 409         }
 410         return $retval;
 411     } else {
 412         return;
 413     }
 414 }
 415
 416 #####
 417 # Usage: &delFactoid($faqtoid);
 418 sub delFactoid {
 419     my ($faqtoid) = @_;
 420
 421     if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
 422         &WARN("delF: faqtoid == NULL.");
 423         return;
 424     }
 425
 426     if (defined $factoids{$faqtoid}) {  # dbm hash exception.
 427         delete $factoids{$faqtoid};
 428         &status("DELETED $faqtoid");
 429     } else {
 430         &WARN("delF: nothing to deleted? ($faqtoid)");
 431         return;
 432     }
 433 }
 434
 435 sub checkTables {
 436 # nothing - DB_FIle will create them on openDB()
 437 }
 438
 439 1;