]> git.donarmstrong.com Git - infobot.git/commitdiff
- added weather from Nathan Moschkin <logeist@guinerd.myip.org>. Thanks!
authordms <dms@c11ca15a-4712-0410-83d8-924469b57eb5>
Mon, 13 May 2002 14:07:04 +0000 (14:07 +0000)
committerdms <dms@c11ca15a-4712-0410-83d8-924469b57eb5>
Mon, 13 May 2002 14:07:04 +0000 (14:07 +0000)
- performStrictReply => pSR()
- now we can disable shared memory "noSHM", although not recommended.
- new sysdump added.

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

src/CommandStubs.pl
src/DynaConfig.pl
src/Misc.pl
src/Modules/DumpVars2.pl [new file with mode: 0644]
src/Modules/News.pl
src/Modules/UserDCC.pl
src/Modules/Weather.pl [new file with mode: 0644]
src/Process.pl
src/Shm.pl
src/core.pl
src/modules.pl

index 7f0681408a8ec6e931751aa53216e7f4f9d22cb9..39833b589dc820bd98df508f9d8e3713ee82bc7d 100644 (file)
@@ -215,6 +215,9 @@ sub parseCmdHook {
        'Identifier' => 'freshmeat', 'Cmdstats' => 'Freshmeat',
        'Forker' => 1, 'Help' => 'freshmeat') );
 &addCmdHook("extra", 'verstats', ('CODEREF' => 'do_verstats' ) );
+&addCmdHook("extra", 'weather', ('CODEREF' => 'Weather::Weather',
+       'Identifier' => 'weather', 'Help' => 'weather',
+       'Cmdstats' => 'Weather') );
 
 ###
 ### END OF ADDING HOOKS.
@@ -529,7 +532,7 @@ sub Modules {
            $reply .= ".  Started the scan ".&Time2String(time() - $wingaterun)." ago";
        }
 
-       &performStrictReply("$reply.");
+       &pSReply("$reply.");
 
        return;
     }
@@ -781,7 +784,7 @@ sub DebianNew {
     }
     close IDX1;
 
-    &::performStrictReply( &::formListReply(0, "New debian packages:", @new) );
+    &::pSReply( &::formListReply(0, "New debian packages:", @new) );
 }
 
 sub do_verstats {
index d284165099bee1ca60116c62e03d6994005aa106..da1739a0070b3d19b2292cf0b5b091bb028001b1 100644 (file)
@@ -217,7 +217,7 @@ sub writeUserFile {
     $wtime_userfile = time();
     &status("--- Saved USERFILE ($cusers users; $cbans bans; $cignore ignore) at $time");
     if (defined $msgType and $msgType =~ /^chat$/) {
-       &performStrictReply("--- Writing user file...");
+       &pSReply("--- Writing user file...");
     }
 }
 
@@ -249,7 +249,8 @@ sub readChanFile {
     while (<IN>) {
        chop;
 
-       next if /^$/;
+       next if /^\s*$/;
+       next if /^\// or /^\;/; # / or ; are comment lines.
 
        if (/^(\S+)\s*$/) {
            $chan       = $1;
@@ -279,7 +280,8 @@ sub readChanFile {
     ### TODO: check against valid params.
     foreach $chan (keys %chanconf) {
        foreach (keys %{ $chanconf{$chan} }) {
-           next unless (/^[+-]/);
+           next unless /^[+-]/;
+
            &WARN("invalid param: chanconf{$chan}{$_}; removing.");
            delete $chanconf{$chan}{$_};
            undef $chanconf{$chan}{$_};
@@ -320,6 +322,7 @@ sub writeChanFile {
                next if ($chan eq "_default");
                next unless (exists $chanconf{$chan}{$opt});
                next unless ($val eq $chanconf{$chan}{$opt});
+
                push(@chans,$chan);
                delete $chanconf{$chan}{$opt};
            }
@@ -387,7 +390,7 @@ sub writeChanFile {
                " chans) at $time");
 
     if (defined $msgType and $msgType =~ /^chat$/) {
-       &performStrictReply("--- Writing chan file...");
+       &pSReply("--- Writing chan file...");
     }
 }
 
@@ -489,7 +492,7 @@ sub hasFlag {
        return 1;
     } else {
        &status("DCC CHAT: <$who> $message -- not enough flags.");
-       &performStrictReply("error: you do not have enough flags for that. ($flag required)");
+       &pSReply("error: you do not have enough flags for that. ($flag required)");
        return 0;
     }
 }
index 358515467576b10dedebb1a9bac7906a406fe79d..68e4fa4c3a7275426bf88a110a065af0522d5e1c 100644 (file)
@@ -66,7 +66,7 @@ sub help {
 
     if (exists $help{$topic}) {
        foreach (split /\n/, $help{$topic}) {
-           &performStrictReply($_);
+           &pSReply($_);
        }
     } else {
        &pSReply("no help on $topic.  Use 'help' without arguments.");
@@ -200,9 +200,9 @@ sub fixFileList {
 
     # generate a hash list.
     foreach (@files) {
-       if (/^(.*\/)(.*?)$/) {
-           $files{$1}{$2} = 1;
-       }
+       next unless /^(.*\/)(.*?)$/;
+
+       $files{$1}{$2} = 1;
     }
     @files = ();       # reuse the array.
 
diff --git a/src/Modules/DumpVars2.pl b/src/Modules/DumpVars2.pl
new file mode 100644 (file)
index 0000000..f507396
--- /dev/null
@@ -0,0 +1,65 @@
+#
+#  DumpVars2.pl: Perl variables dumper ][.
+#    Maintained: dms
+#       Version: v0.1 (20020329)
+#       Created: 20020329
+#
+
+#use strict;
+use Devel::Symdump;
+
+sub symdumplog {
+    my ($line) = @_;
+
+    if (fileno SYMDUMP) {
+       print SYMDUMP $line."\n";
+    } else {
+       &status("SD: ".$line);
+    }
+}
+
+sub symdumpAll {
+    my $o = Devel::Symdump->rnew();
+
+    # scalars.
+    foreach ($o->scalars) {
+#      &symdumpRecur($_);
+       symdumplog("  scalar($_)");
+    }
+}
+
+sub symdumpRecur {
+    my $x = shift;
+
+    if (ref $x eq "HASH") {
+       foreach (keys %$x) {
+           &symdumpRecur($_);
+       }
+    } else {
+       symdumplog("unknown: $x");
+    }
+}
+
+sub symdumpAllFile {
+    &DEBUG("before open");
+    if (&IsParam("symdumpLogFile")) {
+       my $file = $param{'symdumpLogFile'};
+       &status("opening fh to symdump ($file)");
+       if (!open(SYMDUMP,">$file")) {
+           &ERROR("cannot open dumpvars.");
+           return;
+       }
+    }
+    &DEBUG("after open");
+
+    symdumpAll();
+
+    if (fileno SYMDUMP) {
+       &status("closing fh to symdump");
+       close SYMDUMP;
+    }
+
+    &status("SD: count == $countlines");
+}
+
+1;
index 9998c3c609989d844079c1feed295df901806e07..33d8933d86b923f3b833bd29b5cb98ab8abc91aa 100644 (file)
@@ -1,7 +1,7 @@
 #
 # News.pl: Advanced news management
 #   Author: dms
-#  Version: v0.3 (20014012)
+#  Version: v0.3 (20010412)
 #  Created: 20010326
 #    Notes: Testing done by greycat, kudos!
 #
@@ -102,8 +102,9 @@ sub Parse {
     } elsif ($what =~ /^(expire|text|desc)(\s+(.*))?$/i) {
        # shortcut/link.
        # nice hack.
+       my $cmd = $1;
        my($arg1,$arg2) = split(/\s+/, $3, 2);
-       &set("$arg1 $1 $arg2");
+       &set("$arg1 $cmd $arg2");
 
     } elsif ($what =~ /^help(\s+(.*))?$/i) {
        &::help("news $2");
@@ -192,11 +193,13 @@ sub readNews {
     close NEWS;
 
     my $cn = scalar(keys %::news);
+    return unless ($ci or $cn or $cu);
+
     &::status("News: read ".
        $ci. &::fixPlural(" item", $ci). " for ".
        $cn. &::fixPlural(" chan", $cn). ", ".
        $cu. &::fixPlural(" user", $cu), " cache"
-    ) if ($ci or $cn or $cu);
+    );
 }
 
 sub writeNews {
@@ -205,10 +208,11 @@ sub writeNews {
        return;
     }
 
+    # should define this at the top of file.
     my $file = "$::bot_base_dir/blootbot-news.txt";
 
     if (fileno NEWS) {
-       &::ERROR("fileno NEWS exists, should never happen.");
+       &::ERROR("News: write: fileno NEWS exists, should never happen.");
        return;
     }
 
@@ -443,11 +447,11 @@ sub read {
     my $item   = &getNewsItem($str);
     if (!defined $item or !scalar keys %{ $::news{$chan}{$item} }) {
        # todo: numerical check.
-       if ($str =~ /^(\d+) (\d+)$/ or
-           $str =~ /^(\d+)-(\d+)$/ or
-           $str =~ /^-(\d+)$/ or $str =~ /^(\d+)-$/ or 0
+       if ($str =~ /^(\d+)[-, ](\d+)$/ or
+           $str =~ /^-(\d+)$/ or
+           $str =~ /^(\d+)-$/ or 0
        ) {
-           &::notice($who, "We don't support multiple requests of news items, sorry.");
+           &::notice($who, "We don't support multiple requests of news items yet.  Sorry.");
            return;
        }
 
@@ -714,8 +718,8 @@ sub latest {
     my($tchan, $flag) = @_;
 
     # hack hack hack.
-    $chan      ||= $tchan;
-    $who       = $::who;
+    $chan ||= $tchan;
+    $who    = $::who;
 
     # todo: if chan = undefined, guess.
 #    if (!exists $::news{$chan}) {
@@ -733,7 +737,7 @@ sub latest {
 
     if (defined $t and ($t == 0 or $t == -1)) {
        if ($flag) {
-           &::notice($who, "if you want to read news, try /msg $::ident news or /msg $::ident news notify");
+           &::notice($who, "if you want to read news, try \002/msg $::ident news $chan\002 or \002/msg $::ident news $chan notify\002");
        } else {
            &::DEBUG("news: not displaying any new news for $who");
            return;
@@ -818,7 +822,7 @@ sub latest {
 #              $i, $_, &::Time2String($age) ) );
        }
 
-       &::notice($who, "|= to read, do 'news read <#>' or 'news read <keyword>'");
+       &::notice($who, "|= to read, do \002news $chan read <#>\002 or \002news $chan read <keyword>\002");
 
        # lame hack to prevent dupes if we just ignore it.
        my $x = $::newsuser{$chan}{$who};
index 8c457651d38c04d59923557385492ab1160b201d..6648f2bff51aca56ff8b77bf81395aa65d23be3f 100644 (file)
@@ -116,6 +116,17 @@ sub userDCC {
        return;
     }
 
+    # dump variables ][.
+    if ($message =~ /^symdump$/i) {
+       return unless (&hasFlag("o"));
+       return unless (&IsParam("symdump"));
+
+       &status("Dumping all variables...");
+       &symdumpAllFile();
+
+       return;
+    }
+
     # kick.
     if ($message =~ /^kick(\s+(\S+)(\s+(\S+))?)?/) {
        return unless (&hasFlag("o"));
diff --git a/src/Modules/Weather.pl b/src/Modules/Weather.pl
new file mode 100644 (file)
index 0000000..b80d238
--- /dev/null
@@ -0,0 +1,61 @@
+#
+#  Weather.pl: Frontend to GEO::Weather (weather.com).
+#      Author: logeist
+#     Version: v0.1 (20020512).
+#     Created: 20020512.
+#
+
+package Weather;
+
+use IO::Socket;
+use strict;
+
+###local $SIG{ALRM} = sub { die "alarm\n" };
+
+sub Weather {
+    my ($query) = @_;
+    my (@weatherloc, $whash); 
+    my $retval;
+
+    return unless &::loadPerlModule("Geo::Weather");
+    my $weather = new Geo::Weather;
+
+    for ($query) {
+       s/^[\s\t]+//;
+       s/[\s\t]+$//;
+       s/[\s\t]+/ /;
+    }
+
+    @weatherloc = split /,\s*/, $query;
+
+    if (@weatherloc == 1) { 
+        $whash = $weather->get_weather ("$weatherloc[0]");
+    } else {
+       $whash = $weather->get_weather ("$weatherloc[0]", "$weatherloc[1]");
+    }
+
+    if (!ref $whash) {
+       $retval = "I'm sorry, not able to return weather conditions for $query";
+       &::performStrictReply($retval);
+       undef $weather;
+       return;
+    }
+
+    $retval = "Current conditions in $whash->{city}, $whash->{state}: $whash->{cond}, $whash->{temp}° F.  Winds $whash->{wind} MPH.  Dewpoint: $whash->{dewp}° F, Relative Humidity: $whash->{humi}%,";
+
+    if ($whash->{visb} eq 'Unlimited') {
+       $retval .= " Visibility: $whash->{visb}, ";
+    } else {
+       $retval .= " Visibility: $whash->{visb} mi., ";
+    }
+
+    $retval .= " Barometric Pressure: $whash->{baro} in.";
+    if($whash->{heat} ne 'N/A') {
+       $retval .= " Heat Index: $whash->{heat}° F.";
+    }
+
+    &::performStrictReply($retval);
+    undef $weather;
+}
+
+1;
index 1a4b126764036c7639d11e53f2d0ea219ba61015..894ef86049a7486bae6a807bbce0ed02319163c6 100644 (file)
@@ -240,7 +240,7 @@ sub process {
 
        # customized random message.
        my $tmp = (rand() < 0.5) ? ", $who" : "";
-       &performStrictReply(&getRandom(keys %{ $lang{'hello'} }) . $tmp);
+       &pSReply( &getRandom(keys %{ $lang{'hello'} }) . $tmp );
        return;
     }
 
@@ -262,7 +262,7 @@ sub process {
        &status("random praise detected");
 
        my $tmp = (rand() < 0.5) ? "thanks $who " : "";
-       &performStrictReply($tmp.":)");
+       &pSReply($tmp.":)");
 
        return;
     }
index 6a29ff4b6aa85f0f1e12159d2bea4d8c8bce13a6..34b68f2f1e7d1d3314f330cb4809fd15c835f97e 100644 (file)
@@ -12,6 +12,11 @@ sub openSHM {
     my $IPC_PRIVATE = 0;
     my $size = 2000;
 
+    if (&IsParam("noSHM")) {
+       &status("Created shared memory: disabled. [bot may become  unreliable]");
+       return 0;
+    }
+
     if (defined( $_ = shmget($IPC_PRIVATE, $size, 0777) )) {
        &status("Created shared memory (shm) key: [$_]");
        return $_;
@@ -39,6 +44,8 @@ sub shmRead {
     my $size = 3*80;
     my $retval = '';
 
+    return '' if (&IsParam("noSHM"));
+
     if (shmread($key,$retval,$position,$size)) {
        return $retval;
     } else {
@@ -54,6 +61,8 @@ sub shmWrite {
     my $position = 0;
     my $size = 80*3;
 
+    return if (&IsParam("noSHM"));
+
     # NULL hack.
     ### TODO: create shmClear to deal with this.
     if ($str !~ /^$/) {
index 20ee8a1b0db4656a1a895e7fac91d593c92281ab..266890ecf4e4e9366661ff352185ff21563ae37b 100644 (file)
@@ -112,6 +112,7 @@ sub doExit {
        &closeDB();
        &closeSHM($shm);
        &dumpallvars()          if (&IsParam("dumpvarsAtExit"));
+       &symdumpAll()           if (&IsParam("symdumpAtExit"));
        &closeLog();
        &closeSQLDebug()        if (&IsParam("SQLDebug"));
 
index 46521b0661d54f514e19b8e1cd0efa695cadc586..13b878eaebf81e57d6fc5df5b8297020d18e0c0a 100644 (file)
@@ -26,6 +26,7 @@ if ($@) {
        "debianExtra"   => "DebianExtra.pl",
        "dict"          => "Dict.pl",
        "dumpvars"      => "DumpVars.pl",
+       "symdump"       => "DumpVars2.pl",
        "factoids"      => "Factoids.pl",
        "freshmeat"     => "Freshmeat.pl",
        "kernel"        => "Kernel.pl",
@@ -51,7 +52,7 @@ if ($@) {
 my @myModulesLoadNow;
 my @myModulesReloadNot;
 BEGIN {
-    @myModulesLoadNow  = ('topic', 'uptime', 'news', 'rootWarn');
+    @myModulesLoadNow  = ('topic', 'uptime', 'news', 'rootWarn', 'symdump');
     @myModulesReloadNot        = ('IRC/Irc.pl','IRC/Schedulers.pl');
 }