$nuh = "local!local\@local";
$uh = "local\@local";
- $who = "local";
- $orig{who} = "local";
+ $who = 'local';
+ $orig{who} = 'local';
$ident = $param{'ircUser'};
$chan = $talkchannel = "_local";
$addressed = 1;
$msgType = 'private';
- $host = "local";
+ $host = 'local';
# install libterm-readline-gnu-perl to get history support
use Term::ReadLine;
}
if (!defined $msg) {
- $msg ||= "NULL";
+ $msg ||= 'NULL';
&WARN("msg: msg == $msg.");
return;
}
if (/^--(\S+)[\s\t]+(.*)$/) { # user: middle entry.
my ($what,$val) = ($1,$2);
- if (!defined $val or $val eq "") {
+ if (!defined $val or $val eq '') {
&WARN("$what: val == NULL.");
next;
}
}
# nice little hack.
- if ($what eq "HOSTS") {
+ if ($what eq 'HOSTS') {
$users{$nick}{$what}{$val} = 1;
} else {
$users{$nick}{$what} = $val;
} elsif (/^::(\S+) ignore$/) { # ignore: start entry.
$chan = $1;
- $type = "ignore";
+ $type = 'ignore';
- } elsif (/^- (\S+):\+(\d+):\+(\d+):(\S+):(.*)$/ and $type eq "ignore") {
+ } elsif (/^- (\S+):\+(\d+):\+(\d+):(\S+):(.*)$/ and $type eq 'ignore') {
### ignore: middle entry.
my $mask = $1;
my(@array) = ($2,$3,$4,$5);
} elsif (/^::(\S+) bans$/) { # bans: start entry.
$chan = $1;
- $type = "bans";
+ $type = 'bans';
- } elsif (/^- (\S+):\+(\d+):\+(\d+):(\d+):(\S+):(.*)$/ and $type eq "bans") {
+ } elsif (/^- (\S+):\+(\d+):\+(\d+):(\d+):(\S+):(.*)$/ and $type eq 'bans') {
### bans: middle entry.
# $btime, $atime, $count, $whoby, $reason.
my(@array) = ($2,$3,$4,$5,$6);
my $what = $_;
my $val = $users{$user}{$_};
- if (ref($val) eq "HASH") {
+ if (ref($val) eq 'HASH') {
foreach (sort keys %{ $users{$user}{$_} }) {
print OUT "--$what\t\t$_\n";
}
# TODO: return all flags for opers
sub IsFlag {
my $flags = shift;
- my ($ret, $f, $o) = "";
+ my ($ret, $f, $o) = '';
&verifyUser($who, $nuh);
return $userHandle;
}
- $userHandle = "";
+ $userHandle = '';
foreach $user (keys %users) {
next if ($user eq "_default");
last;
}
- last if ($userHandle ne "");
+ last if ($userHandle ne '');
if ($user =~ /^\Q$nick\E$/i and !exists $cache{VUSERWARN}{$user}) {
&status("vU: nick matched but host is not in list ($lnuh).");
sub ckpasswd {
# returns true if arg1 encrypts to arg2
my ($plain, $encrypted) = @_;
- if ($encrypted eq "") {
+ if ($encrypted eq '') {
($plain, $encrypted) = split(/\s+/, $plain, 2);
}
- return 0 unless ($plain ne "" and $encrypted ne "");
+ return 0 unless ($plain ne '' and $encrypted ne '');
# MD5 // DES. Bobby Billingsley++.
my $salt;
sub ignoreAdd {
my($mask,$chan,$expire,$comment) = @_;
- $chan ||= "*"; # global if undefined.
- $comment ||= ""; # optional.
+ $chan ||= '*'; # global if undefined.
+ $comment ||= ''; # optional.
$expire ||= 0; # permament.
my $count ||= 0;
sub banAdd {
my($mask,$chan,$expire,$reason) = @_;
- $chan ||= "*";
+ $chan ||= '*';
$expire ||= 0;
if ($expire > 0) {
exists $bans{'*'}{$mask});
$bans{$chan}{$mask} = [$expire, time(), 0, $who, $reason];
- my @chans = ($chan eq "*") ? keys %channels : $chan;
+ my @chans = ($chan eq '*') ? keys %channels : $chan;
my $m = $mask;
$m =~ s/\?/\\./g;
$m =~ s/\*/\\S*/g;
my $was = $chanconf{$chan}{$what};
if ($set) { # add/set.
- if (defined $was and $was eq "1") {
+ if (defined $was and $was eq '1') {
&performStrictReply("setting $what for $chan already 1.");
return;
}
}
# alter for cosmetic (print out) reasons only.
- $was = (defined $was) ? "; was '$was'" : "";
+ $was = (defined $was) ? "; was '$was'" : '';
- if ($val eq "0") {
+ if ($val eq '0') {
&performStrictReply("Unsetting $what for $chan$was.");
delete $chanconf{$chan}{$what};
} else {
&performStrictReply("setting $what for $chan already '$val'.");
return;
}
- $was = ($was) ? "; was '$was'" : "";
+ $was = ($was) ? "; was '$was'" : '';
&performStrictReply("Setting $what for $chan to '$val'$was.");
$chanconf{$chan}{$what} = $val;
my @regFlagsUser = (
# possible chars to include in FLAG
- "A", # bot administration over /msg
+ 'A', # bot administration over /msg
# default is only via DCC CHAT
- "O", # dynamic ops (as on channel). (automatic +o)
- "T", # add topics.
- "a", # ask/request factoid.
- "m", # modify factoid. (includes renaming)
- "n", # bot owner, can "reload"
- "o", # master of bot (automatic +amrt)
+ 'O', # dynamic ops (as on channel). (automatic +o)
+ 'T', # add topics.
+ 'a', # ask/request factoid.
+ 'm', # modify factoid. (includes renaming)
+ 'n', # bot owner, can 'reload'
+ 'o', # master of bot (automatic +amrt)
# can search on factoid strings shorter than 2 chars
# can tell bot to join new channels
# can [un]lock factoids
- "r", # remove factoid.
- "t", # teach/add factoid.
+ 'r', # remove factoid.
+ 't', # teach/add factoid.
);
1;
for (lc $lhs) {
# allow the following only if they have been made on purpose.
- if ($rhs ne "" and $rhs !~ /^</) {
+ if ($rhs ne '' and $rhs !~ /^</) {
/ \Q$ident$/i and last; # someone said i'm something.
/^i('m)? / and last;
/^(it|that|there|what)('s)?(\s+|$)/ and last;
if ($param{'acceptUrl'} !~ /REQUIRE/ or $rhs =~ /(http|ftp|mailto|telnet|file):/) {
&msg($target, "$who knew: $lhs $mhs $rhs");
- # "are" hack :)
- $rhs = "<REPLY> are" if ($mhs eq "are");
- &setFactInfo($lhs, "factoid_value", $rhs);
+ # 'are' hack :)
+ $rhs = "<REPLY> are" if ($mhs eq 'are');
+ &setFactInfo($lhs, 'factoid_value', $rhs);
}
return 'INFOBOT REPLY';
return 'forget: no addr' unless ($addressed);
my $faqtoid = $message;
- if ($faqtoid eq "") {
- &help("forget");
+ if ($faqtoid eq '') {
+ &help('forget');
return;
}
}
# TODO: squeeze 3 getFactInfo calls into one?
- my $author = &getFactInfo($faqtoid, "created_by");
- my $count = &getFactInfo($faqtoid, "requested_count") || 0;
+ my $author = &getFactInfo($faqtoid, 'created_by');
+ my $count = &getFactInfo($faqtoid, 'requested_count') || 0;
# don't delete if requested $limit times
my $limit = &getChanConfDefault('factoidPreventForgetLimit', 100, $chan);
# don't delete if older than $limitage seconds (modified by requests below)
my $limitage = &getChanConfDefault('factoidPreventForgetLimitTime', 7 * 24 * 60 * 60, $chan);
- my $t = &getFactInfo($faqtoid, "created_time") || 0;
+ my $t = &getFactInfo($faqtoid, 'created_time') || 0;
my $age = time() - $t;
# lets scale limitage from 1 (nearly 0) to $limit (full time).
$limitage = $limitage*($count+1)/$limit if ($count < $limit);
# isauthor and isop.
my $isau = (defined $author and &IsHostMatch($author) == 2) ? 1 : 0;
- my $isop = (&IsFlag("o") eq "o") ? 1 : 0;
+ my $isop = (&IsFlag('o') eq 'o') ? 1 : 0;
- if (IsFlag("r") ne "r" && !$isop) {
+ if (IsFlag('r') ne 'r' && !$isop) {
&msg($who, "you don't have access to remove factoids");
return;
}
# prevent deletion if other factoids redirect to it.
# TODO: use hash instead of array.
my @list;
- if (&getChanConf("factoidPreventForgetRedirect")) {
+ if (&getChanConf('factoidPreventForgetRedirect')) {
&status("Factoids/Core: forget: checking for redirect factoids");
- @list = &searchTable("factoids", "factoid_key",
- "factoid_value", "^<REPLY> see ");
+ @list = &searchTable('factoids', 'factoid_key',
+ 'factoid_value', "^<REPLY> see ");
}
my $match = 0;
for (@list) {
my $f = $_;
- my $v = &getFactInfo($f, "factoid_value");
+ my $v = &getFactInfo($f, 'factoid_value');
my $fsafe = quotemeta($faqtoid);
next unless ($v =~ /^<REPLY> ?see( also)? $fsafe\.?$/i);
# TODO: make forget limit configurable.
# TODO: make forget ignore time configurable.
if ($cache{forget}{$h} > 5) {
- &ignoreAdd(&makeHostMask($nuh), "*", 3*24*60, "abuse of forget");
+ &ignoreAdd(&makeHostMask($nuh), '*', 3*24*60, "abuse of forget");
&msg($who, "forget: Ignoring you for abuse!");
}
}
# lets do it!
- if (&IsParam("factoidDeleteDelay") or &IsChanConf("factoidDeleteDelay") > 0) {
+ if (&IsParam('factoidDeleteDelay') or &IsChanConf('factoidDeleteDelay') > 0) {
if (!($isop or $isau) and $faqtoid =~ / #DEL#$/) {
&msg($who, "cannot delete it ($faqtoid).");
return;
}
&status("forgot (safe delete): '$faqtoid' - ". scalar(gmtime));
- ### TODO: check if the "backup" exists and overwrite it
+ ### TODO: check if the 'backup' exists and overwrite it
my $check = &getFactoid("$faqtoid #DEL#");
if (!defined $check or $check =~ /^\s*$/) {
&DEBUG("forget: not overwriting backup: $faqtoid");
} else {
&status("forget: backing up '$faqtoid'");
- &setFactInfo($faqtoid, "factoid_key", $new);
- &setFactInfo($new, "modified_by", $who);
- &setFactInfo($new, "modified_time", time());
+ &setFactInfo($faqtoid, 'factoid_key', $new);
+ &setFactInfo($new, 'modified_by', $who);
+ &setFactInfo($new, 'modified_time', time());
}
} else {
return 'unforget: no addr' unless ($addressed);
my $i = 0;
- $i++ if (&IsParam("factoidDeleteDelay"));
- $i++ if (&IsChanConf("factoidDeleteDelay") > 0);
+ $i++ if (&IsParam('factoidDeleteDelay'));
+ $i++ if (&IsChanConf('factoidDeleteDelay') > 0);
if (!$i) {
&performReply("safe delete has been disable so what is there to undelete?");
return;
}
my $faqtoid = $message;
- if ($faqtoid eq "") {
- &help("unforget");
+ if ($faqtoid eq '') {
+ &help('unforget');
return;
}
return;
}
- &setFactInfo($faqtoid." #DEL#", "factoid_key", $faqtoid);
-# &setFactInfo($faqtoid, "modified_by", "");
-# &setFactInfo($faqtoid, "modified_time", 0);
+ &setFactInfo($faqtoid." #DEL#", 'factoid_key', $faqtoid);
+# &setFactInfo($faqtoid, 'modified_by', '');
+# &setFactInfo($faqtoid, 'modified_time', 0);
$check = &getFactoid($faqtoid);
# TODO: check if $faqtoid." #DEL#" exists?
my $function = lc $1;
my $faqtoid = lc $4;
- if ($faqtoid eq "") {
+ if ($faqtoid eq '') {
&help($function);
return;
}
- if (&getFactoid($faqtoid) eq "") {
+ if (&getFactoid($faqtoid) eq '') {
&msg($who, "factoid \002$faqtoid\002 does not exist");
return;
}
- if ($function eq "lock") {
+ if ($function eq 'lock') {
# strongly requested by #debian on 19991028. -xk
- if (1 and $faqtoid !~ /^\Q$who\E$/i and &IsFlag("o") ne "o") {
+ if (1 and $faqtoid !~ /^\Q$who\E$/i and &IsFlag('o') ne 'o') {
&msg($who,"sorry, locking cannot be used since it can be abused unneccesarily.");
&status("Replace 1 with 0 in Process.pl#~324 for locking support.");
return;
if ($message =~ s/^rename(\s+|$)//) {
return 'rename: no addr' unless ($addressed);
- if ($message eq "") {
- &help("rename");
+ if ($message eq '') {
+ &help('rename');
return;
}
}
# who == nick!user@host.
- if (&IsFlag("m") ne "m" and $author !~ /^\Q$who\E\!/i) {
+ if (&IsFlag('m') ne 'm' and $author !~ /^\Q$who\E\!/i) {
&msg($who, "factoid '$from' is not yours to modify.");
return;
}
return;
}
- &setFactInfo($from,"factoid_key",$to);
+ &setFactInfo($from,'factoid_key',$to);
&status("rename: <$who> '$from' is now '$to'");
&performReply("i renamed '$from' to '$to'");
return 'subst: locked' if (&IsLocked($faqtoid) == 1);
my $was = $result;
- if (($flags eq "g" && $result =~ s/\Q$op/$np/gi) || $result =~ s/\Q$op/$np/i) {
+ if (($flags eq 'g' && $result =~ s/\Q$op/$np/gi) || $result =~ s/\Q$op/$np/i) {
# excessive length.
if (length $result > $param{'maxDataSize'}) {
&performReply("that's too long");
return;
}
# min length.
- my $faqauth = &getFactInfo($faqtoid, "created_by");
+ my $faqauth = &getFactInfo($faqtoid, 'created_by');
if ((length $result)*2 < length $was and
- &IsFlag("o") ne "o" and
+ &IsFlag('o') ne 'o' and
&IsHostMatch($faqauth) != 2
) {
&performReply("too drastic change of factoid.");
}
- &setFactInfo($faqtoid, "factoid_value", $result);
+ &setFactInfo($faqtoid, 'factoid_value', $result);
&status("update: '$faqtoid' =is=> '$result'; was '$was'");
- &performReply("OK");
+ &performReply('OK');
} else {
&performReply("that doesn't contain '$op'");
}
&loadMyModule('Math');
my $newresult = &perlMath();
- if (defined $newresult and $newresult ne "") {
+ if (defined $newresult and $newresult ne '') {
$cmdstats{'Maths'}++;
$result = $newresult;
&status("math: <$who> $message => $result");
#####
# Usage: &setFactInfo($faqtoid, $key, $val);
sub setFactInfo {
- &sqlSet("factoids",
+ &sqlSet('factoids',
{ factoid_key => $_[0] },
{ $_[1] => $_[2] }
);
#####
# Usage: &getFactInfo($faqtoid, [$what]);
sub getFactInfo {
- return &sqlSelect("factoids", $_[1], { factoid_key => $_[0] } );
+ return &sqlSelect('factoids', $_[1], { factoid_key => $_[0] } );
}
#####
# Usage: &getFactoid($faqtoid);
sub getFactoid {
- return &getFactInfo($_[0], "factoid_value");
+ return &getFactInfo($_[0], 'factoid_value');
}
#####
sub delFactoid {
my ($faqtoid) = @_;
- &sqlDelete("factoids", { factoid_key => $faqtoid } );
+ &sqlDelete('factoids', { factoid_key => $faqtoid } );
&status("DELETED $faqtoid");
return 1;
# Usage: &IsLocked($faqtoid);
sub IsLocked {
my ($faqtoid) = @_;
- my $thisnuh = &getFactInfo($faqtoid, "locked_by");
+ my $thisnuh = &getFactInfo($faqtoid, 'locked_by');
- if (defined $thisnuh and $thisnuh ne "") {
- if (!&IsHostMatch($thisnuh) and &IsFlag("o") ne "o") {
+ if (defined $thisnuh and $thisnuh ne '') {
+ if (!&IsHostMatch($thisnuh) and &IsFlag('o') ne 'o') {
&performReply("cannot alter locked factoids");
return 1;
}
# Usage: &AddModified($faqtoid,$nuh);
sub AddModified {
my ($faqtoid,$nuh) = @_;
- my $modified_by = &getFactInfo($faqtoid, "modified_by");
+ my $modified_by = &getFactInfo($faqtoid, 'modified_by');
my (@modifiedlist, @modified, %modified);
if (defined $modified_by) {
}
shift(@modifiedlist) while (scalar @modifiedlist > 3);
- &setFactInfo($faqtoid, "modified_by", join(",",@modifiedlist));
- &setFactInfo($faqtoid, "modified_time", time());
+ &setFactInfo($faqtoid, 'modified_by', join(",",@modifiedlist));
+ &setFactInfo($faqtoid, 'modified_time', time());
return 1;
}
sub CmdLock {
my ($faqtoid) = @_;
- my $thisnuh = &getFactInfo($faqtoid,"locked_by");
+ my $thisnuh = &getFactInfo($faqtoid,'locked_by');
- if (defined $thisnuh and $thisnuh ne "") {
+ if (defined $thisnuh and $thisnuh ne '') {
my $locked_by = (split(/\!/,$thisnuh))[0];
&msg($who,"factoid \002$faqtoid\002 has already been locked by $locked_by.");
return 0;
}
- $thisnuh ||= &getFactInfo($faqtoid,"created_by");
+ $thisnuh ||= &getFactInfo($faqtoid,'created_by');
# fixes bug found on 19991103.
# code needs to be reorganised though.
- if ($thisnuh ne "") {
- if (!&IsHostMatch($thisnuh) && IsFlag("o") ne "o") {
+ if ($thisnuh ne '') {
+ if (!&IsHostMatch($thisnuh) && IsFlag('o') ne 'o') {
&msg($who, "sorry, you are not allowed to lock '$faqtoid'.");
return 0;
}
}
&performReply("locking factoid \002$faqtoid\002");
- &setFactInfo($faqtoid,"locked_by",$nuh);
- &setFactInfo($faqtoid,"locked_time", time());
+ &setFactInfo($faqtoid,'locked_by',$nuh);
+ &setFactInfo($faqtoid,'locked_time', time());
return 1;
}
sub CmdUnLock {
my ($faqtoid) = @_;
- my $thisnuh = &getFactInfo($faqtoid,"locked_by");
+ my $thisnuh = &getFactInfo($faqtoid,'locked_by');
if (!defined $thisnuh) {
&msg($who, "factoid \002$faqtoid\002 is not locked.");
return 0;
}
- if ($thisnuh ne "" and !&IsHostMatch($thisnuh) and &IsFlag("o") ne "o") {
+ if ($thisnuh ne '' and !&IsHostMatch($thisnuh) and &IsFlag('o') ne 'o') {
&msg($who, "sorry, you are not allowed to unlock factoid '$faqtoid'.");
return 0;
}
&performReply("unlocking factoid \002$faqtoid\002");
- &setFactInfo($faqtoid,"locked_by", "");
- &setFactInfo($faqtoid,"locked_time", "0"); # pgsql complains if NOT NULL set. So set 0 which is the default
+ &setFactInfo($faqtoid,'locked_by', '');
+ &setFactInfo($faqtoid,'locked_time', '0'); # pgsql complains if NOT NULL set. So set 0 which is the default
return 1;
}
s/(^|\W)you\'?re(\W|$)/$1you are$2/ig;
if ($addressed) {
- my $mynick = "UNDEF";
+ my $mynick = 'UNDEF';
$mynick = $conn->nick() if ($conn);
# is it safe to remove $in from here, too?
$in =~ s/yourself/$mynick/i;
# my doesn't allow variables to be inherinted, local does.
# following is used in math()...
local($query) = @_;
- local($reply) = "";
+ local($reply) = '';
local $finalQMark = $query =~ s/\?+\s*$//;
$finalQMark += $query =~ s/\?\s*$//;
$query =~ s/^\s+|\s+$//g;
return '';
}
- my $questionWord = "";
+ my $questionWord = '';
if (!$addressed) {
return '' unless ($finalQMark);
- return '' unless &IsChanConf("minVolunteerLength") > 0;
+ return '' unless &IsChanConf('minVolunteerLength') > 0;
return '' if (length $query < &::getChanConf('minVolunteerLength'));
} else {
### TODO: this should be caught in Process.pl?
# there is no flag to disable/enable asking factoids...
# so it was added... thanks zyxep! :)
- if (&IsFlag("a") ne "a" && &IsFlag("o") ne "o") {
+ if (&IsFlag('a') ne 'a' && &IsFlag('o') ne 'o') {
&status("$who tried to ask us when not allowed.");
return;
}
$questionWord = lc($1);
}
- if ($questionWord eq "" and $finalQMark and $addressed) {
- $questionWord = "where";
+ if ($questionWord eq '' and $finalQMark and $addressed) {
+ $questionWord = 'where';
}
$query =~ s/^\s+|\s+$//g; # bleh. hacked.
push(@query, $query) if ($query ne $x);
- if (&IsChanConf("factoidArguments") > 0) {
+ if (&IsChanConf('factoidArguments') > 0) {
$result = &factoidArgs($query[0]);
return $result if (defined $result);
for (my$i=0; $i<scalar @query; $i++) {
$query = $query[$i];
$result = &getReply($query);
- next if (!defined $result or $result eq "");
+ next if (!defined $result or $result eq '');
# 'see also' factoid redirection support.
return;
}
- last if (!defined $newr or $newr eq "");
+ last if (!defined $newr or $newr eq '');
$result = $newr;
}
### return $result if (defined $result);
}
- if ($questionWord ne "" or $finalQMark) {
+ if ($questionWord ne '' or $finalQMark) {
# if it has not been explicitly marked as a question
- if ($addressed and $reply eq "") {
+ if ($addressed and $reply eq '') {
&status("notfound: <$who> ".join(' :: ', @query))
if ($finalQMark);
- return '' unless (&IsParam("friendlyBots"));
+ return '' unless (&IsParam('friendlyBots'));
foreach (split /\s+/, $param{'friendlyBots'}) {
&msg($_, ":INFOBOT:QUERY <$who> $query");
# ignore split to commands [dumb commands vs. factoids] (editing commands?)
return undef if $str =~ /\s+\=\~\s+s[\#\/\:]/;
- my @list = &searchTable("factoids", "factoid_key", "factoid_key", "^cmd: $first ");
+ my @list = &searchTable('factoids', 'factoid_key', 'factoid_key', "^cmd: $first ");
# my $delta_time = &timedelta($t);
# &DEBUG("factArgs: delta_time = $delta_time s");
# &DEBUG("factArgs: list => ".scalar(@list) );
}
# update stats. old mysql/sqlite don't do +1
- my ($count) = &sqlSelect("factoids", "requested_count", { factoid_key => $q });
+ my ($count) = &sqlSelect('factoids', 'requested_count', { factoid_key => $q });
$count++;
- &sqlSet("factoids", {'factoid_key' => $q}, {
+ &sqlSet('factoids', {'factoid_key' => $q}, {
requested_by => $nuh,
requested_time => time(),
requested_count => $count
} else {
$factoid = "$search $message";
}
- ($count, $fauthor, $result) = &sqlSelect("factoids",
+ ($count, $fauthor, $result) = &sqlSelect('factoids',
"requested_count,created_by,factoid_value",
{ factoid_key => $factoid }
);
if ($result) {
$lhs = $message;
- $mhs = "is";
+ $mhs = 'is';
$rhs = $result;
return "\"$factoid\" $mhs \"$rhs\"" if ($literal);
$result = &SARit($result);
$reply = $result;
- if ($result ne "") {
+ if ($result ne '') {
### AT LAST, REPEAT PREVENTION CODE REMOVED IN FAVOUR OF GLOBAL
### FLOOD REPETION AND PROTECTION. -20000124
### FIXME: old mysql/sqlite doesn't support
### "requested_count=requested_count+1".
$count++;
- &sqlSet("factoids", {'factoid_key' => $factoid}, {
+ &sqlSet('factoids', {'factoid_key' => $factoid}, {
requested_by => $nuh,
requested_time => time(),
requested_count => $count
# TODO: rename $real to something else!
my $real = 0;
-# my $author = &getFactInfo($lhs,"created_by") || '';
+# my $author = &getFactInfo($lhs,'created_by') || '';
# $real++ if ($author =~ /^\Q$who\E\!/);
-# $real++ if (&IsFlag("n"));
+# $real++ if (&IsFlag('n'));
$real = 0 if ($msgType =~ /public/);
### fix up the reply.
### bot->person reply.
# result is random if separated by '||'.
# rhs is full factoid with '||'.
- if ($mhs eq "is") {
+ if ($mhs eq 'is') {
$reply = &getRandom(keys %{ $lang{'factoid'} });
$reply =~ s/##KEY/$lhs/;
$reply =~ s/##VALUE/$result/;
}
if ($reply =~ /\$factoids/) {
- my $factoids = &countKeys("factoids");
+ my $factoids = &countKeys('factoids');
$reply =~ s/\$factoids/$factoids/;
}
if ($reply =~ /\$Fupdate/) {
my $x = "\002$count{'Update'}\002 ".
- &fixPlural("modification", $count{'Update'});
+ &fixPlural('modification', $count{'Update'});
$reply =~ s/\$Fupdate/$x/;
}
if ($reply =~ /\$Fquestion/) {
my $x = "\002$count{'Question'}\002 ".
- &fixPlural("question", $count{'Question'});
+ &fixPlural('question', $count{'Question'});
$reply =~ s/\$Fquestion/$x/;
}
if ($reply =~ /\$Fdunno/) {
my $x = "\002$count{'Dunno'}\002 ".
- &fixPlural("dunno", $count{'Dunno'});
+ &fixPlural('dunno', $count{'Dunno'});
$reply =~ s/\$Fdunno/$x/;
}
# check if we need to be addressed and if we are
return unless ($learnok);
- my($urlType) = "";
+ my($urlType) = '';
# prefix www with http:// and ftp with ftp://
$in =~ s/ www\./ http:\/\/www\./ig;
$in =~ s/ ftp\./ ftp:\/\/ftp\./ig;
- $urlType = "about" if ($in =~ /\babout:/i);
+ $urlType = 'about' if ($in =~ /\babout:/i);
$urlType = 'afp' if ($in =~ /\bafp:/);
$urlType = 'file' if ($in =~ /\bfile:/);
$urlType = 'palace' if ($in =~ /\bpalace:/);
}
# acceptUrl.
- if (&IsParam("acceptUrl")) {
+ if (&IsParam('acceptUrl')) {
if ($param{'acceptUrl'} eq 'REQUIRE') { # require url type.
- return if ($urlType eq "");
+ return if ($urlType eq '');
} elsif ($param{'acceptUrl'} eq 'REJECT') {
- &status("REJECTED URL entry") if (&IsParam("VERBOSITY"));
- return unless ($urlType eq "");
+ &status("REJECTED URL entry") if (&IsParam('VERBOSITY'));
+ return unless ($urlType eq '');
} else {
# OPTIONAL
}
my($lhs, $mhs, $rhs) = ($`, $&, $');
# allows factoid arguments to be updated. -lear.
- $lhs =~ s/^(cmd: )?(.*)/$1||"" . lc $2/e;
+ $lhs =~ s/^(cmd: )?(.*)/$1||'' . lc $2/e;
# discard article.
$lhs =~ s/^(the|da|an?)\s+//i;
$rhs =~ s/^\s+|\s+$//g;
# break if either lhs or rhs is NULL.
- if ($lhs eq "" or $rhs eq "") {
+ if ($lhs eq '' or $rhs eq '') {
return "NOT-A-STATEMENT";
}
&status("statement: <$who> $message");
- # change "#*#" back to "*" because of '\' sar to '#blah#'.
+ # change "#*#" back to '*' because of '\' sar to '#blah#'.
$lhs =~ s/\#(\S+)\#/$1/g;
$rhs =~ s/\#(\S+)\#/$1/g;
return if (&update($lhs, $mhs, $rhs));
}
- return "CONTINUE";
+ return 'CONTINUE';
}
1;
return if (&IsLocked($lhs) == 1);
# profanity.
- if (&IsParam("profanityCheck") and &hasProfanity($rhs)) {
+ if (&IsParam('profanityCheck') and &hasProfanity($rhs)) {
&performReply("please, watch your language.");
return 1;
}
# teaching.
- if (&IsFlag("t") ne "t" && &IsFlag("o") ne "o") {
+ if (&IsFlag('t') ne 't' && &IsFlag('o') ne 'o') {
&msg($who, "permission denied.");
&status("alert: $who wanted to teach me.");
return 1;
# factoid arguments handler.
# must start with a non-variable
- if (&IsChanConf("factoidArguments") > 0 and $lhs =~ /^[^\$]+.*\$/) {
+ if (&IsChanConf('factoidArguments') > 0 and $lhs =~ /^[^\$]+.*\$/) {
&status("Update: Factoid Arguments found.");
&status("Update: orig lhs => '$lhs'.");
&status("Update: orig rhs => '$rhs'.");
# nice 'are' hack (or work-around).
if ($mhs =~ /^are$/i and $rhs !~ /<\S+>/) {
&status("Update: 'are' hack detected.");
- $mhs = "is";
+ $mhs = 'is';
$rhs = "<REPLY> are ". $rhs;
}
&status("enter: <$who> \'$lhs\' =$mhs=> \'$rhs\'");
$count{'Update'}++;
- &performAddressedReply("okay");
+ &performAddressedReply('okay');
- &sqlInsert("factoids", {
+ &sqlInsert('factoids', {
created_by => $nuh,
created_time => time(), # modified time.
factoid_key => $lhs,
factoid_value => $rhs,
} );
- if (!defined $rhs or $rhs eq "") {
+ if (!defined $rhs or $rhs eq '') {
&ERROR("Update: rhs1 == NULL.");
}
}
}
- &performAddressedReply("okay");
+ &performAddressedReply('okay');
$count{'Update'}++;
&status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'");
- &sqlSet("factoids", {'factoid_key' => $lhs}, {
+ &sqlSet('factoids', {'factoid_key' => $lhs}, {
modified_by => $nuh,
modified_time => time(),
factoid_value => $rhs,
} );
- if (!defined $rhs or $rhs eq "") {
+ if (!defined $rhs or $rhs eq '') {
&ERROR("Update: rhs1 == NULL.");
}
- } else { # not "also"
+ } else { # not 'also'
if (!$correction_plausible) { # "no, blah is ..."
if ($addressed) {
return 1;
}
- my $author = &getFactInfo($lhs, "created_by") || "";
+ my $author = &getFactInfo($lhs, 'created_by') || '';
- if (IsFlag("m") ne "m" && IsFlag("o") ne "o" &&
+ if (IsFlag('m') ne 'm' && IsFlag('o') ne 'o' &&
$author !~ /^\Q$who\E\!/i
) {
&msg($who, "you can't change that factoid.");
return 1;
}
- &performAddressedReply("okay");
+ &performAddressedReply('okay');
$count{'Update'}++;
&status("update: <$who> \'$lhs\' =$mhs=> \'$rhs\'; was \'$exists\'");
- &sqlSet("factoids", {'factoid_key' => $lhs}, {
+ &sqlSet('factoids', {'factoid_key' => $lhs}, {
modified_by => $nuh,
modified_time => time(),
factoid_value => $rhs,
} );
- if (!defined $rhs or $rhs eq "") {
+ if (!defined $rhs or $rhs eq '') {
&ERROR("Update: rhs1 == NULL.");
}
}
while (<FILE>) {
chop;
- if ($_ eq "" || /^#/) {
+ if ($_ eq '' || /^#/) {
undef $replyName;
next;
}
# works? needs to actually do something
# should likely listen on a tcp port instead
- #$irc->addfh(STDIN, \&on_stdin, "r");
+ #$irc->addfh(STDIN, \&on_stdin, 'r');
&status("starting main loop");
my ($buf) = @_;
$buf =~ s/\n//gi;
- # slow down a bit if traffic is "high".
+ # slow down a bit if traffic is 'high'.
# need to take into account time of last message sent.
if ($last{buflen} > 256 and length($buf) > 256) {
sleep 1;
my ($msg) = @_;
my $mynick = $conn->nick();
if (!defined $msg) {
- $msg ||= "NULL";
+ $msg ||= 'NULL';
&WARN("say: msg == $msg.");
return;
}
return unless (&whatInterface() =~ /IRC/);
- $msg = "zero" if ($msg =~ /^0+$/);
+ $msg = 'zero' if ($msg =~ /^0+$/);
my $t = time();
$pubcount++;
$pubsize += length $msg;
- my $i = &getChanConfDefault("sendPublicLimitLines", 3, $chan);
- my $j = &getChanConfDefault("sendPublicLimitBytes", 1000, $chan);
+ my $i = &getChanConfDefault('sendPublicLimitLines', 3, $chan);
+ my $j = &getChanConfDefault('sendPublicLimitBytes', 1000, $chan);
if ( ($pubcount % $i) == 0 and $pubcount) {
sleep 1;
}
if (!defined $msg) {
- $msg ||= "NULL";
+ $msg ||= 'NULL';
&WARN("msg: msg == $msg.");
return;
}
$msgcount++;
$msgsize += length $msg;
- my $i = &getChanConfDefault("sendPrivateLimitLines", 3, $chan);
- my $j = &getChanConfDefault("sendPrivateLimitBytes", 1000, $chan);
+ my $i = &getChanConfDefault('sendPrivateLimitLines', 3, $chan);
+ my $j = &getChanConfDefault('sendPrivateLimitBytes', 1000, $chan);
if ( ($msgcount % $i) == 0 and $msgcount) {
sleep 1;
} elsif ($msgsize > $j) {
$notcount++;
$notsize += length $txt;
- my $i = &getChanConfDefault("sendNoticeLimitLines", 3, $chan);
- my $j = &getChanConfDefault("sendNoticeLimitBytes", 1000, $chan);
+ my $i = &getChanConfDefault('sendNoticeLimitLines', 3, $chan);
+ my $j = &getChanConfDefault('sendNoticeLimitBytes', 1000, $chan);
if ( ($notcount % $i) == 0 and $notcount) {
sleep 1;
sub joinchan {
my ($chan, $key) = @_;
- $key ||= &getChanConf("chankey", $chan);
- $key ||= "";
+ $key ||= &getChanConf('chankey', $chan);
+ $key ||= '';
# forgot for about 2 years to implement channel keys when moving
# over to Net::IRC...
my $chan;
foreach $chan (@_) {
- next if ($chan eq "");
+ next if ($chan eq '');
$chan =~ tr/A-Z/a-z/; # lowercase.
if ($chan !~ /^$mask{chan}$/) {
sub op {
my ($chan, @who) = @_;
- my $os = "o" x scalar(@who);
+ my $os = 'o' x scalar(@who);
&mode($chan, "+$os @who");
}
sub deop {
my ($chan, @who) = @_;
- my $os = "o" x scalar(@who);
+ my $os = 'o' x scalar(@who);
&mode($chan, "-$os ".@who);
}
sub kick {
my ($nick,$chan,$msg) = @_;
- my (@chans) = ($chan eq "") ? (keys %channels) : lc($chan);
+ my (@chans) = ($chan eq '') ? (keys %channels) : lc($chan);
my $mynick = $conn->nick();
- if ($chan ne "" and &validChan($chan) == 0) {
+ if ($chan ne '' and &validChan($chan) == 0) {
&ERROR("kick: invalid channel $chan.");
return;
}
}
# chanserv check: global channels, in case we missed one.
- foreach ( &ChanConfList("chanServ_ops") ) {
+ foreach ( &ChanConfList('chanServ_ops') ) {
&chanServCheck($_);
}
}
my $nick = $conn->nick();
foreach (keys %chanconf) {
- next if ($_ eq "_default");
+ next if ($_ eq '_default');
my $skip = 0;
my $val = $chanconf{$_}{autojoin};
if (defined $val) {
- $skip++ if ($val eq "0");
- if ($val eq "1") {
+ $skip++ if ($val eq '0');
+ if ($val eq '1') {
# convert old +autojoin to autojoin <nick>
$val = lc $nick;
$chanconf{$_}{autojoin} = $val;
sub joinfloodCheck {
my($who,$chan,$userhost) = @_;
- return unless (&IsChanConf("joinfloodCheck") > 0);
+ return unless (&IsChanConf('joinfloodCheck') > 0);
if (exists $netsplit{lc $who}) { # netsplit join.
&DEBUG("joinfloodCheck: $who was in netsplit; not checking.");
my $target = shift @targets;
if ($parity) {
- $chanstats{$chan}{'Op'}++ if ($mode eq "o");
- $chanstats{$chan}{'Ban'}++ if ($mode eq "b");
+ $chanstats{$chan}{'Op'}++ if ($mode eq 'o');
+ $chanstats{$chan}{'Ban'}++ if ($mode eq 'b');
} else {
- $chanstats{$chan}{'Deop'}++ if ($mode eq "o");
- $chanstats{$chan}{'Unban'}++ if ($mode eq "b");
+ $chanstats{$chan}{'Deop'}++ if ($mode eq 'o');
+ $chanstats{$chan}{'Unban'}++ if ($mode eq 'b');
}
# modes w/ target affecting nick => cache it.
delete $channels{$chan}{$mode}{$target} if !$parity;
# lets do some custom stuff.
- if ($mode eq "o" and $parity) {
- if ($nick eq "ChanServ" and $target =~ /^\Q$ident\E$/i) {
+ if ($mode eq 'o' and $parity) {
+ if ($nick eq 'ChanServ' and $target =~ /^\Q$ident\E$/i) {
&VERB("hookmode: chanserv deopped us! asking",2);
&chanServCheck($chan);
}
$addressed = 1;
} else {
# ignore messages addressed to other people or unaddressed.
- $skipmessage++ if ($2 ne "" and $2 !~ /^ /);
+ $skipmessage++ if ($2 ne '' and $2 !~ /^ /);
}
}
}
# Determine floodwho.
- my $c = "_default";
+ my $c = '_default';
if ($msgType =~ /public/i) {
# public.
$floodwho = $c = lc $chan;
&FIXME("floodwho = ???");
}
- my $val = &getChanConfDefault("floodRepeat", "2:5", $c);
+ my $val = &getChanConfDefault('floodRepeat', "2:5", $c);
my ($count, $interval) = split /:/, $val;
# flood repeat protection.
if ($addressed) {
my $time = $flood{$floodwho}{$message} || 0;
- if (!&IsFlag('o') and $msgType eq "public" and (time() - $time < $interval)) {
+ if (!&IsFlag('o') and $msgType eq 'public' and (time() - $time < $interval)) {
### public != personal who so the below is kind of pointless.
my @who;
foreach (keys %flood) {
return if ($lobotomized);
if (!scalar @who) {
- push(@who,"Someone");
+ push(@who,'Someone');
}
&msg($who,join(' ', @who)." already said that ". (time - $time) ." seconds ago" );
if ($addrchar) {
&status("$b_cyan$who$ob is short-addressing $mynick");
- } elsif ($msgType eq "private") { # private.
+ } elsif ($msgType eq 'private') { # private.
&status("$b_cyan$who$ob is /msg'ing $mynick");
} else { # public?
&status("$b_cyan$who$ob is addressing $mynick");
}
$flood{$floodwho}{$message} = time();
- } elsif ($msgType eq "public" and &IsChanConf("kickOnRepeat") > 0) {
+ } elsif ($msgType eq 'public' and &IsChanConf('kickOnRepeat') > 0) {
# unaddressed, public only.
### TODO: use a separate "short-time" hash.
@data = keys %{ $flood{$floodwho} } if (exists $flood{$floodwho});
}
- $val = &getChanConfDefault("floodMessages", "5:30", $c);
+ $val = &getChanConfDefault('floodMessages', "5:30", $c);
($count, $interval) = split /:/, $val;
# flood overflow protection.
$seencache{$who}{'msg'} = $orig{message};
$seencache{$who}{'msgcount'}++;
}
- if (&IsChanConf("minVolunteerLength") > 0) {
+ if (&IsChanConf('minVolunteerLength') > 0) {
# FIXME hack to treat unaddressed as if using addrchar
$addrchar = 1;
}
$chan = $c;
my $l = $channels{$chan}{'l'};
- return unless (&IsChanConf("chanlimitcheck") > 0);
+ return unless (&IsChanConf('chanlimitcheck') > 0);
if (scalar keys %netsplit) {
&WARN("clV: netsplit active (1, chan = $chan); skipping.");
}
# only change it if it's not set.
- my $plus = &getChanConfDefault("chanlimitcheckPlus", 5, $chan);
+ my $plus = &getChanConfDefault('chanlimitcheckPlus', 5, $chan);
my $count = scalar(keys %{ $channels{$chan}{''} });
- my $int = &getChanConfDefault("chanlimitcheckInterval", 10, $chan);
+ my $int = &getChanConfDefault('chanlimitcheckInterval', 10, $chan);
my $delta = $count + $plus - $l;
# $delta =~ s/^\-//;
&DEBUG("chanServCheck: lowercased chan ($chan)");
}
- if (! &IsChanConf("chanServ_ops") > 0) {
+ if (! &IsChanConf('chanServ_ops') > 0) {
return 0;
}
&VERB("chanServCheck($chan) called.",2);
- if ( &IsParam("nickServ_pass") and !$nickserv) {
- $conn->who("NickServ");
+ if ( &IsParam('nickServ_pass') and !$nickserv) {
+ $conn->who('NickServ');
return 0;
}
}
### set vars that would have been set in hookMsg.
- $userHandle = ""; # reset.
+ $userHandle = ''; # reset.
$who = lc $nick;
$message = $msg;
$orig{who} = $nick;
my $crypto = $users{$userHandle}{PASS};
my $success = 0;
- if ($userHandle eq "_default") {
+ if ($userHandle eq '_default') {
&WARN("DCC CHAT: _default/guest not allowed.");
return;
}
$conn->privmsg($sock, "Commands start with '.' (like '.quit' or '.help')");
$conn->privmsg($sock, "Everything else goes out to the party line.");
- &dccStatus(2) unless (exists $sched{"dccStatus"}{RUNNING});
+ &dccStatus(2) unless (exists $sched{'dccStatus'}{RUNNING});
$success++;
$dcc{'CHATvrfy'}{$nick} = $userHandle;
- return if ($userHandle eq "_default");
+ return if ($userHandle eq '_default');
&dccsay($nick,"Flags: $users{$userHandle}{FLAGS}");
}
### TODO: make use of &Forker(); here?
&loadMyModule('UserDCC');
- &DCCBroadcast("#$who# $message","m");
+ &DCCBroadcast("#$who# $message",'m');
my $retval = &userDCC();
return unless (defined $retval);
# first time run.
if (!exists $users{_default}) {
&status("!!! First time run... adding _default user.");
- $users{_default}{FLAGS} = "amrt";
+ $users{_default}{FLAGS} = 'amrt';
$users{_default}{HOSTS}{"*!*@*"} = 1;
}
}
if ($firsttime) {
- &ScheduleThis(1, "setupSchedulers");
+ &ScheduleThis(1, 'setupSchedulers');
$firsttime = 0;
}
- if (&IsParam("ircUMode")) {
+ if (&IsParam('ircUMode')) {
&VERB("Attempting change of user modes to $param{'ircUMode'}.", 2);
if ($param{'ircUMode'} !~ /^[-+]/) {
&WARN("ircUMode had no +- prefix; adding +");
$conn->ison($conn->nick());
# Q, as on quakenet.org.
- if (&IsParam("Q_pass")) {
+ if (&IsParam('Q_pass')) {
&status("Authing to Q...");
&rawout("PRIVMSG Q\@CServe.quakenet.org :AUTH $param{'Q_user'} $param{'Q_pass'}");
}
### TODO: run ScheduleThis inside on_dcc_open_chat recursively
### 1,3,5,10 seconds then fail.
if ($nuh{$nick} eq "GETTING-NOW") {
- &ScheduleThis(3/60, "on_dcc_open_chat", $nick, $sock);
+ &ScheduleThis(3/60, 'on_dcc_open_chat', $nick, $sock);
} else {
on_dcc_open_chat(undef, $nick, $sock);
}
$dcc{'CHAT'}{$nick} = $sock;
# TODO: don't make DCC CHAT established in the first place.
- if ($userHandle eq "_default") {
+ if ($userHandle eq '_default') {
&dccsay($nick, "_default/guest not allowed");
$sock->close();
return;
&WARN("scheduling call ircCheck() in 60s");
&clearIRCVars();
- &ScheduleThis(1, "ircCheck");
+ &ScheduleThis(1, 'ircCheck');
}
sub on_endofnames {
my $txt;
my @array;
- foreach ("o","v","") {
+ foreach ('o','v','') {
my $count = scalar(keys %{ $channels{$chan}{$_} });
next unless ($count);
- $txt = "total" if ($_ eq "");
- $txt = "voice" if ($_ eq "v");
- $txt = "ops" if ($_ eq "o");
+ $txt = 'total' if ($_ eq '');
+ $txt = 'voice' if ($_ eq 'v');
+ $txt = 'ops' if ($_ eq 'o');
push(@array, "$count $txt");
}
my ($user,$host) = split(/\@/, $event->userhost);
$chan = lc( ($event->to)[0] ); # CASING!!!!
$who = $event->nick();
- $msgType = "public";
+ $msgType = 'public';
my $i = scalar(keys %{ $channels{$chan} });
my $j = $cache{maxpeeps}{$chan} || 0;
- if (!&IsParam("noSHM") && time() > ($sched{shmFlush}{TIME} || time()) + 3600) {
+ if (!&IsParam('noSHM') && time() > ($sched{shmFlush}{TIME} || time()) + 3600) {
&DEBUG("looks like schedulers died somewhere... restarting...");
&setupSchedulers();
}
$chanstats{$chan}{'Join'}++;
- $userstats{lc $who}{'Join'} = time() if (&IsChanConf("seenStats") > 0);
+ $userstats{lc $who}{'Join'} = time() if (&IsChanConf('seenStats') > 0);
$cache{maxpeeps}{$chan} = $i if ($i > $j);
&joinfloodCheck($who, $chan, $event->userhost);
# how to tell if there's a netjoin???
- my $netsplitstr = "";
+ my $netsplitstr = '';
$netsplitstr = " $b_yellow\[${ob}NETSPLIT VICTIM$b_yellow]$ob" if ($netsplit);
&status(">>> join/$b_blue$chan$ob $b_cyan$who$ob $b_yellow($ob$user\@$host$b_yellow)$ob$netsplitstr");
### on-join bans.
my @bans;
push(@bans, keys %{ $bans{$chan} }) if (exists $bans{$chan});
- push(@bans, keys %{ $bans{"*"} }) if (exists $bans{"*"});
+ push(@bans, keys %{ $bans{'*'} }) if (exists $bans{'*'});
foreach (@bans) {
my $ban = $_;
}
my $reason = "no reason";
- foreach ($chan, "*") {
+ foreach ($chan, '*') {
next unless (exists $bans{$_});
next unless (exists $bans{$_}{$ban});
$chan = ($event->to)[0];
# last element is empty... so nuke it.
- pop @args while ($args[$#args] eq "");
+ pop @args while ($args[$#args] eq '');
if ($nick eq $chan) { # UMODE
&status(">>> mode $b_yellow\[$ob$b@args$b_yellow\]$ob by $b_cyan$nick$ob");
$h = $host;
if ($nick eq $ident) { # hopefully ourselves.
- if ($msg eq "TEST") {
+ if ($msg eq 'TEST') {
&status("IRCTEST: Yes, we're alive.");
delete $cache{connect};
return;
}
&hookMsg('private', undef, $nick, $msg);
- $who = "";
- $chan = "";
- $msgType = "";
+ $who = '';
+ $chan = '';
+ $msgType = '';
}
sub on_names {
$conn = shift(@_);
my $nick = $conn->nick();
#my $newnick = $nick . int(rand 10);
- my $newnick = $nick . "_";
+ my $newnick = $nick . '_';
&DEBUG("on_nick_taken: nick => $nick");
if ($check) {
&status("nickserv told us to register; doing it.");
- if (&IsParam("nickServ_pass")) {
+ if (&IsParam('nickServ_pass')) {
&status("NickServ: ==> Identifying.");
&rawout("PRIVMSG NickServ :IDENTIFY $param{'nickServ_pass'}");
return;
if ($args =~ /^Password a/i) {
my $done = 0;
- foreach ( &ChanConfList("chanServ_ops") ) {
+ foreach ( &ChanConfList('chanServ_ops') ) {
next unless &chanServCheck($_);
next if ($done);
&DEBUG("nickserv activated or restarted; doing chanserv check.");
my $nick = $event->nick;
my $userhost = $event->userhost;
$who = $nick;
- $msgType = "public";
+ $msgType = 'public';
if (!exists $channels{$chan}) {
&DEBUG("on_part: found out $mynick is on $chan!");
&clearChanVars($chan);
}
- if (!&IsNickInAnyChan($nick) and &IsChanConf("seenStats") > 0) {
+ if (!&IsNickInAnyChan($nick) and &IsChanConf('seenStats') > 0) {
delete $userstats{lc $nick};
}
$who = $nick;
$uh = $event->userhost();
$nuh = $nick."!".$uh;
- $msgType = "public";
+ $msgType = 'public';
# TODO: move this out of hookMsg to here?
($user,$host) = split(/\@/, $uh);
$h = $host;
$msgtime = time();
$lastWho{$chan} = $nick;
### TODO: use $nick or lc $nick?
- if (&IsChanConf("seenStats") > 0) {
+ if (&IsChanConf('seenStats') > 0) {
$userstats{lc $nick}{'Count'}++;
$userstats{lc $nick}{'Time'} = time();
}
my $time = time();
if (!$cache{ircTextCounters}) {
&DEBUG("caching ircTextCounters for first time.");
- my @str = split(/\s+/, &getChanConf("ircTextCounters"));
+ my @str = split(/\s+/, &getChanConf('ircTextCounters'));
for (@str) { $_ = quotemeta($_); }
$cache{ircTextCounters} = join('|', @str);
}
my $x = $1;
&VERB("textcounters: $x matched for $who",2);
- my $c = $chan || "PRIVATE";
+ my $c = $chan || 'PRIVATE';
# better to do "counter=counter+1".
# but that will avoid time check.
- my ($v,$t) = &sqlSelect("stats", "counter,time", {
+ my ($v,$t) = &sqlSelect('stats', "counter,time", {
nick => $who,
type => $x,
channel => $c,
# don't allow ppl to cheat the stats :-)
if (defined $t && $time - $t > 60) {
- &sqlSet("stats", {'nick' => $who}, {
+ &sqlSet('stats', {'nick' => $who}, {
type => $x,
channel => $c,
time => $time,
&hookMsg('public', $chan, $nick, $msg);
$chanstats{$chan}{'PublicMsg'}++;
- $who = "";
- $chan = "";
- $msgType = "";
+ $who = '';
+ $chan = '';
+ $msgType = '';
}
sub on_quit {
my $reason = ($event->args)[0];
# hack for ICC.
- $msgType = "public";
+ $msgType = 'public';
$who = $nick;
### $chan = $reason; # no.
# chanlimit code.
foreach $chan ( &getNickInChans($nick) ) {
- next unless ( &IsChanConf("chanlimitcheck") > 0);
+ next unless ( &IsChanConf('chanlimitcheck') > 0);
next unless ( exists $channels{$_}{'l'} );
&DEBUG("on_quit: netsplit detected on $_; disabling chan limit.");
# well.. it's good but weird that this has happened - lets just
# be quiet about it.
}
- delete $userstats{lc $nick} if (&IsChanConf("seenStats") > 0);
+ delete $userstats{lc $nick} if (&IsChanConf('seenStats') > 0);
delete $chanstats{lc $nick};
###
# )
#%schedule = {
-# uptimeLoop => ("", 60, 1),
+# uptimeLoop => ('', 60, 1),
#};
sub setupSchedulersII {
####
sub randomQuote {
- my $interval = &getChanConfDefault("randomQuoteInterval", 60, $chan);
+ my $interval = &getChanConfDefault('randomQuoteInterval', 60, $chan);
if (@_) {
- &ScheduleThis($interval, "randomQuote");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis($interval, 'randomQuote');
+ return if ($_[0] eq '2'); # defer.
}
- foreach ( &ChanConfList("randomQuote") ) {
+ foreach ( &ChanConfList('randomQuote') ) {
next unless (&validChan($_));
my $line = &getRandomLineFromFile($bot_data_dir. "/blootbot.randtext");
my ($key,$val);
my $error = 0;
- my $interval = &getChanConfDefault("randomFactoidInterval", 60, $chan);
+ my $interval = &getChanConfDefault('randomFactoidInterval', 60, $chan);
if (@_) {
- &ScheduleThis($interval, "randomFactoid");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis($interval, 'randomFactoid');
+ return if ($_[0] eq '2'); # defer.
}
- foreach ( &ChanConfList("randomFactoid") ) {
+ foreach ( &ChanConfList('randomFactoid') ) {
next unless (&validChan($_));
&status("sending random Factoid to $_.");
while (1) {
- ($key,$val) = &randKey("factoids","factoid_key,factoid_value");
+ ($key,$val) = &randKey('factoids',"factoid_key,factoid_value");
&DEBUG("rF: $key, $val");
### $val =~ tr/^[A-Z]/[a-z]/; # blah is Good => blah is good.
last if ((defined $val) and ($val !~ /^</) and ($key !~ /\#DEL\#/) and ($key !~ /^cmd:/));
sub logLoop {
if (@_) {
- &ScheduleThis(60, "logLoop");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis(60, 'logLoop');
+ return if ($_[0] eq '2'); # defer.
}
return unless (defined fileno LOG);
- return unless (&IsParam("logfile"));
- return unless (&IsParam("maxLogSize"));
+ return unless (&IsParam('logfile'));
+ return unless (&IsParam('maxLogSize'));
### check if current size is too large.
if ( -s $file{log} > $param{'maxLogSize'}) {
sub seenFlushOld {
if (@_) {
- &ScheduleThis(1440, "seenFlushOld");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis(1440, 'seenFlushOld');
+ return if ($_[0] eq '2'); # defer.
}
# is this global-only?
- return unless (&IsChanConf("seen") > 0);
- return unless (&IsChanConf("seenFlushInterval") > 0);
+ return unless (&IsChanConf('seen') > 0);
+ return unless (&IsChanConf('seenFlushInterval') > 0);
# global setting. does not make sense for per-channel.
- my $max_time = &getChanConfDefault("seenMaxDays", 30, $chan) *60*60*24;
+ my $max_time = &getChanConfDefault('seenMaxDays', 30, $chan) *60*60*24;
my $delete = 0;
if ($param{'DBType'} =~ /^(pgsql|mysql|sqlite(2)?)$/i) {
while (my @row = $sth->fetchrow_array) {
my ($nick,$time) = @row;
- &sqlDelete("seen", { nick => $nick } );
+ &sqlDelete('seen', { nick => $nick } );
$delete++;
}
$sth->finish;
sub newsFlush {
if (@_) {
- &ScheduleThis(60, "newsFlush");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis(60, 'newsFlush');
+ return if ($_[0] eq '2'); # defer.
}
if (!&ChanConfList('News')) {
}
sub chanlimitCheck {
- my $interval = &getChanConfDefault("chanlimitcheckInterval", 10, $chan);
+ my $interval = &getChanConfDefault('chanlimitcheckInterval', 10, $chan);
my $mynick=$conn->nick();
if (@_) {
- &ScheduleThis($interval, "chanlimitCheck");
- return if ($_[0] eq "2");
+ &ScheduleThis($interval, 'chanlimitCheck');
+ return if ($_[0] eq '2');
}
- my $str = join(' ', &ChanConfList("chanlimitcheck") );
+ my $str = join(' ', &ChanConfList('chanlimitcheck') );
- foreach $chan ( &ChanConfList("chanlimitcheck") ) {
+ foreach $chan ( &ChanConfList('chanlimitcheck') ) {
next unless (&validChan($chan));
- if ($chan eq "_default") {
+ if ($chan eq '_default') {
&WARN("chanlimit: we're doing $chan!! HELP ME!");
next;
}
- my $limitplus = &getChanConfDefault("chanlimitcheckPlus", 5, $chan);
+ my $limitplus = &getChanConfDefault('chanlimitcheckPlus', 5, $chan);
my $newlimit = scalar(keys %{ $channels{$chan}{''} }) + $limitplus;
my $limit = $channels{$chan}{'l'};
my ($s1,$s2);
if (@_) {
- &ScheduleThis(15, "netsplitCheck");
- return if ($_[0] eq "2");
+ &ScheduleThis(15, 'netsplitCheck');
+ return if ($_[0] eq '2');
}
$cache{'netsplitCache'}++;
my $who;
if (@_) {
- &ScheduleThis(60, "floodLoop"); # minutes.
- return if ($_[0] eq "2");
+ &ScheduleThis(60, 'floodLoop'); # minutes.
+ return if ($_[0] eq '2');
}
my $time = time();
- my $interval = &getChanConfDefault("floodCycle",60, $chan);
+ my $interval = &getChanConfDefault('floodCycle',60, $chan);
foreach $who (keys %flood) {
foreach (keys %{ $flood{$who} }) {
sub seenFlush {
if (@_) {
- my $interval = &getChanConfDefault("seenFlushInterval", 60, $chan);
- &ScheduleThis($interval, "seenFlush");
- return if ($_[0] eq "2");
+ my $interval = &getChanConfDefault('seenFlushInterval', 60, $chan);
+ &ScheduleThis($interval, 'seenFlush');
+ return if ($_[0] eq '2');
}
my %stats;
my $nick;
my $flushed = 0;
- $stats{'count_old'} = &countKeys("seen") || 0;
+ $stats{'count_old'} = &countKeys('seen') || 0;
$stats{'new'} = 0;
$stats{'old'} = 0;
if ($param{'DBType'} =~ /^(mysql|pgsql|sqlite(2)?)$/i) {
foreach $nick (keys %seencache) {
- my $retval = &sqlSet("seen", {'nick' => lc $seencache{$nick}{'nick'}}, {
+ my $retval = &sqlSet('seen', {'nick' => lc $seencache{$nick}{'nick'}}, {
time => $seencache{$nick}{'time'},
host => $seencache{$nick}{'host'},
channel => $seencache{$nick}{'chan'},
$stats{'new'}*100/($stats{'count_old'} || 1),
$stats{'new'}, ( $stats{'count_old'} || 1) ), 2) if ($stats{'new'});
&VERB(sprintf(" now seen: %3.1f%% (%d/%d)",
- $stats{'old'}*100 / ( &countKeys("seen") || 1),
- $stats{'old'}, &countKeys("seen") ), 2) if ($stats{'old'});
+ $stats{'old'}*100 / ( &countKeys('seen') || 1),
+ $stats{'old'}, &countKeys('seen') ), 2) if ($stats{'old'});
&WARN("scalar keys seenflush != 0!") if (scalar keys %seenflush);
}
my $count = 0;
if (@_) {
- &ScheduleThis(240, "leakCheck");
- return if ($_[0] eq "2");
+ &ScheduleThis(240, 'leakCheck');
+ return if ($_[0] eq '2');
}
# flood. this is dealt with in floodLoop()
sub ignoreCheck {
if (@_) {
- &ScheduleThis(60, "ignoreCheck");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis(60, 'ignoreCheck');
+ return if ($_[0] eq '2'); # defer.
}
my $time = time();
sub ircCheck {
if (@_) {
- &ScheduleThis(15, "ircCheck");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis(15, 'ircCheck');
+ return if ($_[0] eq '2'); # defer.
}
$cache{statusSafe} = 1;
} else {
&status('ircCheck: possible lost in space; checking.'.
scalar(gmtime) );
- &msg($mynick, "TEST");
+ &msg($mynick, 'TEST');
$cache{connect} = time();
}
}
sub miscCheck {
if (@_) {
- &ScheduleThis(120, "miscCheck");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis(120, 'miscCheck');
+ return if ($_[0] eq '2'); # defer.
}
# SHM check.
sub miscCheck2 {
if (@_) {
- &ScheduleThis(240, "miscCheck2");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis(240, 'miscCheck2');
+ return if ($_[0] eq '2'); # defer.
}
# debian check.
# }
#
# if (@_) {
-# &ScheduleThis(30, "getNickInUse");
-# return if ($_[0] eq "2"); # defer.
+# &ScheduleThis(30, 'getNickInUse');
+# return if ($_[0] eq '2'); # defer.
# }
#
# &nick( $param{'ircNick'} );
if (@_) {
&ScheduleThis(60, 'slashdotLoop');
- return if ($_[0] eq "2");
+ return if ($_[0] eq '2');
}
my @chans = &ChanConfList('slashdotAnnounce');
if (@_) {
&ScheduleThis(60, 'plugLoop');
- return if ($_[0] eq "2");
+ return if ($_[0] eq '2');
}
my @chans = &ChanConfList('plugAnnounce');
sub kernelLoop {
if (@_) {
- &ScheduleThis(240, "kernelLoop");
- return if ($_[0] eq "2");
+ &ScheduleThis(240, 'kernelLoop');
+ return if ($_[0] eq '2');
}
- my @chans = &ChanConfList("kernelAnnounce");
+ my @chans = &ChanConfList('kernelAnnounce');
return unless (scalar @chans);
- &Forker("Kernel", sub {
+ &Forker('Kernel', sub {
my @data = &Kernel::kernelAnnounce();
foreach (@chans) {
### FILE CACHE OF OFFENDING WINGATES.
foreach (grep /^$host$/, @wingateBad) {
&status("Wingate: RUNNING ON $host BY $who");
- &ban("*!*\@$host", "") if &IsChanConf('wingateBan') > 0;
+ &ban("*!*\@$host", '') if &IsChanConf('wingateBan') > 0;
my $reason = &getChanConf('wingateKick');
next unless ($reason);
- &kick($who, "", $reason)
+ &kick($who, '', $reason)
}
### RUN CACHE OF TRIED WINGATES.
sub wingateWriteFile {
if (@_) {
&ScheduleThis(60, 'wingateWriteFile');
- return if ($_[0] eq "2"); # defer.
+ return if ($_[0] eq '2'); # defer.
}
return unless (scalar @wingateCache);
sub factoidCheck {
if (@_) {
- &ScheduleThis(720, "factoidCheck");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis(720, 'factoidCheck');
+ return if ($_[0] eq '2'); # defer.
}
- my @list = &searchTable("factoids", "factoid_key", "factoid_key", " #DEL#");
- my $stale = &getChanConfDefault("factoidDeleteDelay", 14, $chan) *60*60*24;
+ my @list = &searchTable('factoids', 'factoid_key', 'factoid_key', " #DEL#");
+ my $stale = &getChanConfDefault('factoidDeleteDelay', 14, $chan) *60*60*24;
if ($stale < 1) {
- # disable it since it's "illegal".
+ # disable it since it's 'illegal'.
return;
}
my $time = time();
foreach (@list) {
- my $age = &getFactInfo($_, "modified_time");
+ my $age = &getFactInfo($_, 'modified_time');
if (!defined $age or $age !~ /^\d+$/) {
if (scalar @list > 50) {
return unless (scalar keys %{ $dcc{CHAT} });
if (@_) {
- &ScheduleThis(10, "dccStatus");
- return if ($_[0] eq "2"); # defer.
+ &ScheduleThis(10, 'dccStatus');
+ return if ($_[0] eq '2'); # defer.
}
my $time = strftime("%H:%M", gmtime(time()) );
return;
}
- my $age = "New";
+ my $age = 'New';
if ( -e "$file~" ) {
- $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time);
+ $backup++ if ((stat $file)[9] - (stat "$file~")[9] > $time);
my $delta = time() - (stat "$file~")[9];
$age = &Time2String($delta);
} else {
my %help = ();
# crude hack for performStrictReply() to work as expected.
- $msgType = "private" if ($msgType eq "public");
+ $msgType = 'private' if ($msgType eq 'public');
if (!open(FILE, $file)) {
&ERROR("Failed reading help file ($file): $!");
$val =~ s/__/\037/g;
$val =~ s/==/ /;
- $help{$key} = "" if (!exists $help{$key});
+ $help{$key} = '' if (!exists $help{$key});
$help{$key} .= $val."\n";
}
close FILE;
- if (!defined $topic or $topic eq "") {
+ if (!defined $topic or $topic eq '') {
&msg($who, $help{'main'});
my $i = 0;
# Usage: &IJoin(@array);
sub IJoin {
if (!scalar @_) {
- return "NULL";
+ return 'NULL';
} elsif (scalar @_ == 1) {
return $_[0];
} else {
# Usage: &Time2String(seconds);
sub Time2String {
my ($time) = @_;
- my $prefix = "";
+ my $prefix = '';
my (@s, @t);
- return "NULL" if (!defined $time);
+ return 'NULL' if (!defined $time);
return $time if ($time !~ /\d+/);
if ($time < 0) {
return $str;
}
- if ($str eq "has") {
- $str = "have" if ($int > 1);
- } elsif ($str eq "is") {
- $str = "are" if ($int > 1);
- } elsif ($str eq "was") {
- $str = "were" if ($int > 1);
- } elsif ($str eq "this") {
- $str = "these" if ($int > 1);
+ if ($str eq 'has') {
+ $str = 'have' if ($int > 1);
+ } elsif ($str eq 'is') {
+ $str = 'are' if ($int > 1);
+ } elsif ($str eq 'was') {
+ $str = 'were' if ($int > 1);
+ } elsif ($str eq 'this') {
+ $str = 'these' if ($int > 1);
} elsif ($str =~ /y$/) {
if ($int > 1) {
if ($str =~ /ey$/) {
- $str .= "s"; # eg: "money" => "moneys".
+ $str .= 's'; # eg: 'money' => 'moneys'.
} else {
$str =~ s/y$/ies/;
}
}
} else {
- $str .= "s" if ($int != 1);
+ $str .= 's' if ($int != 1);
}
return $str;
$this{'host'} = &makeHostMask(lc $3);
} else {
&WARN("IHM: thisnuh is invalid '$thisnuh'.");
- return 1 if ($thisnuh eq "");
+ return 1 if ($thisnuh eq '');
return 0;
}
# Usage: &makeHostMask($host);
sub makeHostMask {
my ($host) = @_;
- my $nu = "";
+ my $nu = '';
if ($host =~ s/^(\S+!\S+\@)//) {
&DEBUG("mHM: detected nick!user\@ for host arg; fixing");
sub checkMsgType {
my ($reply) = @_;
- return unless (&IsParam("minLengthBeforePrivate"));
+ return unless (&IsParam('minLengthBeforePrivate'));
return if ($force_public_reply);
if (length $reply > $param{'minLengthBeforePrivate'}) {
&shmFlush();
&VERB("double fork detected; not forking.",2) if ($$ != $bot_pid);
- if (&IsParam("forking") and $$ == $bot_pid) {
+ if (&IsParam('forking') and $$ == $bot_pid) {
return unless &addForked($label);
$SIG{CHLD} = 'IGNORE';
}
sub closeStats {
- return unless (&getChanConfList("ircTextCounters"));
+ return unless (&getChanConfList('ircTextCounters'));
foreach (keys %cmdstats) {
my $type = $_;
- my $i = &sqlSelect("stats", "counter", {
+ my $i = &sqlSelect('stats', 'counter', {
nick => $type,
- type => "cmdstats",
+ type => 'cmdstats',
} );
my $z = 0;
$z++ unless ($i);
$i += $cmdstats{$type};
- &sqlSet("stats", {'nick' => $type}, {
- type => "cmdstats",
+ &sqlSet('stats', {'nick' => $type}, {
+ type => 'cmdstats',
'time' => time(),
counter => $i,
} );
sub list {
my ($response);
my $ua = new LWP::UserAgent;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
$ua->timeout(5);
my ($style, $maxShots, $shakeWins, $shakeTimeout, $maxPlayerScore, $maxTeamScore, $maxTime,
$maxPlayers, $rogueSize, $rogueMax, $redSize, $redMax, $greenSize, $greenMax,
$blueSize, $blueMax, $purpleSize, $purpleMax, $observerSize, $observerMax) =
- unpack("A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2", $flags);
+ unpack('A4A4A4A4A4A4A4A2A2A2A2A2A2A2A2A2A2A2A2A2', $flags);
my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize)
+ hex($blueSize) + hex($purpleSize) + hex($observerSize);
$servers{$serverport} = $playerSize;
sub list17 {
my ($response);
my $ua = new LWP::UserAgent;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
$ua->timeout(5);
$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
$shakeWins,$shakeTimeout,
$maxPlayerScore,$maxTeamScore,$maxTime) =
- unpack("A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4", $flags);
+ unpack('A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4A4', $flags);
my $playerSize = hex($rogueSize) + hex($redSize) + hex($greenSize)
+ hex($blueSize) + hex($purpleSize);
$servers{$serverport} = $playerSize;
&::status("BZFlag module requires Socket.");
return 'BZFlag module not active';
}
- #my @teamName = ("Rogue", "Red", "Green", "Blue", "Purple", "Observer", "Rabbit");
- my @teamName = ("X", "R", "G", "B", "P", "O", "K");
+ #my @teamName = ('Rogue', 'Red', 'Green', 'Blue', 'Purple', 'Observer', 'Rabbit');
+ my @teamName = ('X', 'R', 'G', 'B', 'P', 'O', 'K');
my ($message, $server, $response);
$port = 5154 unless $port;
my ($version) = $magic . $major . $minor . $something . $revision;
# quit if version isn't valid
- return 'not a bzflag server' if ($magic ne "BZFS");
+ return 'not a bzflag server' if ($magic ne 'BZFS');
$response .= "$major$minor$something$revision ";
# check version
- if ($version eq "BZFS0026") {
+ if ($version eq 'BZFS0026') {
# 1.11.x handled here
return 'read error' unless read(S1, $buffer, 1) == 1;
- my ($id) = unpack("C", $buffer);
+ my ($id) = unpack('C', $buffer);
return "rejected by server" if ($id == 255);
# send game request
- print S1 pack("n2", 0, 0x7167);
+ print S1 pack('n2', 0, 0x7167);
# get reply
my $nbytes = read(S1, $buffer, 4);
- my ($infolen, $infocode) = unpack("n2", $buffer);
+ my ($infolen, $infocode) = unpack('n2', $buffer);
if ($infocode == 0x6774) {
# read and ignore MsgGameTime from new servers
$nbytes = read(S1, $buffer, 8);
$nbytes = read(S1, $buffer, 4);
- ($infolen, $infocode) = unpack("n2", $buffer);
+ ($infolen, $infocode) = unpack('n2', $buffer);
}
$nbytes = read(S1, $buffer, 42);
if ($nbytes != 42) {
$rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,$observerSize,
$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,$observerMax,
$shakeWins,$shakeTimeout,
- $maxPlayerScore,$maxTeamScore,$maxTime,$timeElapsed) = unpack("n23", $buffer);
+ $maxPlayerScore,$maxTeamScore,$maxTime,$timeElapsed) = unpack('n23', $buffer);
return "bad server data $infocode" unless $infocode == 0x7167;
# send players request
- print S1 pack("n2", 0, 0x7170);
+ print S1 pack('n2', 0, 0x7170);
# get number of teams and players we'll be receiving
return 'count read error' unless read(S1, $buffer, 8) == 8;
- my ($countlen,$countcode,$numTeams,$numPlayers) = unpack("n4", $buffer);
+ my ($countlen,$countcode,$numTeams,$numPlayers) = unpack('n4', $buffer);
# get the teams
return 'bad count data' unless $countcode == 0x7170;
($countlen,$countcode,$numTeams) = unpack("n n C", $buffer);
for (1..$numTeams) {
return 'team read error' unless read(S1, $buffer, 8) == 8;
- my ($team,$size,$won,$lost) = unpack("n4", $buffer);
+ my ($team,$size,$won,$lost) = unpack('n4', $buffer);
if ($size > 0) {
my $score = $won - $lost;
$response .= "$teamName[$team]:$score($won-$lost) ";
for (1..$numPlayers) {
last unless read(S1, $buffer, 175) == 175;
my ($playerlen,$playercode,$pID,$type,$team,$won,$lost,$tks,$sign,$email) =
- unpack("n2Cn5A32A128", $buffer);
+ unpack('n2Cn5A32A128', $buffer);
#my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) =
# unpack("n2Nn2 n4A32A128", $buffer);
return 'bad player data' unless $playercode == 0x6170;
# 1.10.x handled here
$revision = $something * 10 + $revision;
return 'read error' unless read(S1, $buffer, 1) == 1;
- my ($id) = unpack("C", $buffer);
+ my ($id) = unpack('C', $buffer);
# send game request
- print S1 pack("n2", 0, 0x7167);
+ print S1 pack('n2', 0, 0x7167);
# FIXME the packets are wrong from here down
# get reply
$rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,
$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
$shakeWins,$shakeTimeout,
- $maxPlayerScore,$maxTeamScore,$maxTime) = unpack("n20", $buffer);
+ $maxPlayerScore,$maxTeamScore,$maxTime) = unpack('n20', $buffer);
return 'bad server data' unless $infocode == 0x7167;
# send players request
- print S1 pack("n2", 0, 0x7170);
+ print S1 pack('n2', 0, 0x7170);
# get number of teams and players we'll be receiving
return 'count read error' unless read(S1, $buffer, 8) == 8;
- my ($countlen,$countcode,$numTeams,$numPlayers) = unpack("n4", $buffer);
+ my ($countlen,$countcode,$numTeams,$numPlayers) = unpack('n4', $buffer);
# get the teams
return 'bad count data' unless $countcode == 0x7170;
($countlen,$countcode,$numTeams) = unpack("n n C", $buffer);
for (1..$numTeams) {
return 'team read error' unless read(S1, $buffer, 8) == 8;
- my ($team,$size,$won,$lost) = unpack("n4", $buffer);
+ my ($team,$size,$won,$lost) = unpack('n4', $buffer);
if ($size > 0) {
my $score = $won - $lost;
$response .= "$teamName[$team]:$score($won-$lost) ";
for (1..$numPlayers) {
last unless read(S1, $buffer, 175) == 175;
my ($playerlen,$playercode,$pID,$type,$team,$won,$lost,$tks,$sign,$email) =
- unpack("n2Cn5A32A128", $buffer);
+ unpack('n2Cn5A32A128', $buffer);
#my ($playerlen,$playercode,$pAddr,$pPort,$pNum,$type,$team,$won,$lost,$sign,$email) =
# unpack("n2Nn2 n4A32A128", $buffer);
return 'bad player data' unless $playercode == 0x6170;
# 1.7* versions handled here
# old servers send a reconnect port number
return 'read error' unless read(S1, $buffer, 2) == 2;
- my ($reconnect) = unpack("n", $buffer);
+ my ($reconnect) = unpack('n', $buffer);
$minor = $minor * 10 + $something;
# quit if rejected
return 'rejected by server' if ($reconnect == 0);
close(S1);
# send game request
- print S pack("n2", 0, 0x7167);
+ print S pack('n2', 0, 0x7167);
# get reply
return 'server read error' unless read(S, $buffer, 40) == 40;
$rogueSize,$redSize,$greenSize,$blueSize,$purpleSize,
$rogueMax,$redMax,$greenMax,$blueMax,$purpleMax,
$shakeWins,$shakeTimeout,
- $maxPlayerScore,$maxTeamScore,$maxTime) = unpack("n20", $buffer);
+ $maxPlayerScore,$maxTeamScore,$maxTime) = unpack('n20', $buffer);
return 'bad server data' unless $infocode == 0x7167;
# send players request
- print S pack("n2", 0, 0x7170);
+ print S pack('n2', 0, 0x7170);
# get number of teams and players we'll be receiving
return 'count read error' unless read(S, $buffer, 8) == 8;
- my ($countlen,$countcode,$numTeams,$numPlayers) = unpack("n4", $buffer);
+ my ($countlen,$countcode,$numTeams,$numPlayers) = unpack('n4', $buffer);
return 'bad count data' unless $countcode == 0x7170;
# get the teams
for (1..$numTeams) {
return 'team read error' unless read(S, $buffer, 14) == 14;
- my ($teamlen,$teamcode,$team,$size,$aSize,$won,$lost) = unpack("n7", $buffer);
+ my ($teamlen,$teamcode,$team,$size,$aSize,$won,$lost) = unpack('n7', $buffer);
return 'bad team data' unless $teamcode == 0x7475;
if ($size > 0) {
my $score = $won - $lost;
$grepRE = "$query*\[ \t]";
}
- # fix up grepRE for "*".
+ # fix up grepRE for '*'.
$grepRE =~ s/\*/.*/g;
my @files;
} elsif (scalar @list == 1) { # list = 1.
&::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
- &infoPackages("info", $list[0]);
+ &infoPackages('info', $list[0]);
} else { # list > 1.
my $prefix = "Debian Desc Search of '$query' ";
} elsif (/^Maintainer: (.*) \<(\S+)\>$/) {
my($name,$email) = ($1,$2);
- if ($package eq "") {
+ if ($package eq '') {
&::DEBUG("deb: sA: package == NULL.");
next;
}
$maint{$name}{$email} = 1;
$pkg{$name}{$package} = 1;
- $package = "";
+ $package = '';
} else {
chop;
next unless (eval { $desc =~ /$regex/i });
return unless &checkEval($@);
- if ($package eq "") {
+ if ($package eq '') {
&::WARN("sD: package == NULL?");
next;
}
$desc{$package} = $desc;
- $package = "";
+ $package = '';
} else {
chop;
print IDX "$1\n";
print PKG "Package: $1\n";
print PKG "Version: $2\n";
- print PKG "Architecture: ", (defined $4) ? $4 : "all", "\n";
+ print PKG "Architecture: ", (defined $4) ? $4 : 'all', "\n";
}
print PKG "Filename: $file\n";
print PKG "Size: $ftp{$file}\n";
# download packages file.
# hrm...
my %urls = &fixDist($dist, %urlpackages);
- if ($dist ne "incoming") {
+ if ($dist ne 'incoming') {
&::DEBUG("deb: download 3.") if ($debug);
if (!&DebianDownload($dist, %urls)) { # no good download.
my @files = &validPackage($package, $dist);
if (!scalar @files) {
&::status("Debian: no valid package found; checking incoming.");
- @files = &validPackage($package, "incoming");
+ @files = &validPackage($package, 'incoming');
if (scalar @files) {
&::status("Debian: cool, it exists in incoming.");
}
my %pkg = &getPackageInfo($package, $file);
- $query = "info" if ($query eq "dinfo");
+ $query = 'info' if ($query eq 'dinfo');
# 'fm'-like output.
- if ($query eq "info") {
+ if ($query eq 'info') {
if (scalar keys %pkg <= 5) {
&::DEBUG("deb: running debianCheck() due to problems (".scalar(keys %pkg).").");
&debianCheck();
}
}
- if ($dist eq "incoming") {
+ if ($dist eq 'incoming') {
$pkg{'info'} .= "Version: \002$pkg{'version'}\002";
$pkg{'info'} .= ", Packaged size: \002". int($pkg{'size'}/1024) ."\002 kB";
$pkg{'info'} .= ", is in incoming!!!";
}
if (!exists $pkg{$query}) {
- if ($query eq "suggests") {
+ if ($query eq 'suggests') {
$pkg{$query} = "has no suggestions";
- } elsif ($query eq "conflicts") {
+ } elsif ($query eq 'conflicts') {
$pkg{$query} = "does not conflict with any other package";
- } elsif ($query eq "depends") {
+ } elsif ($query eq 'depends') {
$pkg{$query} = "does not depend on anything";
- } elsif ($query eq "maint") {
+ } elsif ($query eq 'maint') {
$pkg{$query} = "has no maintainer";
} else {
$pkg{$query} = "has nothing about $query";
unlink $file if ( -z $file );
while (!open IN, $file) {
- if ($dist eq "incoming") {
+ if ($dist eq 'incoming') {
&::DEBUG("deb: sP: dist == incoming; calling gI().");
&generateIncoming();
}
sub getDistro {
my $dist = $_[0];
- if (!defined $dist or $dist eq "") {
+ if (!defined $dist or $dist eq '') {
&::DEBUG("deb: gD: dist == NULL; dist = defaultdist.");
$dist = $defaultdist;
}
my @results = sort &searchPackage($str);
if (!scalar @results) {
- &::Forker("Debian", sub { &searchContents($str); } );
+ &::Forker('Debian', sub { &searchContents($str); } );
} elsif (scalar @results == 1) {
&::status("searchPackage returned one result; getting info of package instead!");
- &::Forker("Debian", sub { &infoPackages("info", "$results[0] $dist"); } );
+ &::Forker('Debian', sub { &infoPackages('info', "$results[0] $dist"); } );
} else {
my $prefix = "Debian Package Listing of '$query' ";
&::performStrictReply( &::formListReply(0, $prefix, @results) );
&::performStrictReply( &::formListReply(0, $prefix, ) );
} elsif (scalar @list == 1) { # list = 1.
&::DEBUG("deb: list == 1; showing package info of '$list[0]'.");
- &infoPackages("info", $list[0]);
+ &infoPackages('info', $list[0]);
} else { # list > 1.
my $prefix = "Debian Desc Search of '$query' ";
&::performStrictReply( &::formListReply(0, $prefix, @list) );
my $socket = new IO::Socket;
socket($socket, PF_INET, SOCK_STREAM, $proto) or return "error: socket: $!";
eval {
- local $SIG{ALRM} = sub { die "alarm" };
+ local $SIG{ALRM} = sub { die 'alarm' };
alarm 10;
connect($socket, sockaddr_in($port, inet_aton($server))) or die "error: connect: $!";
alarm 0;
&::DEBUG("Dict: asking $dict.");
print $socket "DEFINE $dict \"$query\"\n";
- my $def = "";
+ my $def = '';
my $term = $query;
while (<$socket>) {
$def =~ s/\s+$//;
#&::DEBUG("def => '$def'.");
$def =~ s/\[[^\]]*\]//g;
- push(@results, $def) if ($def ne "");
+ push(@results, $def) if ($def ne '');
$def = $text;
} elsif (/^\s+(.*)/) {
$def .= $line;
sub dumpvarslog {
my ($line) = @_;
- if (&IsParam("dumpvarsLogFile")) {
+ if (&IsParam('dumpvarsLogFile')) {
print DUMPVARS $line."\n";
} else {
&status("DV: ".$line);
my $line;
if ($packname eq 'main::') {
- &dumpvarslog("Packages");
+ &dumpvarslog('Packages');
foreach $symname (sort keys %$package) {
local *sym = $$package{$symname};
}
sub dumpallvars {
- if (&IsParam("dumpvarsLogFile")) {
+ if (&IsParam('dumpvarsLogFile')) {
my $file = $param{'dumpvarsLogFile'};
&status("opening fh to dumpvars ($file)");
if (!open(DUMPVARS,">$file")) {
DumpNames(%main::,'main::');
- if (&IsParam("dumpvarsLogFile")) {
+ if (&IsParam('dumpvarsLogFile')) {
&status("closing fh to dumpvars");
close DUMPVARS;
}
sub symdumpRecur {
my $x = shift;
- if (ref $x eq "HASH") {
+ if (ref $x eq 'HASH') {
foreach (keys %$x) {
&symdumpRecur($_);
}
#!/usr/bin/perl
-# Exchange.pl - currency exchange "module"
+# Exchange.pl - currency exchange 'module'
#
# Last update: 990818 08:30:10, bobby@bofh.dk
# 20021111 Tim Riker <Tim@Rikers.org>
sub GetTlds {
my %Hash = (
- "AF", "AFGHANISTAN",
- "AL", "ALBANIA",
- "DZ", "ALGERIA",
- "AS", "AMERICAN SAMOA",
- "AD", "ANDORRA",
- "AO", "ANGOLA",
- "AI", "ANGUILLA",
- "AQ", "ANTARCTICA",
- "AG", "ANTIGUA AND BARBUDA",
- "AR", "ARGENTINA",
- "AM", "ARMENIA",
- "AW", "ARUBA",
- "AU", "AUSTRALIA",
- "AT", "AUSTRIA",
- "AZ", "AZERBAIJAN",
- "BS", "BAHAMAS",
- "BH", "BAHRAIN",
- "BD", "BANGLADESH",
- "BB", "BARBADOS",
- "BY", "BELARUS",
- "BE", "BELGIUM",
- "BZ", "BELIZE",
- "BJ", "BENIN",
- "BM", "BERMUDA",
- "BT", "BHUTAN",
- "BO", "BOLIVIA",
- "BA", "BOSNIA AND HERZEGOWINA",
- "BW", "BOTSWANA",
- "BV", "BOUVET ISLAND",
- "BR", "BRAZIL",
- "IO", "BRITISH INDIAN OCEAN TERRITORY",
- "BN", "BRUNEI DARUSSALAM",
- "BG", "BULGARIA",
- "BF", "BURKINA FASO",
- "BI", "BURUNDI",
- "KH", "CAMBODIA",
- "CM", "CAMEROON",
- "CA", "CANADA",
- "CV", "CAPE VERDE",
- "KY", "CAYMAN ISLANDS",
- "CF", "CENTRAL AFRICAN REPUBLIC",
- "TD", "CHAD",
- "CL", "CHILE",
- "CN", "CHINA",
- "CX", "CHRISTMAS ISLAND",
- "CC", "COCOS (KEELING) ISLANDS",
- "CO", "COLOMBIA",
- "KM", "COMOROS",
- "CG", "CONGO",
- "CD", "CONGO, THE DEMOCRATIC REPUBLIC OF THE",
- "CK", "COOK ISLANDS",
- "CR", "COSTA RICA",
- "CI", "COTE D'IVOIRE",
- "HR", "CROATIA (local name: Hrvatska)",
- "CU", "CUBA",
- "CY", "CYPRUS",
- "CZ", "CZECH REPUBLIC",
- "DK", "DENMARK",
- "DJ", "DJIBOUTI",
- "DM", "DOMINICA",
- "DO", "DOMINICAN REPUBLIC",
- "TP", "EAST TIMOR",
- "EC", "ECUADOR",
- "EG", "EGYPT",
- "SV", "EL SALVADOR",
- "GQ", "EQUATORIAL GUINEA",
- "ER", "ERITREA",
- "EE", "ESTONIA",
- "ET", "ETHIOPIA",
- "FK", "FALKLAND ISLANDS (MALVINAS)",
- "FO", "FAROE ISLANDS",
- "FJ", "FIJI",
- "FI", "FINLAND",
- "FR", "FRANCE",
- "FX", "FRANCE, METROPOLITAN",
- "GF", "FRENCH GUIANA",
- "PF", "FRENCH POLYNESIA",
- "TF", "FRENCH SOUTHERN TERRITORIES",
- "GA", "GABON",
- "GM", "GAMBIA",
- "GE", "GEORGIA",
- "DE", "GERMANY",
- "GH", "GHANA",
- "GI", "GIBRALTAR",
- "GR", "GREECE",
- "GL", "GREENLAND",
- "GD", "GRENADA",
- "GP", "GUADELOUPE",
- "GU", "GUAM",
- "GT", "GUATEMALA",
- "GN", "GUINEA",
- "GW", "GUINEA-BISSAU",
- "GY", "GUYANA",
- "HT", "HAITI",
- "HM", "HEARD AND MC DONALD ISLANDS",
- "VA", "HOLY SEE (VATICAN CITY STATE)",
- "HN", "HONDURAS",
- "HK", "HONG KONG",
- "HU", "HUNGARY",
- "IS", "ICELAND",
- "IN", "INDIA",
- "ID", "INDONESIA",
- "IR", "IRAN (ISLAMIC REPUBLIC OF)",
- "IQ", "IRAQ",
- "IE", "IRELAND",
- "IL", "ISRAEL",
- "IT", "ITALY",
- "JM", "JAMAICA",
- "JP", "JAPAN",
- "JO", "JORDAN",
- "KZ", "KAZAKHSTAN",
- "KE", "KENYA",
- "KI", "KIRIBATI",
- "KP", "KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF",
- "KR", "KOREA, REPUBLIC OF",
- "KW", "KUWAIT",
- "KG", "KYRGYZSTAN",
- "LA", "LAO PEOPLE'S DEMOCRATIC REPUBLIC",
- "LV", "LATVIA",
- "LB", "LEBANON",
- "LS", "LESOTHO",
- "LR", "LIBERIA",
- "LY", "LIBYAN ARAB JAMAHIRIYA",
- "LI", "LIECHTENSTEIN",
- "LT", "LITHUANIA",
- "LU", "LUXEMBOURG",
- "MO", "MACAU",
- "MK", "MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF",
- "MG", "MADAGASCAR",
- "MW", "MALAWI",
- "MY", "MALAYSIA",
- "MV", "MALDIVES",
- "ML", "MALI",
- "MT", "MALTA",
- "MH", "MARSHALL ISLANDS",
- "MQ", "MARTINIQUE",
- "MR", "MAURITANIA",
- "MU", "MAURITIUS",
- "YT", "MAYOTTE",
- "MX", "MEXICO",
- "FM", "MICRONESIA, FEDERATED STATES OF",
- "MD", "MOLDOVA, REPUBLIC OF",
- "MC", "MONACO",
- "MN", "MONGOLIA",
- "MS", "MONTSERRAT",
- "MA", "MOROCCO",
- "MZ", "MOZAMBIQUE",
- "MM", "MYANMAR",
- "NA", "NAMIBIA",
- "NR", "NAURU",
- "NP", "NEPAL",
- "NL", "NETHERLANDS",
- "AN", "NETHERLANDS ANTILLES",
- "NC", "NEW CALEDONIA",
- "NZ", "NEW ZEALAND",
- "NI", "NICARAGUA",
- "NE", "NIGER",
- "NG", "NIGERIA",
- "NU", "NIUE",
- "NF", "NORFOLK ISLAND",
- "MP", "NORTHERN MARIANA ISLANDS",
- "NO", "NORWAY",
- "OM", "OMAN",
- "PK", "PAKISTAN",
- "PW", "PALAU",
- "PA", "PANAMA",
- "PG", "PAPUA NEW GUINEA",
- "PY", "PARAGUAY",
- "PE", "PERU",
- "PH", "PHILIPPINES",
- "PN", "PITCAIRN",
- "PL", "POLAND",
- "PT", "PORTUGAL",
- "PR", "PUERTO RICO",
- "QA", "QATAR",
- "RE", "REUNION",
- "RO", "ROMANIA",
- "RU", "RUSSIAN FEDERATION",
- "RW", "RWANDA",
- "KN", "SAINT KITTS AND NEVIS",
- "LC", "SAINT LUCIA",
- "VC", "SAINT VINCENT AND THE GRENADINES",
- "WS", "SAMOA",
- "SM", "SAN MARINO",
- "ST", "SAO TOME AND PRINCIPE",
- "SA", "SAUDI ARABIA",
- "SN", "SENEGAL",
- "SC", "SEYCHELLES",
- "SL", "SIERRA LEONE",
- "SG", "SINGAPORE",
- "SK", "SLOVAKIA (Slovak Republic)",
- "SI", "SLOVENIA",
- "SB", "SOLOMON ISLANDS",
- "SO", "SOMALIA",
- "ZA", "SOUTH AFRICA",
- "GS", "SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS",
- "ES", "SPAIN",
- "LK", "SRI LANKA",
- "SH", "ST. HELENA",
- "PM", "ST. PIERRE AND MIQUELON",
- "SD", "SUDAN",
- "SR", "SURINAME",
- "SJ", "SVALBARD AND JAN MAYEN ISLANDS",
- "SZ", "SWAZILAND",
- "SE", "SWEDEN",
- "CH", "SWITZERLAND",
- "SY", "SYRIAN ARAB REPUBLIC",
- "TW", "TAIWAN, PROVINCE OF CHINA",
- "TJ", "TAJIKISTAN",
- "TZ", "TANZANIA, UNITED REPUBLIC OF",
- "TH", "THAILAND",
- "TG", "TOGO",
- "TK", "TOKELAU",
- "TO", "TONGA",
- "TT", "TRINIDAD AND TOBAGO",
- "TN", "TUNISIA",
- "TR", "TURKEY",
- "TM", "TURKMENISTAN",
- "TC", "TURKS AND CAICOS ISLANDS",
- "TV", "TUVALU",
- "UG", "UGANDA",
- "UA", "UKRAINE",
- "AE", "UNITED ARAB EMIRATES",
- "GB", "UNITED KINGDOM",
- "US", "UNITED STATES",
- "UM", "UNITED STATES MINOR OUTLYING ISLANDS",
- "UY", "URUGUAY",
- "UZ", "UZBEKISTAN",
- "VU", "VANUATU",
- "VE", "VENEZUELA",
- "VN", "VIET NAM",
- "VG", "VIRGIN ISLANDS (BRITISH)",
- "VI", "VIRGIN ISLANDS (U.S.)",
- "WF", "WALLIS AND FUTUNA ISLANDS",
- "EH", "WESTERN SAHARA",
- "YE", "YEMEN",
- "YU", "YUGOSLAVIA",
- "ZM", "ZAMBIA",
- "ZW", "ZIMBABWE",
+ 'AF', 'AFGHANISTAN',
+ 'AL', 'ALBANIA',
+ 'DZ', 'ALGERIA',
+ 'AS', 'AMERICAN SAMOA',
+ 'AD', 'ANDORRA',
+ 'AO', 'ANGOLA',
+ 'AI', 'ANGUILLA',
+ 'AQ', 'ANTARCTICA',
+ 'AG', 'ANTIGUA AND BARBUDA',
+ 'AR', 'ARGENTINA',
+ 'AM', 'ARMENIA',
+ 'AW', 'ARUBA',
+ 'AU', 'AUSTRALIA',
+ 'AT', 'AUSTRIA',
+ 'AZ', 'AZERBAIJAN',
+ 'BS', 'BAHAMAS',
+ 'BH', 'BAHRAIN',
+ 'BD', 'BANGLADESH',
+ 'BB', 'BARBADOS',
+ 'BY', 'BELARUS',
+ 'BE', 'BELGIUM',
+ 'BZ', 'BELIZE',
+ 'BJ', 'BENIN',
+ 'BM', 'BERMUDA',
+ 'BT', 'BHUTAN',
+ 'BO', 'BOLIVIA',
+ 'BA', 'BOSNIA AND HERZEGOWINA',
+ 'BW', 'BOTSWANA',
+ 'BV', 'BOUVET ISLAND',
+ 'BR', 'BRAZIL',
+ 'IO', 'BRITISH INDIAN OCEAN TERRITORY',
+ 'BN', 'BRUNEI DARUSSALAM',
+ 'BG', 'BULGARIA',
+ 'BF', 'BURKINA FASO',
+ 'BI', 'BURUNDI',
+ 'KH', 'CAMBODIA',
+ 'CM', 'CAMEROON',
+ 'CA', 'CANADA',
+ 'CV', 'CAPE VERDE',
+ 'KY', 'CAYMAN ISLANDS',
+ 'CF', 'CENTRAL AFRICAN REPUBLIC',
+ 'TD', 'CHAD',
+ 'CL', 'CHILE',
+ 'CN', 'CHINA',
+ 'CX', 'CHRISTMAS ISLAND',
+ 'CC', 'COCOS (KEELING) ISLANDS',
+ 'CO', 'COLOMBIA',
+ 'KM', 'COMOROS',
+ 'CG', 'CONGO',
+ 'CD', 'CONGO, THE DEMOCRATIC REPUBLIC OF THE',
+ 'CK', 'COOK ISLANDS',
+ 'CR', 'COSTA RICA',
+ 'CI', "COTE D'IVOIRE",
+ 'HR', 'CROATIA (local name: Hrvatska)',
+ 'CU', 'CUBA',
+ 'CY', 'CYPRUS',
+ 'CZ', 'CZECH REPUBLIC',
+ 'DK', 'DENMARK',
+ 'DJ', 'DJIBOUTI',
+ 'DM', 'DOMINICA',
+ 'DO', 'DOMINICAN REPUBLIC',
+ 'TP', 'EAST TIMOR',
+ 'EC', 'ECUADOR',
+ 'EG', 'EGYPT',
+ 'SV', 'EL SALVADOR',
+ 'GQ', 'EQUATORIAL GUINEA',
+ 'ER', 'ERITREA',
+ 'EE', 'ESTONIA',
+ 'ET', 'ETHIOPIA',
+ 'FK', 'FALKLAND ISLANDS (MALVINAS)',
+ 'FO', 'FAROE ISLANDS',
+ 'FJ', 'FIJI',
+ 'FI', 'FINLAND',
+ 'FR', 'FRANCE',
+ 'FX', 'FRANCE, METROPOLITAN',
+ 'GF', 'FRENCH GUIANA',
+ 'PF', 'FRENCH POLYNESIA',
+ 'TF', 'FRENCH SOUTHERN TERRITORIES',
+ 'GA', 'GABON',
+ 'GM', 'GAMBIA',
+ 'GE', 'GEORGIA',
+ 'DE', 'GERMANY',
+ 'GH', 'GHANA',
+ 'GI', 'GIBRALTAR',
+ 'GR', 'GREECE',
+ 'GL', 'GREENLAND',
+ 'GD', 'GRENADA',
+ 'GP', 'GUADELOUPE',
+ 'GU', 'GUAM',
+ 'GT', 'GUATEMALA',
+ 'GN', 'GUINEA',
+ 'GW', 'GUINEA-BISSAU',
+ 'GY', 'GUYANA',
+ 'HT', 'HAITI',
+ 'HM', 'HEARD AND MC DONALD ISLANDS',
+ 'VA', 'HOLY SEE (VATICAN CITY STATE)',
+ 'HN', 'HONDURAS',
+ 'HK', 'HONG KONG',
+ 'HU', 'HUNGARY',
+ 'IS', 'ICELAND',
+ 'IN', 'INDIA',
+ 'ID', 'INDONESIA',
+ 'IR', 'IRAN (ISLAMIC REPUBLIC OF)',
+ 'IQ', 'IRAQ',
+ 'IE', 'IRELAND',
+ 'IL', 'ISRAEL',
+ 'IT', 'ITALY',
+ 'JM', 'JAMAICA',
+ 'JP', 'JAPAN',
+ 'JO', 'JORDAN',
+ 'KZ', 'KAZAKHSTAN',
+ 'KE', 'KENYA',
+ 'KI', 'KIRIBATI',
+ 'KP', "KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF",
+ 'KR', 'KOREA, REPUBLIC OF',
+ 'KW', 'KUWAIT',
+ 'KG', 'KYRGYZSTAN',
+ 'LA', "LAO PEOPLE'S DEMOCRATIC REPUBLIC",
+ 'LV', 'LATVIA',
+ 'LB', 'LEBANON',
+ 'LS', 'LESOTHO',
+ 'LR', 'LIBERIA',
+ 'LY', 'LIBYAN ARAB JAMAHIRIYA',
+ 'LI', 'LIECHTENSTEIN',
+ 'LT', 'LITHUANIA',
+ 'LU', 'LUXEMBOURG',
+ 'MO', 'MACAU',
+ 'MK', 'MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF',
+ 'MG', 'MADAGASCAR',
+ 'MW', 'MALAWI',
+ 'MY', 'MALAYSIA',
+ 'MV', 'MALDIVES',
+ 'ML', 'MALI',
+ 'MT', 'MALTA',
+ 'MH', 'MARSHALL ISLANDS',
+ 'MQ', 'MARTINIQUE',
+ 'MR', 'MAURITANIA',
+ 'MU', 'MAURITIUS',
+ 'YT', 'MAYOTTE',
+ 'MX', 'MEXICO',
+ 'FM', 'MICRONESIA, FEDERATED STATES OF',
+ 'MD', 'MOLDOVA, REPUBLIC OF',
+ 'MC', 'MONACO',
+ 'MN', 'MONGOLIA',
+ 'MS', 'MONTSERRAT',
+ 'MA', 'MOROCCO',
+ 'MZ', 'MOZAMBIQUE',
+ 'MM', 'MYANMAR',
+ 'NA', 'NAMIBIA',
+ 'NR', 'NAURU',
+ 'NP', 'NEPAL',
+ 'NL', 'NETHERLANDS',
+ 'AN', 'NETHERLANDS ANTILLES',
+ 'NC', 'NEW CALEDONIA',
+ 'NZ', 'NEW ZEALAND',
+ 'NI', 'NICARAGUA',
+ 'NE', 'NIGER',
+ 'NG', 'NIGERIA',
+ 'NU', 'NIUE',
+ 'NF', 'NORFOLK ISLAND',
+ 'MP', 'NORTHERN MARIANA ISLANDS',
+ 'NO', 'NORWAY',
+ 'OM', 'OMAN',
+ 'PK', 'PAKISTAN',
+ 'PW', 'PALAU',
+ 'PA', 'PANAMA',
+ 'PG', 'PAPUA NEW GUINEA',
+ 'PY', 'PARAGUAY',
+ 'PE', 'PERU',
+ 'PH', 'PHILIPPINES',
+ 'PN', 'PITCAIRN',
+ 'PL', 'POLAND',
+ 'PT', 'PORTUGAL',
+ 'PR', 'PUERTO RICO',
+ 'QA', 'QATAR',
+ 'RE', 'REUNION',
+ 'RO', 'ROMANIA',
+ 'RU', 'RUSSIAN FEDERATION',
+ 'RW', 'RWANDA',
+ 'KN', 'SAINT KITTS AND NEVIS',
+ 'LC', 'SAINT LUCIA',
+ 'VC', 'SAINT VINCENT AND THE GRENADINES',
+ 'WS', 'SAMOA',
+ 'SM', 'SAN MARINO',
+ 'ST', 'SAO TOME AND PRINCIPE',
+ 'SA', 'SAUDI ARABIA',
+ 'SN', 'SENEGAL',
+ 'SC', 'SEYCHELLES',
+ 'SL', 'SIERRA LEONE',
+ 'SG', 'SINGAPORE',
+ 'SK', 'SLOVAKIA (Slovak Republic)',
+ 'SI', 'SLOVENIA',
+ 'SB', 'SOLOMON ISLANDS',
+ 'SO', 'SOMALIA',
+ 'ZA', 'SOUTH AFRICA',
+ 'GS', 'SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS',
+ 'ES', 'SPAIN',
+ 'LK', 'SRI LANKA',
+ 'SH', 'ST. HELENA',
+ 'PM', 'ST. PIERRE AND MIQUELON',
+ 'SD', 'SUDAN',
+ 'SR', 'SURINAME',
+ 'SJ', 'SVALBARD AND JAN MAYEN ISLANDS',
+ 'SZ', 'SWAZILAND',
+ 'SE', 'SWEDEN',
+ 'CH', 'SWITZERLAND',
+ 'SY', 'SYRIAN ARAB REPUBLIC',
+ 'TW', 'TAIWAN, PROVINCE OF CHINA',
+ 'TJ', 'TAJIKISTAN',
+ 'TZ', 'TANZANIA, UNITED REPUBLIC OF',
+ 'TH', 'THAILAND',
+ 'TG', 'TOGO',
+ 'TK', 'TOKELAU',
+ 'TO', 'TONGA',
+ 'TT', 'TRINIDAD AND TOBAGO',
+ 'TN', 'TUNISIA',
+ 'TR', 'TURKEY',
+ 'TM', 'TURKMENISTAN',
+ 'TC', 'TURKS AND CAICOS ISLANDS',
+ 'TV', 'TUVALU',
+ 'UG', 'UGANDA',
+ 'UA', 'UKRAINE',
+ 'AE', 'UNITED ARAB EMIRATES',
+ 'GB', 'UNITED KINGDOM',
+ 'US', 'UNITED STATES',
+ 'UM', 'UNITED STATES MINOR OUTLYING ISLANDS',
+ 'UY', 'URUGUAY',
+ 'UZ', 'UZBEKISTAN',
+ 'VU', 'VANUATU',
+ 'VE', 'VENEZUELA',
+ 'VN', 'VIET NAM',
+ 'VG', 'VIRGIN ISLANDS (BRITISH)',
+ 'VI', 'VIRGIN ISLANDS (U.S.)',
+ 'WF', 'WALLIS AND FUTUNA ISLANDS',
+ 'EH', 'WESTERN SAHARA',
+ 'YE', 'YEMEN',
+ 'YU', 'YUGOSLAVIA',
+ 'ZM', 'ZAMBIA',
+ 'ZW', 'ZIMBABWE',
);
return %Hash;
}
my ($message) = @_;
&::DEBUG("exchange(@_)");
- return "Exchange.pl needs LWP::UserAgent and HTTP::Request::Common"
+ return 'Exchange.pl needs LWP::UserAgent and HTTP::Request::Common'
if ($no_exchange);
my ($From, $To, $Amount, $Country);
# looking up the currency for a country
$Country = $1;
} else {
- return "that doesn't look right";
+ return 'that doesn't look right';
}
my $ua = new LWP::UserAgent;
# Let's pretend
- #$ua->agent("Mozilla/5.0 " . $ua->agent);
- $ua->agent("Mozilla/5.0");
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ #$ua->agent('Mozilla/5.0 ' . $ua->agent);
+ $ua->agent('Mozilla/5.0');
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
$ua->timeout(10);
my $Referer = 'http://www.xe.net/ucc/full.shtml';
my $grab = GET $Referer;
my $reply = $ua->request($grab);
if (!$reply->is_success) {
- return "EXCHANGE: ".$reply->status_line;
+ return 'EXCHANGE: '.$reply->status_line;
}
my $html = $reply->as_string;
my %Currencies = (grep /\S+/,
return "$Cfrom $Currencies{$From} makes ".
"$Cto $Currencies{$To} (from http://www.xe.com/)"; # ." ($When)\n";
} else {
- return "i got some error trying that";
+ return 'i got some error trying that';
}
} else {
# Oh dear.
sub CmdFactInfo {
my ($faqtoid, $query) = (lc $_[0], $_[1]);
my @array;
- my $string = "";
+ my $string = '';
- if ($faqtoid eq "") {
- &help("factinfo");
+ if ($faqtoid eq '') {
+ &help('factinfo');
return;
}
- my %factinfo = &sqlSelectRowHash("factoids", "*",
+ my %factinfo = &sqlSelectRowHash('factoids', '*',
{ factoid_key => $faqtoid }
);
if ($factinfo{'created_by'}) {
$factinfo{'created_by'} =~ s/\!/ </;
- $factinfo{'created_by'} .= ">";
+ $factinfo{'created_by'} .= '>';
$string = "created by $factinfo{'created_by'}";
my $time = $factinfo{'created_time'};
$string .= " at \037". scalar(gmtime $time). "\037" .
" ($days days)";
} else {
- $string .= " ".&Time2String(time() - $time)." ago";
+ $string .= ' '.&Time2String(time() - $time).' ago';
}
}
push(@array,$string);
}
- # modified: (TimRiker asks "why do you keep turning this off?)
+ # modified: (TimRiker asks: why do you keep turning this off?)
if ($factinfo{'modified_by'}) {
- $string = "last modified";
+ $string = 'last modified';
my $time = $factinfo{'modified_time'};
if ($time) {
if (time() - $time > 60*60*24*7) {
$string .= " at \037". scalar(gmtime $time). "\037";
} else {
- $string .= " ".&Time2String(time() - $time)." ago ";
+ $string .= ' '.&Time2String(time() - $time).' ago ';
}
}
- $string .= " by ".(split ",", $factinfo{'modified_by'})[0];
+ $string .= ' by '.(split ',', $factinfo{'modified_by'})[0];
push(@array,$string);
}
my $requested_count = $factinfo{'requested_count'};
if ($requested_count) {
- $string = "it has been requested ";
+ $string = 'it has been requested ';
if ($requested_count == 1) {
$string .= "\002once\002";
} else {
$string .= "\002". $requested_count. "\002 ".
- &fixPlural("time", $requested_count);
+ &fixPlural('time', $requested_count);
}
my $requested_by = $factinfo{'requested_by'};
if (time() - $requested_time > 60*60*24*7) {
$string .= " at \037". scalar(localtime $requested_time). "\037";
} else {
- $string .= ", ".&Time2String(time() - $requested_time)." ago";
+ $string .= ', '.&Time2String(time() - $requested_time).' ago';
}
}
} else {
- $string = "has not been requested yet";
+ $string = 'has not been requested yet';
}
push(@array, $string);
return;
}
- &performStrictReply("$factinfo{'factoid_key'} -- ". join("; ", @array) .".");
+ &performStrictReply("$factinfo{'factoid_key'} -- ". join('; ', @array) .'.');
return;
}
my ($type) = @_;
if ($type =~ /^author$/i) {
- my %hash = &sqlSelectColHash("factoids",
- "factoid_key,created_by", undef,
- "WHERE created_by IS NOT NULL"
+ my %hash = &sqlSelectColHash('factoids',
+ 'factoid_key,created_by', undef,
+ 'WHERE created_by IS NOT NULL'
);
my %author;
my $count;
my @list;
foreach $count (sort { $b <=> $a } keys %count) {
- my $author = join(", ", sort keys %{ $count{$count} });
+ my $author = join(', ', sort keys %{ $count{$count} });
push(@list, "$count by $author");
}
- my $prefix = "factoid statistics by author: ";
+ my $prefix = 'factoid statistics by author: ';
return &formListReply(0, $prefix, @list);
} elsif ($type =~ /^vandalism$/i) {
- &status("factstats(vandalism): starting...");
+ &status('factstats(vandalism): starting...');
my $start_time = &timeget();
- my %data = &sqlSelectColHash("factoids",
- "factoid_key,factoid_value", undef,
- "WHERE factoid_value IS NOT NULL"
+ my %data = &sqlSelectColHash('factoids',
+ 'factoid_key,factoid_value', undef,
+ 'WHERE factoid_value IS NOT NULL'
);
my @list;
my $delta_time = &timedelta($start_time);
- &status(sprintf("factstats(vandalism): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
+ &status(sprintf('factstats(vandalism): %.02f sec to retreive all factoids.', $delta_time)) if ($delta_time > 0);
$start_time = &timeget();
# parse the factoids.
}
$delta_time = &timedelta($start_time);
- &status(sprintf("factstats(vandalism): %.02f sec to complete.", $delta_time)) if ($delta_time > 0);
+ &status(sprintf('factstats(vandalism): %.02f sec to complete.', $delta_time)) if ($delta_time > 0);
# bail out on no results.
if (scalar @list == 0) {
}
# parse the results.
- my $prefix = "Vandalised factoid ";
+ my $prefix = 'Vandalised factoid ';
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^total$/i) {
- &status("factstats(total): starting...");
+ &status('factstats(total): starting...');
my $start_time = &timeget();
my @list;
my $str;
### lets do it.
# total factoids requests.
- $i = &sumKey("factoids", "requested_count");
+ $i = &sumKey('factoids', 'requested_count');
push(@list, "total requests - $i");
# total factoids modified.
- $str = &countKeys("factoids", "modified_by");
+ $str = &countKeys('factoids', 'modified_by');
push(@list, "total modified - $str");
# total factoids modified.
- $j = &countKeys("factoids", "requested_count");
- $str = &countKeys("factoids", "factoid_key");
- push(@list, "total non-requested - ".($str - $i));
+ $j = &countKeys('factoids', 'requested_count');
+ $str = &countKeys('factoids', 'factoid_key');
+ push(@list, 'total non-requested - '.($str - $i));
# average request/factoid.
# i/j == total(requested_count)/count(requested_count)
- $str = sprintf("%.01f", $i/$j);
+ $str = sprintf('%.01f', $i/$j);
push(@list, "average requested per factoid - $str");
# total prepared for deletion.
- $str = scalar( &searchTable("factoids", "factoid_key", "factoid_value", " #DEL") );
+ $str = scalar( &searchTable('factoids', 'factoid_key', 'factoid_value', ' #DEL') );
push(@list, "total prepared for deletion - $str");
# total unique authors.
# TODO: convert to sqlSelectColHash ? (or ColArray?)
- foreach ( &sqlRawReturn("SELECT created_by FROM factoids WHERE created_by IS NOT NULL") ) {
+ foreach ( &sqlRawReturn('SELECT created_by FROM factoids WHERE created_by IS NOT NULL') ) {
/^(\S+)!/;
my $nick = lc $1;
$hash{$nick}++;
}
- push(@list, "total unique authors - ".(scalar keys %hash) );
+ push(@list, 'total unique authors - '.(scalar keys %hash) );
undef %hash;
# total unique requesters.
- foreach ( &sqlRawReturn("SELECT requested_by FROM factoids WHERE requested_by IS NOT NULL") ) {
+ foreach ( &sqlRawReturn('SELECT requested_by FROM factoids WHERE requested_by IS NOT NULL') ) {
/^(\S+)!/;
my $nick = lc $1;
$hash{$nick}++;
}
- push(@list, "total unique requesters - ".(scalar keys %hash) );
+ push(@list, 'total unique requesters - '.(scalar keys %hash) );
undef %hash;
- ### end of "job".
+ ### end of 'job'.
my $delta_time = &timedelta($start_time);
- &status(sprintf("factstats(broken): %.02f sec to retreive all factoids.", $delta_time)) if ($delta_time > 0);
+ &status(sprintf('factstats(broken): %.02f sec to retreive all factoids.', $delta_time)) if ($delta_time > 0);
$start_time = &timeget();
# bail out on no results.
}
# parse the results.
- my $prefix = "General factoid statistics ";
+ my $prefix = 'General factoid statistics ';
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^deadredir$/i) {
- my @list = &searchTable("factoids", "factoid_key",
- "factoid_value", "^<REPLY> see ");
+ my @list = &searchTable('factoids', 'factoid_key',
+ 'factoid_value', '^<REPLY> see ');
my %redir;
my $f;
for (@list) {
my $factoid = $_;
- my $val = &getFactInfo($factoid, "factoid_value");
+ my $val = &getFactInfo($factoid, 'factoid_value');
if ($val =~ /^<REPLY> ?see( also)? (.*?)\.?$/i) {
my $redirf = lc $2;
- my $redir = &getFactInfo($redirf, "factoid_value");
+ my $redir = &getFactInfo($redirf, 'factoid_value');
next if (defined $redir);
next if (length $val > 50);
}
# parse the results.
- my $prefix = "Loose link (dead) redirections in factoids ";
+ my $prefix = 'Loose link (dead) redirections in factoids ';
return &formListReply(1, $prefix, @newlist);
} elsif ($type =~ /^dup(licate|e)$/i) {
- &status("factstats(dupe): starting...");
+ &status('factstats(dupe): starting...');
my $start_time = &timeget();
- my %hash = &sqlSelectColHash("factoids",
- "factoid_key,factoid_value", undef,
- "WHERE factoid_value IS NOT NULL", 1
+ my %hash = &sqlSelectColHash('factoids',
+ 'factoid_key,factoid_value', undef,
+ 'WHERE factoid_value IS NOT NULL', 1
);
my $refs = 0;
my @list;
}
s/([\,\;]+)/\037$1\037/g;
- if ($_ eq "") {
- &WARN("dupe: _ = NULL. should never happen!.");
+ if ($_ eq '') {
+ &WARN('dupe: _ = NULL. should never happen!.');
next;
}
push(@sublist, $_);
next unless (scalar @sublist);
- push(@list, join(", ", @sublist));
+ push(@list, join(', ', @sublist));
}
&status("factstats(dupe): (good) dupe refs: $refs.");
my $delta_time = &timedelta($start_time);
- &status(sprintf("factstats(dupe): %.02f sec to complete", $delta_time)) if ($delta_time > 0);
+ &status(sprintf('factstats(dupe): %.02f sec to complete', $delta_time)) if ($delta_time > 0);
# bail out on no results.
if (scalar @list == 0) {
- return "no duplicate factoids... woohoo.";
+ return 'no duplicate factoids... woohoo.';
}
# parse the results.
- my $prefix = "dupe factoid ";
+ my $prefix = 'dupe factoid ';
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^nullfactoids$/i) {
my @list;
while (my @row = $sth->fetchrow_array) {
- if ($row[1] ne "") {
+ if ($row[1] ne '') {
&DEBUG("row[1] != NULL for $row[0].");
next;
}
$sth->finish;
# parse the results.
- my $prefix = "NULL factoids (not deleted yet) ";
+ my $prefix = 'NULL factoids (not deleted yet) ';
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^(2|too)short$/i) {
# Custom select statement.
- my $query = "SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) <= 40";
+ my $query = 'SELECT factoid_key,factoid_value FROM factoids WHERE length(factoid_value) <= 40';
my $sth = $dbh->prepare($query);
&ERROR("factstats(lame): => '$query'.") unless $sth->execute;
$sth->finish;
# parse the results.
- my $prefix = "Lame factoids ";
+ my $prefix = 'Lame factoids ';
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^listfix$/i) {
# Custom select statement.
- my $query = "SELECT factoid_key,factoid_value FROM factoids";
+ my $query = 'SELECT factoid_key,factoid_value FROM factoids';
my $sth = $dbh->prepare($query);
&ERROR("factstats(listfix): => '$query'.") unless $sth->execute;
push(@list, $key);
$val =~ s/,? or /, /g;
&DEBUG("fixed: => $val.");
- &setFactInfo($key,"factoid_value", $val);
+ &setFactInfo($key,'factoid_value', $val);
}
$sth->finish;
# parse the results.
- my $prefix = "Inefficient lists fixed ";
+ my $prefix = 'Inefficient lists fixed ';
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^locked$/i) {
- my %hash = &sqlSelectColHash("factoids",
- "factoid_key,locked_by", undef,
- "WHERE locked_by IS NOT NULL"
+ my %hash = &sqlSelectColHash('factoids',
+ 'factoid_key,locked_by', undef,
+ 'WHERE locked_by IS NOT NULL'
);
my @list = keys %hash;
return &formListReply(0, $prefix, @list);
} elsif ($type =~ /^new$/i) {
- my %hash = &sqlSelectColHash("factoids",
- "factoid_key,created_time", undef,
- "WHERE created_time IS NOT NULL"
+ my %hash = &sqlSelectColHash('factoids',
+ 'factoid_key,created_time', undef,
+ 'WHERE created_time IS NOT NULL'
);
my %age;
}
if (scalar keys %age == 0) {
- return "sorry, no new factoids.";
+ return 'sorry, no new factoids.';
}
my @list;
foreach (sort {$a <=> $b} keys %age) {
- push(@list, join(",", keys %{ $age{$_} }));
+ push(@list, join(',', keys %{ $age{$_} }));
}
- my $prefix = "new factoids in the last 24hours ";
+ my $prefix = 'new factoids in the last 24hours ';
return &formListReply(0, $prefix, @list);
} elsif ($type =~ /^part(ial)?dupe$/i) {
- ### requires "custom" select statement... oh well...
+ ### requires 'custom' select statement... oh well...
my $start_time = &timeget();
# form length|key and key=length hash list.
- &status("factstats(partdupe): forming length hash list.");
- my $query = "SELECT factoid_key,factoid_value,length(factoid_value) AS length FROM factoids WHERE length(factoid_value) >= 192 ORDER BY length";
+ &status('factstats(partdupe): forming length hash list.');
+ my $query = 'SELECT factoid_key,factoid_value,length(factoid_value) AS length FROM factoids WHERE length(factoid_value) >= 192 ORDER BY length';
my $sth = $dbh->prepare($query);
&ERROR("factstats(partdupe): => '$query'.") unless $sth->execute;
}
$sth->finish;
&status("factstats(partdupe): total keys => '". scalar(@key) ."'.");
- &status("factstats(partdupe): now deciphering data gathered");
+ &status('factstats(partdupe): now deciphering data gathered');
my @length = sort { $a <=> $b } keys %length;
my $key;
if ($key{$_} =~ /^$val/i) {
s/([\,\;]+)/\037$1\037/g;
s/( and|and )/\037$1\037/g;
- push(@sublist,$key." and ".$_);
+ push(@sublist,$key.' and '.$_);
}
}
}
- push(@list, join(" ,",@sublist)) if (scalar @sublist);
+ push(@list, join(' ,',@sublist)) if (scalar @sublist);
}
- my $delta_time = sprintf("%.02fs", &timedelta($start_time) );
+ my $delta_time = sprintf('%.02fs', &timedelta($start_time) );
&status("factstats(partdupe): $delta_time sec to complete.") if ($delta_time > 0);
# bail out on no results.
if (scalar @list == 0) {
- return "no initial partial duplicate factoids... woohoo.";
+ return 'no initial partial duplicate factoids... woohoo.';
}
# parse the results.
- my $prefix = "initial partial dupe factoid ";
+ my $prefix = 'initial partial dupe factoid ';
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^profanity$/i) {
- my %data = &sqlSelectColHash("factoids",
- "factoid_key,factoid_value", undef,
- "WHERE factoid_value IS NOT NULL"
+ my %data = &sqlSelectColHash('factoids',
+ 'factoid_key,factoid_value', undef,
+ 'WHERE factoid_value IS NOT NULL'
);
my @list;
foreach (keys %data) {
- push(@list, $_) if (&hasProfanity($_." ".$data{$_}));
+ push(@list, $_) if (&hasProfanity($_.' '.$data{$_}));
}
# parse the results.
- my $prefix = "Profanity in factoids ";
+ my $prefix = 'Profanity in factoids ';
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^redir(ection)?$/i) {
- my @list = &searchTable("factoids", "factoid_key",
- "factoid_value", "^<REPLY> see ");
+ my @list = &searchTable('factoids', 'factoid_key',
+ 'factoid_value', '^<REPLY> see ');
my %redir;
my $f;
my $dangling = 0;
for (@list) {
my $factoid = $_;
- my $val = &getFactInfo($factoid, "factoid_value");
+ my $val = &getFactInfo($factoid, 'factoid_value');
if ($val =~ /^<REPLY> see( also)? (.*?)\.?$/i) {
my $redir = lc $2;
- my $redirval = &getFactInfo($redir, "factoid_value");
+ my $redirval = &getFactInfo($redir, 'factoid_value');
if (defined $redirval) {
$redir{$redir}{$factoid} = 1;
} else {
return &formListReply(1, $prefix, @newlist);
} elsif ($type =~ /^request(ed)?$/i) {
- my %hash = &sqlSelectColHash("factoids",
- "factoid_key,requested_count", undef,
- "WHERE requested_count IS NOT NULL", 1
+ my %hash = &sqlSelectColHash('factoids',
+ 'factoid_key,requested_count', undef,
+ 'WHERE requested_count IS NOT NULL', 1
);
if (!scalar keys %hash) {
}
$total += $count * scalar(@faqtoids);
- push(@list, "$count - ". join(", ", @faqtoids));
+ push(@list, "$count - ". join(', ', @faqtoids));
}
unshift(@list, "\037$total - TOTAL\037");
return &formListReply(0, $prefix, @list);
} elsif ($type =~ /^reqrate$/i) {
- my %hash = &sqlSelectColHash("factoids",
+ my %hash = &sqlSelectColHash('factoids',
"factoid_key,(unix_timestamp() - created_time)/requested_count as rate", undef,
- "WHERE requested_by IS NOT NULL and created_time IS NOT NULL ORDER BY rate LIMIT 15", 1
+ 'WHERE requested_by IS NOT NULL and created_time IS NOT NULL ORDER BY rate LIMIT 15', 1
);
my $rate;
my $total = 0;
my $users = 0;
foreach $rate (sort { $b <=> $a } keys %hash) {
- my $f = join(", ", sort keys %{ $hash{$rate} });
+ my $f = join(', ', sort keys %{ $hash{$rate} });
my $str = "$f - ".&Time2String($rate);
$str =~ s/\002//g;
push(@list, $str);
return &formListReply(0, $prefix, @list);
} elsif ($type =~ /^requesters?$/i) {
- my %hash = &sqlSelectColHash("factoids",
- "factoid_key,requested_by", undef,
- "WHERE requested_by IS NOT NULL"
+ my %hash = &sqlSelectColHash('factoids',
+ 'factoid_key,requested_by', undef,
+ 'WHERE requested_by IS NOT NULL'
);
my %requester;
my $total = 0;
my $users = 0;
foreach $count (sort { $b <=> $a } keys %count) {
- my $requester = join(", ", sort keys %{ $count{$count} });
+ my $requester = join(', ', sort keys %{ $count{$count} });
$total += $count * scalar(keys %{ $count{$count} });
$users += scalar(keys %{ $count{$count} });
push(@list, "$count by $requester");
# should not the above value be the same as collected by
# 'requested'? soemthing weird is going on!
- my $prefix = "rank of top factoid requesters: ";
+ my $prefix = 'rank of top factoid requesters: ';
return &formListReply(0, $prefix, @list);
} elsif ($type =~ /^seefix$/i) {
- my @list = &searchTable("factoids", "factoid_key",
- "factoid_value", "^see ");
+ my @list = &searchTable('factoids', 'factoid_key',
+ 'factoid_value', '^see ');
my @newlist;
my $fixed = 0;
my %loop;
for (@list) {
my $factoid = $_;
- my $val = &getFactInfo($factoid, "factoid_value");
+ my $val = &getFactInfo($factoid, 'factoid_value');
next unless ($val =~ /^see( also)? (.*?)\.?$/i);
my $redirf = lc $2;
- my $redir = &getFactInfo($redirf, "factoid_value");
+ my $redir = &getFactInfo($redirf, 'factoid_value');
if ($redirf =~ /^\Q$factoid\W$/i) {
&delFactoid($factoid);
}
if (defined $redir) { # good.
- &setFactInfo($factoid,"factoid_value","<REPLY> see $redir");
+ &setFactInfo($factoid,'factoid_value',"<REPLY> see $redir");
$fixed++;
} else {
push(@newlist, $redirf);
# parse the results.
&msg($who, "Fixed $fixed factoids.");
- &msg($who, "Self looped factoids removed: ". keys %loop ) if (scalar keys %loop);
+ &msg($who, 'Self looped factoids removed: '. keys %loop ) if (scalar keys %loop);
my $prefix = "Loose link (dead) redirections in factoids ";
return &formListReply(1, $prefix, @newlist);
$sth->finish;
if (scalar @list == 0) {
- return "good. no factoids exceed length.";
+ return 'good. no factoids exceed length.';
}
# parse the results.
- my $prefix = "factoid key||value exceeding length ";
+ my $prefix = 'factoid key||value exceeding length ';
return &formListReply(1, $prefix, @list);
} elsif ($type =~ /^unrequest(ed)?$/i) {
sub CmdListAuth {
my ($query) = @_;
my $maxshow = &::getChanConfDefault('maxListReplyCount', 15, $chan);
- my @list = &searchTable("factoids","factoid_key", "created_by", "^$query!");
+ my @list = &searchTable('factoids','factoid_key', 'created_by', "^$query!");
@list=grep(!/\#DEL\#$/,@list) if (scalar(@list) > $maxshow);
my $prefix = "factoid author list by '$query' ";
$s->write_request(HEAD => "/");
my $sel = IO::Select->new($s);
- $line = "Header timeout" unless $sel->can_read(10);
+ $line = 'Header timeout' unless $sel->can_read(10);
($code, $mess, %h) = $s->read_response_headers;
$line = (length($h{Server}) > 0) ? $h{Server} :
"Couldn't fetch headers from $HOST";
- &::performStrictReply($line||"Unknown Error Condition");
+ &::performStrictReply($line||'Unknown Error Condition');
}
1;
}
sub Kernel {
- my $retval = "Linux kernel versions";
+ my $retval = 'Linux kernel versions';
my @now = &kernelGetInfo();
if (!scalar @now) {
&::msg($::who, "failed.");
$line =~ s/ for 2.4//;
$line =~ s/ for 2.2//;
$line =~ s/ is: */: /;
- $retval .= ", " . $line;
+ $retval .= ', ' . $line;
}
&::performStrictReply($retval);
}
my @old;
if (!scalar @now) {
- &::DEBUG("kA: failure to retrieve.");
+ &::DEBUG('kA: failure to retrieve.');
return;
}
use vars qw($message);
my %digits = (
- "first", "1",
- "second", "2",
- "third", "3",
- "fourth", "4",
- "fifth", "5",
- "sixth", "6",
- "seventh", "7",
- "eighth", "8",
- "ninth", "9",
- "tenth", "10",
- "one", "1",
- "two", "2",
- "three", "3",
- "four", "4",
- "five", "5",
- "six", "6",
- "seven", "7",
- "eight", "8",
- "nine", "9",
- "ten", "10"
+ 'first', '1',
+ 'second', '2',
+ 'third', '3',
+ 'fourth', '4',
+ 'fifth', '5',
+ 'sixth', '6',
+ 'seventh', '7',
+ 'eighth', '8',
+ 'ninth', '9',
+ 'tenth', '10',
+ 'one', '1',
+ 'two', '2',
+ 'three', '3',
+ 'four', '4',
+ 'five', '5',
+ 'six', '6',
+ 'seven', '7',
+ 'eight', '8',
+ 'nine', '9',
+ 'ten', '10'
);
sub perlMath {
while ($locMsg =~ /(log\s*((\d+\.?\d*)|\d*\.?\d+))\s*/) {
my ($exp, $res) = ($1, $2);
- my $val = ($res) ? log($res) : "Infinity";
+ my $val = ($res) ? log($res) : 'Infinity';
$locMsg =~ s/$exp/+$val/g;
}
while ($locMsg =~ /(bin2dec ([01]+))/) {
my $exp = $1;
- my $val = join ("", unpack("B*",$2)) ;
+ my $val = join ('', unpack('B*',$2)) ;
$locMsg =~ s/$exp/+$val/g;
}
&FIXME("math: locMsg => '$locMsg'...");
} else {
&status("math: could not really compute.");
- $locMsg = "";
+ $locMsg = '';
}
}
} else {
- $locMsg = "";
+ $locMsg = '';
}
if (defined $locMsg and $locMsg ne $message) {
&readNews();
}
- if ($::msgType ne "private") {
+ if ($::msgType ne 'private') {
$chan = $::chan;
}
} elsif ($what =~ /^(un)?notify$/i) {
my $state = ($1) ? 0 : 1;
- # TODO: don't notify even if "News" is called.
- if (&::IsChanConf("newsNotifyAll") <= 0) {
+ # TODO: don't notify even if 'News' is called.
+ if (&::IsChanConf('newsNotifyAll') <= 0) {
&::DEBUG("news: chan => $chan, ::chan => $::chan.");
&::notice($who, "not available for this channel or disabled altogether.");
return;
} else { # state = 0
my $x = $::newsuser{$chan}{$who};
if (defined $x and ($x == 0 or $x == -1)) {
- &::notice($who, "notify already disabled");
+ &::notice($who, 'notify already disabled');
return;
}
$::newsuser{$chan}{$who} = -1;
return unless ($ci or $cn or $cu);
&::status("News: read ".
- $ci. &::fixPlural(" item", $ci). " for ".
- $cn. &::fixPlural(" chan", $cn). ", ".
- $cu. &::fixPlural(" user", $cu), " cache"
+ $ci. &::fixPlural(' item', $ci). ' for '.
+ $cn. &::fixPlural(' chan', $cn). ', '.
+ $cu. &::fixPlural(' user', $cu), ' cache'
);
}
}
# TODO: show how many users we wrote down.
- if (&::getChanConfList("newsKeepRead")) {
+ if (&::getChanConfList('newsKeepRead')) {
# old users are removed in newsFlush(), perhaps it should be
# done here.
my($str) = @_;
if (!defined $chan or !defined $str or $str =~ /^\s*$/) {
- &::help("news add");
+ &::help('news add');
return;
}
}
$::news{$chan}{$str}{Time} = time();
- my $expire = &::getChanConfDefault("newsDefaultExpire",7, $chan);
+ my $expire = &::getChanConfDefault('newsDefaultExpire',7, $chan);
$::news{$chan}{$str}{Expire} = time() + $expire*60*60*24;
$::news{$chan}{$str}{Author} = $::who; # case!
my $item = 0;
if (!defined $what) {
- &::help("news del");
+ &::help('news del');
return;
}
if (exists $::news{$chan}{$what}) {
my $auth = 0;
$auth++ if ($::who eq $::news{$chan}{$what}{Author});
- $auth++ if (&::IsFlag("o"));
+ $auth++ if (&::IsFlag('o'));
if (!$auth) {
# TODO: show when it'll expire.
return;
}
- if (&::IsChanConf("newsKeepRead") > 0) {
+ if (&::IsChanConf('newsKeepRead') > 0) {
my $x = $::newsuser{$chan}{$who};
if (defined $x and ($x == 0 or $x == -1)) {
}
my $timestr = &::Time2String(time() - $newest);
&::msg($who, "|= Last updated $timestr ago.");
- &::msg($who, " \037Num\037 \037Item ".(" "x40)." \037");
+ &::msg($who, " \037Num\037 \037Item ".(' 'x40)." \037");
# &::DEBUG("news: list: expire = $expire");
# &::DEBUG("news: list: eno = $eno");
foreach ( &getNewsAll() ) {
my $subtopic = $_;
my $setby = $::news{$chan}{$subtopic}{Author};
- my $chr = (exists $::News{$chan}{$subtopic}{Text}) ? "" : "*";
+ my $chr = (exists $::News{$chan}{$subtopic}{Text}) ? '' : '*';
if (!defined $subtopic) {
&::DEBUG("news: warn: subtopic == undef.");
my($str) = @_;
if (!defined $chan or !defined $str or $str =~ /^\s*$/) {
- &::help("news read");
+ &::help('news read');
return;
}
}
if (!exists $::news{$chan}{$item}{Text}) {
- &::notice($who, "Someone forgot to add info to this news item");
+ &::notice($who, 'Someone forgot to add info to this news item');
return;
}
sub mod {
my($item, $str) = split /\s+/, $_[0], 2;
- if (!defined $item or $item eq "" or $str =~ /^\s*$/) {
- &::help("news mod");
+ if (!defined $item or $item eq '' or $str =~ /^\s*$/) {
+ &::help('news mod');
return;
}
# TODO: make code safer.
my $done = 0;
# TODO: use eval to deal with flags easily.
- if ($flags eq "") {
+ if ($flags eq '') {
$done++ if (!$done and $mod_news =~ s/\Q$op\E/$np/);
$done++ if (!$done and $mod_nnews =~ s/\Q$op\E/$np/);
- } elsif ($flags eq "g") {
+ } elsif ($flags eq 'g') {
$done++ if ($mod_news =~ s/\Q$op\E/$np/g);
$done++ if ($mod_nnews =~ s/\Q$op\E/$np/g);
}
$what = $1 if ($args =~ s/^(\S+)\s*//);
$value = $args;
- if ($item eq "") {
- &::help("news set");
+ if ($item eq '') {
+ &::help('news set');
return;
}
}
my $ok = 0;
- my @elements = ("Expire","Text");
+ my @elements = ('Expire','Text');
foreach (@elements) {
next unless ($what =~ /^$_$/i);
$what = $_;
return;
}
- if ($what eq "Expire") {
+ if ($what eq 'Expire') {
# TODO: use do_set().
my $time = 0;
# &::DEBUG("news: who => '$who'");
my $author = $::news{$chan}{$news}{Author};
$auth++ if ($::who eq $author);
- $auth++ if (&::IsFlag("o"));
+ $auth++ if (&::IsFlag('o'));
if (!defined $author) {
&::DEBUG("news: news{$chan}{$news}{Author} is not defined! auth'd anyway");
$::news{$chan}{$news}{Author} = $::who;
}
$::chan = $chan;
- return if (&::IsChanConf("newsNotifyAll") <= 0);
+ return if (&::IsChanConf('newsNotifyAll') <= 0);
# I don't understand this code ;)
$t = 1 if (!defined $t);
# scalar @new, !$flag
my $unread = scalar @new;
my $total = scalar keys %{ $::news{$chan} };
- if (!$flag && &::IsChanConf("newsTellUnread") <= 0) {
+ if (!$flag && &::IsChanConf('newsTellUnread') <= 0) {
return;
}
&sqlDelete('onjoin', { nick => $nick, channel => $ch });
my $insert = &sqlInsert('onjoin', { nick => $nick, channel => $ch, message => $msg, modified_by => $who, modified_time => time() });
if ($insert){
- &performReply("ok");
+ &performReply('ok');
}
else{
&performReply('whoops. database error');
my $retval = "i could not get the headlines.";
if (scalar @results) {
- my $prefix = "Plug Headlines ";
+ my $prefix = 'Plug Headlines ';
my @list = &plugParse(@results);
$retval = &::formListReply(0, $prefix, @list);
}
sub Quote {
my $stock = shift;
- my @results = &::getURL("http://quote.yahoo.com/d/quotes.csv" .
+ my @results = &::getURL('http://quote.yahoo.com/d/quotes.csv' .
"?s=$stock&f=sl1d1t1c1ohgv&e=.csv");
"Opened $open, Volume $newvol, Change $change";
}
- if ($reply eq "") {
+ if ($reply eq '') {
$reply = "i couldn't get the quote for $stock. sorry. :(";
}
&status('RootWarn: Detected root user; notifying user');
} else {
&status('RootWarn: Detected root user; notifying nick and channel.');
- &msg($chan, "ROO".("O" x int(rand 8))."T has landed!");
+ &msg($chan, 'ROO'.('O' x int(rand 8))."T has landed!");
}
if ($_ = &getFactoid('root')) {
$attempt++;
### TODO: OPTIMIZE THIS.
# ok... don't record the attempt if nick==root.
- return if ($nick eq "root");
+ return if ($nick eq 'root');
&sqlSet('rootwarn', { nick => lc($nick) }, {
attempt => $attempt,
}
# reply #1.
- $reply = "there ".&fixPlural("has",$count) ." been \002$count\002 ".
- &fixPlural("rooter",$count) ." warned about root.";
+ $reply = 'there '.&fixPlural('has',$count) ." been \002$count\002 ".
+ &fixPlural('rooter',$count) ." warned about root.";
if ($param{'DBType'} !~ /^(pg|my)sql$/i) {
&FIXME("rootwarn does not yet support non-{my,pg}sql.");
if ($found) {
$reply .= " Of which, \002$found\002 ".
- &fixPlural("rooter",$found)." ".
- &fixPlural("has",$found).
+ &fixPlural('rooter',$found).' '.
+ &fixPlural('has',$found).
" done it at least 3 times.";
}
$type =~ s/s$//; # nice work-around.
- if ($type eq "value") {
+ if ($type eq 'value') {
# search by value.
- @list = &::searchTable("factoids", "factoid_key", "factoid_value", $str);
+ @list = &::searchTable('factoids', 'factoid_key', 'factoid_value', $str);
} else {
# search by key.
- @list = &::searchTable("factoids", "factoid_key", "factoid_key", $str);
+ @list = &::searchTable('factoids', 'factoid_key', 'factoid_key', $str);
}
@list=grep(!/\#DEL\#$/,@list) if (scalar(@list) > $maxshow);
}
my $subtopic = $_;
- my $owner = "Unknown";
+ my $owner = 'Unknown';
if (/(.*)\s+\((.*?)\)$/) {
$subtopic = $1;
foreach (@_) {
my ($subtopic, $setby) = split /\|\|/;
- if ($param{'topicAuthor'} eq "1" and (!$setby =~ /^(unknown|)$/i)) {
+ if ($param{'topicAuthor'} eq '1' and (!$setby =~ /^(unknown|)$/i)) {
push(@topic, "$subtopic ($setby)");
} else {
push(@topic, "$subtopic");
return 1;
}
- if (defined $updateMsg && $updateMsg ne "") {
+ if (defined $updateMsg && $updateMsg ne '') {
&msg($who, $updateMsg);
}
$conn->topic($chan, $topic);
&topicAddHistory($chan, $topic);
} else {
- $conn->topic($chan, " ");
+ $conn->topic($chan, ' ');
}
return 1;
my ($chan, $topic) = @_;
my $dupe = 0;
- return 1 if ($topic eq ""); # required fix.
+ return 1 if ($topic eq ''); # required fix.
foreach (@{ $topic{$chan}{'History'} }) {
- next if ($_ ne "" and $_ ne $topic);
+ next if ($_ ne '' and $_ ne $topic);
# checking length is required.
# slightly weird to put a return statement in a loop.
sub do_add {
my ($chan, $args) = @_;
- if ($args eq "") {
- &help("topic add");
+ if ($args eq '') {
+ &help('topic add');
return;
}
# heh, joeyh. 19990819. -xk
if ($who =~ /\|\|/) {
- &msg($who, "error: you have an invalid nick, loser!");
+ &msg($who, 'error: you have an invalid nick, loser!');
return;
}
- return if ($channels{$chan}{t} and !&hasFlag("T"));
+ return if ($channels{$chan}{t} and !&hasFlag('T'));
my @prev = &topicDecipher($chan);
my $new;
# If bot new to chan and topic is blank, it still got a (owner). This is fix
- if ($param{'topicAuthor'} eq "1") {
- $new = "$args ($orig{who})";
+ if ($param{'topicAuthor'} eq '1') {
+ $new = "$args ($orig{who})";
} else {
$new = "$args";
}
$new = &topicCipher(@prev, $str);
}
- &topicNew($chan, $new, "");
+ &topicNew($chan, $new, '');
}
# cmd: delete.
my $topiccount = scalar @subtopics;
if ($topiccount == 0) {
- &msg($who, "No topic set.");
+ &msg($who, 'No topic set.');
return;
}
- if ($args eq "") {
- &help("topic del");
+ if ($args eq '') {
+ &help('topic del');
return;
}
}
my @delete;
- foreach (split ",", $args) {
- next if ($_ eq "");
+ foreach (split ',', $args) {
+ next if ($_ eq '');
# change to hash list instead of array?
if (/^(\d+)-(\d+)$/) {
return;
}
- $topic{$chan}{'What'} = "Deleted ".join("/",@delete);
+ $topic{$chan}{'What'} = 'Deleted '.join("/",@delete);
}
foreach (@delete) {
my ($subtopic,$whoby) = split('\|\|', $subtopics[$_-1]);
- $whoby = "unknown" if ($whoby eq "");
+ $whoby = 'unknown' if ($whoby eq '');
&msg($who, "Deleting topic: $subtopic ($whoby)");
undef $subtopics[$_-1];
push(@newtopics, $_);
}
- &topicNew($chan, &topicCipher(@newtopics), "");
+ &topicNew($chan, &topicCipher(@newtopics), '');
}
# cmd: list
sub do_modify {
my ($chan, $args) = @_;
- if ($args eq "") {
- &help("topic mod");
+ if ($args eq '') {
+ &help('topic mod');
return;
}
my $topic = $topic{$chan}{'Current'};
### 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/)
+ 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/.";
sub do_move {
my ($chan, $args) = @_;
- if ($args eq "") {
- &help("topic mv");
+ if ($args eq '') {
+ &help('topic mv');
return;
}
undef @subtopics; # lets reuse this array.
foreach (@newtopics) {
- next if (!defined $_ or $_ eq "");
+ next if (!defined $_ or $_ eq '');
push(@subtopics, $_);
}
my @subtopics = &topicDecipher($chan);
my @newtopics;
- $topic{$chan}{'What'} = "shuffled";
+ $topic{$chan}{'What'} = 'shuffled';
foreach (&makeRandom(scalar @subtopics)) {
push(@newtopics, $subtopics[$_]);
sub do_restore {
my ($chan, $args) = @_;
- if ($args eq "") {
- &help("topic restore");
+ if ($args eq '') {
+ &help('topic restore');
return;
}
my ($chan) = @_;
$_ = "Rehashing topic...";
- $topic{$chan}{'What'} = "Rehash";
+ $topic{$chan}{'What'} = 'Rehash';
&topicNew($chan, $topic{$chan}{'Current'}, $_, 1);
}
if (exists $topic{$chan}{'Who'} and exists $topic{$chan}{'Time'}) {
$reply = "topic on \002$chan\002 was last set by ".
$topic{$chan}{'Who'}. ". This was done ".
- &Time2String(time() - $topic{$chan}{'Time'}) ." ago".
+ &Time2String(time() - $topic{$chan}{'Time'}) .' ago'.
". Length: ".length($topic{$chan}{'Current'});
my $change = $topic{$chan}{'What'};
$reply .= ". Change => $change" if (defined $change);
} else {
### HELP:
- if ($cmd ne "" and $cmd !~ /^help/i) {
+ if ($cmd ne '' and $cmd !~ /^help/i) {
&msg($who, "Invalid command [$cmd].");
&msg($who, "Try 'help topic'.");
return;
}
- &help("topic");
+ &help('topic');
}
return;
$defs_read += read_defs("$::bot_data_dir/unittab");
unless ($defs_read) {
- &::ERROR("Could not read any of the initialization files UNITTAB");
+ &::ERROR('Could not read any of the initialization files UNITTAB');
return;
}
}
return;
}
unless ($from =~ /\S/) {
- &::DEBUG("FAILURE 2");
+ &::DEBUG('FAILURE 2');
return;
}
# print
# "conformability (Not the same dimension)\n",
-# "\t", $from, " is ", text_unit($hu), "\n",
-# "\t", $to, " is ", text_unit($wu), "\n",
+# "\t", $from, ' is ', text_unit($hu), "\n",
+# "\t", $to, ' is ', text_unit($wu), "\n",
# ;
}
}
sub unit_divide {
my ($a, $b) = @_;
if ($b->{_} == 0) {
- &::DEBUG("Division by zero error");
+ &::DEBUG('Division by zero error');
return;
}
my $r = {%$a};
}
close OUT;
- &status("--- Saved uptime records.");
+ &status('--- Saved uptime records.');
return unless defined $conn;
- $conn->schedule(&getRandomInt("1800-3600"), \&uptimeWriteFile, "");
+ $conn->schedule(&getRandomInt('1800-3600'), \&uptimeWriteFile, '');
}
1;
if ($message =~ /^tellme(\s+(.*))?$/i) {
my $args = $2;
if ($args =~ /^\s*$/) {
- &help("tellme");
+ &help('tellme');
return;
}
# 4op.
if ($message =~ /^4op(\s+($mask{chan}))?$/i) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
my $chan = $2;
- if ($chan eq "") {
- &help("4op");
+ if ($chan eq '') {
+ &help('4op');
return;
}
# opme.
if ($message =~ /^opme(\s+($mask{chan}))?$/i) {
- return unless (&hasFlag("o"));
- return unless (&hasFlag("A"));
+ return unless (&hasFlag('o'));
+ return unless (&hasFlag('A'));
my $chan = $2;
- if ($chan eq "") {
- &help("4op");
+ if ($chan eq '') {
+ &help('4op');
return;
}
# backlog.
if ($message =~ /^backlog(\s+(.*))?$/i) {
- return unless (&hasFlag("o"));
- return unless (&IsParam("backlog"));
+ return unless (&hasFlag('o'));
+ return unless (&IsParam('backlog'));
my $num = $2;
my $max = $param{'backlog'};
if (!defined $num) {
- &help("backlog");
+ &help('backlog');
return;
} elsif ($num !~ /^\d+/) {
&msg($who, "error: argument is not positive integer.");
# dump variables.
if ($message =~ /^dumpvars$/i) {
- return unless (&hasFlag("o"));
- return unless (&IsParam("DumpVars"));
+ return unless (&hasFlag('o'));
+ return unless (&IsParam('DumpVars'));
&status("Dumping all variables...");
&dumpallvars();
# kick.
if ($message =~ /^kick(\s+(.*?))$/) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
my $arg = $2;
- if ($arg eq "") {
- &help("kick");
+ if ($arg eq '') {
+ &help('kick');
return;
}
my @args = split(/\s+/, $arg);
# mode.
if ($message =~ /^mode(\s+(.*))?$/) {
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
my ($chan,$mode) = split /\s+/,$2,2;
- if ($chan eq "") {
- &help("mode");
+ if ($chan eq '') {
+ &help('mode');
return;
}
# part.
if ($message =~ /^part(\s+(\S+))?$/i) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
my $jchan = $2;
if ($jchan !~ /^$mask{chan}$/) {
&msg($who, "error, invalid chan.");
- &help("part");
+ &help('part');
return;
}
# lobotomy. sometimes we want the bot to be _QUIET_.
if ($message =~ /^(lobotomy|bequiet)$/i) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
if ($lobotomized) {
&performReply("i'm already lobotomized");
} else {
- &performReply("i have been lobotomized");
+ &performReply('i have been lobotomized');
$lobotomized = 1;
}
# unlobotomy.
if ($message =~ /^(unlobotomy|benoisy)$/i) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
if ($lobotomized) {
- &performReply("i have been unlobotomized, woohoo");
+ &performReply('i have been unlobotomized, woohoo');
$lobotomized = 0;
delete $cache{lobotomy};
# undef $cache{lobotomy}; # ??
# op.
if ($message =~ /^op(\s+(.*))?$/i) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
my ($opee) = lc $2;
my @chans;
# deop.
if ($message =~ /^deop(\s+(.*))?$/i) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
my ($opee) = lc $2;
my @chans;
# say.
if ($message =~ s/^say\s+(\S+)\s+(.*)//) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
my ($chan,$msg) = (lc $1, $2);
&DEBUG("chan => '$1', msg => '$msg'.");
# do.
if ($message =~ s/^do\s+(\S+)\s+(.*)//) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
my ($chan,$msg) = (lc $1, $2);
&DEBUG("chan => '$1', msg => '$msg'.");
# die.
if ($message =~ /^die$/) {
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
&doExit();
# global factoid substitution.
if ($message =~ m|^\* =~ s([/,#])(.+?)\1(.*?)\1;?\s*$|) {
my ($delim,$op,$np) = ($1, $2, $3);
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
### TODO: support flags to do full-on global.
# incorrect format.
### TODO: fix up $op to support mysql/sqlite/pgsql
### TODO: => add db/sql specific function to fix this.
- my @list = &searchTable("factoids", "factoid_key",
- "factoid_value", $op);
+ my @list = &searchTable('factoids', 'factoid_key',
+ 'factoid_value', $op);
if (!scalar @list) {
&performReply("Expression didn't match anything.");
}
&status("gsubst: going to alter ".scalar(@list)." factoids.");
- &performReply("going to alter ".scalar(@list)." factoids.");
+ &performReply('going to alter '.scalar(@list)." factoids.");
my $error = 0;
foreach (@list) {
&performReply("that's too long (or was long)");
return;
}
- &setFactInfo($faqtoid, "factoid_value", $result);
+ &setFactInfo($faqtoid, 'factoid_value', $result);
&status("update: '$faqtoid' =is=> '$result'; was '$was'");
} else {
&WARN("subst: that's weird... thought we found the string ($op) in '$faqtoid'.");
}
&performReply("Ok... did s/$op/$np/ for ".
- (scalar(@list) - $error)." factoids");
+ (scalar(@list) - $error).' factoids');
return;
}
# jump.
if ($message =~ /^jump(\s+(\S+))?$/i) {
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
- if ($2 eq "") {
- &help("jump");
+ if ($2 eq '') {
+ &help('jump');
return;
}
# reload.
if ($message =~ /^reload$/i) {
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
&status("USER reload $who");
&performStrictReply("reloading...");
# reset.
if ($message =~ /^reset$/i) {
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
&msg($who,"resetting...");
my @done;
push(@done, $_);
sleep 1;
}
- &DEBUG("before clearircvars");
+ &DEBUG('before clearircvars');
&clearIRCVars();
- &DEBUG("before joinnextchan");
+ &DEBUG('before joinnextchan');
&joinNextChan();
- &DEBUG("after joinnextchan");
+ &DEBUG('after joinnextchan');
&status("USER reset $who");
- &msg($who,"reset complete");
+ &msg($who,'reset complete');
return;
}
# rehash.
if ($message =~ /^rehash$/) {
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
&msg($who,"rehashing...");
- &restart("REHASH");
+ &restart('REHASH');
&status("USER rehash $who");
- &msg($who,"rehashed");
+ &msg($who,'rehashed');
return;
}
my @args = split /[\s\t]+/, $2; # hrm.
if (scalar @args != 1) {
- &help("chaninfo");
+ &help('chaninfo');
return;
}
}
if (!scalar @chans) {
- push(@chans, "_default");
+ push(@chans, '_default');
$no_chan = 1;
}
my($what,$val) = split /[\s\t]+/, $args, 2;
### TODO: "cannot set values without +m".
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
# READ ONLY.
if (defined $what and $what !~ /^[-+]/ and !defined $val and $no_chan) {
}
### TODO: move to UserDCC again.
- if ($cmd eq "chanset" and !defined $what) {
+ if ($cmd eq 'chanset' and !defined $what) {
&DEBUG("showing channel conf.");
foreach $chan (@chans) {
if ($chan eq '_default') {
- &performStrictReply("Default channel settings");
+ &performStrictReply('Default channel settings');
} else {
&performStrictReply("chan: $chan (see _default also)");
}
my @items;
- my $str = "";
+ my $str = '';
foreach (sort keys %{ $chanconf{$chan} }) {
my $newstr = join(', ', @items);
### TODO: make length use channel line limit?
}
if ($message =~ /^(chanunset|\-chan)(\s+(.*))?$/) {
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
my $args = $3;
my $no_chan = 0;
if (!defined $args) {
- &help("chanunset");
+ &help('chanunset');
return;
}
$delete = ($1) ? 1 : 0;
} else {
&VERB("no chan arg; setting to default.",2);
- $chan = "_default";
+ $chan = '_default';
$no_chan = 1;
}
return;
}
- if ($args ne "") {
+ if ($args ne '') {
if (!&getChanConf($args,$chan)) {
&performStrictReply("$args does not exist for $chan");
my @chans = &ChanConfList($args);
&DEBUG("scalar chans => ".scalar(@chans) );
- if (scalar @chans == 1 and $chans[0] eq "_default" and !$no_chan) {
+ if (scalar @chans == 1 and $chans[0] eq '_default' and !$no_chan) {
&performStrictReply("ok, $args was set only for _default; unsetting for _defaul but setting for other chans.");
my $val = $chanconf{$_}{_default};
my(@args) = split /[\s\t]+/, $2 || '';
if (scalar @args != 1) {
- &help("newpass");
+ &help('newpass');
return;
}
my(@args) = split /[\s\t]+/, $2 || '';
if (!scalar @args) {
- &help("chpass");
+ &help('chpass');
return;
}
if (scalar @args == 1) {
# del pass.
- if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
+ if (!&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i) {
&performStrictReply("cannot remove passwd of others.");
return;
}
my(@args) = split /[\s\t]+/, $2 || '';
if (!scalar @args) {
- &help("chattr");
+ &help('chattr');
return;
}
&DEBUG("who => $who");
&DEBUG("verifyUser => $verifyUser");
- if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
+ if (!&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i) {
&performStrictReply("cannto change attributes of others.");
- return "REPLY";
+ return 'REPLY';
}
my $state;
next if ($flags =~ /\Q$_\E/);
$flags .= $_;
} else {
- if (&IsParam("owner")
+ if (&IsParam('owner')
and $param{owner} =~ /^\Q$user\E$/i
and $flags =~ /[nmo]/
) {
if ($message =~ /^chnick(\s+(.*))?$/) {
my(@args) = split /[\s\t]+/, $2 || '';
- if ($who eq "_default") {
+ if ($who eq '_default') {
&WARN("$who or verifyuser tried to run chnick.");
- return "REPLY";
+ return 'REPLY';
}
if (!scalar @args or scalar @args > 2) {
- &help("chnick");
+ &help('chnick');
return;
}
return;
}
- if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
+ if (!&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i) {
&performStrictReply("cannto change nick of others.");
- return "REPLY" if ($who eq "_default");
+ return 'REPLY' if ($who eq '_default');
return;
}
}
if ($message =~ /^([-+])host(\s+(.*))?$/) {
- my $cmd = $1."host";
+ my $cmd = $1.'host';
my(@args) = split /[\s\t]+/, $3 || '';
my $state = ($1 eq "+") ? 1 : 0;
return;
}
- if ($who eq "_default") {
+ if ($who eq '_default') {
&WARN("$who or verifyuser tried to run $cmd.");
- return "REPLY";
+ return 'REPLY';
}
my ($user,$mask);
if ($args[0] =~ /^$mask{nick}$/i) { # <nick>
- return unless (&hasFlag("n"));
+ return unless (&hasFlag('n'));
$user = &getUser($args[0]);
$mask = $args[1];
} else { # <mask>
}
if (!defined $mask) {
- &performStrictReply("Hostmasks for $user: " . join(" ", keys %{$users{$user}{HOSTS}}));
+ &performStrictReply("Hostmasks for $user: " . join(' ', keys %{$users{$user}{HOSTS}}));
return;
}
- if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
+ if (!&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i) {
&performStrictReply("cannto change masks of others.");
return;
}
}
if ($message =~ /^([-+])ban(\s+(.*))?$/) {
- my $cmd = $1."ban";
+ my $cmd = $1.'ban';
my $flatarg = $3;
my(@args) = split /[\s\t]+/, $3 || '';
my $state = ($1 eq "+") ? 1 : 0;
if ($flatarg =~ s/^($mask{chan})\s*//) {
$chan = $1;
} else {
- $chan = "*"; # _default instead?
+ $chan = '*'; # _default instead?
}
if ($state == 0) { # delete.
$reason = $1;
}
- if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
+ if (!&IsFlag('n') and $who !~ /^\Q$verifyUser\E$/i) {
&performStrictReply("cannto change masks of others.");
return;
}
my $arg = $2;
if (!defined $arg) {
- &help("whois");
+ &help('whois');
return;
}
foreach (keys %{ $users{$user} }) {
my $ref = ref $users{$user}{$_};
- if ($ref eq "HASH") {
+ if ($ref eq 'HASH') {
my $type = $_;
### DOES NOT WORK???
foreach (keys %{ $users{$user}{$type} }) {
my $arg = $2;
if (defined $arg) {
- if ($arg ne "_default" and !&validChan($arg) ) {
+ if ($arg ne '_default' and !&validChan($arg) ) {
&performStrictReply("error: chan $chan is invalid.");
return;
}
foreach (keys %{ $bans{$c} }) {
my $val = $bans{$c}{$_};
- if (ref $val eq "ARRAY") {
+ if (ref $val eq 'ARRAY') {
my @array = @{ $val };
&performStrictReply(" $_: @array");
} else {
}
if ($message =~ /^save$/) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
&writeUserFile();
&writeChanFile();
- &performStrictReply("saved user and chan files");
+ &performStrictReply('saved user and chan files');
return;
}
# ignore.
if ($message =~ /^(\+|\-)ignore(\s+(.*))?$/i) {
- return unless (&hasFlag("o"));
+ return unless (&hasFlag('o'));
my $state = ($1 eq "+") ? 1 : 0;
- my $str = $1."ignore";
+ my $str = $1.'ignore';
my $args = $3;
if (!$args) {
if ($args =~ s/^($mask{chan}|\*)\s*//) {
$chan = $1;
} else {
- $chan = "*";
+ $chan = '*';
}
# time.
foreach (keys %{ $ignore{$c} }) {
my $ref = ref $ignore{$c}{$_};
- if ($ref eq "ARRAY") {
+ if ($ref eq 'ARRAY') {
my @array = @{ $ignore{$c}{$_} };
&performStrictReply(" $_: @array");
} else {
# adduser/deluser.
if ($message =~ /^(add|del)user(\s+(.*))?$/i) {
my $str = $1;
- my $strstr = $1."user";
+ my $strstr = $1.'user';
my @args = split /\s+/, $3 || '';
my $args = $3;
my $state = ($str =~ /^(add)$/) ? 1 : 0;
my @time;
foreach (sort { $a <=> $b } keys %time) {
- my $str = join(", ", sort keys %{ $time{$_} });
+ my $str = join(', ', sort keys %{ $time{$_} });
&DEBUG("time => $_, str => $str");
push(@time, "$str (".&Time2String($_).")");
}
}
# quite a cool hack: reply in DCC CHAT.
- $msgType = "chat" if (exists $dcc{'CHAT'}{$who});
+ $msgType = 'chat' if (exists $dcc{'CHAT'}{$who});
my $done = 0;
$done++ if &parseCmdHook($message);
return;
}
- return "REPLY";
+ return 'REPLY';
}
1;
use strict;
-my $orderOfInfo = "RN,J,C,W,D";
+my $orderOfInfo = 'RN,J,C,W,D';
my %infoDesc = (
- "RN" => "Real Name",
- "J" => "Occupation",
- "C" => "Contact",
- "W" => "URL",
- "D" => "Description",
+ 'RN' => 'Real Name',
+ 'J' => 'Occupation',
+ 'C' => 'Contact',
+ 'W' => 'URL',
+ 'D' => 'Description',
);
sub UserInfo2Hash {
}
my $result;
- if ($result = &getFactoid($query." info")) {
+ if ($result = &getFactoid($query.' info')) {
# good.
} else { # bad.
&performReply("No User Information on \002$query\002");
$userInfo{$info} = $what;
}
- &setFactInfo($who." info", "factoid_value", &Hash2UserInfo(%userInfo));
+ &setFactInfo($who.' info', 'factoid_value', &Hash2UserInfo(%userInfo));
if ($new) {
&DEBUG("UIS: locking '$who info'.");
&DEBUG("UIS: nuh => '$nuh'.");
# search_parse_debug => 2,
}
);
- $Search->http_proxy($::param{'httpProxy'}) if (&::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 $ua = new LWP::UserAgent;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
$ua->timeout(10);
my $request = new HTTP::Request('GET', "http://weather.noaa.gov/weather/current/$station.html");
. " or http://www.nws.noaa.gov/tg/siteloc.shtml"
. " for ICAO locations codes).";
} else {
- return "Something failed in connecting to the NOAA web"
+ return 'Something failed in connecting to the NOAA web'
. " server. Try again later.";
}
}
if ($time) {
if ($wxmode eq 'metar' && defined($feat{'ob'})) {
- return ("METAR " . $place . ": " . $feat{'ob'});
+ return ('METAR ' . $place . ": " . $feat{'ob'});
}
$result = "$place; $id; last updated: $time";
&::status("Wingate: RUNNING ON $host BY $::who.");
if (&::IsChanConf('wingateBan') > 0) {
- &::ban("*!*\@$host", "");
+ &::ban("*!*\@$host", '');
}
my $reason = &::getChanConf('wingateKick');
sub zippy::get {
my @yows;
- &::DEBUG("Reading zippy data");
+ &::DEBUG('Reading zippy data');
while (<DATA>) {
chomp;
push @yows, $_;
$to = $lang_code{$to};
my $ua = new LWP::UserAgent;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
# Let's pretend
$ua->agent("Mozilla/5.0 " . $ua->agent);
$ua->timeout(5);
my($what) = @_;
if (!defined $what or $what =~ /^\s*$/) {
- &::help("botmail");
+ &::help('botmail');
return;
}
}
sub stats {
- my $botmail = &::countKeys("botmail");
- &::msg($::who, "I have \002$botmail\002 ". &::fixPlural("message", $botmail). ".");
+ my $botmail = &::countKeys('botmail');
+ &::msg($::who, "I have \002$botmail\002 ". &::fixPlural('message', $botmail). ".");
}
#####
my($recipient, $always) = @_;
$recipient ||= $::who;
- my %from = &::sqlSelectColHash("botmail", "srcwho,time", {
+ my %from = &::sqlSelectColHash('botmail', "srcwho,time", {
dstwho => lc $recipient
} );
my $t = keys %from;
sub next {
my($recipient) = @_;
- my %hash = &::sqlSelectRowHash("botmail", "*", {
+ my %hash = &::sqlSelectRowHash('botmail', '*', {
dstwho => lc $recipient
} );
my $ago = &::Time2String(time() - $hash{'time'});
&::msg($recipient, "From $hash{srcwho} ($hash{srcuh}) on $date ($ago ago):");
&::msg($recipient, $hash{'msg'});
- &::sqlDelete("botmail", { 'dstwho'=>$hash{dstwho}, 'srcwho'=>$hash{srcwho}});
+ &::sqlDelete('botmail', { 'dstwho'=>$hash{dstwho}, 'srcwho'=>$hash{srcwho}});
}
}
# only support 1 botmail with unique dstwho/srcwho to have same
# functionality as botmail from infobot.
# Note: I removed the &::sqlQuote reference. Seems to be working and inserting fine without it here. -- troubled
- my %hash = &::sqlSelectRowHash("botmail", "*", {
+ my %hash = &::sqlSelectRowHash('botmail', '*', {
srcwho => lc $::who,
dstwho => lc $recipient
} );
return;
}
- &::sqlInsert("botmail", {
+ &::sqlInsert('botmail', {
'dstwho' => lc $recipient,
'srcwho' => lc $::who,
'srcuh' => $::nuh,
my @adjs;
my @amts;
my @nouns;
- &::DEBUG("Reading insult data");
+ &::DEBUG('Reading insult data');
while (<DATA>) {
chomp;
- push(@adjs, split(" ", $1)) if /^adj\s*(.*)/;
- push(@amts, split(" ", $1)) if /^amt\s*(.*)/;
- push(@nouns, split(" ", $1)) if /^noun\s*(.*)/;
+ push(@adjs, split(' ', $1)) if /^adj\s*(.*)/;
+ push(@amts, split(' ', $1)) if /^amt\s*(.*)/;
+ push(@nouns, split(' ', $1)) if /^noun\s*(.*)/;
}
grep(s/\|/ /g, @adjs);
grep(s/\|/ /g, @amts);
my $adj2 = @adjs[rand(@adjs)];
my $noun = @nouns[rand(@nouns)];
my $whois = "$insultwho is";
- $whois = "You are" if ($insultwho eq $::who or $insultwho eq "me");
+ $whois = 'You are' if ($insultwho eq $::who or $insultwho eq 'me');
&::performStrictReply("$whois nothing but a$n $adj $amt of $adj2 $noun");
}
sub md5 {
my($message) = @_;
- return unless &::loadPerlModule("Digest::MD5");
+ return unless &::loadPerlModule('Digest::MD5');
&::performStrictReply(&Digest::MD5::md5_hex($message));
}
### TODO: compact with map?
my @list;
foreach (sort {$b <=> $a} keys %nickometer) {
- my $str = join(", ", sort keys %{ $nickometer{$_} });
+ my $str = join(', ', sort keys %{ $nickometer{$_} });
push(@list, "$str ($_%)");
}
my $percentage = &nickometer($term);
if ($percentage =~ /NaN/) {
- $percentage = "off the scale";
+ $percentage = 'off the scale';
} else {
$percentage = sprintf("%0.4f", $percentage);
$percentage =~ s/(\.\d+)0+$/$1/;
$text =~ s/^([^\[\]]*) (\[) (.*) (\]) ([^\[\]]*) $/$1$3$5/x)
{
print "Removed $2$4 outside parentheses; nick now $_\n" if $verbose;
- &punish(15, "brackets");
+ &punish(15, 'brackets');
}
my $parentheses = $text =~ tr/(){}[]/(){}[]/;
&punish(&slow_pow(10, $parentheses),
}
my $channel = $::chan || 'infobot';
- # TODO disallow use from private message? $chan="_default"
+ # TODO disallow use from private message? $chan='_default'
&::status("pager: from $from <$fromaddr>, to $to <$toaddr>, msg \"$msg\"");
my %headers = (
To => "$to <$toaddr>",
From => "$from <$fromaddr>",
Subject => "Message from $channel!",
- 'X-Mailer' => "blootbot",
+ 'X-Mailer' => 'blootbot',
);
# my $logmsg;
&::performStrictReply($retval);
}
-"pager";
+'pager';
# vim: ts=2 sw=2
# FIXME: does not handle:
# non-trailing punctuation and hyphens
- # y as vowel "style" -> "ylestay"
+ # y as vowel 'style' -> 'ylestay'
# contractions
for my $word (split /\s+/, $text) {
my ($pigword, $postfix);
sub reverse {
my($message) = @_;
- &::performStrictReply(join("",reverse(split("",$message))));
+ &::performStrictReply(join('',reverse(split('',$message))));
}
1;
}
# shuffle the middle letters
- $new_middle = join "", List::Util::shuffle(split //, $middle);
+ $new_middle = join '', List::Util::shuffle(split //, $middle);
}
while (($cnt < 10) && ($middle eq $new_middle));
# been included in the original string
$scrambled =~ s/\s+$//;
- &::performStrictReply($scrambled||"Unknown Error Condition");
+ &::performStrictReply($scrambled||'Unknown Error Condition');
}
1;
my $retval = "i could not get the headlines.";
if (scalar @results) {
- my $prefix = "Slashdot Headlines ";
+ my $prefix = 'Slashdot Headlines ';
my @list = &slashdotParse(@results);
$retval = &::formListReply(0, $prefix, @list);
}
sub spell::spell {
my $query = shift;
if ($query =~ m/[^[:alpha:]]/) {
- return("only one word of alphabetic characters supported");
+ return('only one word of alphabetic characters supported');
}
my $binary;
}
if (!$binary) {
- return("no binary found.");
+ return('no binary found.');
}
if (!&::validExec($query)) {
- return("argument appears to be fuzzy.");
+ return('argument appears to be fuzzy.');
}
my $reply = "I can't find alternate spellings for '$query'";
&::DEBUG("wikipedia($phrase)");
my $ua = new LWP::UserAgent;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
# Let's pretend
$ua->agent("Mozilla/5.0 " . $ua->agent);
$ua->timeout(5);
#$text = substr($text, 0, 330);
#$text =~ s/(.+)\.([^.]*)$/$1./g;
- return("At " . $url . " (URL), Wikipedia explains: " . $text,
+ return('At ' . $url . " (URL), Wikipedia explains: " . $text,
1);
}
}
&::DEBUG("wikipedia_get_text($article)");
my $ua = new LWP::UserAgent;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
# Let's pretend
$ua->agent("Mozilla/5.0 " . $ua->agent);
$ua->timeout(5);
} elsif (/#REDIRECT\s*\[\[(.*?)\]\]/i) {
$redirect = $1;
$redirect =~ tr/ /_/;
- &::DEBUG("wiki redirect to " . $redirect);
+ &::DEBUG('wiki redirect to ' . $redirect);
last;
} elsif (/<text[^>]*>(.*)/) {
$text = '"' . $1;
} elsif (/(.*)<\/text>/) {
- $text = $text . " " . $1 . '"';
+ $text = $text . ' ' . $1 . '"';
last;
} elsif ($text) {
- $text = $text . " " . $_;
+ $text = $text . ' ' . $_;
}
}
&::DEBUG("wikipedia returned text: " . $text .
- ", redirect " . $redirect. "\n");
+ ', redirect ' . $redirect. "\n");
if (!$redirect and !$text) {
return ($res->as_string);
return("argument appears to be fuzzy.");
}
- my $reply ="";
+ my $reply ='';
foreach (`$binary '$query' 2>&1`){
$reply .= $_;
}
my $res_return = 5;
my $ua = new LWP::UserAgent;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
$ua->timeout(10);
my $res_return = 5;
my $ua = new LWP::UserAgent;
- $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam("httpProxy"));
+ $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
$ua->timeout(10);
my $delta_time = &timedelta($start_time);
if ($delta_time > 0 and $verbose_ftp) {
&status(sprintf("FTP: %.02f sec to complete.", $delta_time));
- my ($rateunit,$rate) = ("B", $size / $delta_time);
+ my ($rateunit,$rate) = ('B', $size / $delta_time);
if ($rate > 1024) {
$rate /= 1024;
- $rateunit = "kB";
+ $rateunit = 'kB';
}
&status(sprintf("FTP: %.01f ${rateunit}/sec.", $rate));
}
return unless &loadPerlModule("LWP::UserAgent");
$ua = new LWP::UserAgent;
- $ua->proxy('http', $param{'httpProxy'}) if &IsParam("httpProxy");
+ $ua->proxy('http', $param{'httpProxy'}) if &IsParam('httpProxy');
if (defined $post) {
$req = new HTTP::Request('POST',$url);
}
$ua = new LWP::UserAgent;
- $ua->proxy('http', $param{'httpProxy'}) if &IsParam("httpProxy");
+ $ua->proxy('http', $param{'httpProxy'}) if &IsParam('httpProxy');
$req = HTTP::Request->new('GET', $url);
&status("getURLAsFile: getting '$url' as '$file'");
$res = $ua->request($req, $file);
my $IPC_PRIVATE = 0;
my $size = 2000;
- if (&IsParam("noSHM")) {
+ if (&IsParam('noSHM')) {
&status("Shared memory: Disabled. WARNING: bot may become unreliable");
return 0;
}
my $size = 3*80;
my $retval = '';
- return '' if (&IsParam("noSHM"));
+ return '' if (&IsParam('noSHM'));
if (shmread($key,$retval,$position,$size)) {
#&DEBUG("shmRead($key): $retval");
my $position = 0;
my $size = 80*3;
- return if (&IsParam("noSHM"));
+ return if (&IsParam('noSHM'));
if (length($str) > $size) {
&status("ERROR: length(str) (..)>$size...");
my $read = &shmRead($key);
$read =~ s/\0+//g;
- if ($read eq "") {
+ if ($read eq '') {
$str = sprintf("%s:%d:%d: ", $param{ircUser}, $bot_pid, time());
} else {
$str = $read ."||". $str;
return if ($$ != $::bot_pid); # fork protection.
if (@_) {
- &ScheduleThis(15, "shmFlush");
- return if ($_[0] eq "2");
+ &ScheduleThis(15, 'shmFlush');
+ return if ($_[0] eq '2');
}
my $time;
}
}
- &shmWrite($shm,"") if ($shmmsg ne "");
+ &shmWrite($shm,'') if ($shmmsg ne '');
}
1;
my $reply = $3;
if (!defined $reply) {
- &help("rot13");
+ &help('rot13');
return;
}
my $num = $1 % 26;
# initialize variables.
$last{buflen} = 0;
-$last{say} = "";
-$last{msg} = "";
+$last{say} = '';
+$last{msg} = '';
$userHandle = "_default";
$wingaterun = time();
$firsttime = 1;
$notcount = 0;
###
$bot_release = "1.3.3";
-if ( -d "CVS" ) {
+if ( -d 'CVS' ) {
use POSIX qw(strftime);
- $bot_release .= strftime(" cvs (%Y%m%d)", gmtime( (stat("CVS"))[9] ) );
+ $bot_release .= strftime(" cvs (%Y%m%d)", gmtime( (stat('CVS'))[9] ) );
}
$bot_version = "blootbot $bot_release -- $^O";
-$noreply = "NOREPLY";
+$noreply = 'NOREPLY';
##########
### misc commands.
###
sub whatInterface {
- if (!&IsParam("Interface") or $param{'Interface'} =~ /IRC/) {
- return "IRC";
+ if (!&IsParam('Interface') or $param{'Interface'} =~ /IRC/) {
+ return 'IRC';
} else {
- return "CLI";
+ return 'CLI';
}
}
&status("parent caught SIG$sig (pid $$).") if (defined $sig);
&status("--- Start of quit.");
- $ident ||= "blootbot"; # lame hack.
+ $ident ||= 'blootbot'; # lame hack.
&status("Memory Usage: $memusage KiB");
&sqlCloseDB();
&closeSHM($shm);
- if (&IsParam("dumpvarsAtExit")) {
+ if (&IsParam('dumpvarsAtExit')) {
&loadMyModule('DumpVars');
&dumpallvars();
}
- &symdumpAll() if (&IsParam("symdumpAtExit"));
+ &symdumpAll() if (&IsParam('symdumpAtExit'));
&closeLog();
- &closeSQLDebug() if (&IsParam("SQLDebug"));
+ &closeSQLDebug() if (&IsParam('SQLDebug'));
&status("--- QUIT.");
} else { # child.
&WARN("multiple items found?");
}
- if ($chanconf{$chan}{$param} eq "0") {
+ if ($chanconf{$chan}{$param} eq '0') {
$chan{$chan} = -1;
} else {
$chan{$chan} = 1;
my($param) = shift;
# knocked tons of bugs with this! :)
- my $debug = 0; # 1 if ($param eq "whatever");
+ my $debug = 0; # 1 if ($param eq 'whatever');
if (!defined $param) {
&WARN("IsChanConf: param == NULL.");
if (!defined $msgType) {
$nomatch++;
} else {
- $nomatch++ if ($msgType eq "");
+ $nomatch++ if ($msgType eq '');
$nomatch++ unless ($msgType =~ /^(public|private)$/i);
}
if (!defined $chanconf{$c[0]}{$param} and ($c ne '_default')) {
return &getChanConf($param, '_default');
}
- #&DEBUG("gCC: $param,$c \"" . $chanconf{$c[0]}{$param} . '"');
+ &DEBUG("gCC: $param,$c \"" . $chanconf{$c[0]}{$param} . '"');
return $chanconf{$c[0]}{$param};
}
}
sub showProc {
- my ($prefix) = $_[0] || "";
+ my ($prefix) = $_[0] || '';
- if ($^O eq "linux") {
+ if ($^O eq 'linux') {
if (!open(IN, "/proc/$$/status")) {
&ERROR("cannot open '/proc/$$/status'.");
return;
}
close IN;
- } elsif ($^O eq "netbsd") {
+ } elsif ($^O eq 'netbsd') {
$memusage = int( (stat "/proc/$$/mem")[7]/1024 );
} elsif ($^O =~ /^(free|open)bsd$/) {
$memusage = $info[20];
} else {
- $memusage = "UNKNOWN";
+ $memusage = 'UNKNOWN';
return;
}
- if (defined $memusageOld and &IsParam("DEBUG")) {
+ if (defined $memusageOld and &IsParam('DEBUG')) {
# it's always going to be increase.
my $delta = $memusage - $memusageOld;
my $str;
&loadMyModulesNow(); # must be after chan file.
$shm = &openSHM();
- &openSQLDebug() if (&IsParam("SQLDebug"));
+ &openSQLDebug() if (&IsParam('SQLDebug'));
&sqlOpenDB($param{'DBName'}, $param{'DBType'}, $param{'SQLUser'},
$param{'SQLPass'});
&checkTables();
- &status("Setup: ". &countKeys("factoids") ." factoids.");
- &getChanConfDefault("sendPrivateLimitLines", 3, $chan);
- &getChanConfDefault("sendPrivateLimitBytes", 1000, $chan);
- &getChanConfDefault("sendPublicLimitLines", 3, $chan);
- &getChanConfDefault("sendPublicLimitBytes", 1000, $chan);
- &getChanConfDefault("sendNoticeLimitLines", 3, $chan);
- &getChanConfDefault("sendNoticeLimitBytes", 1000, $chan);
+ &status("Setup: ". &countKeys('factoids') ." factoids.");
+ &getChanConfDefault('sendPrivateLimitLines', 3, $chan);
+ &getChanConfDefault('sendPrivateLimitBytes', 1000, $chan);
+ &getChanConfDefault('sendPublicLimitLines', 3, $chan);
+ &getChanConfDefault('sendPublicLimitBytes', 1000, $chan);
+ &getChanConfDefault('sendNoticeLimitLines', 3, $chan);
+ &getChanConfDefault('sendNoticeLimitBytes', 1000, $chan);
$param{tempDir} =~ s#\~/#$ENV{HOME}/#;
}
sub startup {
- if (&IsParam("DEBUG")) {
+ if (&IsParam('DEBUG')) {
&status("enabling debug diagnostics.");
# I thought disabling this reduced memory usage by 1000 KiB.
use diagnostics;
&status("--- shutdown called.");
# hack.
- $ident ||= "blootbot";
+ $ident ||= 'blootbot';
if (!&isFileUpdated("$bot_state_dir/blootbot.users", $wtime_userfile)) {
&writeUserFile()
&ircCheck(); # heh, evil!
- &DCCBroadcast("-HUP called.","m");
+ &DCCBroadcast("-HUP called.",'m');
&shutdown($sig);
&loadConfig($bot_config_dir."/blootbot.config");
- &reloadAllModules() if (&IsParam("DEBUG"));
+ &reloadAllModules() if (&IsParam('DEBUG'));
&setup();
&status("--- End of $sig.");
next unless /\S/;
my ($set,$key,$val) = split(/\s+/, $_, 3);
- if ($set ne "set") {
+ if ($set ne 'set') {
&status("loadConfig: invalid line '$_'.");
next;
}
$db = "dbname=$db.sqlite";
} elsif ($type =~ /^pg/i) {
$db = "dbname=$db";
- $type = "Pg";
+ $type = 'Pg';
}
my $dsn = "DBI:$type:$db";
- my $hoststr = "";
+ my $hoststr = '';
# SQLHost should be unset for SQLite
if (exists $param{'SQLHost'} and $param{'SQLHost'}) {
- # PostgreSQL requires ";" and keyword "host". See perldoc Pg -- troubled
- if ($type eq "Pg") {
+ # PostgreSQL requires ";" and keyword 'host'. See perldoc Pg -- troubled
+ if ($type eq 'Pg') {
$dsn .= ";host=$param{SQLHost}";
} else {
$dsn .= ":$param{SQLHost}";
return 0 unless ($dbh);
my $x = $param{SQLHost};
- my $hoststr = ($x) ? " to $x" : "";
+ my $hoststr = ($x) ? " to $x" : '';
&status("Closed DBI connection$hoststr.");
$dbh->disconnect();
return;
}
- if (!defined $data_href or ref($data_href) ne "HASH") {
+ if (!defined $data_href or ref($data_href) ne 'HASH') {
&WARN("sqlSet: data_href == NULL.");
return;
}
sub sqlUpdate {
my ($table, $data_href, $where_href) = @_;
- if (!defined $data_href or ref($data_href) ne "HASH") {
+ if (!defined $data_href or ref($data_href) ne 'HASH') {
&WARN("sqlSet: data_href == NULL.");
return 0;
}
my $where = &hashref2where($where_href) if ($where_href);
my $update = &hashref2update($data_href) if ($data_href);
- &sqlRaw("Update", "UPDATE $table SET $update WHERE $where");
+ &sqlRaw('Update', "UPDATE $table SET $update WHERE $where");
return 1;
}
# Usage: &sqlInsert($table, $data_href, $other);
sub sqlInsert {
my ($table, $data_href, $other) = @_;
- # note: if $other == 1, add "DELAYED" to function instead.
+ # note: if $other == 1, add 'DELAYED' to function instead.
# note: ^^^ doesnt actually do anything lol. Need code to s/1/DELAYED/ below -- troubled
- if (!defined $data_href or ref($data_href) ne "HASH") {
+ if (!defined $data_href or ref($data_href) ne 'HASH') {
&WARN("sqlInsert: data_href == NULL.");
return;
}
return &sqlRaw("Insert($table)", sprintf(
"INSERT %s INTO %s (%s) VALUES (%s)",
- ($other || ""), $table, join(',',@k), join(',',@v)
+ ($other || ''), $table, join(',',@k), join(',',@v)
) );
}
sub sqlReplace {
my ($table, $data_href, $pkey) = @_;
- if (!defined $data_href or ref($data_href) ne "HASH") {
+ if (!defined $data_href or ref($data_href) ne 'HASH') {
&WARN("sqlReplace: data_href == NULL.");
return;
}
sub sqlDelete {
my ($table, $where_href) = @_;
- if (!defined $where_href or ref($where_href) ne "HASH") {
+ if (!defined $where_href or ref($where_href) ne 'HASH') {
&WARN("sqlDelete: where_href == NULL.");
return;
}
my $where = &hashref2where($where_href);
- &sqlRaw("Delete", "DELETE FROM $table WHERE $where");
+ &sqlRaw('Delete', "DELETE FROM $table WHERE $where");
return 1;
}
return;
}
- if (ref($href) ne "HASH") {
+ if (ref($href) ne 'HASH') {
&WARN("hashref2where: href is not HASH ref (href => $href)");
return;
}
sub hashref2update {
my ($href) = @_;
- if (ref($href) ne "HASH") {
+ if (ref($href) ne 'HASH') {
&WARN("hashref2update: href is not HASH ref.");
return;
}
sub hashref2array {
my ($href) = @_;
- if (ref($href) ne "HASH") {
+ if (ref($href) ne 'HASH') {
&WARN("hashref2update: href is not HASH ref.");
return;
}
# Usage: &countKeys($table, [$col]);
sub countKeys {
my ($table, $col) = @_;
- $col ||= "*";
+ $col ||= '*';
return (&sqlRawReturn("SELECT count($col) FROM $table"))[0];
}
$logtime = time();
$logcount = 0;
$logrepeat = 0;
-$logold = "";
+$logold = '';
$param{VEBOSITY} ||= 1; # lame fix for preload
# logging support.
sub openLog {
- return unless (&IsParam("logfile"));
+ return unless (&IsParam('logfile'));
$file{log} = $param{'logfile'};
my $error = 0;
$error++;
}
- if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
+ if (&IsParam('logType') and $param{'logType'} =~ /DAILY/i) {
my ($day,$month,$year) = (gmtime time())[3,4,5];
$logDate = sprintf("%04d%02d%02d",$year+1900,$month+1,$day);
$file{log} .= $logDate;
sub closeLog {
# lame fix for paramlogfile.
- return unless (&IsParam("logfile"));
+ return unless (&IsParam('logfile'));
return unless (defined fileno LOG);
close LOG;
}
sub DEBUG {
- return unless (&IsParam("DEBUG"));
+ return unless (&IsParam('DEBUG'));
&status("${b_green}!DEBUG!$ob $_[0]");
}
}
sub WARN {
- return unless (&IsParam("WARN"));
+ return unless (&IsParam('WARN'));
return if ($_[0] =~ /^PERL: Subroutine \S+ redefined at/);
}
sub VERB {
- if (!&IsParam("VERBOSITY")) {
+ if (!&IsParam('VERBOSITY')) {
# NOTHING.
- } elsif ($param{'VERBOSITY'} eq "1" and $_[1] <= 1) {
+ } elsif ($param{'VERBOSITY'} eq '1' and $_[1] <= 1) {
&status($_[0]);
- } elsif ($param{'VERBOSITY'} eq "2" and $_[1] <= 2) {
+ } elsif ($param{'VERBOSITY'} eq '2' and $_[1] <= 2) {
&status($_[0]);
}
}
# if it's not a scalar, attempt to warn and fix.
my $ref = ref $input;
- if (defined $ref and $ref ne "") {
+ if (defined $ref and $ref ne '') {
&WARN("status: 'input' is not scalar ($ref).");
- if ($ref eq "ARRAY") {
+ if ($ref eq 'ARRAY') {
foreach (@$input) {
&WARN("status: '$_'.");
}
$status = "[$statcount] ".$input;
}
- if (&IsParam("backlog")) {
+ if (&IsParam('backlog')) {
push(@backlog, $status); # append to end.
shift(@backlog) if (scalar @backlog > $param{'backlog'});
}
- if (&IsParam("VERBOSITY")) {
+ if (&IsParam('VERBOSITY')) {
if ($statcountfix) {
printf $_red."!%6d!".$ob." ", $statcount;
} else {
}
# log the line into a file.
- return unless (&IsParam("logfile"));
+ return unless (&IsParam('logfile'));
return unless (defined fileno LOG);
# remove control characters from logging to LOGFILE.
for ($input) {
- last if (&IsParam("logColors"));
+ last if (&IsParam('logColors'));
s/\e\[[0-9;]+m//g; # escape codes.
s/[\cA-\c_]//g; # control chars.
}
$input = "FORK($$) ".$input if ($statcountfix);
my $date;
- if (&IsParam("logType") and $param{'logType'} =~ /DAILY/i) {
+ if (&IsParam('logType') and $param{'logType'} =~ /DAILY/i) {
$date = sprintf("%02d:%02d.%02d", (gmtime $time)[2,1,0]);
my ($day,$month,$year) = (gmtime $time)[3,4,5];
}
sub SQLDebug {
- return unless (&IsParam("SQLDebug"));
+ return unless (&IsParam('SQLDebug'));
return unless (fileno SQLDEBUG);
}
$moduleAge{$mod} = (stat $mod)[9];
- &showProc(" ($_)") if (&IsParam("DEBUG"));
+ &showProc(" ($_)") if (&IsParam('DEBUG'));
}
}
}
sub loadFactoidsModules {
- if (!&IsParam("factoids")) {
+ if (!&IsParam('factoids')) {
&status("Factoid support DISABLED.");
return;
}
}
$moduleAge{$mod} = (stat $mod)[9];
- &showProc(" ($_)") if (&IsParam("DEBUG"));
+ &showProc(" ($_)") if (&IsParam('DEBUG'));
}
}
# hrm... use another config option besides DEBUG to display
# change in memory usage.
- &status("Loading Modules \"$mod\"") if (!&IsParam("DEBUG"));
+ &status("Loading Modules \"$mod\"") if (!&IsParam('DEBUG'));
eval "require \"$mod\"";
if ($@) {
&ERROR("require \"$mod\" => $@");
}
$moduleAge{$mod} = (stat $mod)[9];
- &showProc(" ($_)") if (&IsParam("DEBUG"));
+ &showProc(" ($_)") if (&IsParam('DEBUG'));
}
}
### rename to moduleReloadAll?
sub reloadAllModules {
- my $retval = "";
+ my $retval = '';
&VERB("Module: reloading all.",2);
sub reloadModule {
my ($mod) = @_;
my $file = (grep /\/$mod/, keys %INC)[0];
- my $retval = "";
+ my $retval = '';
# don't reload if it's not our module.
if ($mod =~ /::/ or $mod !~ /pl$/) {
projects / infobot.git / commitdiff