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.
72 foreach (keys %formats) {
73 next unless (&IsParam($_));
75 my $file = "$param{'DBName'}-$_";
77 if (dbmopen(%{ $_ }, $file, 0666)) {
78 &status("Opened DBM $_ ($file).");
80 &ERROR("Failed open to DBM $_ ($file).");
88 foreach (keys %formats) {
89 next unless (&IsParam($_));
91 if (dbmclose(%{ $_ })) {
92 &status("Closed DBM $_ successfully.");
95 &ERROR("Failed closing DBM $_.");
100 # Usage: &dbGetColInfo($table);
104 if (scalar @{$formats{$table}}) {
105 return @{$formats{$table}};
107 &ERROR("dbGCI: no format for table ($table).");
114 # Usage: &dbQuote($str);
120 # Usage: &dbGet($table, $select, $where);
122 my ($table, $select, $where) = @_;
123 my ($key, $val) = split('=',$where) if $where =~ /=/;
127 &DEBUG("dbGet($table, $select, $where);");
130 my @format = &dbGetColInfo($table);
131 if (!scalar @format) {
135 if (!defined ${ "$table" }{lc $val}) { # dbm hash exception.
136 &DEBUG("dbGet: '$val' does not exist in $table.");
140 # return the whole row.
141 if ($select eq "*") {
142 @retval = split $;, ${"$table"}{lc $val};
143 unshift(@retval,$key);
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));
154 &DEBUG("dG: pushing '$array[$_]'.");
155 push(@retval, $array[$_]);
158 if (scalar @retval > 1) {
160 } elsif (scalar @retval == 1) {
168 # Usage: &dbGetCol();
169 # Usage: &dbGetCol($table, $select, $where, [$type]);
171 my ($table, $select, $where, $type) = @_;
172 &FIXME("STUB: &dbGetCol($table, $select, $where, $type);");
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};
183 $hash{lc $key} = $val;
184 my (@format) = &dbGetColInfo($table);
186 @hash{@format} = split $;, ${$table}{lc $val};
191 # Usage: &dbInsert($table, $primkey, %hash);
192 # Note: dbInsert should do dbQuote.
194 my ($table, $primkey, %hash) = @_;
196 &DEBUG("dbInsert($table, $primkey, ...)");
198 my $info = ${$table}{lc $primkey} || ''; # primkey or primval?
200 my @format = &dbGetColInfo($table);
201 if (!scalar @format) {
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];
213 &DEBUG("dbI: setting $table->$primkey\{$col\} => '$array[$i - 1]'.");
216 if (scalar keys %hash) {
217 &ERROR("dbI: not added...");
218 foreach (keys %hash) {
219 &ERROR("dbI: '$_' => '$hash{$_}'");
224 ${$table}{lc $primkey} = join $;, @array;
230 &FIXME("STUB: &dbUpdate(@_); => somehow use dbInsert!");
234 # Usage: &dbSetRow($table, @values);
236 my ($table, @values) = @_;
237 &DEBUG("dbSetRow(@_);");
238 my $key = lc $values[0];
240 my @format = &dbGetColInfo($table);
241 if (!scalar @format) {
245 if (defined ${$table}{$key}) {
246 &WARN("dbSetRow: $table {$key} already exists?");
249 if (scalar @values != scalar @format) {
250 &WARN("dbSetRow: scalar values != scalar ${table} format.");
253 for (0 .. $#format) {
254 if (defined $array[$_] and $array[$_] ne "") {
255 &DEBUG("dbSetRow: array[$_] != NULL($array[$_]).");
257 $array[$_] = $values[$_];
260 ${$table}{$key} = join $;, @array;
264 # Usage: &dbDel($table, $primkey, $primval, [$key]);
266 my ($table, $primkey, $primval, $key) = @_;
267 &DEBUG("dbDel($table, $primkey, $primval);");
269 if (!defined ${$table}{lc $primval}) {
270 &WARN("dbDel: lc $primval does not exist in $table.");
272 delete ${$table}{lc $primval};
279 # Usage: &dbReplace($table, $key, %hash);
280 # Note: dbReplace does optional dbQuote.
282 my ($table, $key, %hash) = @_;
283 &DEBUG("dbReplace($table, $key, %hash);");
285 &dbDel($table, $key, $hash{$key}, %hash);
286 &dbInsert($table, $hash{$key}, %hash);
291 # Usage: &dbSet($table, $primhash_ref, $hash_ref);
293 my ($table, $phref, $href) = @_;
295 my ($key) = keys %{$phref};
296 my $where = $key . "=" . $phref->{$key};
298 my %hash = &dbGetColNiceHash($table, "*", $where);
299 foreach (keys %{$href}) {
300 &DEBUG("dbSet: setting $_=${$href}{$_}");
301 $hash{$_} = ${$href}{$_};
303 &dbReplace($table, $key, %hash);
308 &FIXME("STUB: &dbRaw(@_);");
312 &FIXME("STUB: &dbRawReturn(@_);");
317 ####################################################################
318 ##### Factoid related stuff...
322 return scalar keys %{$_[0]};
326 &FIXME("STUB: &getKeys(@_); -- REDUNDANT");
330 &FIXME("STUB: &randKey(@_);");
333 ##### $select is misleading???
334 # Usage: &searchTable($table, $returnkey, $primkey, $str);
336 &FIXME("STUB: searchTable($table, $primkey, $key, $str)");
338 my ($table, $primkey, $key, $str) = @_;
339 &DEBUG("searchTable($table, $primkey, $key, $str)");
341 if (!scalar &dbGetColInfo($table)) {
346 foreach (keys %{$table}) {
347 my $val = &dbGet($table, "NULL", $_, $key) || '';
348 next unless ($val =~ /\Q$str\E/);
352 &DEBUG("sT: ".scalar(@results) );
358 # Usage: &getFactInfo($faqtoid, $type);
360 my ($faqtoid, $type) = @_;
362 my @format = &dbGetColInfo("factoids");
363 if (!scalar @format) {
367 if (!defined $factoids{$faqtoid}) { # dbm hash exception.
371 if ($type eq "*") { # all.
372 return split /$;/, $factoids{$faqtoid};
376 if (!grep /^$type$/, @format) {
377 &ERROR("gFI: type '$type' not valid for factoids.");
381 my @array = split /$;/, $factoids{$faqtoid};
382 for (0 .. $#format) {
383 next unless ($type eq $format[$_]);
387 &ERROR("gFI: should never happen.");
391 # Usage: &getFactoid($faqtoid);
395 if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
396 &WARN("getF: faqtoid == NULL.");
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];
405 if (defined $retval) {
406 &DEBUG("getF: returning '$retval' for '$faqtoid'.");
408 &DEBUG("getF: returning NULL for '$faqtoid'.");
417 # Usage: &delFactoid($faqtoid);
421 if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
422 &WARN("delF: faqtoid == NULL.");
426 if (defined $factoids{$faqtoid}) { # dbm hash exception.
427 delete $factoids{$faqtoid};
428 &status("DELETED $faqtoid");
430 &WARN("delF: nothing to deleted? ($faqtoid)");
436 # nothing - DB_FIle will create them on openDB()