indirectly caused by the change over to dynamic configuration
git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk/blootbot@259
c11ca15a-4712-0410-83d8-
924469b57eb5
26 files changed:
# dangerous; common preambles should be stripped before here
if ($query =~ /^forget /i or $query =~ /^no, /) {
# dangerous; common preambles should be stripped before here
if ($query =~ /^forget /i or $query =~ /^no, /) {
- return $noreply if (exists $bots{$nuh});
+ return if (exists $bots{$nuh});
}
# convert to canonical reference form
}
# convert to canonical reference form
# valid factoid.
if ($query =~ s/[\!\.]$//) {
# valid factoid.
if ($query =~ s/[\!\.]$//) {
- &DEBUG("Question: Pushing query without trailing symbols.");
push(@query,$query);
}
for (my$i=0; $i<scalar(@query); $i++) {
push(@query,$query);
}
for (my$i=0; $i<scalar(@query); $i++) {
$result = &getReply($query);
$result = &getReply($query);
- next if ($result eq "");
+ next if (!defined $result or $result eq "");
# 'see also' factoid redirection support.
if ($result =~ /^see( also)? (.*?)\.?$/) {
# 'see also' factoid redirection support.
if ($result =~ /^see( also)? (.*?)\.?$/) {
if (&IsParam("freshmeatForFactoid")) {
&loadMyModule($myModules{'freshmeat'});
$result = &Freshmeat::showPackage($query);
if (&IsParam("freshmeatForFactoid")) {
&loadMyModule($myModules{'freshmeat'});
$result = &Freshmeat::showPackage($query);
- return $result unless ($result eq $noreply);
+ return $result if (defined $result);
}
### TODO: Use &Forker(); move function to Debian.pl
}
### TODO: Use &Forker(); move function to Debian.pl
$result = &Debian::DebianFind($query); # ???
### TODO: debian module should tell, through shm, that it went
### ok or not.
$result = &Debian::DebianFind($query); # ???
### TODO: debian module should tell, through shm, that it went
### ok or not.
-### return $result unless ($result eq $noreply);
+### return $result if (defined $result);
}
if ($questionWord ne "" or $finalQMark) {
# if it has not been explicitly marked as a question
if ($addressed and $reply eq "") {
}
if ($questionWord ne "" or $finalQMark) {
# if it has not been explicitly marked as a question
if ($addressed and $reply eq "") {
- &status("notfound: <$who> ".join(' :: ', @query));
+ &status("notfound: <$who> ".join(' :: ', @query))
+ if ($finalQMark);
return '' unless (&IsParam("friendlyBots"));
return '' unless (&IsParam("friendlyBots"));
# fix the person.
} else {
if ($reply =~ /^you are / or $reply =~ / you are /) {
# fix the person.
} else {
if ($reply =~ /^you are / or $reply =~ / you are /) {
- return $noreply if ($addressed);
+ return if ($addressed);
##
## otherwise return
## - null for confused.
##
## otherwise return
## - null for confused.
-## - NOREPLY not to respond.
##
if (&IsParam("useStrict")) { use strict; }
##
if (&IsParam("useStrict")) { use strict; }
$in =~ s/^no([, ]+)//i; # 'no, '.
# check if we need to be addressed and if we are
$in =~ s/^no([, ]+)//i; # 'no, '.
# check if we need to be addressed and if we are
- return $noreply unless ($learnok);
+ return unless ($learnok);
# acceptUrl.
if (&IsParam("acceptUrl")) {
if ($param{'acceptUrl'} eq 'REQUIRE') { # require url type.
# acceptUrl.
if (&IsParam("acceptUrl")) {
if ($param{'acceptUrl'} eq 'REQUIRE') { # require url type.
- return $noreply if ($urlType eq "");
+ return if ($urlType eq "");
} elsif ($param{'acceptUrl'} eq 'REJECT') {
&status("REJECTED URL entry") if (&IsParam("VERBOSITY"));
} elsif ($param{'acceptUrl'} eq 'REJECT') {
&status("REJECTED URL entry") if (&IsParam("VERBOSITY"));
- return $noreply unless ($urlType eq "");
+ return unless ($urlType eq "");
# break if either lhs or rhs is NULL.
if ($lhs eq "" or $rhs eq "") {
# break if either lhs or rhs is NULL.
if ($lhs eq "" or $rhs eq "") {
}
# lets check if it failed.
}
# lets check if it failed.
&status("IGNORE statement: <$who> $message");
&performReply( &getRandom(keys %{$lang{'confused'}}) );
}
&status("IGNORE statement: <$who> $message");
&performReply( &getRandom(keys %{$lang{'confused'}}) );
}
- return $noreply if (!$addressed and $lhs =~ /\s+/);
+ return if (!$addressed and $lhs =~ /\s+/);
&status("statement: <$who> $message");
&status("statement: <$who> $message");
if ($ord > 170 and $ord < 220) {
&status("statement: illegal character '$_' $ord.");
&performAddressedReply("i'm not going to learn illegal characters");
if ($ord > 170 and $ord < 220) {
&status("statement: illegal character '$_' $ord.");
&performAddressedReply("i'm not going to learn illegal characters");
}
}
return &update($lhs, $mhs, $rhs);
}
}
}
return &update($lhs, $mhs, $rhs);
}
$lhs =~ s/\s+/ /g;
# locked.
$lhs =~ s/\s+/ /g;
# locked.
- return $noreply if (&IsLocked($lhs) == 1);
+ return if (&IsLocked($lhs) == 1);
# profanity.
if (&IsParam("profanityCheck") and &hasProfanity($rhs)) {
&msg($who, "please, watch your language.");
# profanity.
if (&IsParam("profanityCheck") and &hasProfanity($rhs)) {
&msg($who, "please, watch your language.");
}
# teaching.
if (&IsFlag("t") ne "t") {
&msg($who, "permission denied.");
&status("alert: $who wanted to teach me.");
}
# teaching.
if (&IsFlag("t") ne "t") {
&msg($who, "permission denied.");
&status("alert: $who wanted to teach me.");
length($rhs) > $param{'maxDataSize'})
{
&performAddressedReply("that's too long");
length($rhs) > $param{'maxDataSize'})
{
&performAddressedReply("that's too long");
if (&dbGet("freshmeat", "name", $lhs, "name")) {
&msg($who, "permission denied. (freshmeat)");
&status("alert: $who wanted to teach me something that freshmeat already has info on.");
if (&dbGet("freshmeat", "name", $lhs, "name")) {
&msg($who, "permission denied. (freshmeat)");
&status("alert: $who wanted to teach me something that freshmeat already has info on.");
}
}
if (my $exists = &getFactoid($lhs)) { # factoid exists.
if ($exists eq $rhs) {
&performAddressedReply("i already had it that way");
}
}
if (my $exists = &getFactoid($lhs)) { # factoid exists.
if ($exists eq $rhs) {
&performAddressedReply("i already had it that way");
}
if ($also) { # 'is also'.
}
if ($also) { # 'is also'.
if (length($rhs) > $param{'maxDataSize'}) {
if (length($rhs) > length($exists)) {
&performAddressedReply("that's too long");
if (length($rhs) > $param{'maxDataSize'}) {
if (length($rhs) > length($exists)) {
&performAddressedReply("that's too long");
} else {
&status("Update: new length is still longer than maxDataSize but less than before, we'll let it go.");
}
} else {
&status("Update: new length is still longer than maxDataSize but less than before, we'll let it go.");
}
if (IsFlag("m") ne "m" and $author !~ /^\Q$who\E\!/i) {
&msg($who, "you can't change that factoid.");
if (IsFlag("m") ne "m" and $author !~ /^\Q$who\E\!/i) {
&msg($who, "you can't change that factoid.");
}
&performAddressedReply("okay");
}
&performAddressedReply("okay");
&performStrictReply("...but \002$lhs\002 is already something else...");
&status("FAILED update: <$who> \'$lhs\' =$mhs=> \'$rhs\'");
}
&performStrictReply("...but \002$lhs\002 is already something else...");
&status("FAILED update: <$who> \'$lhs\' =$mhs=> \'$rhs\'");
}
}
}
} else { # not exists.
}
}
} else { # not exists.
# static scalar variables.
$mask{ip} = '(\d+)\.(\d+)\.(\d+)\.(\d+)';
$mask{host} = '[\d\w\_\-\/]+\.[\.\d\w\_\-\/]+';
# static scalar variables.
$mask{ip} = '(\d+)\.(\d+)\.(\d+)\.(\d+)';
$mask{host} = '[\d\w\_\-\/]+\.[\.\d\w\_\-\/]+';
-$mask{chan} = '[\#\&\+]\S*';
+$mask{chan} = '[\#\&]\S*';
my $isnick1 = 'a-zA-Z\[\]\{\}\_\`\^\|\\\\';
my $isnick2 = '0-9\-';
$mask{nick} = "[$isnick1]{1}[$isnick1$isnick2]*";
my $isnick1 = 'a-zA-Z\[\]\{\}\_\`\^\|\\\\';
my $isnick2 = '0-9\-';
$mask{nick} = "[$isnick1]{1}[$isnick1$isnick2]*";
+$mask{nuh} = '\S*!\S*\@\S*';
sub ircloop {
my $error = 0;
sub ircloop {
my $error = 0;
sub say {
my ($msg) = @_;
sub say {
my ($msg) = @_;
- if (!defined $msg or $msg eq $noreply) {
$msg ||= "NULL";
&DEBUG("say: msg == $msg.");
return;
$msg ||= "NULL";
&DEBUG("say: msg == $msg.");
return;
- if (!defined $msg or $msg eq $noreply) {
$msg ||= "NULL";
&DEBUG("msg: msg == $msg.");
return;
$msg ||= "NULL";
&DEBUG("msg: msg == $msg.");
return;
+ my ($txt,$flag) = @_;
+
+ ### FIXME: flag not supported yet.
foreach (keys %{$dcc{'CHAT'}}) {
$conn->privmsg($dcc{'CHAT'}{$_}, $txt);
foreach (keys %{$dcc{'CHAT'}}) {
$conn->privmsg($dcc{'CHAT'}{$_}, $txt);
+sub pSReply {
+ &performStrictReply(@_);
+}
+
# Usage: &performStrictReply($reply);
sub performStrictReply {
my ($reply) = @_;
# Usage: &performStrictReply($reply);
sub performStrictReply {
my ($reply) = @_;
+# Usage: &GetNicksInChan($chan);
+sub GetNicksInChan {
+ my ($chan) = @_;
+ my @array;
+
+ return keys %{ $channels{$chan}{''} };
+}
+
sub IsNickInChan {
my ($nick,$chan) = @_;
sub IsNickInChan {
my ($nick,$chan) = @_;
&DEBUG("clearIRCVars() called!");
undef %channels;
undef %floodjoin;
&DEBUG("clearIRCVars() called!");
undef %channels;
undef %floodjoin;
- @joinchan = split /[\t\s]+/, $param{'join_channels'};
+
+ @joinchan = &getJoinChans();
-sub makeChanList {
- my ($str) = @_;
- my $inverse = 0;
- if ($str eq "ALL") {
- return(keys %channels);
- } elsif ($str =~ s/^ALL but //i) {
- @chans = keys %channels;
- foreach (split /[\s\t\,]+/, lc $str) {
- @chans = grep !/^$_$/, @chans;
+ foreach (keys %chanconf) {
+ my $val = $chanconf{$_}{autojoin};
+ my $skip = 0;
+ if (defined $val) {
+ $skip++ if ($val eq "0");
+ } else {
+ $skip++;
- } else {
- foreach (split /[\s\t\,]+/, lc $str) {
- next unless (&validChan($_));
- push(@chans, $_);
+
+ if ($skip) {
+ push(@skip, $_);
+ next;
+ if (scalar @skip) {
+ &status("channels not auto-joining: @skip");
+ }
+
+ return @chans;
&DEBUG("jfC: $delete deleted.") if ($delete);
}
&DEBUG("jfC: $delete deleted.") if ($delete);
}
+sub getHostMask {
+ my($n) = @_;
+
+ &FIXME("getHostMask...");
+}
+
if (exists $help{$topic}) {
foreach (split /\n/, $help{$topic}) {
if (exists $help{$topic}) {
foreach (split /\n/, $help{$topic}) {
+ &performStrictReply($_);
- &msg($who, "no help on $topic. Use 'help' without arguments.");
+ &pSReply("no help on $topic. Use 'help' without arguments.");
my $time = shift;
my $retval;
my $time = shift;
my $retval;
- return("0s") if ($time !~ /\d+/ or $time <= 0);
+ return("0s")
+ if (!defined $time or $time !~ /\d+/ or $time <= 0);
my $s = int($time) % 60;
my $m = int($time / 60) % 60;
my $s = int($time) % 60;
my $m = int($time / 60) % 60;
sub fixPlural {
my ($str,$int) = @_;
sub fixPlural {
my ($str,$int) = @_;
+ if (!defined $str) {
+ &WARN("fixPlural: str == NULL.");
+ return;
+ }
+
if ($str eq "has") {
$str = "have" if ($int > 1);
} elsif ($str eq "is") {
if ($str eq "has") {
$str = "have" if ($int > 1);
} elsif ($str eq "is") {
sub getRandomInt {
my $str = $_[0];
sub getRandomInt {
my $str = $_[0];
+ if (!defined $str) {
+ &WARN("gRI: str == NULL.");
+ return;
+ }
+
srand();
if ($str =~ /^(\d+)$/) {
srand();
if ($str =~ /^(\d+)$/) {
+### rename to hasChanConf() ?
sub hasParam {
my ($param) = @_;
sub hasParam {
my ($param) = @_;
- if (&IsParam($param)) {
+ ### TODO: specific reason why it failed.
+ if (&IsChanConf($param)) {
return 1;
} else {
&msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
return 1;
} else {
&msg($who, "unfortunately, \002$param\002 is disabled in my configuration") unless ($addrchar);
&VERB("double fork detected; not forking.",2) if ($$ != $bot_pid);
if (&IsParam("forking") and $$ == $bot_pid) {
&VERB("double fork detected; not forking.",2) if ($$ != $bot_pid);
if (&IsParam("forking") and $$ == $bot_pid) {
- return $noreply unless (&addForked($label));
+ return unless &addForked($label);
$SIG{CHLD} = 'IGNORE';
$pid = eval { fork() };
$SIG{CHLD} = 'IGNORE';
$pid = eval { fork() };
- return $noreply if $pid; # parent does nothing
+ return if $pid; # parent does nothing
select(undef, undef, undef, 0.2);
select(undef, undef, undef, 0.2);
- &status("fork starting for '$label', PID == $$.");
+# &status("fork starting for '$label', PID == $$.");
+ &status("--- fork starting for '$label', PID == $$ ---");
&shmWrite($shm,"SET FORKPID $label $$");
sleep 1;
&shmWrite($shm,"SET FORKPID $label $$");
sleep 1;
# Usage: &DebianDownload(%hash);
sub DebianDownload {
my ($dist, %urls) = @_;
# Usage: &DebianDownload(%hash);
sub DebianDownload {
my ($dist, %urls) = @_;
- my $refresh = $main::param{'debianRefreshInterval'} * 60 * 60 * 24;
+ my $refresh = $::param{'debianRefreshInterval'} * 60 * 60 * 24;
my $bad = 0;
my $good = 0;
if (! -d "debian/") {
my $bad = 0;
my $good = 0;
if (! -d "debian/") {
- &main::status("Debian: creating debian dir.");
+ &::status("Debian: creating debian dir.");
- &main::DEBUG("announce == $announce.");
+ &::DEBUG("announce == $announce.");
if ($good + $bad == 0 and !$announce) {
if ($good + $bad == 0 and !$announce) {
- &main::status("Debian: Downloading files for '$dist'.");
- &main::msg($main::who, "Updating debian files... please wait.");
+ &::status("Debian: Downloading files for '$dist'.");
+ &::msg($::who, "Updating debian files... please wait.");
- if (exists $main::debian{$url}) {
- &main::DEBUG("2: ".(time - $main::debian{$url})." <= $refresh");
- next if (time() - $main::debian{$url} <= $refresh);
- &main::DEBUG("stale for url $url; updating!");
+ if (exists $::debian{$url}) {
+ &::DEBUG("2: ".(time - $::debian{$url})." <= $refresh");
+ next if (time() - $::debian{$url} <= $refresh);
+ &::DEBUG("stale for url $url; updating!");
}
if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) {
}
if ($url =~ /^ftp:\/\/(.*?)\/(\S+)\/(\S+)$/) {
# error internally to ftp.
# hope it doesn't do anything bad.
if ($file =~ /Contents-woody-i386-non-US/) {
# error internally to ftp.
# hope it doesn't do anything bad.
if ($file =~ /Contents-woody-i386-non-US/) {
- &main::DEBUG("Skipping Contents-woody-i386-non-US.");
+ &::DEBUG("Skipping Contents-woody-i386-non-US.");
# $file =~ s/woody/potato/;
# $path =~ s/woody/potato/;
### next;
}
# $file =~ s/woody/potato/;
# $path =~ s/woody/potato/;
### next;
}
- if (!&main::ftpGet($host,$path,$thisfile,$file)) {
- &main::WARN("deb: down: $file == BAD.");
+ if (!&::ftpGet($host,$path,$thisfile,$file)) {
+ &::WARN("deb: down: $file == BAD.");
$bad++;
next;
}
if (! -f $file) {
$bad++;
next;
}
if (! -f $file) {
- &main::DEBUG("deb: down: ftpGet: !file");
+ &::DEBUG("deb: down: ftpGet: !file");
$bad++;
next;
}
if ($file =~ /Contents-potato-i386-non-US/) {
$bad++;
next;
}
if ($file =~ /Contents-potato-i386-non-US/) {
- &main::DEBUG("hack: using potato's non-US contents for woody.");
+ &::DEBUG("hack: using potato's non-US contents for woody.");
system("cp debian/Contents-potato-i386-non-US.gz debian/Contents-woody-i386-non-US.gz");
}
system("cp debian/Contents-potato-i386-non-US.gz debian/Contents-woody-i386-non-US.gz");
}
- &main::DEBUG("deb: download: good.");
+ &::DEBUG("deb: download: good.");
## $ret{$
$good++;
} else {
## $ret{$
$good++;
} else {
- &main::ERROR("Debian: invalid format of url => ($url).");
+ &::ERROR("Debian: invalid format of url => ($url).");
return 1;
} else {
return -1 unless ($bad); # no download.
return 1;
} else {
return -1 unless ($bad); # no download.
- &main::DEBUG("DD: !good and bad($bad). :(");
+ &::DEBUG("DD: !good and bad($bad). :(");
# Usage: &searchContents($query);
sub searchContents {
my ($dist, $query) = &getDistroFromStr($_[0]);
# Usage: &searchContents($query);
sub searchContents {
my ($dist, $query) = &getDistroFromStr($_[0]);
- &main::status("Debian: Contents search for '$query' on $dist.");
+ &::status("Debian: Contents search for '$query' on $dist.");
my $dccsend = 0;
$dccsend++ if ($query =~ s/^dcc\s+//i);
my $dccsend = 0;
$dccsend++ if ($query =~ s/^dcc\s+//i);
$query =~ s/\\([\^\$])/$1/g; # hrm?
$query =~ s/^\s+|\s+$//g;
$query =~ s/\\([\^\$])/$1/g; # hrm?
$query =~ s/^\s+|\s+$//g;
- if (!&main::validExec($query)) {
- &main::msg($main::who, "search string looks fuzzy.");
+ if (!&::validExec($query)) {
+ &::msg($::who, "search string looks fuzzy.");
return;
}
if ($dist eq "incoming") { # nothing yet.
return;
}
if ($dist eq "incoming") { # nothing yet.
- &main::DEBUG("sC: dist = 'incoming'. no contents yet.");
+ &::DEBUG("sC: dist = 'incoming'. no contents yet.");
return;
} else {
my %urls = &fixDist($dist, %urlcontents);
# download contents file.
return;
} else {
my %urls = &fixDist($dist, %urlcontents);
# download contents file.
- &main::DEBUG("deb: download 1.");
+ &::DEBUG("deb: download 1.");
if (!&DebianDownload($dist, %urls)) {
if (!&DebianDownload($dist, %urls)) {
- &main::WARN("Debian: could not download files.");
+ &::WARN("Debian: could not download files.");
- my $start_time = &main::timeget();
+ my $start_time = &::timeget();
my $found = 0;
my %contents;
my $found = 0;
my %contents;
my $front = 0;
### TODO: search properly if /usr/bin/blah is done.
if ($query =~ s/\$$//) {
my $front = 0;
### TODO: search properly if /usr/bin/blah is done.
if ($query =~ s/\$$//) {
- &main::DEBUG("search-regex found.");
+ &::DEBUG("search-regex found.");
$grepRE = "$query\[ \t]";
} elsif ($query =~ s/^\^//) {
$grepRE = "$query\[ \t]";
} elsif ($query =~ s/^\^//) {
- &main::DEBUG("front marker regex found.");
+ &::DEBUG("front marker regex found.");
$front = 1;
$grepRE = $query;
} else {
$front = 1;
$grepRE = $query;
} else {
- &main::ERROR("sC: no files?");
- &main::msg($main::who, "failed.");
+ &::ERROR("sC: no files?");
+ &::msg($::who, "failed.");
### send results with dcc.
if ($dccsend) {
### send results with dcc.
if ($dccsend) {
- if (exists $main::dcc{'SEND'}{$main::who}) {
- &main::msg($main::who, "DCC already active!");
+ if (exists $::dcc{'SEND'}{$::who}) {
+ &::msg($::who, "DCC already active!");
return;
}
if (!scalar %contents) {
return;
}
if (!scalar %contents) {
- &main::msg($main::who,"search returned no results.");
+ &::msg($::who,"search returned no results.");
- my $file = "$main::param{tempDir}/$main::who.txt";
+ my $file = "$::param{tempDir}/$::who.txt";
if (!open(OUT,">$file")) {
if (!open(OUT,">$file")) {
- &main::ERROR("Debian: cannot write file for dcc send.");
+ &::ERROR("Debian: cannot write file for dcc send.");
- &main::shmWrite($main::shm, "DCC SEND $main::who $file");
+ &::shmWrite($::shm, "DCC SEND $::who $file");
- &main::status("Debian: $found contents results found.");
+ &::status("Debian: $found contents results found.");
my @list;
foreach $pkg (keys %contents) {
my @list;
foreach $pkg (keys %contents) {
- my @tmplist = &main::fixFileList(keys %{$contents{$pkg}});
+ my @tmplist = &::fixFileList(keys %{$contents{$pkg}});
my @sublist = sort { length $a <=> length $b } @tmplist;
pop @sublist while (scalar @sublist > 3);
my @sublist = sort { length $a <=> length $b } @tmplist;
pop @sublist while (scalar @sublist > 3);
@list = sort { length $a <=> length $b } @list;
# show how long it took.
@list = sort { length $a <=> length $b } @list;
# show how long it took.
- my $delta_time = &main::timedelta($start_time);
- &main::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
+ my $delta_time = &::timedelta($start_time);
+ &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
my $prefix = "Debian Search of '$query' ";
if (scalar @list) { # @list.
my $prefix = "Debian Search of '$query' ";
if (scalar @list) { # @list.
- &main::performStrictReply( &main::formListReply(0, $prefix, @list) );
+ &::pSReply( &::formListReply(0, $prefix, @list) );
- &main::DEBUG("ok, !\@list, searching desc for '$query'.");
+ &::DEBUG("ok, !\@list, searching desc for '$query'.");
# Usage: &searchAuthor($query);
sub searchAuthor {
my ($dist, $query) = &getDistroFromStr($_[0]);
# Usage: &searchAuthor($query);
sub searchAuthor {
my ($dist, $query) = &getDistroFromStr($_[0]);
- &main::DEBUG("searchAuthor: dist => '$dist', query => '$query'.");
+ &::DEBUG("searchAuthor: dist => '$dist', query => '$query'.");
$query =~ s/^\s+|\s+$//g;
# start of search.
$query =~ s/^\s+|\s+$//g;
# start of search.
- my $start_time = &main::timeget();
- &main::status("Debian: starting author search.");
+ my $start_time = &::timeget();
+ &::status("Debian: starting author search.");
my $files;
my ($bad,$good) = (0,0);
my $files;
my ($bad,$good) = (0,0);
- &main::DEBUG("good = $good, bad = $bad...");
+ &::DEBUG("good = $good, bad = $bad...");
if ($good == 0 and $bad != 0) {
my %urls = &fixDist($dist, %urlpackages);
if ($good == 0 and $bad != 0) {
my %urls = &fixDist($dist, %urlpackages);
- &main::DEBUG("deb: download 2.");
+ &::DEBUG("deb: download 2.");
if (!&DebianDownload($dist, %urls)) {
if (!&DebianDownload($dist, %urls)) {
- &main::ERROR("Debian(sA): could not download files.");
+ &::ERROR("Debian(sA): could not download files.");
} elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
my($name,$email) = ($1,$2);
if ($package eq "") {
} elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
my($name,$email) = ($1,$2);
if ($package eq "") {
- &main::DEBUG("sA: package == NULL.");
+ &::DEBUG("sA: package == NULL.");
next;
}
$maint{$name}{$email} = 1;
$pkg{$name}{$package} = 1;
$package = "";
} else {
next;
}
$maint{$name}{$email} = 1;
$pkg{$name}{$package} = 1;
$package = "";
} else {
- &main::WARN("invalid line: '$_'.");
+ &::WARN("invalid line: '$_'.");
my @list = keys %hash;
if (scalar @list != 1) {
my $prefix = "Debian Author Search of '$query' ";
my @list = keys %hash;
if (scalar @list != 1) {
my $prefix = "Debian Author Search of '$query' ";
- &main::performStrictReply( &main::formListReply(0, $prefix, @list) );
+ &::pSReply( &::formListReply(0, $prefix, @list) );
- &main::DEBUG("showing all packages by '$list[0]'...");
+ &::DEBUG("showing all packages by '$list[0]'...");
my @pkg = sort keys %{$pkg{$list[0]}};
# show how long it took.
my @pkg = sort keys %{$pkg{$list[0]}};
# show how long it took.
- my $delta_time = &main::timedelta($start_time);
- &main::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
+ my $delta_time = &::timedelta($start_time);
+ &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
my $email = join(', ', keys %{$maint{$list[0]}});
my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
my $email = join(', ', keys %{$maint{$list[0]}});
my $prefix = "Debian Packages by $list[0] \002<\002$email\002>\002 ";
- &main::performStrictReply( &main::formListReply(0, $prefix, @pkg) );
+ &::pSReply( &::formListReply(0, $prefix, @pkg) );
}
####
# Usage: &searchDesc($query);
sub searchDesc {
my ($dist, $query) = &getDistroFromStr($_[0]);
}
####
# Usage: &searchDesc($query);
sub searchDesc {
my ($dist, $query) = &getDistroFromStr($_[0]);
- &main::DEBUG("searchDesc: dist => '$dist', query => '$query'.");
+ &::DEBUG("searchDesc: dist => '$dist', query => '$query'.");
$query =~ s/^\s+|\s+$//g;
# start of search.
$query =~ s/^\s+|\s+$//g;
# start of search.
- my $start_time = &main::timeget();
- &main::status("Debian: starting desc search.");
+ my $start_time = &::timeget();
+ &::status("Debian: starting desc search.");
my $files;
my ($bad,$good) = (0,0);
my $files;
my ($bad,$good) = (0,0);
- &main::DEBUG("good = $good, bad = $bad...");
+ &::DEBUG("good = $good, bad = $bad...");
if ($good == 0 and $bad != 0) {
my %urls = &fixDist($dist, %urlpackages);
if ($good == 0 and $bad != 0) {
my %urls = &fixDist($dist, %urlpackages);
- &main::DEBUG("deb: download 2c.");
+ &::DEBUG("deb: download 2c.");
if (!&DebianDownload($dist, %urls)) {
if (!&DebianDownload($dist, %urls)) {
- &main::ERROR("Debian(sD): could not download files.");
+ &::ERROR("Debian(sD): could not download files.");
my $desc = $1;
next unless ($desc =~ /\Q$query\E/i);
if ($package eq "") {
my $desc = $1;
next unless ($desc =~ /\Q$query\E/i);
if ($package eq "") {
- &main::WARN("sD: package == NULL?");
+ &::WARN("sD: package == NULL?");
next;
}
$desc{$package} = $desc;
$package = "";
} else {
next;
}
$desc{$package} = $desc;
$package = "";
} else {
- &main::WARN("invalid line: '$_'.");
+ &::WARN("invalid line: '$_'.");
my @list = keys %desc;
if (!scalar @list) {
my $prefix = "Debian Desc Search of '$query' ";
my @list = keys %desc;
if (!scalar @list) {
my $prefix = "Debian Desc Search of '$query' ";
- &main::performStrictReply( &main::formListReply(0, $prefix, ) );
+ &::pSReply( &::formListReply(0, $prefix, ) );
} elsif (scalar @list == 1) { # list = 1.
} elsif (scalar @list == 1) { # list = 1.
- &main::DEBUG("list == 1; showing package info of '$list[0]'.");
+ &::DEBUG("list == 1; showing package info of '$list[0]'.");
&infoPackages("info", $list[0]);
} else { # list > 1.
my $prefix = "Debian Desc Search of '$query' ";
&infoPackages("info", $list[0]);
} else { # list > 1.
my $prefix = "Debian Desc Search of '$query' ";
- &main::performStrictReply( &main::formListReply(0, $prefix, @list) );
+ &::pSReply( &::formListReply(0, $prefix, @list) );
}
# show how long it took.
}
# show how long it took.
- my $delta_time = &main::timedelta($start_time);
- &main::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
+ my $delta_time = &::timedelta($start_time);
+ &::status(sprintf("Debian: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
}
####
# Usage: &generateIncoming();
sub generateIncoming {
}
####
# Usage: &generateIncoming();
sub generateIncoming {
- my $interval = $main::param{'debianRefreshInterval'};
+ my $interval = $::param{'debianRefreshInterval'};
my $pkgfile = "debian/Packages-incoming";
my $idxfile = $pkgfile.".idx";
my $stale = 0;
my $pkgfile = "debian/Packages-incoming";
my $idxfile = $pkgfile.".idx";
my $stale = 0;
- $stale++ if (&main::isStale($pkgfile.".gz", $interval));
- $stale++ if (&main::isStale($idxfile, $interval));
- &main::DEBUG("gI: stale => '$stale'.");
+ $stale++ if (&::isStale($pkgfile.".gz", $interval));
+ $stale++ if (&::isStale($idxfile, $interval));
+ &::DEBUG("gI: stale => '$stale'.");
return 0 unless ($stale);
### STATIC URL.
return 0 unless ($stale);
### STATIC URL.
- my %ftp = &main::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/");
+ my %ftp = &::ftpList("llug.sep.bnl.gov", "/pub/debian/Incoming/");
if (!open(PKG,">$pkgfile")) {
if (!open(PKG,">$pkgfile")) {
- &main::ERROR("cannot write to pkg $pkgfile.");
+ &::ERROR("cannot write to pkg $pkgfile.");
return 0;
}
if (!open(IDX,">$idxfile")) {
return 0;
}
if (!open(IDX,">$idxfile")) {
- &main::ERROR("cannot write to idx $idxfile.");
+ &::ERROR("cannot write to idx $idxfile.");
system("gzip -9fv $pkgfile"); # lame fix.
system("gzip -9fv $pkgfile"); # lame fix.
- &main::status("Debian: generateIncoming() complete.");
+ &::status("Debian: generateIncoming() complete.");
my ($package, $file) = @_;
if (! -f $file) {
my ($package, $file) = @_;
if (! -f $file) {
- &main::status("gPI: file $file does not exist?");
+ &::status("gPI: file $file does not exist?");
$pkg{'conflicts'} = $1;
}
$pkg{'conflicts'} = $1;
}
-### &main::DEBUG("=> '$_'.");
+### &::DEBUG("=> '$_'.");
# Usage: &infoPackages($query,$package);
sub infoPackages {
my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1]));
# Usage: &infoPackages($query,$package);
sub infoPackages {
my ($query,$dist,$package) = ($_[0], &getDistroFromStr($_[1]));
- my $interval = $main::param{'debianRefreshInterval'} || 7;
+ my $interval = $::param{'debianRefreshInterval'} || 7;
- &main::status("Debian: Searching for package '$package' in '$dist'.");
+ &::status("Debian: Searching for package '$package' in '$dist'.");
# download packages file.
# hrm...
my %urls = &fixDist($dist, %urlpackages);
if ($dist ne "incoming") {
# download packages file.
# hrm...
my %urls = &fixDist($dist, %urlpackages);
if ($dist ne "incoming") {
- &main::DEBUG("deb: download 3.");
+ &::DEBUG("deb: download 3.");
if (!&DebianDownload($dist, %urls)) { # no good download.
if (!&DebianDownload($dist, %urls)) { # no good download.
- &main::WARN("Debian(iP): could not download ANY files.");
+ &::WARN("Debian(iP): could not download ANY files.");
my $incoming = 0;
my @files = &validPackage($package, $dist);
if (!scalar @files) {
my $incoming = 0;
my @files = &validPackage($package, $dist);
if (!scalar @files) {
- &main::status("Debian: no valid package found; checking incoming.");
+ &::status("Debian: no valid package found; checking incoming.");
@files = &validPackage($package, "incoming");
if (scalar @files) {
@files = &validPackage($package, "incoming");
if (scalar @files) {
- &main::status("Debian: cool, it exists in incoming.");
+ &::status("Debian: cool, it exists in incoming.");
- &main::msg($main::who, "Package '$package' does not exist.");
+ &::msg($::who, "Package '$package' does not exist.");
return 0;
}
}
if (scalar @files > 1) {
return 0;
}
}
if (scalar @files > 1) {
- &main::WARN("same package in more than one file; random.");
- &main::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
- $files[0] = &main::getRandom(@files);
+ &::WARN("same package in more than one file; random.");
+ &::DEBUG("THIS SHOULD BE FIXED SOMEHOW!!!");
+ $files[0] = &::getRandom(@files);
- &main::WARN("files[0] ($files[0]) doesn't exist.");
- &main::msg($main::who, "WARNING: $files[0] does not exist? FIXME");
+ &::WARN("files[0] ($files[0]) doesn't exist.");
+ &::msg($::who, "WARNING: $files[0] does not exist? FIXME");
### TODO: use fe, dump to a hash. if only one version of the package
### exists. do as normal otherwise list all versions.
if (! -f $file) {
### TODO: use fe, dump to a hash. if only one version of the package
### exists. do as normal otherwise list all versions.
if (! -f $file) {
- &main::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
+ &::ERROR("D:iP: file '$file' DOES NOT EXIST!!! should never happen.");
return 0;
}
my %pkg = &getPackageInfo($package, $file);
return 0;
}
my %pkg = &getPackageInfo($package, $file);
$pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
if ($incoming) {
$pkg{'info'} .= ", Installed size: \002$pkg{'installed'}\002 kB";
if ($incoming) {
- &main::status("iP: info requested and pkg is in incoming, too.");
+ &::status("iP: info requested and pkg is in incoming, too.");
my %incpkg = &getPackageInfo($query, "debian/Packages-incoming");
if (scalar keys %incpkg) {
$pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
} else {
my %incpkg = &getPackageInfo($query, "debian/Packages-incoming");
if (scalar keys %incpkg) {
$pkg{'info'} .= ". Is in incoming ($incpkg{'file'}).";
} else {
- &main::ERROR("iP: pkg $query is in incoming but we couldn't get any info?");
+ &::ERROR("iP: pkg $query is in incoming but we couldn't get any info?");
- &main::DEBUG("running debianCheck() due to problems (".scalar(keys %pkg).").");
+ &::DEBUG("running debianCheck() due to problems (".scalar(keys %pkg).").");
- &main::DEBUG("end of debianCheck()");
+ &::DEBUG("end of debianCheck()");
- &main::msg($main::who,"Debian: Package appears to exist but I could not retrieve info about it...");
+ &::msg($::who,"Debian: Package appears to exist but I could not retrieve info about it...");
- &main::performStrictReply("$package: $pkg{$query}");
+ &::pSReply("$package: $pkg{$query}");
}
# Usage: &infoStats($dist);
}
# Usage: &infoStats($dist);
$dist = &getDistro($dist);
return unless (defined $dist);
$dist = &getDistro($dist);
return unless (defined $dist);
- &main::DEBUG("infoS: dist => '$dist'.");
- my $interval = $main::param{'debianRefreshInterval'} || 7;
+ &::DEBUG("infoS: dist => '$dist'.");
+ my $interval = $::param{'debianRefreshInterval'} || 7;
# download packages file if needed.
my %urls = &fixDist($dist, %urlpackages);
# download packages file if needed.
my %urls = &fixDist($dist, %urlpackages);
- &main::DEBUG("deb: download 4.");
+ &::DEBUG("deb: download 4.");
if (!&DebianDownload($dist, %urls)) {
if (!&DebianDownload($dist, %urls)) {
- &main::WARN("Debian(iS): could not download ANY files.");
- &main::msg($main::who, "Debian(iS): internal error.");
+ &::WARN("Debian(iS): could not download ANY files.");
+ &::msg($::who, "Debian(iS): internal error.");
my $file;
foreach $file (keys %urlpackages) {
$file =~ s/##DIST/$dist/g; # won't work for incoming.
my $file;
foreach $file (keys %urlpackages) {
$file =~ s/##DIST/$dist/g; # won't work for incoming.
- &main::DEBUG("file => '$file'.");
+ &::DEBUG("file => '$file'.");
if (exists $stats{$file}{'count'}) {
if (exists $stats{$file}{'count'}) {
- &main::DEBUG("hrm... duplicate open with $file???");
+ &::DEBUG("hrm... duplicate open with $file???");
next;
}
open(IN,"zcat $file 2>&1 |");
if (! -e $file) {
next;
}
open(IN,"zcat $file 2>&1 |");
if (! -e $file) {
- &main::DEBUG("iS: $file does not exist.");
+ &::DEBUG("iS: $file does not exist.");
-### &main::DEBUG("=> '$_'.");
+### &::DEBUG("=> '$_'.");
}
close IN;
}
### TODO: don't count ppl with multiple email addresses.
}
close IN;
}
### TODO: don't count ppl with multiple email addresses.
- &main::performStrictReply(
"Debian Distro Stats on $dist... ".
"\002$total{'count'}\002 packages, ".
"\002".scalar(keys %{$total{'maint'}})."\002 maintainers, ".
"Debian Distro Stats on $dist... ".
"\002$total{'count'}\002 packages, ".
"\002".scalar(keys %{$total{'maint'}})."\002 maintainers, ".
### TODO: do individual stats? if so, we need _another_ arg.
# foreach $file (keys %stats) {
# foreach (keys %{$stats{$file}}) {
### TODO: do individual stats? if so, we need _another_ arg.
# foreach $file (keys %stats) {
# foreach (keys %{$stats{$file}}) {
-# &main::DEBUG(" '$file' '$_' '$stats{$file}{$_}'.");
+# &::DEBUG(" '$file' '$_' '$stats{$file}{$_}'.");
# Usage: &generateIndex();
sub generateIndex {
my (@dists) = @_;
# Usage: &generateIndex();
sub generateIndex {
my (@dists) = @_;
- &main::status("Debian: !!! generateIndex() called !!!");
+ &::status("Debian: !!! generateIndex() called !!!");
if (!scalar @dists or $dists[0] eq '') {
if (!scalar @dists or $dists[0] eq '') {
- &main::ERROR("gI: no dists to generate index.");
+ &::ERROR("gI: no dists to generate index.");
# regenerate it, even if it's not stale.
# TODO: also, regenerate the index if the packages file is newer
# than the index.
# regenerate it, even if it's not stale.
# TODO: also, regenerate the index if the packages file is newer
# than the index.
- next unless (&main::isStale($idx, $main::param{'debianRefreshInterval'}));
+ next unless (&::isStale($idx, $::param{'debianRefreshInterval'}));
- &main::DEBUG("gIndex: calling generateIncoming()!");
+ &::DEBUG("gIndex: calling generateIncoming()!");
&generateIncoming();
next;
}
if (/^woody$/i) {
&generateIncoming();
next;
}
if (/^woody$/i) {
- &main::DEBUG("Copying old index of woody to -old");
+ &::DEBUG("Copying old index of woody to -old");
system("cp $idx $idx-old");
}
system("cp $idx $idx-old");
}
- &main::DEBUG("gIndeX: calling DebianDownload($dist, ...).");
+ &::DEBUG("gIndeX: calling DebianDownload($dist, ...).");
&DebianDownload($dist, %urlpackages);
&DebianDownload($dist, %urlpackages);
- &main::status("Debian: generating index for '$dist'.");
+ &::status("Debian: generating index for '$dist'.");
if (!open(OUT,">$idx")) {
if (!open(OUT,">$idx")) {
- &main::ERROR("cannot write to $idx.");
+ &::ERROR("cannot write to $idx.");
$packages =~ s/##DIST/$dist/;
if (! -e $packages) {
$packages =~ s/##DIST/$dist/;
if (! -e $packages) {
- &main::ERROR("gIndex: '$packages' does not exist?");
+ &::ERROR("gIndex: '$packages' does not exist?");
- &main::DEBUG("D: validPackage($package, $dist) called.");
+ &::DEBUG("D: validPackage($package, $dist) called.");
my $error = 0;
while (!open(IN, "debian/Packages-$dist.idx")) {
if ($error) {
my $error = 0;
while (!open(IN, "debian/Packages-$dist.idx")) {
if ($error) {
- &main::ERROR("Packages-$dist.idx does not exist (#1).");
+ &::ERROR("Packages-$dist.idx does not exist (#1).");
- &main::DEBUG("vP: scanned $count items in index.");
+ &::DEBUG("vP: scanned $count items in index.");
- &main::status("Debian: Search package matching '$query' in '$dist'.");
+ &::status("Debian: Search package matching '$query' in '$dist'.");
unlink $file if ( -z $file);
while (!open(IN, $file)) {
if ($dist eq "incoming") {
unlink $file if ( -z $file);
while (!open(IN, $file)) {
if ($dist eq "incoming") {
- &main::DEBUG("sP: dist == incoming; calling gI().");
+ &::DEBUG("sP: dist == incoming; calling gI().");
&generateIncoming();
}
if ($error) {
&generateIncoming();
}
if ($error) {
- &main::ERROR("could not generate index!!!");
+ &::ERROR("could not generate index!!!");
- &main::DEBUG("should we be doing this?");
+ &::DEBUG("should we be doing this?");
&generateIndex(($dist));
}
&generateIndex(($dist));
}
if (/^\*(.*)$/) {
$file = $1;
if (/^\*(.*)$/) {
$file = $1;
- if (&main::isStale($file, $main::param{'debianRefreshInterval'})) {
- &main::DEBUG("STALE $file! regen.");
+ if (&::isStale($file, $::param{'debianRefreshInterval'})) {
+ &::DEBUG("STALE $file! regen.");
&generateIndex(($dist));
### @files = searchPackage("$query $dist");
&generateIndex(($dist));
### @files = searchPackage("$query $dist");
- &main::DEBUG("EVIL HACK HACK HACK.");
+ &::DEBUG("EVIL HACK HACK HACK.");
close IN;
if (scalar @files and $warn) {
close IN;
if (scalar @files and $warn) {
- &main::msg($main::who, "searching for package name should be fully lowercase!");
+ &::msg($::who, "searching for package name should be fully lowercase!");
my $dist = $_[0];
if (!defined $dist or $dist eq "") {
my $dist = $_[0];
if (!defined $dist or $dist eq "") {
- &main::DEBUG("gD: dist == NULL; dist = defaultdist.");
+ &::DEBUG("gD: dist == NULL; dist = defaultdist.");
$dist = $defaultdist;
}
if ($dist =~ /^(slink|hamm|rex|bo)$/i) {
$dist = $defaultdist;
}
if ($dist =~ /^(slink|hamm|rex|bo)$/i) {
- &main::DEBUG("Debian: deprecated version ($dist).");
- &main::msg($main::who, "Debian: deprecated distribution version.");
+ &::DEBUG("Debian: deprecated version ($dist).");
+ &::msg($::who, "Debian: deprecated distribution version.");
return $dists{$dist};
} else {
if (!grep /^\Q$dist\E$/i, %dists) {
return $dists{$dist};
} else {
if (!grep /^\Q$dist\E$/i, %dists) {
- &main::msg($main::who, "invalid dist '$dist'.");
+ &::msg($::who, "invalid dist '$dist'.");
my @results = sort &searchPackage($str);
if (!scalar @results) {
my @results = sort &searchPackage($str);
if (!scalar @results) {
- &main::Forker("debian", sub { &searchContents($str); } );
+ &::Forker("debian", sub { &searchContents($str); } );
} elsif (scalar @results == 1) {
} elsif (scalar @results == 1) {
- &main::status("searchPackage returned one result; getting info of package instead!");
- &main::Forker("debian", sub { &infoPackages("info", "$results[0] $dist"); } );
+ &::status("searchPackage returned one result; getting info of package instead!");
+ &::Forker("debian", sub { &infoPackages("info", "$results[0] $dist"); } );
} else {
my $prefix = "Debian Package Listing of '$str' ";
} else {
my $prefix = "Debian Package Listing of '$str' ";
- &main::performStrictReply( &main::formListReply(0, $prefix, @results) );
+ &::pSReply( &::formListReply(0, $prefix, @results) );
my $dir = "debian/";
my $error = 0;
my $dir = "debian/";
my $error = 0;
- &main::status("debianCheck() called.");
+ &::status("debianCheck() called.");
### TODO: remove the following loop (check if dir exists before)
while (1) {
last if (opendir(DEBIAN, $dir));
if ($error) {
### TODO: remove the following loop (check if dir exists before)
while (1) {
last if (opendir(DEBIAN, $dir));
if ($error) {
- &main::ERROR("dC: cannot opendir debian.");
+ &::ERROR("dC: cannot opendir debian.");
return;
}
mkdir $dir, 0755;
return;
}
mkdir $dir, 0755;
my $exit = system("gzip -t '$dir/$file'");
next unless ($exit);
my $exit = system("gzip -t '$dir/$file'");
next unless ($exit);
- &main::DEBUG("hmr... => ".(time() - (stat($file))[8])."'.");
+ &::DEBUG("hmr... => ".(time() - (stat($file))[8])."'.");
next unless (time() - (stat($file))[8] > 3600);
next unless (time() - (stat($file))[8] > 3600);
- &main::DEBUG("dC: exit => '$exit'.");
- &main::WARN("dC: '$dir/$file' corrupted? deleting!");
+ &::DEBUG("dC: exit => '$exit'.");
+ &::WARN("dC: '$dir/$file' corrupted? deleting!");
unlink $dir."/".$file;
$retval++;
}
unlink $dir."/".$file;
$retval++;
}
my $bugs_url = "http://master.debian.org/~wakkerma/bugs";
sub debianBugs {
my $bugs_url = "http://master.debian.org/~wakkerma/bugs";
sub debianBugs {
- my @results = &main::getURL($bugs_url);
+ my @results = &::getURL($bugs_url);
my ($date, $rcbugs, $remove);
my ($bugs_closed, $bugs_opened) = (0,0);
my ($date, $rcbugs, $remove);
my ($bugs_closed, $bugs_opened) = (0,0);
"It's good to see " :
"Oh no, the bug count is rising -- ";
"It's good to see " :
"Oh no, the bug count is rising -- ";
- &main::performStrictReply(
"Debian bugs statistics, last updated on $date... ".
"There are \002$rcbugs\002 release-critical bugs; $xtxt".
"\002$bugs_closed\002 bugs closed, opening \002$bugs_opened\002 bugs. ".
"About \002$remove\002 packages will be removed."
);
} else {
"Debian bugs statistics, last updated on $date... ".
"There are \002$rcbugs\002 release-critical bugs; $xtxt".
"\002$bugs_closed\002 bugs closed, opening \002$bugs_opened\002 bugs. ".
"About \002$remove\002 packages will be removed."
);
} else {
- &main::msg($main::who, "Couldn't retrieve data for debian bug stats.");
+ &::msg($::who, "Couldn't retrieve data for debian bug stats.");
sub Dict {
my ($query) = @_;
sub Dict {
my ($query) = @_;
-### return unless &main::loadPerlModule("IO::Socket");
+### return unless &::loadPerlModule("IO::Socket");
my $socket = new IO::Socket;
my @results;
my $socket = new IO::Socket;
my @results;
my $total = scalar @results;
if (defined $num and ($num > $total or $num < 0)) {
my $total = scalar @results;
if (defined $num and ($num > $total or $num < 0)) {
- &msg($main::who, "error: choice in definition is out of range.");
+ &msg($::who, "error: choice in definition is out of range.");
} else {
# suggested by larne and others.
my $prefix = "Dictionary '$query' ";
} else {
# suggested by larne and others.
my $prefix = "Dictionary '$query' ";
- $retval = &main::formListReply(1, $prefix, @results);
+ $retval = &::formListReply(1, $prefix, @results);
}
} elsif ($total == 1) {
$retval = "Dictionary '$query' ".$results[0];
}
} elsif ($total == 1) {
$retval = "Dictionary '$query' ".$results[0];
- &main::performStrictReply($retval);
+ &::performStrictReply($retval);
}
sub Dict_Wordnet {
my ($socket, $query) = @_;
my @results;
}
sub Dict_Wordnet {
my ($socket, $query) = @_;
my @results;
- &main::status("Dict: asking Wordnet.");
+ &::status("Dict: asking Wordnet.");
print $socket "DEFINE wn \"$query\"\n";
my $def = "";
print $socket "DEFINE wn \"$query\"\n";
my $def = "";
} elsif (/^\s+(\S+ )?(\d+)?: (.*)/) { # start of sub def.
my $text = $3;
$def =~ s/\s+$//;
} elsif (/^\s+(\S+ )?(\d+)?: (.*)/) { # start of sub def.
my $text = $3;
$def =~ s/\s+$//;
-### &main::DEBUG("def => '$def'.");
+### &::DEBUG("def => '$def'.");
push(@results, $def) if ($def ne "");
$def = $text;
if (0) { # old non-fLR format.
$def = "$query $wordtype: $text" if (defined $text);
$wordtype = substr($1,0,-1) if (defined $1);
push(@results, $def) if ($def ne "");
$def = $text;
if (0) { # old non-fLR format.
$def = "$query $wordtype: $text" if (defined $text);
$wordtype = substr($1,0,-1) if (defined $1);
-### &main::DEBUG("_ => '$_'.") if (!defined $text);
+### &::DEBUG("_ => '$_'.") if (!defined $text);
- &main::status("Dict: wordnet: found ". scalar(@results) ." defs.");
+ &::status("Dict: wordnet: found ". scalar(@results) ." defs.");
return if (!scalar @results);
return if (!scalar @results);
my ($socket,$query) = @_;
my @results;
my ($socket,$query) = @_;
my @results;
- &main::status("Dict: asking Foldoc.");
+ &::status("Dict: asking Foldoc.");
print $socket "DEFINE foldoc \"$query\"\n";
my $firsttime = 1;
print $socket "DEFINE foldoc \"$query\"\n";
my $firsttime = 1;
- &main::status("Dict: foldoc: found ". scalar(@results) ." defs.");
+ &::status("Dict: foldoc: found ". scalar(@results) ." defs.");
return if (!scalar @results);
pop @results; # last def is date of entry.
return if (!scalar @results);
pop @results; # last def is date of entry.
if ($faqtoid eq "") {
&help("factinfo");
if ($faqtoid eq "") {
&help("factinfo");
# factoid does not exist.
if (scalar @factinfo <= 1) {
&performReply("there's no such factoid as \002$faqtoid\002");
# factoid does not exist.
if (scalar @factinfo <= 1) {
&performReply("there's no such factoid as \002$faqtoid\002");
}
# fix for problem observed by asuffield.
}
# fix for problem observed by asuffield.
&DEBUG("factinfo{$_} => '$factinfo{$_}'.");
}
### &delFactoid($faqtoid);
&DEBUG("factinfo{$_} => '$factinfo{$_}'.");
}
### &delFactoid($faqtoid);
# factoid was inserted not through the bot.
if (!scalar @array) {
&performReply("no extra info on \002$faqtoid\002");
# factoid was inserted not through the bot.
if (!scalar @array) {
&performReply("no extra info on \002$faqtoid\002");
}
&performStrictReply("$factinfo{'factoid_key'} -- ". join("; ", @array) .".");
}
&performStrictReply("$factinfo{'factoid_key'} -- ". join("; ", @array) .".");
# Usage: &Freshmeat($string);
sub Freshmeat {
my $sstr = lc($_[0]);
# Usage: &Freshmeat($string);
sub Freshmeat {
my $sstr = lc($_[0]);
- my $refresh = $main::param{'freshmeatRefreshInterval'} * 60 * 60;
+ my $refresh = $::param{'freshmeatRefreshInterval'} * 60 * 60;
- my $last_refresh = &main::dbGet("freshmeat", "name","_","stable");
+ my $last_refresh = &::dbGet("freshmeat", "name","_","stable");
my $renewtable = 0;
if (defined $last_refresh) {
my $renewtable = 0;
if (defined $last_refresh) {
} else {
$renewtable++;
}
} else {
$renewtable++;
}
- $renewtable++ if (&main::countKeys("freshmeat") < 10);
+ $renewtable++ if (&::countKeys("freshmeat") < 10);
- if ($renewtable and $$ == $main::bot_pid) {
- &main::Forker("freshmeat", sub {
+ if ($renewtable and $$ == $::bot_pid) {
+ &::Forker("freshmeat", sub {
&downloadIndex();
&Freshmeat($sstr);
} );
# both parent/fork runs here, in case the following looks weird.
&downloadIndex();
&Freshmeat($sstr);
} );
# both parent/fork runs here, in case the following looks weird.
- return if ($$ == $main::bot_pid);
+ return if ($$ == $::bot_pid);
}
if (!&showPackage($sstr)) { # no exact match.
}
if (!&showPackage($sstr)) { # no exact match.
- my $start_time = &main::timeget();
+ my $start_time = &::timeget();
my %hash;
# search by key/NAME first.
my %hash;
# search by key/NAME first.
- foreach (&main::searchTable("freshmeat", "name","name",$sstr)) {
+ foreach (&::searchTable("freshmeat", "name","name",$sstr)) {
$hash{$_} = 1 unless exists $hash{$_};
}
# search by description line.
$hash{$_} = 1 unless exists $hash{$_};
}
# search by description line.
- foreach (&main::searchTable("freshmeat", "name","oneliner", $sstr)) {
+ foreach (&::searchTable("freshmeat", "name","oneliner", $sstr)) {
$hash{$_} = 1 unless exists $hash{$_};
last if (scalar keys %hash > 15);
}
$hash{$_} = 1 unless exists $hash{$_};
last if (scalar keys %hash > 15);
}
my @list = keys %hash;
# search by value, if we have enough room to do it.
if (scalar @list == 1) {
my @list = keys %hash;
# search by value, if we have enough room to do it.
if (scalar @list == 1) {
- &main::status("only one match found; showing full info.");
+ &::status("only one match found; showing full info.");
&showPackage($list[0]);
return;
}
# show how long it took.
&showPackage($list[0]);
return;
}
# show how long it took.
- my $delta_time = &main::timedelta($start_time);
- &main::status(sprintf("freshmeat: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
+ my $delta_time = &::timedelta($start_time);
+ &::status(sprintf("freshmeat: %.02f sec to complete query.", $delta_time)) if ($delta_time > 0);
for (@list) {
tr/A-Z/a-z/;
s/([\,\;]+)/\037$1\037/g;
}
for (@list) {
tr/A-Z/a-z/;
s/([\,\;]+)/\037$1\037/g;
}
- &main::performStrictReply( &main::formListReply(1, "Freshmeat ", @list) );
+ &::performStrictReply( &::formListReply(1, "Freshmeat ", @list) );
}
}
sub showPackage {
my ($pkg) = @_;
}
}
sub showPackage {
my ($pkg) = @_;
- my @fm = &main::dbGet("freshmeat", "name",$pkg,"*");
+ my @fm = &::dbGet("freshmeat", "name",$pkg,"*");
if (scalar @fm) { #1: perfect match of name.
my $retval;
if (scalar @fm) { #1: perfect match of name.
my $retval;
$retval .= "Development: \002$fm[2]\002. ";
$retval .= $fm[5] || $fm[6]; # fallback to 'download'.
$retval .= " deb: ".$fm[8] if ($fm[8] ne ""); # 'deb'.
$retval .= "Development: \002$fm[2]\002. ";
$retval .= $fm[5] || $fm[6]; # fallback to 'download'.
$retval .= " deb: ".$fm[8] if ($fm[8] ne ""); # 'deb'.
- &main::performStrictReply($retval);
+ &::performStrictReply($retval);
return 1;
} else {
return 0;
}
}
return 1;
} else {
return 0;
}
}
+sub randPackage {
+ my @fm = &::randKey("freshmeat","*");
+
+ if (scalar @fm) { #1: perfect match of name.
+ my $retval;
+ $retval = "$fm[0] \002(\002$fm[11]\002)\002, ";
+ $retval .= "section $fm[3], ";
+ $retval .= "is $fm[4]. ";
+ $retval .= "Stable: \002$fm[1]\002, ";
+ $retval .= "Development: \002$fm[2]\002. ";
+ $retval .= $fm[5] || $fm[6]; # fallback to 'download'.
+ $retval .= " deb: ".$fm[8] if ($fm[8] ne ""); # 'deb'.
+
+ return $retval;
+ } else {
+ return;
+ }
+}
+
- my $start_time = &main::timeget(); # set the start time.
- my $idx = "$main::param{tempDir}/fm_index.txt";
+ my $start_time = &::timeget(); # set the start time.
+ my $idx = "$::param{tempDir}/fm_index.txt";
- &main::msg($main::who, "Updating freshmeat index... please wait");
+ &::msg($::who, "Updating freshmeat index... please wait");
- if (&main::isStale($idx, 1)) {
- &main::status("Freshmeat: fetching data.");
+ if (&::isStale($idx, 1)) {
+ &::status("Freshmeat: fetching data.");
- my $retval = &main::getURLAsFile($urls{$_}, $idx);
+ my $retval = &::getURLAsFile($urls{$_}, $idx);
next if ($retval =~ /^(403|500)$/);
next if ($retval =~ /^(403|500)$/);
- &main::DEBUG("FM: last! retval => '$retval'.");
+ &::DEBUG("FM: last! retval => '$retval'.");
- &main::status("Freshmeat: local file hack.");
+ &::status("Freshmeat: local file hack.");
- &main::msg($main::who, "the freshmeat butcher is closed.");
+ &::msg($::who, "the freshmeat butcher is closed.");
return;
}
if ( -s $idx < 100000) {
return;
}
if ( -s $idx < 100000) {
- &main::DEBUG("FM: index too small?");
+ &::DEBUG("FM: index too small?");
- &main::msg($main::who, "internal error?");
+ &::msg($::who, "internal error?");
}
# delete the table before we redo it.
}
# delete the table before we redo it.
- &main::deleteTable("freshmeat");
+ &::deleteTable("freshmeat");
### lets get on with business.
# set the last refresh time. fixes multiple spawn bug.
### lets get on with business.
# set the last refresh time. fixes multiple spawn bug.
- &main::dbSet("freshmeat", "name","_","stable",time());
+ &::dbSet("freshmeat", "name","_","stable",time());
my $i = 0;
while (my $line = <IN>) {
my $i = 0;
while (my $line = <IN>) {
- &main::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
+ &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
my @data;
my @done;
while (my $line = <IN>) {
my @data;
my @done;
while (my $line = <IN>) {
}
if ($i % 200 == 0 and $i != 0) {
}
if ($i % 200 == 0 and $i != 0) {
- &main::DEBUG("FM: unlocking and locking.");
- &main::dbRaw("UNLOCK", "UNLOCK TABLES");
+ &::DEBUG("FM: unlocking and locking.");
+ &::dbRaw("UNLOCK", "UNLOCK TABLES");
### another lame hack to "prevent" errors.
select(undef, undef, undef, 0.2);
### another lame hack to "prevent" errors.
select(undef, undef, undef, 0.2);
- &main::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
+ &::dbRaw("LOCK", "LOCK TABLES freshmeat WRITE");
}
if (grep /^\Q$data[0]\E$/, @done) {
}
if (grep /^\Q$data[0]\E$/, @done) {
- &main::DEBUG("dupe? $data[0]");
+ &::DEBUG("dupe? $data[0]");
pop @data;
$data[1] ||= "none";
$data[2] ||= "none";
pop @data;
$data[1] ||= "none";
$data[2] ||= "none";
- &main::dbSetRow("freshmeat", @data);
+ &::dbSetRow("freshmeat", @data);
push(@done,$data[0]);
@data = ();
}
close IN;
push(@done,$data[0]);
@data = ();
}
close IN;
- &main::DEBUG("FM: data ".scalar(@data) );
- &main::dbRaw("UNLOCK", "UNLOCK TABLES");
+ &::DEBUG("FM: data ".scalar(@data) );
+ &::dbRaw("UNLOCK", "UNLOCK TABLES");
- my $delta_time = &main::timedelta($start_time);
- &main::status(sprintf("Freshmeat: %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
+ my $delta_time = &::timedelta($start_time);
+ &::status(sprintf("Freshmeat: %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
- my $count = &main::countKeys("freshmeat");
- &main::status("Freshmeat: $count entries loaded.");
+ my $count = &::countKeys("freshmeat");
+ &::status("Freshmeat: $count entries loaded.");
}
sub freshmeatAnnounce {
}
sub freshmeatAnnounce {
- my $file = "$main::param{tempDir}/fm_recent.txt";
+ my $file = "$::param{tempDir}/fm_recent.txt";
my @old;
### if file exists, lets read it.
my @old;
### if file exists, lets read it.
- my @array = &main::getURL("http://core.freshmeat.net/backend/recentnews.txt");
+ my @array = &::getURL("http://core.freshmeat.net/backend/recentnews.txt");
my @now;
while (@array) {
my @now;
while (@array) {
- &main::DEBUG("fA: no new items.");
+ &::DEBUG("fA: no new items.");
- my $chan;
- my @chans = split(/[\s\t]+/, lc $main::param{'freshmeatAnnounce'});
- @chans = keys(%main::channels) unless (scalar @chans);
-
- my $line = "Freshmeat update: ".join(" \002::\002 ", @new);
- foreach (@chans) {
- next unless (&main::validChan($_));
-
- &main::status("sending freshmeat update to $_.");
- &main::notice($_, $line);
- }
-
### output new file.
open(OUT, ">$file");
foreach (@now) {
print OUT "$_\n";
}
close OUT;
### output new file.
open(OUT, ">$file");
foreach (@now) {
print OUT "$_\n";
}
close OUT;
+
+ return "Freshmeat update: ".join(" \002::\002 ", @new);
###local $SIG{ALRM} = sub { die "alarm\n" };
sub kernelGetInfo {
###local $SIG{ALRM} = sub { die "alarm\n" };
sub kernelGetInfo {
-### return unless &main::loadPerlModule("IO::Socket");
+### return unless &::loadPerlModule("IO::Socket");
my $socket = new IO::Socket;
my $socket = new IO::Socket;
sub Kernel {
my @now = &kernelGetInfo();
if (!scalar @now) {
sub Kernel {
my @now = &kernelGetInfo();
if (!scalar @now) {
- &main::msg($main::who, "failed.");
+ &::msg($::who, "failed.");
return;
}
foreach (@now) {
return;
}
foreach (@now) {
- &main::msg($main::who, $_);
- my $file = "$main::param{tempDir}/kernel.txt";
+ my $file = "$::param{tempDir}/kernel.txt";
my @now = &kernelGetInfo();
my @old;
if (!scalar @now) {
my @now = &kernelGetInfo();
my @old;
if (!scalar @now) {
- &main::DEBUG("kA: failure to retrieve.");
+ &::DEBUG("kA: failure to retrieve.");
}
if (scalar @now != scalar @old) {
}
if (scalar @now != scalar @old) {
- &main::DEBUG("kA: scalar mismatch; removing and exiting.");
+ &::DEBUG("kA: scalar mismatch; removing and exiting.");
unlink $file;
return;
}
if (!scalar @new) {
unlink $file;
return;
}
if (!scalar @new) {
- &main::DEBUG("kA: no new kernels.");
+ &::DEBUG("kA: no new kernels.");
- my $chan;
- my @chans = split(/[\s\t]+/, lc $main::param{'kernelAnnounce'});
- @chans = keys(%main::channels) unless (scalar @chans);
- foreach $chan (@chans) {
- next unless (&main::validChan($chan));
-
- &main::status("sending kernel update to $chan.");
- foreach (@new) {
- &main::notice($chan, "Kernel: $_");
- }
- }
-
open(OUT, ">$file");
foreach (@now) {
print OUT "$_\n";
}
close OUT;
open(OUT, ">$file");
foreach (@now) {
print OUT "$_\n";
}
close OUT;
sub Quote {
my $stock = shift;
sub Quote {
my $stock = shift;
- my @results = &main::getURL("http://quote.yahoo.com/q?s=$stock&d=v1");
+ my @results = &::getURL("http://quote.yahoo.com/q?s=$stock&d=v1");
- &main::msg($main::who, "i could not get a stock quote :(");
+ &::msg($::who, "i could not get a stock quote :(");
}
my $flathtml = join(" ", @results);
}
my $flathtml = join(" ", @results);
$reply = "i couldn't get the quote for $stock. sorry. :(";
}
$reply = "i couldn't get the quote for $stock. sorry. :(";
}
- &main::performStrictReply($reply);
+ &::performStrictReply($reply);
# Search(keys||vals, str);
sub Search {
my ($type, $str) = @_;
# Search(keys||vals, str);
sub Search {
my ($type, $str) = @_;
- my $start_time = &main::timeget();
+ my $start_time = &::timeget();
my @list;
$type =~ s/s$//; # nice work-around.
if ($type eq "value") { # search by value.
my @list;
$type =~ s/s$//; # nice work-around.
if ($type eq "value") { # search by value.
- @list = &main::searchTable("factoids", "factoid_key", "factoid_value", $str);
+ @list = &::searchTable("factoids", "factoid_key", "factoid_value", $str);
} else { # search by key.
} else { # search by key.
- @list = &main::searchTable("factoids", "factoid_key", "factoid_key", $str);
+ @list = &::searchTable("factoids", "factoid_key", "factoid_key", $str);
- my $delta_time = sprintf("%.02f", &main::timedelta($start_time) );
- &main::status("search: took $delta_time sec for query.") if ($delta_time > 0);
+ my $delta_time = sprintf("%.02f", &::timedelta($start_time) );
+ &::status("search: took $delta_time sec for query.") if ($delta_time > 0);
my $prefix = "Factoid search of '\002$str\002' by $type ";
my $prefix = "Factoid search of '\002$str\002' by $type ";
- &main::performStrictReply( &main::formListReply(1, $prefix, @list) );
+ &::performStrictReply( &::formListReply(1, $prefix, @list) );
- my @results = &main::getURL("http://www.slashdot.org/slashdot.xml");
+ my @results = &::getURL("http://www.slashdot.org/slashdot.xml");
my $retval = "i could not get the headlines.";
if (scalar @results) {
my $prefix = "Slashdot Headlines ";
my @list = &slashdotParse(@results);
my $retval = "i could not get the headlines.";
if (scalar @results) {
my $prefix = "Slashdot Headlines ";
my @list = &slashdotParse(@results);
- $retval = &main::formListReply(0, $prefix, @list);
+ $retval = &::formListReply(0, $prefix, @list);
- &main::performStrictReply($retval);
+ &::performStrictReply($retval);
- my $file = "$main::param{tempDir}/slashdot.xml";
+ my $file = "$::param{tempDir}/slashdot.xml";
- my @Cxml = &main::getURL("http://www.slashdot.org/slashdot.xml");
+ my @Cxml = &::getURL("http://www.slashdot.org/slashdot.xml");
- &main::DEBUG("sdA: failure (Cxml == NULL).");
+ &::DEBUG("sdA: failure (Cxml == NULL).");
}
if (scalar @new == 0) {
}
if (scalar @new == 0) {
- &main::status("Slashdot: no new headlines.");
+ &::status("Slashdot: no new headlines.");
return;
}
if (scalar @new == scalar @Chl) {
return;
}
if (scalar @new == scalar @Chl) {
- &main::DEBUG("sdA: scalar(new) == scalar(Chl). bad?");
+ &::DEBUG("sdA: scalar(new) == scalar(Chl). bad?");
my $line = "Slashdot: News for nerds, stuff that matters -- ".
join(" \002::\002 ", @new);
my $line = "Slashdot: News for nerds, stuff that matters -- ".
join(" \002::\002 ", @new);
- my @chans = split(/[\s\t]+/, lc $main::param{'slashdotAnnounce'});
- @chans = keys(%main::channels) unless (scalar @chans);
+ my @chans = split(/[\s\t]+/, lc $::param{'slashdotAnnounce'});
+ @chans = keys(%::channels) unless (scalar @chans);
- next unless (&main::validChan($_));
+ next unless (&::validChan($_));
- &main::status("sending slashdot update to $_.");
- &main::notice($_, $line);
+ &::status("sending slashdot update to $_.");
+ &::notice($_, $line);
}
sleep 1; # just in case?
}
}
sleep 1; # just in case?
}
### CMD: ADD:
if ($args eq "") {
&help("topic add");
### CMD: ADD:
if ($args eq "") {
&help("topic add");
}
# heh, joeyh. 19990819. -xk
if ($who =~ /\|\|/) {
&msg($who, "error: you have an invalid nick, loser!");
}
# heh, joeyh. 19990819. -xk
if ($who =~ /\|\|/) {
&msg($who, "error: you have an invalid nick, loser!");
}
my @prev = &topicDecipher($chan);
}
my @prev = &topicDecipher($chan);
if ($topiccount == 0) {
&msg($who, "No topic set.");
if ($topiccount == 0) {
&msg($who, "No topic set.");
}
if ($args eq "") {
&help("topic del");
}
if ($args eq "") {
&help("topic del");
if ($args !~ /[\,\-\d]/) {
&msg($who, "error: Invalid argument ($args).");
if ($args !~ /[\,\-\d]/) {
&msg($who, "error: Invalid argument ($args).");
}
foreach (split ",", $args) {
}
foreach (split ",", $args) {
push(@delete, $1);
} else {
&msg($who, "error: Invalid sub-argument ($_).");
push(@delete, $1);
} else {
&msg($who, "error: Invalid sub-argument ($_).");
}
$topic{$chan}{'What'} = "Deleted ".join("/",@delete);
}
$topic{$chan}{'What'} = "Deleted ".join("/",@delete);
foreach (@delete) {
if ($_ > $topiccount || $_ < 1) {
&msg($who, "error: argument out of range. (max: $topiccount)");
foreach (@delete) {
if ($_ > $topiccount || $_ < 1) {
&msg($who, "error: argument out of range. (max: $topiccount)");
}
# skip if already deleted.
# only checked if x-y range is given.
}
# skip if already deleted.
# only checked if x-y range is given.
my @topics = &topicDecipher($chan);
if (!scalar @topics) {
&msg($who, "No topics for \002$chan\002.");
my @topics = &topicDecipher($chan);
if (!scalar @topics) {
&msg($who, "No topics for \002$chan\002.");
}
&msg($who, "Topics for \002$chan\002:");
}
&msg($who, "Topics for \002$chan\002:");
if ($args eq "") {
&help("topic mod");
if ($args eq "") {
&help("topic mod");
}
# a warning message instead of halting. we kind of trust the user now.
}
# a warning message instead of halting. we kind of trust the user now.
# SAR patch. mu++
if ($args =~ m|^\s*s([/,#])(.+?)\1(.*?)\1([a-z]*);?\s*$|) {
# SAR patch. mu++
if ($args =~ m|^\s*s([/,#])(.+?)\1(.*?)\1([a-z]*);?\s*$|) {
- my ($delim, $op, $np, $flags) = ($1,quotemeta $2,$3,$4);
+ my ($delim, $op, $np, $flags) = ($1,$2,$3,$4);
if ($flags !~ /^(g)?$/) {
&msg($who, "error: Invalid flags to regex.");
if ($flags !~ /^(g)?$/) {
&msg($who, "error: Invalid flags to regex.");
}
my $topic = $topic{$chan}{'Current'};
}
my $topic = $topic{$chan}{'Current'};
- if (($flags eq "g" and $topic =~ s/$op/$np/g) ||
- ($flags eq "" and $topic =~ s/$op/$np/)) {
+ ### TODO: use m### to make code safe!
+ if (($flags eq "g" and $topic =~ s/\Q$op\E/$np/g) ||
+ ($flags eq "" and $topic =~ s/\Q$op\E/$np/)) {
$_ = "Modifying topic with sar s/$op/$np/.";
&topicNew($chan, $topic, $_, $topicUpdate);
} else {
&msg($who, "warning: regex not found in topic.");
}
$_ = "Modifying topic with sar s/$op/$np/.";
&topicNew($chan, $topic, $_, $topicUpdate);
} else {
&msg($who, "warning: regex not found in topic.");
}
}
&msg($who, "error: Invalid regex. Try s/1/2/, s#3#4#...");
}
&msg($who, "error: Invalid regex. Try s/1/2/, s#3#4#...");
if ($args eq "") {
&help("topic mv");
if ($args eq "") {
&help("topic mv");
}
if ($args =~ /^(first|last|\d+)\s+(before|after|swap)\s+(first|last|\d+)$/i) {
}
if ($args =~ /^(first|last|\d+)\s+(before|after|swap)\s+(first|last|\d+)$/i) {
if ($topiccount == 1) {
&msg($who, "error: impossible to move the only subtopic, dumbass.");
if ($topiccount == 1) {
&msg($who, "error: impossible to move the only subtopic, dumbass.");
}
# Is there an easier way to do this?
}
# Is there an easier way to do this?
if ($from > $topiccount || $to > $topiccount || $from < 1 || $to < 1) {
&msg($who, "error: <from> or <to> is out of range.");
if ($from > $topiccount || $to > $topiccount || $from < 1 || $to < 1) {
&msg($who, "error: <from> or <to> is out of range.");
}
if ($from == $to) {
&msg($who, "error: <from> and <to> are the same.");
}
if ($from == $to) {
&msg($who, "error: <from> and <to> are the same.");
}
$topic{$chan}{'What'} = "Move $from to $to";
}
$topic{$chan}{'What'} = "Move $from to $to";
$_ = "Swapped #\002$from\002 with #\002$to\002.";
&topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate);
$_ = "Swapped #\002$from\002 with #\002$to\002.";
&topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate);
$_ = "Moved #\002$from\002 $action #\002$to\002.";
&topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate);
$_ = "Moved #\002$from\002 $action #\002$to\002.";
&topicNew($chan, &topicCipher(@subtopics), $_, $topicUpdate);
}
&msg($who, "Invalid arguments.");
}
&msg($who, "Invalid arguments.");
### CMD: HISTORY:
if (!scalar @{$topic{$chan}{'History'}}) {
&msg($who, "Sorry, no topics in history list.");
### CMD: HISTORY:
if (!scalar @{$topic{$chan}{'History'}}) {
&msg($who, "Sorry, no topics in history list.");
}
&msg($who, "History of topics on \002$chan\002:");
}
&msg($who, "History of topics on \002$chan\002:");
### CMD: RESTORE:
if ($args eq "") {
&help("topic restore");
### CMD: RESTORE:
if ($args eq "") {
&help("topic restore");
}
$topic{$chan}{'What'} = "Restore topic $args";
}
$topic{$chan}{'What'} = "Restore topic $args";
if ($args =~ /^last$/i) {
if (${$topic{$chan}{'History'}}[0] eq $topic{$chan}{'Current'}) {
&msg($who,"error: cannot restore last topic because it's mine.");
if ($args =~ /^last$/i) {
if (${$topic{$chan}{'History'}}[0] eq $topic{$chan}{'Current'}) {
&msg($who,"error: cannot restore last topic because it's mine.");
if ($args =~ /\d+/) {
if ($args > $#{$topic{$chan}{'History'}} || $args < 1) {
&msg($who, "error: argument is out of range.");
if ($args =~ /\d+/) {
if ($args > $#{$topic{$chan}{'History'}} || $args < 1) {
&msg($who, "error: argument is out of range.");
}
$_ = "Changing topic according to request.";
&topicNew($chan, ${$topic{$chan}{'History'}}[$args-1], $_, $topicUpdate);
}
$_ = "Changing topic according to request.";
&topicNew($chan, ${$topic{$chan}{'History'}}[$args-1], $_, $topicUpdate);
}
&msg($who, "error: argument is not positive integer.");
}
&msg($who, "error: argument is not positive integer.");
if ($cmd ne "" and $cmd !~ /^help/i) {
&msg($who, "Invalid command [$cmd].");
&msg($who, "Try 'help topic'.");
if ($cmd ne "" and $cmd !~ /^help/i) {
&msg($who, "Invalid command [$cmd].");
&msg($who, "Try 'help topic'.");
################################################################
{ my $defs_read = 0;
################################################################
{ my $defs_read = 0;
- $defs_read += read_defs("$main::bot_misc_dir/unittab");
+ $defs_read += read_defs("$::bot_misc_dir/unittab");
- &main::ERROR("Could not read any of the initialization files UNITTAB");
+ &::ERROR("Could not read any of the initialization files UNITTAB");
trim($from);
if ($from =~ s/^\s*\#\s*//) {
if (definition_line($from)) {
trim($from);
if ($from =~ s/^\s*\#\s*//) {
if (definition_line($from)) {
- &main::DEBUG("Defined.");
- &main::DEBUG("Error: $PARSE_ERROR.");
+ &::DEBUG("Error: $PARSE_ERROR.");
- &main::DEBUG("FAILURE 1.");
+ &::DEBUG("FAILURE 1.");
return;
}
unless ($from =~ /\S/) {
return;
}
unless ($from =~ /\S/) {
- &main::DEBUG("FAILURE 2");
return;
}
my $hu = parse_unit($from);
if (is_Zero($hu)) {
return;
}
my $hu = parse_unit($from);
if (is_Zero($hu)) {
- &main::DEBUG($PARSE_ERROR);
- &main::msg($main::who, $PARSE_ERROR);
+ &::DEBUG($PARSE_ERROR);
+ &::msg($::who, $PARSE_ERROR);
redo unless $to =~ /\S/;
$wu = parse_unit($to);
if (is_Zero($wu)) {
redo unless $to =~ /\S/;
$wu = parse_unit($to);
if (is_Zero($wu)) {
- &main::DEBUG($PARSE_ERROR);
+ &::DEBUG($PARSE_ERROR);
}
my $quot = unit_divide($hu, $wu);
if (is_dimensionless($quot)) {
my $q = $quot->{_};
if ($q == 0) {
}
my $quot = unit_divide($hu, $wu);
if (is_dimensionless($quot)) {
my $q = $quot->{_};
if ($q == 0) {
- &main::performStrictReply("$to is an invalid unit?");
+ &::performStrictReply("$to is an invalid unit?");
return;
}
# yet another powers hack.
$from =~ s/(\D+)(\d)/$1\^$2/g;
$to =~ s/(\D+)(\d)/$1\^$2/g;
return;
}
# yet another powers hack.
$from =~ s/(\D+)(\d)/$1\^$2/g;
$to =~ s/(\D+)(\d)/$1\^$2/g;
- &main::performStrictReply(sprintf("$from is approximately \002%.6g\002 $to", $q));
+ &::performStrictReply(sprintf("$from is approximately \002%.6g\002 $to", $q));
- &main::performStrictReply("$from cannot be correctly converted to $to.");
+ &::performStrictReply("$from cannot be correctly converted to $to.");
# print
# "conformability (Not the same dimension)\n",
# print
# "conformability (Not the same dimension)\n",
sub unit_divide {
my ($a, $b) = @_;
if ($b->{_} == 0) {
sub unit_divide {
my ($a, $b) = @_;
if ($b->{_} == 0) {
- &main::DEBUG("Division by zero error");
+ &::DEBUG("Division by zero error");
# Now look for `goto' actions
my $goto = $actions[$STATE]{$result_type};
unless ($goto && $goto->[0] eq 'goto') {
# Now look for `goto' actions
my $goto = $actions[$STATE]{$result_type};
unless ($goto && $goto->[0] eq 'goto') {
- &main::ERROR("No post-reduction goto in state $STATE for $result_type.");
+ &::ERROR("No post-reduction goto in state $STATE for $result_type.");
return;
}
print STDERR "goto $goto->[1]\n" if $DEBUG_p;
$STATE = $goto->[1];
} else {
return;
}
print STDERR "goto $goto->[1]\n" if $DEBUG_p;
$STATE = $goto->[1];
} else {
- &main::ERROR("Bad primary $primary");
+ &::ERROR("Bad primary $primary");
# fixed up bad implementation :)
# should be no problems, even if uptime or pid is duplicated.
# fixed up bad implementation :)
# should be no problems, even if uptime or pid is duplicated.
+ ## WARN: run away forks may get through here, have to fix.
foreach $uptime (sort {$b <=> $a} keys %uptime) {
foreach $pid (keys %{$uptime{$uptime}}) {
next if (exists $done{$pid});
foreach $uptime (sort {$b <=> $a} keys %uptime) {
foreach $pid (keys %{$uptime{$uptime}}) {
next if (exists $done{$pid});
my $file = $file{utm};
if ($$ != $bot_pid) {
my $file = $file{utm};
if ($$ != $bot_pid) {
- &WARN("uptime: forked process doing weird things! FIXME");
+ &FIXME("uptime: forked process doing weird things!");
my ($where, $what, $type) = @_;
my $retval = "$where can't find \002$what\002";
my ($where, $what, $type) = @_;
my $retval = "$where can't find \002$what\002";
- return unless &main::loadPerlModule("WWW::Search");
+ return unless &::loadPerlModule("WWW::Search");
- &main::DEBUG("W3S: type => $type");
+ &::DEBUG("W3S: type => $type");
}
my @matches = grep { lc($_) eq lc($where) ? $_ : undef } @W3Search_engines;
if (@matches) {
$where = shift @matches;
} else {
}
my @matches = grep { lc($_) eq lc($where) ? $_ : undef } @W3Search_engines;
if (@matches) {
$where = shift @matches;
} else {
- &main::msg($main::who, "i don't know how to check '$where'");
+ &::msg($::who, "i don't know how to check '$where'");
}
my $Search = new WWW::Search($where);
}
my $Search = new WWW::Search($where);
# search_parse_debug => 2,
# }
);
# search_parse_debug => 2,
# }
);
- $Search->http_proxy($main::param{'httpProxy'}) if (&main::IsParam("httpProxy"));
+ $Search->http_proxy($::param{'httpProxy'}) if (&::IsParam("httpProxy"));
my $max = $Search->maximum_to_retrieve(10); # DOES NOT WORK.
my (%results, $count, $r);
my $max = $Search->maximum_to_retrieve(10); # DOES NOT WORK.
my (%results, $count, $r);
next if (exists $results{$hostname});
$results{$hostname} = $url;
} else {
next if (exists $results{$hostname});
$results{$hostname} = $url;
} else {
- &main::DEBUG("W3S: url isn't good? ($url).");
+ &::DEBUG("W3S: url isn't good? ($url).");
}
last if ++$count >= $maxshow;
}
last if ++$count >= $maxshow;
join(' or ', map { $results{$_} } sort keys %results);
}
join(' or ', map { $results{$_} } sort keys %results);
}
- &main::performStrictReply($retval);
+ &::performStrictReply($retval);
my $select = IO::Select->new;
sub Wingates {
my $select = IO::Select->new;
sub Wingates {
- my $file = "$main::blootbot_base_dir/$main::param{'ircUser'}.wingate";
+ my $file = "$::blootbot_base_dir/$::param{'ircUser'}.wingate";
my @hosts;
open(IN, $file);
my @hosts;
open(IN, $file);
foreach (@_) {
next if (grep /^$_$/, @hosts);
foreach (@_) {
next if (grep /^$_$/, @hosts);
- &main::DEBUG("W: _ => '$_'.");
+ &::DEBUG("W: _ => '$_'.");
- &main::status("Wingate: connection refused to $host");
+ &::status("Wingate: connection refused to $host");
my $buf;
my $len = 0;
if (!defined($len = sysread($luser, $buf, 512))) {
my $buf;
my $len = 0;
if (!defined($len = sysread($luser, $buf, 512))) {
- &main::status("Wingate: connection lost to $luser/$host.");
+ &::status("Wingate: connection lost to $luser/$host.");
$select->remove($luser);
close($luser);
next;
$select->remove($luser);
close($luser);
next;
$wingate++ if ($buf =~ /^Too many connected users - try again later$/);
if ($wingate) {
$wingate++ if ($buf =~ /^Too many connected users - try again later$/);
if ($wingate) {
- &main::status("Wingate: RUNNING ON $host BY $main::who.");
+ &::status("Wingate: RUNNING ON $host BY $::who.");
- if (&main::IsParam("wingateBan")) {
- &main::ban("*!*\@$host", "");
+ if (&::IsParam("wingateBan")) {
+ &::ban("*!*\@$host", "");
- if (&main::IsParam("wingateKick")) {
- &main::kick($main::who, "", $main::param{'wingateKick'});
+ if (&::IsParam("wingateKick")) {
+ &::kick($::who, "", $::param{'wingateKick'});
- push(@main::wingateBad, "$host\*");
- &main::wingateWriteFile();
+ push(@::wingateBad, "$host\*");
+ &::wingateWriteFile();
-### &main::DEBUG("no wingate.");
+### &::DEBUG("no wingate.");
}
### TODO: close telnet connection correctly!
}
### TODO: close telnet connection correctly!
my $toenglish = "${lang}_en";
if ($direction eq 'to') {
my $toenglish = "${lang}_en";
if ($direction eq 'to') {
- &main::performStrictReply( translate($phrase, $tolang, $req, $ua) );
+ &::performStrictReply( translate($phrase, $tolang, $req, $ua) );
return;
} elsif ($direction eq 'from') {
return;
} elsif ($direction eq 'from') {
- &main::performStrictReply( translate($phrase, $toenglish, $req, $ua) );
+ &::performStrictReply( translate($phrase, $toenglish, $req, $ua) );
$last_english = $phrase = translate($phrase, $toenglish, $req, $ua);
}
$last_english = $phrase = translate($phrase, $toenglish, $req, $ua);
}
- &main::performStrictReply($last_english);
+ &::performStrictReply($last_english);
$t->Net::Telnet::open(Host => "insulthost.colorado.edu", Port => "1695");
my $line = $t->Net::Telnet::getline(Timeout => 4);
$t->Net::Telnet::open(Host => "insulthost.colorado.edu", Port => "1695");
my $line = $t->Net::Telnet::getline(Timeout => 4);
- $line = "No luck, $main::who" unless (defined $line);
+ $line = "No luck, $::who" unless (defined $line);
- if ($insultwho ne $main::who) {
+ if ($insultwho ne $::who) {
$line =~ s/^\s*You are/$insultwho is/i;
}
$line =~ s/^\s*You are/$insultwho is/i;
}
my $verbose = 0;
sub nickometer ($) {
my $verbose = 0;
sub nickometer ($) {
- return unless &loadPerlModule("Getopt::Std");
+# return unless &loadPerlModule("Getopt::Std");
return unless &loadPerlModule("Math::Trig");
local $_ = shift;
return unless &loadPerlModule("Math::Trig");
local $_ = shift;
# User Processing, for all users.
if ($addressed) {
# User Processing, for all users.
if ($addressed) {
- return '$noreply from pCH' if &parseCmdHook("main",$message);
- return '$noreply from userC' if &userCommands() eq $noreply;
+ my $retval;
+ return 'returned from pCH' if &parseCmdHook("main",$message);
+
+ $retval = &userCommands();
+ return unless (defined $retval);
+ return if ($retval eq $noreply);
- if ($er =~ /\S/) {
- &performStrictReply($er) if ($er ne $noreply);
+ if (!defined $er or $er ne $noreply) {
+ &performStrictReply($er);
my $author = &getFactInfo($from, "created_by");
if (&IsFlag("m") and $author =~ /^\Q$who\E\!/i) {
&msg($who, "It's not yours to modify.");
my $author = &getFactInfo($from, "created_by");
if (&IsFlag("m") and $author =~ /^\Q$who\E\!/i) {
&msg($who, "It's not yours to modify.");
}
if ($_ = &getFactoid($to)) {
}
if ($_ = &getFactoid($to)) {
}
my $result = &doQuestion($message);
}
my $result = &doQuestion($message);
-
- return 'result is $noreply' if ($result eq $noreply);
+ if (!defined $result or $result eq $noreply) {
+ return 'result from doQ undef.';
+ }
if (defined $result and $result ne "") { # question.
&status("question: <$who> $message");
$count{'Question'}++;
if (defined $result and $result ne "") { # question.
&status("question: <$who> $message");
$count{'Question'}++;
- } elsif (&IsParam("perlMath") and $addressed) { # perl math.
+ } elsif (&IsChanConf("perlMath") > 0 and $addressed) { # perl math.
&loadMyModule("perlMath");
my $newresult = &perlMath();
&loadMyModule("perlMath");
my $newresult = &perlMath();
- if ($_ = &doStatement($message)) {
+ if (defined &doStatement($message)) {
+ &DEBUG("forked => ".scalar(keys %forked) );
+
foreach (keys %forked) {
my $time = time() - $forked{$_}{Time};
next unless ($time > $forker_timeout);
foreach (keys %forked) {
my $time = time() - $forked{$_}{Time};
next unless ($time > $forker_timeout);
- while (scalar keys %forked > 2) { # 2 or more == fail.
+ while (scalar keys %forked > 1) { # 2 or more == fail.
sleep 1;
if ($count > 3) { # 3 seconds.
sleep 1;
if ($count > 3) { # 3 seconds.
- if (!$dbh) {
- &WARN("closeDB: connection already closed?");
- return 0;
- }
+ return 0 unless ($dbh);
&status("Closed MySQL connection to $param{'SQLHost'}.");
$dbh->disconnect();
&status("Closed MySQL connection to $param{'SQLHost'}.");
$dbh->disconnect();
my ($faqtoid) = @_;
&dbDel("factoids", "factoid_key",$faqtoid);
my ($faqtoid) = @_;
&dbDel("factoids", "factoid_key",$faqtoid);
- &status("DELETED $faqtoid");
+ &status("DELETED '$faqtoid'");
projects / infobot.git / commitdiff