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
 103     if (!scalar @{ "${db}_format" }) {
 104         &ERROR("dG: no valid format layout for $db.");
 105         return;
 106     }
 107
 108     if (!defined ${ "$db" }{lc $val}) { # dbm hash exception.
 109         &DEBUG("dbGet: '$val' does not exist in $db.");
 110         return;
 111     }
 112
 113     # return the whole row.
 114     if ($select eq "*") {
 115         return split $;, ${ "$db" }{lc $val};
 116     } else {
 117         &DEBUG("dbGet: select => '$select'.");
 118     }
 119
 120     my @array = split "$;", ${ "$db" }{lc $val};
 121     for (0 .. $#{ "${db}_format" }) {
 122         my $str = ${ "${db}_format" }[$_];
 123         next unless (grep /^$str$/, split(/\,/, $select));
 124
 125         $array[$_] ||= '';
 126         &DEBUG("dG: pushing '$array[$_]'.");
 127         push(@retval, $array[$_]);
 128     }
 129
 130     if (scalar @retval > 1) {
 131         return @retval;
 132     } elsif (scalar @retval == 1) {
 133         return $retval[0];
 134     } else {
 135         return;
 136     }
 137 }
 138
 139 #####
 140 # Usage: &dbGetCol();
 141 sub dbGetCol {
 142     &DEBUG("STUB: &dbGetCol();");
 143 }
 144
 145 #####
 146 # Usage: &dbGetRowInfo();
 147 sub dbGetRowInfo {
 148     my ($db) = @_;
 149
 150     if (scalar @{ "${db}_format" }) {
 151         return @{ "${db}_format" };
 152     } else {
 153         &ERROR("dbGCI: invalid format name ($db) [${db}_format].");
 154         return;
 155     }
 156 }
 157
 158 #####
 159 # Usage: &dbSet($db, $primkey, $primval, $key, $val);
 160 sub dbSet {
 161     my ($db, $primkey, $primval, $key, $val) = @_;
 162     my $found = 0;
 163     &DEBUG("dbSet($db, $primkey, $primval, $key, $val);");
 164
 165     my $info = ${$db}{lc $primval};     # case insensitive.
 166     my @array = ($info) ? split(/$;/, $info) : ();
 167
 168     # new entry.
 169     if (!defined ${$db}{lc $primval}) {
 170         # we assume primary key as first one. bad!
 171         $array[0] = $primval;           # case sensitive.
 172     }
 173
 174     for (0 .. $#{ "${db}_format" }) {
 175         $array[$_] ||= '';      # from undefined to ''.
 176         next unless (${ "${db}_format" }[$_] eq $key);
 177         &DEBUG("dbSet: Setting array[$_]($key) to '$val'.");
 178         $array[$_] = $val;
 179         $found++;
 180         last;
 181     }
 182
 183     if (!$found) {
 184         &msg($who,"error: invalid element name \002$type\002.");
 185         return 0;
 186     }
 187
 188     &DEBUG("setting $primval => '".join('|', @array)."'.");
 189     ${$db}{lc $primval} = join $;, @array;
 190
 191     return 1;
 192 }
 193
 194 sub dbUpdate {
 195     &DEBUG("STUB: &dbUpdate(@_); FIXME!!!");
 196 }
 197
 198 sub dbInsert {
 199     my ($db, $primkey, %hash) = @_;
 200     my $found = 0;
 201
 202     my $info = ${$db}{lc $primkey} || '';       # primkey or primval?
 203
 204     if (!scalar @{ "${db}_format" }) {
 205         &ERROR("dbI: array ${db}_format does not exist.");
 206         return 0;
 207     }
 208
 209     my $i;
 210     my @array = split $;, $info;
 211     for $i (0 .. $#{ "${db}_format" }) {
 212         $array[$i] ||= '';
 213
 214         foreach (keys %hash) {
 215             my $col = ${ "${db}_format" }[$i];
 216             next unless ($col eq $_);
 217
 218             &DEBUG("dbI: setting $db->$primkey\{$col} => '$hash{$_}'.");
 219             $array[$i] = $hash{$_};
 220             delete $hash{$_};
 221         }
 222     }
 223
 224     if (scalar keys %hash) {
 225         &ERROR("dbI: not added...");
 226         foreach (keys %hash) {
 227             &ERROR("dbI:   '$_' => '$hash{$_}'");
 228         }
 229         return 0;
 230     }
 231
 232     ${$db}{lc $primkey} = join $;, @array;
 233
 234     return 1;
 235 }
 236
 237 #####
 238 # Usage: &dbSetRow($db, @values);
 239 sub dbSetRow {
 240     my ($db, @values) = @_;
 241     my $key = lc $values[0];
 242
 243     if (!scalar @{ "${db}_format" }) {
 244         &ERROR("dbSR: array ${db}_format does not exist.");
 245         return 0;
 246     }
 247
 248     if (defined ${$db}{$key}) {
 249         &WARN("dbSetRow: $db {$key} already exists?");
 250     }
 251
 252     if (scalar @values != scalar @{ "${db}_format" }) {
 253         &WARN("dbSetRow: scalar values != scalar ${db}_format.");
 254     }
 255
 256     for (0 .. $#{ "${db}_format" }) {
 257         if (defined $array[$_] and $array[$_] ne "") {
 258             &DEBUG("dbSetRow: array[$_] != NULL($array[$_]).");
 259         }
 260         $array[$_] = $values[$_];
 261     }
 262
 263     ${$db}{$key}        = join $;, @array;
 264
 265     &DEBUG("STUB: &dbSetRow(@_);");
 266 }
 267
 268 #####
 269 # Usage: &dbDel($db, NULL, $primval);
 270 sub dbDel {
 271     my ($db, $primkey, $primval) = @_;
 272
 273     if (!scalar @{ "${db}_format" }) {
 274         &ERROR("dbD: array ${db}_format does not exist.");
 275         return 0;
 276     }
 277
 278     if (!defined ${$db}{lc $primval}) {
 279         &WARN("dbDel: lc $primval does not exist in $db.");
 280     } else {
 281         delete ${$db}{lc $primval};
 282     }
 283
 284     return '';
 285 }
 286
 287 sub dbRaw {
 288     &DEBUG("STUB: &dbRaw(@_);");
 289 }
 290
 291 sub dbRawReturn {
 292     &DEBUG("STUB: &dbRawReturn(@_);");
 293 }
 294
 295
 296
 297 ####################################################################
 298 ##### Factoid related stuff...
 299 #####
 300
 301 sub countKeys {
 302     return scalar keys %{$_[0]};
 303 }
 304
 305 sub getKeys {
 306     &DEBUG("STUB: &getKeys(@_); -- REDUNDANT");
 307 }
 308
 309 sub randKey {
 310     &DEBUG("STUB: &randKey(@_);");
 311 }
 312
 313 ##### $select is misleading???
 314 # Usage: &searchTable($db, $returnkey, $primkey, $str);
 315 sub searchTable {
 316     my ($db, $primkey, $key, $str) = @_;
 317
 318     if (!scalar @{ "${db}_format" }) {
 319         &ERROR("sT: no valid format layout for $db.");
 320         return;
 321     }
 322
 323     my @results;
 324     foreach (keys %{$db}) {
 325         my $val = &dbGet($db, "NULL", $_, $key) || '';
 326         next unless ($val =~ /\Q$str\E/);
 327         push(@results, $_);
 328     }
 329
 330     &DEBUG("sT: ".scalar(@results) );
 331
 332     @results;
 333 }
 334
 335 #####
 336 # Usage: &getFactInfo($faqtoid, type);
 337 sub getFactInfo {
 338     my ($faqtoid, $type) = @_;
 339
 340     if (!defined $factoids{$faqtoid}) { # dbm hash exception.
 341         return;
 342     }
 343
 344     if ($type eq "*") {         # all.
 345         return split /$;/, $factoids{$faqtoid};
 346     }
 347
 348     # specific.
 349     if (!grep /^$type$/, @factoids_format) {
 350         &ERROR("gFI: type '$type' not valid for factoids.");
 351         return;
 352     }
 353
 354     my @array   = split /$;/, $factoids{$faqtoid};
 355     for (0 .. $#factoids_format) {
 356         next unless ($type eq $factoids_format[$_]);
 357         return $array[$_];
 358     }
 359
 360     &ERROR("gFI: should never happen.");
 361 }
 362
 363 #####
 364 # Usage: &getFactoid($faqtoid);
 365 sub getFactoid {
 366     my ($faqtoid) = @_;
 367
 368     if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
 369         &WARN("getF: faqtoid == NULL.");
 370         return;
 371     }
 372
 373     if (defined $factoids{$faqtoid}) {  # dbm hash exception.
 374         # we assume 1 unfortunately.
 375         ### TODO: use &getFactInfo() instead?
 376         my $retval = (split $;, $factoids{$faqtoid})[1];
 377
 378         if (defined $retval) {
 379             &DEBUG("getF: returning '$retval' for '$faqtoid'.");
 380         } else {
 381             &DEBUG("getF: returning NULL for '$faqtoid'.");
 382         }
 383         return $retval;
 384     } else {
 385         return;
 386     }
 387 }
 388
 389 #####
 390 # Usage: &delFactoid($faqtoid);
 391 sub delFactoid {
 392     my ($faqtoid) = @_;
 393
 394     if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
 395         &WARN("delF: faqtoid == NULL.");
 396         return;
 397     }
 398
 399     if (defined $factoids{$faqtoid}) {  # dbm hash exception.
 400         delete $factoids{$faqtoid};
 401         &status("DELETED $faqtoid");
 402     } else {
 403         &WARN("delF: nothing to deleted? ($faqtoid)");
 404         return;
 405     }
 406 }
 407
 408 1;