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.
14 use vars qw(@factoids_format @rootwarn_format @seen_format);
49 @rootwarn_format = ("nick", "attempt", "time", "host", "channel");
62 my @dbm = ("factoids","freshmeat","rootwarn","seen");
67 next unless (&IsParam($_));
69 my $file = "$param{'DBName'}-$_";
71 if (dbmopen(%{ $_ }, $file, 0644)) {
72 &status("Opened DBM $_ ($file).");
74 &ERROR("Failed open to DBM $_ ($file).");
84 next unless (&IsParam($_));
86 if (dbmclose(%{ $_ })) {
87 &status("Closed DBM $_ successfully.");
90 &ERROR("Failed closing DBM $_.");
95 # Usage: &dbGet($table, $primkey, $primval, $select);
97 my ($db, $key, $val, $select) = @_;
101 &DEBUG("dbGet($db, $key, $val, $select);");
102 # TODO: support change that's done for db_mysql!
104 if (!scalar @{ "${db}_format" }) {
105 &ERROR("dG: no valid format layout for $db.");
109 if (!defined ${ "$db" }{lc $val}) { # dbm hash exception.
110 &DEBUG("dbGet: '$val' does not exist in $db.");
114 # return the whole row.
115 if ($select eq "*") {
116 return split $;, ${ "$db" }{lc $val};
118 &DEBUG("dbGet: select => '$select'.");
121 my @array = split "$;", ${ "$db" }{lc $val};
122 for (0 .. $#{ "${db}_format" }) {
123 my $str = ${ "${db}_format" }[$_];
124 next unless (grep /^$str$/, split(/\,/, $select));
127 &DEBUG("dG: pushing '$array[$_]'.");
128 push(@retval, $array[$_]);
131 if (scalar @retval > 1) {
133 } elsif (scalar @retval == 1) {
141 # Usage: &dbGetCol();
143 &DEBUG("STUB: &dbGetCol();");
147 # Usage: &dbGetColInfo();
151 if (scalar @{ "${db}_format" }) {
152 return @{ "${db}_format" };
154 &ERROR("dbGCI: invalid format name ($db) [${db}_format].");
160 # Usage: &dbSet($db, $primkey, $primval, $key, $val);
162 my ($db, $primkey, $primval, $key, $val) = @_;
164 &DEBUG("dbSet($db, $primkey, $primval, $key, $val);");
166 my $info = ${$db}{lc $primval}; # case insensitive.
167 my @array = ($info) ? split(/$;/, $info) : ();
170 if (!defined ${$db}{lc $primval}) {
171 # we assume primary key as first one. bad!
172 $array[0] = $primval; # case sensitive.
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'.");
185 &msg($who,"error: invalid element name \002$type\002.");
189 &DEBUG("setting $primval => '".join('|', @array)."'.");
190 ${$db}{lc $primval} = join $;, @array;
196 &FIXME("STUB: &dbUpdate(@_); => somehow use dbInsert!");
200 my ($db, $primkey, %hash) = @_;
203 my $info = ${$db}{lc $primkey} || ''; # primkey or primval?
205 if (!scalar @{ "${db}_format" }) {
206 &ERROR("dbI: array ${db}_format does not exist.");
211 my @array = split $;, $info;
212 for $i (0 .. $#{ "${db}_format" }) {
215 foreach (keys %hash) {
216 my $col = ${ "${db}_format" }[$i];
217 next unless ($col eq $_);
219 &DEBUG("dbI: setting $db->$primkey\{$col} => '$hash{$_}'.");
220 $array[$i] = $hash{$_};
225 if (scalar keys %hash) {
226 &ERROR("dbI: not added...");
227 foreach (keys %hash) {
228 &ERROR("dbI: '$_' => '$hash{$_}'");
233 ${$db}{lc $primkey} = join $;, @array;
239 # Usage: &dbSetRow($db, @values);
241 my ($db, @values) = @_;
242 my $key = lc $values[0];
244 if (!scalar @{ "${db}_format" }) {
245 &ERROR("dbSR: array ${db}_format does not exist.");
249 if (defined ${$db}{$key}) {
250 &WARN("dbSetRow: $db {$key} already exists?");
253 if (scalar @values != scalar @{ "${db}_format" }) {
254 &WARN("dbSetRow: scalar values != scalar ${db}_format.");
257 for (0 .. $#{ "${db}_format" }) {
258 if (defined $array[$_] and $array[$_] ne "") {
259 &DEBUG("dbSetRow: array[$_] != NULL($array[$_]).");
261 $array[$_] = $values[$_];
264 ${$db}{$key} = join $;, @array;
266 &DEBUG("STUB: &dbSetRow(@_);");
270 # Usage: &dbDel($db, NULL, $primval);
272 my ($db, $primkey, $primval) = @_;
274 if (!scalar @{ "${db}_format" }) {
275 &ERROR("dbD: array ${db}_format does not exist.");
279 if (!defined ${$db}{lc $primval}) {
280 &WARN("dbDel: lc $primval does not exist in $db.");
282 delete ${$db}{lc $primval};
289 &DEBUG("STUB: &dbRaw(@_);");
293 &DEBUG("STUB: &dbRawReturn(@_);");
298 ####################################################################
299 ##### Factoid related stuff...
303 return scalar keys %{$_[0]};
307 &DEBUG("STUB: &getKeys(@_); -- REDUNDANT");
311 &DEBUG("STUB: &randKey(@_);");
314 ##### $select is misleading???
315 # Usage: &searchTable($db, $returnkey, $primkey, $str);
317 my ($db, $primkey, $key, $str) = @_;
319 if (!scalar @{ "${db}_format" }) {
320 &ERROR("sT: no valid format layout for $db.");
325 foreach (keys %{$db}) {
326 my $val = &dbGet($db, "NULL", $_, $key) || '';
327 next unless ($val =~ /\Q$str\E/);
331 &DEBUG("sT: ".scalar(@results) );
337 # Usage: &getFactInfo($faqtoid, type);
339 my ($faqtoid, $type) = @_;
341 if (!defined $factoids{$faqtoid}) { # dbm hash exception.
345 if ($type eq "*") { # all.
346 return split /$;/, $factoids{$faqtoid};
350 if (!grep /^$type$/, @factoids_format) {
351 &ERROR("gFI: type '$type' not valid for factoids.");
355 my @array = split /$;/, $factoids{$faqtoid};
356 for (0 .. $#factoids_format) {
357 next unless ($type eq $factoids_format[$_]);
361 &ERROR("gFI: should never happen.");
365 # Usage: &getFactoid($faqtoid);
369 if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
370 &WARN("getF: faqtoid == NULL.");
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];
379 if (defined $retval) {
380 &DEBUG("getF: returning '$retval' for '$faqtoid'.");
382 &DEBUG("getF: returning NULL for '$faqtoid'.");
391 # Usage: &delFactoid($faqtoid);
395 if (!defined $faqtoid or $faqtoid =~ /^\s*$/) {
396 &WARN("delF: faqtoid == NULL.");
400 if (defined $factoids{$faqtoid}) { # dbm hash exception.
401 delete $factoids{$faqtoid};
402 &status("DELETED $faqtoid");
404 &WARN("delF: nothing to deleted? ($faqtoid)");