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)
11 if (&IsParam('useStrict')) { use strict;}
13 use vars qw(%factoids %freshmeat %seen %rootwarn); # db hash.
64 foreach (keys %formats) {
65 next unless (&IsParam($_));
67 my $file = "$param{'DBName'}-$_";
69 if (dbmopen(%{ $_ }, $file, 0666)) {
70 &status("Opened DBM $_ ($file).");
72 &ERROR("Failed open to DBM $_ ($file).");
80 foreach (keys %formats) {
81 next unless (&IsParam($_));
83 if (dbmclose(%{ $_ })) {
84 &status("Closed DBM $_ successfully.");
87 &ERROR("Failed closing DBM $_.");
92 # Usage: &dbGetColInfo($table);
96 if (scalar @{$formats{$table}}) {
97 return @{$formats{$table}};
99 &ERROR("dbGCI: no format for table ($table).");
106 # Usage: &dbQuote($str);
112 # Usage: &dbGet($table, $select, $where);
114 my ($table, $select, $where) = @_;
115 my ($key, $val) = split('=',$where) if $where =~ /=/;
119 &DEBUG("dbGet($table, $select, $where);");
122 my @format = &dbGetColInfo($table);
123 if (!scalar @format) {
127 if (!defined ${ "$table" }{lc $val}) { # dbm hash exception.
128 &DEBUG("dbGet: '$val' does not exist in $table.");
132 # return the whole row.
133 if ($select eq "*") {
134 @retval = split $;, ${"$table"}{lc $val};
135 unshift(@retval,$key);
139 &DEBUG("dbGet: select=>'$select'.");
140 my @array = split "$;", ${"$table"}{lc $val};
141 unshift(@array,$val);
142 for (0 .. $#format) {
143 my $str = $format[$_];
144 next unless (grep /^$str$/, split(/\,/, $select));
146 &DEBUG("dG: '$format[$_]'=>'$array[$_]'.");
147 push(@retval, $array[$_]);
150 if (scalar @retval > 1) {
152 } elsif (scalar @retval == 1) {
160 # Usage: &dbGetCol();
161 # Usage: &dbGetCol($table, $select, $where, [$type]);
163 my ($table, $select, $where, $type) = @_;
164 &FIXME("STUB: &dbGetCol($table, $select, $where, $type);");
168 # Usage: &dbGetColNiceHash($table, $select, $where);
169 sub dbGetColNiceHash {
170 my ($table, $select, $where) = @_;
171 &DEBUG("dbGetColNiceHash($table, $select, $where);");
172 my ($key, $val) = split('=',$where) if $where =~ /=/;
173 return unless ${$table}{lc $val};
175 $hash{lc $key} = $val;
176 my (@format) = &dbGetColInfo($table);
178 @hash{@format} = split $;, ${$table}{lc $val};
183 # Usage: &dbInsert($table, $primkey, %hash);
184 # Note: dbInsert should do dbQuote.
186 my ($table, $primkey, %hash) = @_;
188 &DEBUG("dbInsert($table, $primkey, ...)");
190 my $info = ${$table}{lc $primkey} || ''; # primkey or primval?
192 my @format = &dbGetColInfo($table);
193 if (!scalar @format) {
198 my @array = split $;, $info;
199 delete $hash{$format[0]};
200 for $i (1 .. $#format) {
201 my $col = $format[$i];
202 $array[$i - 1]=$hash{$col};
203 $array[$i - 1]='' unless $array[$i - 1];
205 &DEBUG("dbI: '$col'=>'$array[$i - 1]'");
208 if (scalar keys %hash) {
209 &ERROR("dbI: not added...");
210 foreach (keys %hash) {
211 &ERROR("dbI: '$_'=>'$hash{$_}'");
216 ${$table}{lc $primkey} = join $;, @array;
222 &FIXME("STUB: &dbUpdate(@_);=>somehow use dbInsert!");
226 # Usage: &dbSetRow($table, @values);
228 my ($table, @values) = @_;
229 &DEBUG("dbSetRow(@_);");
230 my $key = lc $values[0];
232 my @format = &dbGetColInfo($table);
233 if (!scalar @format) {
237 if (defined ${$table}{$key}) {
238 &WARN("dbSetRow: $table {$key} already exists?");
241 if (scalar @values != scalar @format) {
242 &WARN("dbSetRow: scalar values != scalar ${table} format.");
245 for (0 .. $#format) {
246 if (defined $array[$_] and $array[$_] ne "") {
247 &DEBUG("dbSetRow: array[$_] != NULL($array[$_]).");
249 $array[$_] = $values[$_];
252 ${$table}{$key} = join $;, @array;
256 # Usage: &dbDel($table, $primkey, $primval, [$key]);
258 my ($table, $primkey, $primval, $key) = @_;
259 &DEBUG("dbDel($table, $primkey, $primval);");
261 if (!defined ${$table}{lc $primval}) {
262 &DEBUG("dbDel: lc $primval does not exist in $table.");
264 delete ${$table}{lc $primval};
271 # Usage: &dbReplace($table, $key, %hash);
272 # Note: dbReplace does optional dbQuote.
274 my ($table, $key, %hash) = @_;
275 &DEBUG("dbReplace($table, $key, %hash);");
277 &dbDel($table, $key, $hash{$key}, %hash);
278 &dbInsert($table, $hash{$key}, %hash);
283 # Usage: &dbSet($table, $primhash_ref, $hash_ref);
285 my ($table, $phref, $href) = @_;
287 my ($key) = keys %{$phref};
288 my $where = $key . "=" . $phref->{$key};
290 my %hash = &dbGetColNiceHash($table, "*", $where);
291 $hash{$key}=$phref->{$key};
292 foreach (keys %{$href}) {
293 &DEBUG("dbSet: setting $_=${$href}{$_}");
294 $hash{$_} = ${$href}{$_};
296 &dbReplace($table, $key, %hash);
301 &FIXME("STUB: &dbRaw(@_);");
305 &FIXME("STUB: &dbRawReturn(@_);");
310 ####################################################################
311 ##### Factoid related stuff...
315 return scalar keys %{$_[0]};
319 &FIXME("STUB: &getKeys(@_); -- REDUNDANT");
323 &DEBUG("STUB: &randKey(@_);");
324 my ($table, $select) = @_;
325 my @format = &dbGetColInfo($table);
326 if (!scalar @format) {
330 my $rand = int(rand(&countKeys($table) - 1));
331 my @keys = keys %{$table};
332 &dbGet($table, '$select', "$format[0]=$keys[$rand]");
336 # Usage: &deleteTable($table);
339 &FIXME("STUB: deleteTable($table)");
342 ##### $select is misleading???
343 # Usage: &searchTable($table, $returnkey, $primkey, $str);
345 my ($table, $primkey, $key, $str) = @_;
346 &FIXME("STUB: searchTable($table, $primkey, $key, $str)");
348 &DEBUG("searchTable($table, $primkey, $key, $str)");
350 if (!scalar &dbGetColInfo($table)) {
355 foreach (keys %{$table}) {
356 my $val = &dbGet($table, "NULL", $_, $key) || '';
357 next unless ($val =~ /\Q$str\E/);
361 &DEBUG("sT: ".scalar(@results) );
367 # Usage: &getFactInfo($faqtoid, $type);
369 my ($faqtoid, $type) = @_;
371 my @format = &dbGetColInfo("factoids");
372 if (!scalar @format) {
376 if (!defined $factoids{$faqtoid}) { # dbm hash exception.
380 if ($type eq "*") { # all.
381 return split /$;/, $factoids{$faqtoid};
385 if (!grep /^$type$/, @format) {
386 &ERROR("gFI: type '$type' not valid for factoids.");
390 my @array = split /$;/, $factoids{$faqtoid};
391 for (0 .. $#format) {
392 next unless ($type eq $format[$_]);
396 &ERROR("gFI: should never happen.");
400 # Usage: &getFactoid($faqtoid);
404 if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
405 &WARN("getF: faqtoid == NULL.");
409 if (defined $factoids{$faqtoid}) { # dbm hash exception.
410 # we assume 1 unfortunately.
411 ### TODO: use &getFactInfo() instead?
412 my $retval = (split $;, $factoids{$faqtoid})[1];
414 if (defined $retval) {
415 &DEBUG("getF: returning '$retval' for '$faqtoid'.");
417 &DEBUG("getF: returning NULL for '$faqtoid'.");
426 # Usage: &delFactoid($faqtoid);
430 if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
431 &WARN("delF: faqtoid == NULL.");
435 if (defined $factoids{$faqtoid}) { # dbm hash exception.
436 delete $factoids{$faqtoid};
437 &status("DELETED $faqtoid");
439 &WARN("delF: nothing to deleted? ($faqtoid)");
445 # nothing - DB_FIle will create them on openDB()