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