]> git.donarmstrong.com Git - infobot.git/commitdiff
- berkeley dbm support now works! thanks to tim riker.
authordms <dms@c11ca15a-4712-0410-83d8-924469b57eb5>
Tue, 29 Oct 2002 15:02:18 +0000 (15:02 +0000)
committerdms <dms@c11ca15a-4712-0410-83d8-924469b57eb5>
Tue, 29 Oct 2002 15:02:18 +0000 (15:02 +0000)
- moved shmFlush(),getChanConfDefault out of Scheduler.pl to
  where they should belong, to allow CLI support without need of
  IRC/*.pl.
- disable seen/dcc if interface is not IRC.
- Debian: unlink file if it's corrupted.

git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@560 c11ca15a-4712-0410-83d8-924469b57eb5

16 files changed:
src/CLI/Support.pl [new file with mode: 0644]
src/CommandStubs.pl
src/Factoids/Update.pl
src/IRC/Irc.pl
src/IRC/IrcHelpers.pl
src/IRC/IrcHooks.pl
src/IRC/Schedulers.pl
src/Modules/Debian.pl
src/Shm.pl
src/UserExtra.pl
src/core.pl
src/db_dbm.pl
src/db_mysql.pl
src/interface.pl
src/logger.pl
src/modules.pl

diff --git a/src/CLI/Support.pl b/src/CLI/Support.pl
new file mode 100644 (file)
index 0000000..b3c7b1a
--- /dev/null
@@ -0,0 +1,43 @@
+#
+# CLI/Support.pl: Stubs for functions that are from IRC/*
+#         Author: Tim Riker <Tim@Rikers.org>
+#        Version: v0.1 (20021028)
+#        Created: 20021028
+#
+
+sub msg {
+    my ($nick, $msg) = @_;
+    if (!defined $nick) {
+       &ERROR("msg: nick == NULL.");
+       return;
+    }
+
+    if (!defined $msg) {
+       $msg ||= "NULL";
+       &WARN("msg: msg == $msg.");
+       return;
+    }
+
+    &status(">$nick< $msg");
+
+    print("$nick: $msg\n");
+}
+
+sub performStrictReply {
+    &msg($who, @_);
+}
+
+sub performReply {
+    &msg($who, @_);
+}
+
+sub performAddressedReply {
+    return unless ($addressed);
+    &msg($who, @_);
+}
+
+sub pSReply {
+    &msg($who, @_);
+}
+
+1;
index 39833b589dc820bd98df508f9d8e3713ee82bc7d..7aec2a61eb684a20805f37cae4dbafaf9bce4d85 100644 (file)
@@ -575,6 +575,11 @@ sub seen {
     my($person) = lc shift;
     $person =~ s/\?*$//;
 
+    if (&whatInterface() !~ /IRC/) {
+       &status("seen disabled in CLI.");
+       return;
+    }
+
     if (!defined $person or $person =~ /^$/) {
        &help("seen");
 
index d0b57d13968f3587698b74dd67e093cacbfe1ba7..07b8ec6e1c9bbaa413f6dcb15af7e76833c09b2f 100644 (file)
@@ -224,9 +224,9 @@ sub update {
        &status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'");
 
        # should dbReplace be used here?
-       &delFactoid($lhs);
-       &setFactInfo($lhs,"created_by", $nuh);
-       &setFactInfo($lhs,"created_time", time());
+       #&delFactoid($lhs); # breaks dbm. leave it and use modified_* - Tim Riker <Tim@Rikers.org>
+       &setFactInfo($lhs,"modified_by", $nuh);
+       &setFactInfo($lhs,"modified_time", time());
        &setFactInfo($lhs,"factoid_value", $rhs);
 
        if (!defined $rhs or $rhs eq "") {
index 49d0438ef576933c861ad69d40632a6ff4f812d5..cdc98fa1c5d3b59aa765de94218e9672fb564588 100644 (file)
@@ -604,7 +604,8 @@ sub nick {
     if ($bad) {
        &WARN("Nick: not going to try and get my nick back. [".
                scalar(localtime). "]");
-       return;
+# hrm... over time we lose track of our own nick.
+#      return;
     }
 
     if ($nick =~ /^$mask{nick}$/) {
@@ -612,6 +613,8 @@ sub nick {
 
        if (defined $ident) {
            &status("nick: Changing nick to $nick (from $ident)");
+           # following shouldn't be here :(
+           $ident      = $nick;
        } else {
            &DEBUG("first time nick change.");
            $ident      = $nick;
index 2ce1acb91259eefee97eb714fd6b1511ee6b5ae9..53d3db7f71b19895f7b43d2b44ce607ba15c7a8f 100644 (file)
@@ -244,7 +244,7 @@ sub hookMsg {
        # better to ignore an extra message than to allow one to get
        # through, although it would be better to go through ignore
        # checking again.
-       if (time() - $cache{ignoreCheckTime} > 60) {
+       if (time() - ($cache{ignoreCheckTime} || 0) > 60) {
            &ignoreCheck();
        }
 
index 125ba7cb45754fed35edf1950ec68cf463f913ff..8370a2178650f8c54d8a14dfa2e30ad33bc31e7f 100644 (file)
@@ -459,6 +459,11 @@ sub on_join {
     my $i              = scalar(keys %{ $channels{$chan} });
     my $j              = $cache{maxpeeps}{$chan} || 0;
 
+    if (time() > $sched{shmFlush}{TIME} + 3600) {
+       &DEBUG("looks like schedulers died somewhere... restarting...");
+       &setupSchedulers();
+    }
+
     $chanstats{$chan}{'Join'}++;
     $userstats{lc $who}{'Join'} = time() if (&IsChanConf("seenStats"));
     $cache{maxpeeps}{$chan}    = $i if ($i > $j);
index 22742476350e34186877c3375e65370adc7772c7..7ce4284153c4aef3c72ae42501dc194cdfe3d029 100644 (file)
@@ -875,49 +875,6 @@ sub miscCheck2 {
     closedir DIR;
 }
 
-sub shmFlush {
-    return if ($$ != $::bot_pid); # fork protection.
-
-    if (@_) {
-       &ScheduleThis(5, "shmFlush");
-       return if ($_[0] eq "2");
-    }
-
-    my $time;
-    my $shmmsg = &shmRead($shm);
-    $shmmsg =~ s/\0//g;         # remove padded \0's.
-    if ($shmmsg =~ s/^(\d+): //) {
-       $time   = $1;
-    }
-
-    foreach (split '\|\|', $shmmsg) {
-       next if (/^$/);
-       &VERB("shm: Processing '$_'.",2);
-
-       if (/^DCC SEND (\S+) (\S+)$/) {
-           my ($nick,$file) = ($1,$2);
-           if (exists $dcc{'SEND'}{$who}) {
-               &msg($nick, "DCC already active.");
-           } else {
-               &DEBUG("shm: dcc sending $2 to $1.");
-               $conn->new_send($1,$2);
-               $dcc{'SEND'}{$who} = time();
-           }
-       } elsif (/^SET FORKPID (\S+) (\S+)/) {
-           $forked{$1}{PID} = $2;
-       } elsif (/^DELETE FORK (\S+)$/) {
-           delete $forked{$1};
-       } elsif (/^EVAL (.*)$/) {
-           &DEBUG("evaling '$1'.");
-           eval $1;
-       } else {
-           &DEBUG("shm: unknown msg. ($_)");
-       }
-    }
-
-    &shmWrite($shm,"") if ($shmmsg ne "");
-}
-
 ### this is semi-scheduled
 sub getNickInUse {
     if ($ident eq $param{'ircNick'}) {
@@ -1176,30 +1133,6 @@ sub scheduleList {
     &DEBUG("end of sList.");
 }
 
-sub getChanConfDefault {
-    my($what, $default, $chan) = @_;
-
-    if (exists $param{$what}) {
-       if (!exists $cache{config}{$what}) {
-           &status("conf: backward-compat: found param{$what} ($param{$what}) instead.");
-           $cache{config}{$what} = 1;
-       }
-
-       return $param{$what};
-    }
-
-    my $val = &getChanConf($what, $chan);
-    if (defined $val) {
-       return $val;
-    }
-
-    $param{$what}      = $default;
-    &status("conf: auto-setting param{$what} = $default");
-    $cache{config}{$what} = 1;
-
-    return $default;
-}
-
 sub mkBackup {
     my($file, $time)   = @_;
     my $backup         = 0;
index 8cd663e933afe8b4c8e10caaf40a1fe4b685a8f8..d4f1576e9876f5f8cdcb5bc277048b618783e0a5 100644 (file)
@@ -140,6 +140,13 @@ sub DebianDownload {
 #              system("cp debian/Contents-potato-i386-non-US.gz debian/Contents-woody-i386-non-US.gz");
 #          }
 
+           my $exit = CORE::system("/bin/gzip -t $file >/dev/null 2>&1");
+           if ($exit) {
+               &::WARN("deb: $file is corrupted :/");
+               unlink $file;
+               next;
+           }
+
            &::DEBUG("deb: download: good.") if ($debug);
            $good++;
        } else {
@@ -150,7 +157,7 @@ sub DebianDownload {
     }
 
     # ok... lets just run this.
-    &::miscCheck();
+    &::miscCheck() if (&::whatInterface() =~ /IRC/);
 
     if ($good) {
        &generateIndex($dist);
@@ -394,6 +401,7 @@ sub searchAuthor {
            $package = "";
 
        } else {
+           chop;
            &::WARN("debian: invalid line: '$_' (1).");
        }
     }
@@ -503,6 +511,7 @@ sub searchDesc {
            $package = "";
 
        } else {
+           chop;
            &::WARN("debian: invalid line: '$_'. (2)");
        }
     }
@@ -589,7 +598,7 @@ sub getPackageInfo {
        # package line.
        if (/^Package: (.*)\n$/) {
            $pkg = $1;
-           if ($pkg =~ /^$package$/i) {
+           if ($pkg =~ /^\Q$package\E$/i) {
                $found++;       # we can use pkg{'package'} instead.
                $pkg{'package'} = $pkg;
            }
index 34b68f2f1e7d1d3314f330cb4809fd15c835f97e..ab7e9964538e7549481d5489388b933993a39296 100644 (file)
@@ -5,7 +5,6 @@
 #   Created: 20000124
 #
 
-#use strict;
 use POSIX qw(_exit);
 
 sub openSHM {
@@ -13,7 +12,7 @@ sub openSHM {
     my $size = 2000;
 
     if (&IsParam("noSHM")) {
-       &status("Created shared memory: disabled. [bot may become  unreliable]");
+       &status("Created shared memory: disabled. [bot may become unreliable]");
        return 0;
     }
 
@@ -216,4 +215,47 @@ sub delForked {
     POSIX::_exit(0);
 }
 
+sub shmFlush {
+    return if ($$ != $::bot_pid); # fork protection.
+
+    if (@_) {
+       &ScheduleThis(5, "shmFlush");
+       return if ($_[0] eq "2");
+    }
+
+    my $time;
+    my $shmmsg = &shmRead($shm);
+    $shmmsg =~ s/\0//g;         # remove padded \0's.
+    if ($shmmsg =~ s/^(\d+): //) {
+       $time   = $1;
+    }
+
+    foreach (split '\|\|', $shmmsg) {
+       next if (/^$/);
+       &VERB("shm: Processing '$_'.",2);
+
+       if (/^DCC SEND (\S+) (\S+)$/) {
+           my ($nick,$file) = ($1,$2);
+           if (exists $dcc{'SEND'}{$who}) {
+               &msg($nick, "DCC already active.");
+           } else {
+               &DEBUG("shm: dcc sending $2 to $1.");
+               $conn->new_send($1,$2);
+               $dcc{'SEND'}{$who} = time();
+           }
+       } elsif (/^SET FORKPID (\S+) (\S+)/) {
+           $forked{$1}{PID} = $2;
+       } elsif (/^DELETE FORK (\S+)$/) {
+           delete $forked{$1};
+       } elsif (/^EVAL (.*)$/) {
+           &DEBUG("evaling '$1'.");
+           eval $1;
+       } else {
+           &DEBUG("shm: unknown msg. ($_)");
+       }
+    }
+
+    &shmWrite($shm,"") if ($shmmsg ne "");
+}
+
 1;
index 77f4480fdac2565732adeb6ee83ebf2bd0c4067b..105c22ef99f64df04e41961e6d6b1976b723f29e 100644 (file)
@@ -232,7 +232,7 @@ sub karma {
 sub ispell {
     my $query = shift;
 
-    if (! -x "/usr/bin/spell") {
+    if (! -x "/usr/bin/ispell") {
        &msg($who, "no binary found.");
        return;
     }
@@ -825,6 +825,8 @@ sub userCommands {
        if ($param{'ircNick'} eq $ident) {
            &msg($who, "I hope you're right. I'll try anyway.");
        }
+       &DEBUG("ircNick => $param{'ircNick'}");
+       &DEBUG("ident => $ident");
 
        if (! &IsNickInAnyChan( $param{ircNick} ) ) {
            my $str = "attempting to change nick to $param{'ircNick'}";
@@ -832,8 +834,9 @@ sub userCommands {
            &msg($who, $str);
            &nick($param{'ircNick'});
        } else {
-           &msg($who, "hrm... can't do it");
+           &msg($who, "hrm.. I shouldn't do it (BUG?) but doing it anyway!");
            &DEBUG("wN: nick is somewhere... should try later.");
+           &nick($param{'ircNick'});
        }
 
        return;
index 266890ecf4e4e9366661ff352185ff21563ae37b..da909ce9b8741a754ecc615b9e9c8136e9eb0e12 100644 (file)
@@ -100,10 +100,10 @@ sub doExit {
        &status("--- Start of quit.");
        $ident ||= "blootbot";  # lame hack.
 
-       &closeDCC();
+       &closeDCC() if (&whatInterface() =~ /IRC/); 
        &closePID();
        &closeStats();
-       &seenFlush();
+       &seenFlush() if (&whatInterface() =~ /IRC/);
        &quit($param{'quitMsg'}) if (&whatInterface() =~ /IRC/);
        &writeUserFile();
        &writeChanFile();
@@ -303,6 +303,27 @@ sub getChanConf {
     return $chanconf{"_default"}{$param};
 }
 
+sub getChanConfDefault {
+    my($what, $default, $chan) = @_;
+
+    if (exists $param{$what}) {
+       if (!exists $cache{config}{$what}) {
+           &status("conf: backward-compat: found param{$what} ($param{$what}) instead.");
+           $cache{config}{$what} = 1;
+       }
+
+       return $param{$what};
+    }
+    my $val = &getChanConf($what, $chan);
+    return $val if (defined $val);
+
+    $param{$what}      = $default;
+    &status("conf: auto-setting param{$what} = $default");
+    $cache{config}{$what} = 1;
+    return $default;
+}
+
+
 #####
 #  Usage: &findChanConf($param);
 #  About: Retrieve value for 'param' value from any chan.
index caefae9619626bcb94cf94f701312e70370eb037..a08abe82bae41e61d4c482d66c81b30f1e3980a7 100644 (file)
@@ -16,17 +16,13 @@ use vars qw(@factoids_format @rootwarn_format @seen_format);
 @factoids_format = (
        "factoid_key",
        "factoid_value",
-
        "created_by",
        "created_time",
-
        "modified_by",
        "modified_time",
-
        "requested_by",
        "requested_time",
        "requested_count",
-
        "locked_by",
        "locked_time"
 );
@@ -59,16 +55,22 @@ use vars qw(@factoids_format @rootwarn_format @seen_format);
        "message"
 );
 
-my @dbm        = ("factoids","freshmeat","rootwarn","seen");
+@stats_format = (
+       "nick",
+       "type",
+       "counter"
+);
+
+my @dbm        = ("factoids","freshmeat","rootwarn","seen","stats");
 
 sub openDB {
-
+    use DB_File;
     foreach (@dbm) {
        next unless (&IsParam($_));
 
        my $file = "$param{'DBName'}-$_";
 
-       if (dbmopen(%{ $_ }, $file, 0644)) {
+       if (dbmopen(%{ $_ }, $file, 0666)) {
            &status("Opened DBM $_ ($file).");
        } else {
            &ERROR("Failed open to DBM $_ ($file).");
@@ -92,35 +94,43 @@ sub closeDB {
 }
 
 #####
-# Usage: &dbGet($table, $primkey, $primval, $select);
+# Usage: &dbQuote($str);
+sub dbQuote {
+    return $_[0];
+}
+
+#####
+# Usage: &dbGet($table, $select, $where);
 sub dbGet {
-    my ($db, $key, $val, $select) = @_;
+    my ($table, $select, $where) = @_;
+    my ($key, $val) = split('=',$where) if $where =~ /=/;
     my $found = 0;
     my @retval;
     my $i;
-    &DEBUG("dbGet($db, $key, $val, $select);");
+    &DEBUG("dbGet($table, $select, $where);");
     # TODO: support change that's done for db_mysql!
+    return unless $key;
 
-    if (!scalar @{ "${db}_format" }) {
-       &ERROR("dG: no valid format layout for $db.");
+    if (!scalar @{ "${table}_format" }) {
+       &ERROR("dG: no valid format layout for $table.");
        return;
     }
 
-    if (!defined ${ "$db" }{lc $val}) {        # dbm hash exception.
-       &DEBUG("dbGet: '$val' does not exist in $db.");
+    if (!defined ${ "$table" }{lc $val}) {     # dbm hash exception.
+       &DEBUG("dbGet: '$val' does not exist in $table.");
        return;
     }
 
     # return the whole row.
     if ($select eq "*") {
-       return split $;, ${ "$db" }{lc $val};
+       return split $;, ${ "$table" }{lc $val};
     } else {
        &DEBUG("dbGet: select => '$select'.");
     }
 
-    my @array = split "$;", ${ "$db" }{lc $val};
-    for (0 .. $#{ "${db}_format" }) {
-       my $str = ${ "${db}_format" }[$_];
+    my @array = split "$;", ${ "$table" }{lc $val};
+    for (0 .. $#{ "${table}_format" }) {
+       my $str = ${ "${table}_format" }[$_];
        next unless (grep /^$str$/, split(/\,/, $select));
 
        $array[$_] ||= '';
@@ -139,87 +149,73 @@ sub dbGet {
 
 #####
 # Usage: &dbGetCol();
+# Usage: &dbGetCol($table, $select, $where, [$type]);
 sub dbGetCol {
-    &DEBUG("STUB: &dbGetCol();");
+    my ($table, $select, $where, $type) = @_;
+    &DEBUG("STUB: &dbGetCol($table, $select, $where, $type);");
+}
+
+#####
+# Usage: &dbGetColNiceHash($table, $select, $where);
+sub dbGetColNiceHash {
+    my ($table, $select, $where) = @_;
+    &DEBUG("dbGetColNiceHash($table, $select, $where);");
+    my ($key, $val) = split('=',$where) if $where =~ /=/;
+    my (%hash) = ();
+    return unless ${$table}{lc $val};
+    @hash{@{"${table}_format"}} = split $;, ${$table}{lc $val};
+    return %hash;
 }
 
 #####
 # Usage: &dbGetColInfo();
 sub dbGetColInfo {
-    my ($db) = @_;
+    my ($table) = @_;
 
-    if (scalar @{ "${db}_format" }) {
-       return @{ "${db}_format" };
+    if (scalar @{ "${table}_format" }) {
+       return @{ "${table}_format" };
     } else {
-       &ERROR("dbGCI: invalid format name ($db) [${db}_format].");
+       &ERROR("dbGCI: invalid format name ($table) [${table}_format].");
        return;
     }
 }
 
 #####
-# Usage: &dbSet($db, $primkey, $primval, $key, $val);
-sub dbSet {
-    my ($db, $primkey, $primval, $key, $val) = @_;
-    my $found = 0;
-    &DEBUG("dbSet($db, $primkey, $primval, $key, $val);");
-
-    my $info = ${$db}{lc $primval};    # case insensitive.
-    my @array = ($info) ? split(/$;/, $info) : ();
-
-    # new entry.
-    if (!defined ${$db}{lc $primval}) {
-       # we assume primary key as first one. bad!
-       $array[0] = $primval;           # case sensitive.
-    }
-
-    for (0 .. $#{ "${db}_format" }) {
-       $array[$_] ||= '';      # from undefined to ''.
-       next unless (${ "${db}_format" }[$_] eq $key);
-       &DEBUG("dbSet: Setting array[$_]($key) to '$val'.");
-       $array[$_] = $val;
-       $found++;
-       last;
-    }
-
-    if (!$found) {
-       &msg($who,"error: invalid element name \002$type\002.");
-       return 0;
-    }
-
-    &DEBUG("setting $primval => '".join('|', @array)."'.");
-    ${$db}{lc $primval}        = join $;, @array;
-
-    return 1;
-}
-
-sub dbUpdate {
-    &FIXME("STUB: &dbUpdate(@_); => somehow use dbInsert!");
-}
-
+# Usage: &dbInsert($table, $primkey, %hash);
+#  Note: dbInsert should do dbQuote.
 sub dbInsert {
-    my ($db, $primkey, %hash) = @_;
+    my ($table, $primkey, %hash) = @_;
     my $found = 0;
+    &DEBUG("dbInsert($table, $primkey, ...)");
 
-    my $info = ${$db}{lc $primkey} || '';      # primkey or primval?
+    my $info = ${$table}{lc $primkey} || '';   # primkey or primval?
 
-    if (!scalar @{ "${db}_format" }) {
-       &ERROR("dbI: array ${db}_format does not exist.");
+    if (!scalar @{ "${table}_format" }) {
+       &ERROR("dbI: array ${table}_format does not exist.");
        return 0;
     }
 
     my $i;
     my @array = split $;, $info;
-    for $i (0 .. $#{ "${db}_format" }) {
-       $array[$i] ||= '';
-
-       foreach (keys %hash) {
-           my $col = ${ "${db}_format" }[$i];
-           next unless ($col eq $_);
-
-           &DEBUG("dbI: setting $db->$primkey\{$col} => '$hash{$_}'.");
-           $array[$i] = $hash{$_};
-           delete $hash{$_};
-       }
+    $array[0]=$primkey;
+    delete $hash{${ "${table}_format" }[0]};
+    for $i (1 .. $#{ "${table}_format" }) {
+       my $col = ${ "${table}_format" }[$i];
+       $array[$i]=$hash{$col};
+       $array[$i]='' unless $array[$i];
+       delete $hash{$col};
+       &DEBUG("dbI: setting $table->$primkey\{$col\} => '$array[$i]'.");
+
+#      $array[$i] ||= '';
+#      foreach (keys %hash) {
+#          my $col = ${ "${table}_format" }[$i];
+#          next unless ($col eq $_);
+#          next unless $hash{$_};
+#
+#          &DEBUG("dbI: setting $table->$primkey\{$col\} => '$hash{$_}'.");
+#          $array[$i] = $hash{$_};
+#          delete $hash{$_};
+#      }
     }
 
     if (scalar keys %hash) {
@@ -230,61 +226,133 @@ sub dbInsert {
        return 0;
     }
 
-    ${$db}{lc $primkey}        = join $;, @array;
+    ${$table}{lc $primkey}     = join $;, @array;
 
     return 1;
 }
 
+sub dbUpdate {
+    &FIXME("STUB: &dbUpdate(@_); => somehow use dbInsert!");
+}
+
 #####
-# Usage: &dbSetRow($db, @values);
+# Usage: &dbSetRow($table, @values);
 sub dbSetRow {
-    my ($db, @values) = @_;
+    my ($table, @values) = @_;
+    &DEBUG("dbSetRow(@_);");
     my $key = lc $values[0];
 
-    if (!scalar @{ "${db}_format" }) {
-       &ERROR("dbSR: array ${db}_format does not exist.");
+    if (!scalar @{ "${table}_format" }) {
+       &ERROR("dbSR: array ${table}_format does not exist.");
        return 0;
     }
 
-    if (defined ${$db}{$key}) {
-       &WARN("dbSetRow: $db {$key} already exists?");
+    if (defined ${$table}{$key}) {
+       &WARN("dbSetRow: $table {$key} already exists?");
     }
 
-    if (scalar @values != scalar @{ "${db}_format" }) {
-       &WARN("dbSetRow: scalar values != scalar ${db}_format.");
+    if (scalar @values != scalar @{ "${table}_format" }) {
+       &WARN("dbSetRow: scalar values != scalar ${table}_format.");
     }
 
-    for (0 .. $#{ "${db}_format" }) {
+    for (0 .. $#{ "${table}_format" }) {
        if (defined $array[$_] and $array[$_] ne "") {
            &DEBUG("dbSetRow: array[$_] != NULL($array[$_]).");
        }
        $array[$_] = $values[$_];
     }
 
-    ${$db}{$key}       = join $;, @array;
-
-    &DEBUG("STUB: &dbSetRow(@_);");
+    ${$table}{$key}    = join $;, @array;
 }
 
 #####
-# Usage: &dbDel($db, NULL, $primval);
+# Usage: &dbDel($table, $primkey, $primval, [$key]);
 sub dbDel {
-    my ($db, $primkey, $primval) = @_;
+    my ($table, $primkey, $primval, $key) = @_;
+    &DEBUG("dbDel($table, $primkey, $primval);");
 
-    if (!scalar @{ "${db}_format" }) {
-       &ERROR("dbD: array ${db}_format does not exist.");
+    if (!scalar @{ "${table}_format" }) {
+       &ERROR("dbD: array ${table}_format does not exist.");
        return 0;
     }
 
-    if (!defined ${$db}{lc $primval}) {
-       &WARN("dbDel: lc $primval does not exist in $db.");
+    if (!defined ${$table}{lc $primval}) {
+       &WARN("dbDel: lc $primval does not exist in $table.");
     } else {
-       delete ${$db}{lc $primval};
+       delete ${$table}{lc $primval};
     }
 
     return '';
 }
 
+#####
+# Usage: &dbReplace($table, $key, %hash);
+#  Note: dbReplace does optional dbQuote.
+sub dbReplace {
+    my ($table, $key, %hash) = @_;
+    &DEBUG("dbReplace($table, $key, %hash);");
+
+    &dbDel($table, $key, $hash{$key}, %hash);
+    &dbInsert($table, $hash{$key}, %hash);
+    return 1;
+}
+
+#####
+# Usage: &dbSet($table, $primhash_ref, $hash_ref);
+sub dbSet {
+    my ($table, $phref, $href) = @_;
+    &DEBUG("dbSet(@_)");
+    my ($key) = keys %{$phref};
+    my $where = $key . "=" . $phref->{$key};
+
+    my %hash = &dbGetColNiceHash($table, "*", $where);
+    foreach (keys %{$href}) {
+       &DEBUG("dbSet: setting $_=${$href}{$_}");
+       $hash{$_} = ${$href}{$_};
+    }
+    &dbReplace($table, $key, %hash);
+    return 1;
+
+    my $p = join(' AND ', map {
+               $_."=".&dbQuote($href->{$_})
+       } keys %{$href}
+    );
+    &WARN("dbSet not implemented yet $where $p"); return 0;
+
+    # Usage: &dbSet($table, $primkey, $primval, $key, $val);
+    my ($table, $primkey, $primval, $key, $val) = @_;
+    my $found = 0;
+    &DEBUG("dbSet($table, $primkey, $primval, $key, $val);");
+
+    my $info = ${$table}{lc $primval}; # case insensitive.
+    my @array = ($info) ? split(/$;/, $info) : ();
+
+    # new entry.
+    if (!defined ${$table}{lc $primval}) {
+       # we assume primary key as first one. bad!
+       $array[0] = $primval;           # case sensitive.
+    }
+
+    for (0 .. $#{ "${table}_format" }) {
+       $array[$_] ||= '';      # from undefined to ''.
+       next unless (${ "${table}_format" }[$_] eq $key);
+       &DEBUG("dbSet: Setting array[$_]($key) to '$val'.");
+       $array[$_] = $val;
+       $found++;
+       last;
+    }
+
+    if (!$found) {
+       &msg($who,"error: invalid element name \002$type\002.");
+       return 0;
+    }
+
+    &DEBUG("setting $primval => '".join('|', @array)."'.");
+    ${$table}{lc $primval}     = join $;, @array;
+
+    return 1;
+}
+
 sub dbRaw {
     &DEBUG("STUB: &dbRaw(@_);");
 }
@@ -312,18 +380,20 @@ sub randKey {
 }
 
 ##### $select is misleading???
-# Usage: &searchTable($db, $returnkey, $primkey, $str);
+# Usage: &searchTable($table, $returnkey, $primkey, $str);
 sub searchTable {
-    my ($db, $primkey, $key, $str) = @_;
+    return;
+    my ($table, $primkey, $key, $str) = @_;
+    &DEBUG("searchTable($table, $primkey, $key, $str)");
 
-    if (!scalar @{ "${db}_format" }) {
-       &ERROR("sT: no valid format layout for $db.");
+    if (!scalar @{ "${table}_format" }) {
+       &ERROR("sT: no valid format layout for $table.");
        return;
     }   
 
     my @results;
-    foreach (keys %{$db}) {
-       my $val = &dbGet($db, "NULL", $_, $key) || '';
+    foreach (keys %{$table}) {
+       my $val = &dbGet($table, "NULL", $_, $key) || '';
        next unless ($val =~ /\Q$str\E/);
        push(@results, $_);
     }
@@ -406,4 +476,15 @@ sub delFactoid {
     }
 }
 
+sub checkTables {
+#     &openDB();
+#     &closeDB();
+#    foreach ("factoids", "freshmeat", "rootwarn", "seen", "stats") {
+#    foreach (@dbm) {
+#      next if (exists $table{$_});
+#      &status("  creating new table $_...");
+#      &dbCreateTable($_);
+#    }
+}
+
 1;
index 266dd69f07eb534f4209f20309d8165054e0e6cd..559ac2d2dca8cb2553f87cb313b76e42e3aa56b6 100644 (file)
@@ -465,12 +465,14 @@ sub searchTable {
     }
 
     $str =~ s/\_/\\_/g;
-    $str =~ s/\?/\_/g; # '.' should be supported, too.
+    $str =~ s/\?/_/g;  # '.' should be supported, too.
+    $str =~ s/\*/%/g;  # for mysql.
     # end of string fix.
 
     my $query = "SELECT $select FROM $table WHERE $key LIKE ". 
                &dbQuote($str);
     my $sth = $dbh->prepare($query);
+    &DEBUG("query => '$query'.");
     &SQLDebug($query);
     if (!$sth->execute) {
        &WARN("Search($query)");
index 70331a79e88d437e8185b3a4c2eb327efe8c55b1..1f45c2a4c3fb31f6d2fac737e783b90eda2fcd34 100644 (file)
@@ -23,13 +23,16 @@ sub cliloop {
     $who = "local";
     $orig{who} = "local";
     $ident = $param{'ircNick'};
-    $talkchannel = "#CLI";
+    $chan = $talkchannel = "#cli";
     $addressed = 1;
+    $msgType = 'public';
 
     print ">>> ";
     while (<STDIN>) {
        $orig{message} = $_;
-       $_ = &process("local", 'public', $_);
+       $message = $_;
+       chomp $message;
+       $_ = &process() if $message;
        print ">>> ";
     }
 }
index 252f72b77278ef7bc37d2882c7db71e02ae8dba8..6227ddb465eb1031285c0bfbad91ea76ad4dbbf9 100644 (file)
@@ -333,7 +333,7 @@ sub status {
            print "$printable\n";
        }
     } else {
-       print "VERBOSITY IS OFF?\n";
+       #print "VERBOSITY IS OFF?\n";
     }
 
     # log the line into a file.
index 13b878eaebf81e57d6fc5df5b8297020d18e0c0a..a3e5408089295e7e14e9841460fa6d4bf7f7ce1e 100644 (file)
@@ -109,12 +109,8 @@ sub loadDBModules {
 
     } elsif ($param{'DBType'} =~ /^dbm$/i) {
 
-       &status("  using Berkeley DBM 1.85/2.0 support.");
-       &ERROR("dbm support is broken... if you want it, fix it yourself!");
-       &shutdown();
-       exit 1;
-
-#      require "$bot_src_dir/db_dbm.pl";
+       &status("  using Berkeley DBM support.");
+       require "$bot_src_dir/db_dbm.pl";
     } else {
 
        &status("DB support DISABLED.");
@@ -145,7 +141,8 @@ sub loadFactoidsModules {
 }
 
 sub loadIRCModules {
-    if (&whatInterface() =~ /IRC/) {
+    my ($interface) = &whatInterface();
+    if ($interface =~ /IRC/) {
        &status("Loading IRC modules...");
 
        eval "use Net::IRC";
@@ -154,18 +151,20 @@ sub loadIRCModules {
            exit 1;
        }
        &showProc(" (Net::IRC)");
-
     } else {
        &status("IRC support DISABLED.");
-       return;
+       # disabling forking.
+       $param{forking} = 0;
+       $param{noSHM}   = 1;
     }
 
-    foreach ( &getPerlFiles("$bot_src_dir/IRC") ) {
-       my $mod = "$bot_src_dir/IRC/$_";
+    foreach ( &getPerlFiles("$bot_src_dir/$interface") ) {
+       my $mod = "$bot_src_dir/$interface/$_";
 
+       &status("Loading Modules \"$mod\"");
        eval "require \"$mod\"";
        if ($@) {
-           &ERROR("lIRCM => $@");
+           &ERROR("require \"$mod\" => $@");
            &shutdown();
            exit 1;
         }