use vars qw($uh $message);
sub cliloop {
- &status("Using CLI...");
- &status("Now type what you want.");
+ &status('Using CLI...');
+ &status('Now type what you want.');
$nuh = "local!local\@local";
$uh = "local\@local";
$who = 'local';
$orig{who} = 'local';
$ident = $param{'ircUser'};
- $chan = $talkchannel = "_local";
+ $chan = $talkchannel = '_local';
$addressed = 1;
$msgType = 'private';
$host = 'local';
sub msg {
my ( $nick, $msg ) = @_;
if ( !defined $nick ) {
- &ERROR("msg: nick == NULL.");
+ &ERROR('msg: nick == NULL.');
return;
}
sub action {
my ( $target, $txt ) = @_;
if ( !defined $txt ) {
- &WARN("action: txt == NULL.");
+ &WARN('action: txt == NULL.');
return;
}
if ( length $txt > 480 ) {
- &status("action: txt too long; truncating.");
+ &status('action: txt too long; truncating.');
chop($txt) while ( length $txt > 480 );
}
my $f = "$bot_state_dir/infobot.users";
if ( !-f $f ) {
- &DEBUG("userfile not found; new fresh run detected.");
+ &DEBUG('userfile not found; new fresh run detected.');
return;
}
my $s2 = -s "$f~";
if ( $s2 > $s1 * 3 ) {
- &FIXME("rUF: backup file bigger than current file.");
+ &FIXME('rUF: backup file bigger than current file.');
}
}
my $ver = <IN>;
if ( $ver !~ /^#v1/ ) {
- &ERROR("old or invalid user file found.");
+ &ERROR('old or invalid user file found.');
&closeLog();
exit 1; # correct?
}
&status(
sprintf(
- "USERFILE: Loaded: %d users, %d bans, %d ignore",
+ 'USERFILE: Loaded: %d users, %d bans, %d ignore',
scalar( keys %users ) - 1,
scalar( keys %bans ), # ??
scalar( keys %ignore ), # ??
sub writeUserFile {
if ( !scalar keys %users ) {
- &DEBUG("wUF: nothing to write.");
+ &DEBUG('wUF: nothing to write.');
return;
}
"--- Saved USERFILE ($cusers users; $cbans bans; $cignore ignore) at $time"
);
if ( defined $msgType and $msgType =~ /^chat$/ ) {
- &performStrictReply("--- Writing user file...");
+ &performStrictReply('--- Writing user file...');
}
}
my $s2 = -s "$f~";
if ( $s2 > $s1 * 3 ) {
- &FIXME("rCF: backup file bigger than current file.");
+ &FIXME('rCF: backup file bigger than current file.');
}
}
}
&status(
- "CHANFILE: Loaded: " . ( scalar( keys %chanconf ) - 1 ) . " chans" );
+ 'CHANFILE: Loaded: ' . ( scalar( keys %chanconf ) - 1 ) . ' chans' );
}
sub writeChanFile {
if ( !scalar keys %chanconf ) {
- &DEBUG("wCF: nothing to write.");
+ &DEBUG('wCF: nothing to write.');
return;
}
foreach ( keys %chanconf ) {
$chan = $_;
- next if ( $chan eq "_default" );
+ next if ( $chan eq '_default' );
next unless ( exists $chanconf{$chan}{$opt} );
next unless ( $val eq $chanconf{$chan}{$opt} );
my ( %optsval, %opts );
foreach ( keys %chanconf ) {
$chan = $_;
- next if ( $chan eq "_default" );
+ next if ( $chan eq '_default' );
my $opt;
foreach ( keys %{ $chanconf{$chan} } ) {
close OUT;
$wtime_chanfile = time();
- &status("--- Saved CHANFILE ("
+ &status('--- Saved CHANFILE ('
. scalar( keys %chanconf )
. " chans) at $time" );
if ( defined $msgType and $msgType =~ /^chat$/ ) {
- &performStrictReply("--- Writing chan file...");
+ &performStrictReply('--- Writing chan file...');
}
}
$userHandle = '';
foreach $user ( keys %users ) {
- next if ( $user eq "_default" );
+ next if ( $user eq '_default' );
foreach $m ( keys %{ $users{$user}{HOSTS} } ) {
$m =~ s/\?/./g;
}
}
- $userHandle ||= "_default";
+ $userHandle ||= '_default';
# what's talkchannel for?
$talkWho{$talkchannel} = $who if ( defined $talkchannel );
push( @match, $chan );
}
- &DEBUG( "iD: scalar => " . scalar( keys %{ $ignore{$chan} } ) );
+ &DEBUG( 'iD: scalar => ' . scalar( keys %{ $ignore{$chan} } ) );
}
if ( scalar @match ) {
push( @match, $chan );
}
- &DEBUG( "bans: scalar => " . scalar( keys %{ $bans{$chan} } ) );
+ &DEBUG( 'bans: scalar => ' . scalar( keys %{ $bans{$chan} } ) );
}
if ( scalar @match ) {
my ($user) = @_;
if ( !defined $user ) {
- &WARN("getUser: user == NULL.");
+ &WARN('getUser: user == NULL.');
return;
}
sub chanSet {
my ( $cmd, $chan, $what, $val ) = @_;
- if ( $cmd eq "+chan" ) {
+ if ( $cmd eq '+chan' ) {
if ( exists $chanconf{$chan} ) {
&performStrictReply("chan $chan already exists.");
return;
my $update = 0;
if ( defined $what and $what =~ s/^([+-])(\S+)/$2/ ) {
- ### ".chanset +blah"
- ### ".chanset +blah 10" -- error.
+ ### '.chanset +blah'
+ ### '.chanset +blah 10' -- error.
- my $set = ( $1 eq "+" ) ? 1 : 0;
+ my $set = ( $1 eq '+' ) ? 1 : 0;
my $was = $chanconf{$chan}{$what};
if ($set) { # add/set.
}
elsif ( defined $val ) {
- ### ".chanset blah testing"
+ ### '.chanset blah testing'
my $was = $chanconf{$chan}{$what};
if ( defined $was and $was eq $val ) {
}
else { # read only.
- ### ".chanset"
- ### ".chanset blah"
+ ### '.chanset'
+ ### '.chanset blah'
if ( !defined $what ) {
- &WARN("chanset/DC: what == undefine.");
+ &WARN('chanset/DC: what == undefine.');
return;
}
}
}
- &DEBUG("end of rehashConfVars");
+ &DEBUG('end of rehashConfVars');
delete $cache{confvars};
}
# JUST IN CASE. irq was complaining about this.
if ( $lastrun == time() ) {
- &DEBUG("ircloop: hrm... lastrun == time()");
+ &DEBUG('ircloop: hrm... lastrun == time()');
$error++;
sleep 10;
next;
}
if ( !defined $host ) {
- &DEBUG("ircloop: ircServers[x] = NULL.");
+ &DEBUG('ircloop: ircServers[x] = NULL.');
$lastrun = time();
next;
}
$error++;
if ( $error % 3 == 0 and $error != 0 ) {
- &status("IRC: Could not connect.");
- &status("IRC: ");
+ &status('IRC: Could not connect.');
+ &status('IRC: ');
next;
}
if ( $error >= 3 * 2 ) {
- &status("IRC: cannot connect to any IRC servers; stopping.");
+ &status('IRC: cannot connect to any IRC servers; stopping.');
&shutdown();
exit 1;
}
}
- &status("IRC: ok, done one cycle of IRC servers; trying again.");
+ &status('IRC: ok, done one cycle of IRC servers; trying again.');
&loadIRCServers();
goto loop;
$args{'Nick'} = $mynick;
$conns{$mynick} = $irc->newconn(%args);
if ( !defined $conns{$mynick} ) {
- &ERROR("IRC: connection failed.");
+ &ERROR('IRC: connection failed.');
&ERROR(
"add \"set ircHost 0.0.0.0\" to your config. If that does not work"
);
&ERROR(
-"Please check /etc/hosts to see if you have a localhost line like:"
+'Please check /etc/hosts to see if you have a localhost line like:'
);
- &ERROR("127.0.0.1 localhost localhost");
+ &ERROR('127.0.0.1 localhost localhost');
&ERROR(
- "If this is still a problem, please contact the maintainer.");
+ 'If this is still a problem, please contact the maintainer.');
}
$conns{$mynick}->maxlinelen($maxlinelen);
# should likely listen on a tcp port instead
#$irc->addfh(STDIN, \&on_stdin, 'r');
- &status("starting main loop");
+ &status('starting main loop');
$irc->start;
}
}
if ( &getChanConf( 'silent', $talkchannel )
- and not( &IsFlag("s") and &verifyUser( $who, $nuh{ lc $who } ) ) )
+ and not( &IsFlag('s') and &verifyUser( $who, $nuh{ lc $who } ) ) )
{
&DEBUG("say: silent in $talkchannel, not saying $msg");
return;
sub msg {
my ( $nick, $msg ) = @_;
if ( !defined $nick ) {
- &ERROR("msg: nick == NULL.");
+ &ERROR('msg: nick == NULL.');
return;
}
# some say() end up here (eg +help)
if ( &getChanConf( 'silent', $nick )
- and not( &IsFlag("s") and &verifyUser( $who, $nuh{ lc $who } ) ) )
+ and not( &IsFlag('s') and &verifyUser( $who, $nuh{ lc $who } ) ) )
{
&DEBUG("msg: silent in $nick, not saying $msg");
return;
my $mynick = $conn->nick();
my ( $target, $txt ) = @_;
if ( !defined $txt ) {
- &WARN("action: txt == NULL.");
+ &WARN('action: txt == NULL.');
return;
}
if ( &getChanConf( 'silent', $target )
- and not( &IsFlag("s") and &verifyUser( $who, $nuh{ lc $who } ) ) )
+ and not( &IsFlag('s') and &verifyUser( $who, $nuh{ lc $who } ) ) )
{
&DEBUG("action: silent in $target, not doing $txt");
return;
}
if ( length $txt > 480 ) {
- &status("action: txt too long; truncating.");
+ &status('action: txt too long; truncating.');
chop($txt) while ( length $txt > 480 );
}
sub notice {
my ( $target, $txt ) = @_;
if ( !defined $txt ) {
- &WARN("notice: txt == NULL.");
+ &WARN('notice: txt == NULL.');
return;
}
my ($reply) = @_;
if ( !defined $reply or $reply =~ /^\s*$/ ) {
- &DEBUG("performReply: reply == NULL.");
+ &DEBUG('performReply: reply == NULL.');
return;
}
my ( $who, $reply ) = @_;
if ( !defined $reply or $reply =~ /^\s*$/ ) {
- &WARN("dccsay: reply == NULL.");
+ &WARN('dccsay: reply == NULL.');
return;
}
return if ( $conn->join( $chan, $key ) );
return if ( &validChan($chan) );
- &DEBUG("joinchan: join failed. trying connect!");
+ &DEBUG('joinchan: join failed. trying connect!');
&clearIRCVars();
$conn->connect();
sub mode {
my ( $chan, @modes ) = @_;
- my $modes = join( " ", @modes );
+ my $modes = join( ' ', @modes );
if ( &validChan($chan) == 0 ) {
&ERROR("mode: invalid chan => '$chan'.");
sub quit {
my ($quitmsg) = @_;
if ( defined $conn ) {
- &status( "QUIT " . $conn->nick() . " has quit IRC ($quitmsg)" );
+ &status( 'QUIT ' . $conn->nick() . " has quit IRC ($quitmsg)" );
$conn->quit($quitmsg);
}
else {
- &WARN("quit: could not quit!");
+ &WARN('quit: could not quit!');
}
}
my $mynick = $conn->nick();
if ( !defined $newnick ) {
- &ERROR("nick: nick == NULL.");
+ &ERROR('nick: nick == NULL.');
return;
}
if ( !defined $mynick ) {
- &WARN("nick: mynick == NULL.");
+ &WARN('nick: mynick == NULL.');
return;
}
if ($bad) {
&WARN( "Nick: not going to try to change from $mynick to $newnick. ["
. scalar(gmtime)
- . "]" );
+ . ']' );
# hrm... over time we lose track of our own nick.
#return;
my $timestr = &Time2String($delta);
# FIXME: @join should be @in instead (hacked to 10)
- #my $rate = sprintf("%.1f", $delta / @in);
- my $rate = sprintf( "%.1f", $delta / 10 );
+ #my $rate = sprintf('%.1f', $delta / @in);
+ my $rate = sprintf( '%.1f', $delta / 10 );
delete $cache{joinTime};
&status("time taken to join all chans: $timestr; rate: $rate sec/join");
$chan =~ tr/A-Z/a-z/; # not lowercase unfortunately.
if ( $chan =~ /^$/ ) {
- &DEBUG("INIC: chan == NULL.");
+ &DEBUG('INIC: chan == NULL.');
return 0;
}
else {
foreach ( keys %channels ) {
next unless (/[A-Z]/);
- &DEBUG("iNIC: hash channels contains mixed cased chan!!!");
+ &DEBUG('iNIC: hash channels contains mixed cased chan!!!');
}
return 0;
}
if ( defined $channels{$chan} or exists $channels{$chan} ) {
if ( $chan =~ /^_?default$/ ) {
- # &WARN("validC: chan cannot be _default! returning 0!");
+ # &WARN('validC: chan cannot be _default! returning 0!');
return 0;
}
my @skip;
my @join;
- # Display "Chans:" only if more than $show seconds since last display
+ # Display 'Chans:' only if more than $show seconds since last display
if ( time() - $lastChansTime > $show ) {
$lastChansTime = time();
}
sub closeDCC {
- # &DEBUG("closeDCC called.");
+ # &DEBUG('closeDCC called.');
my $type;
foreach $type ( keys %dcc ) {
# sign. tmp parity needed to store current state
if ( $mode =~ /[-+]/ ) {
- $parity = 1 if ( $mode eq "+" );
- $parity = 0 if ( $mode eq "-" );
+ $parity = 1 if ( $mode eq '+' );
+ $parity = 0 if ( $mode eq '-' );
next;
}
# lets do some custom stuff.
if ( $mode =~ /o/ and not $parity ) {
if ( $target =~ /^\Q$ident\E$/i ) {
- &VERB( "hookmode: someone deopped us!", 2 );
+ &VERB( 'hookmode: someone deopped us!', 2 );
&chanServCheck($chan);
}
else {
# dcc?
- &FIXME("floodwho = ???");
+ &FIXME('floodwho = ???');
}
- my $val = &getChanConfDefault( 'floodRepeat', "2:5", $c );
+ my $val = &getChanConfDefault( 'floodRepeat', '2:5', $c );
my ( $count, $interval ) = split /:/, $val;
# flood repeat protection.
}
&msg( $who,
join( ' ', @who )
- . " already said that "
+ . ' already said that '
. ( time - $time )
- . " seconds ago" );
+ . ' seconds ago' );
### TODO: delete old floodwarn{} keys.
my $floodwarn = 0;
# unaddressed, public only.
- ### TODO: use a separate "short-time" hash.
+ ### TODO: use a separate 'short-time' hash.
my @data;
@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.
&status("FLOOD overflow detected from $floodwho; ignoring");
&ignoreAdd( "*!$uh", $chan, $expire,
- "flood overflow auto-detected." );
+ 'flood overflow auto-detected.' );
return;
}
if ( defined $nuh ) {
if ( !defined $userHandle ) {
- &DEBUG("line 1074: need verifyUser?");
+ &DEBUG('line 1074: need verifyUser?');
&verifyUser( $who, $nuh );
}
}
&status("clc: big change in limit for $chan ($delta);"
. "going for it. (was: $l; now: "
. ( $count + $plus )
- . ")" );
+ . ')' );
- $conn->mode( $chan, "+l", $count + $plus );
+ $conn->mode( $chan, '+l', $count + $plus );
$cache{chanlimitChange}{$chan} = time();
}
($chan) = @_;
if ( !defined $chan or $chan =~ /^\s*$/ ) {
- &WARN("chanServCheck: chan == NULL.");
+ &WARN('chanServCheck: chan == NULL.');
return 0;
}
&chanServCheck($chan);
- # schedule used to solve ircu (OPN) "target too fast" problems.
+ # schedule used to solve ircu (OPN) 'target too fast' problems.
$conn->schedule( 5, sub { &joinNextChan(); } );
}
$check++ if ( $args =~ /nickname.*owned/i );
if ($check) {
- &status("nickserv told us to register; doing it.");
+ &status('nickserv told us to register; doing it.');
if ( &IsParam('nickServ_pass') ) {
- &status("NickServ: ==> Identifying.");
+ &status('NickServ: ==> Identifying.');
&rawout("PRIVMSG NickServ :IDENTIFY $param{'nickServ_pass'}");
return;
}
next unless &chanServCheck($_);
next if ($done);
&DEBUG(
- "nickserv activated or restarted; doing chanserv check.");
+ 'nickserv activated or restarted; doing chanserv check.');
$done++;
}
my $chan = ( $event->to )[0];
my $nick = $event->nick;
- &status("!!! other called.");
+ &status('!!! other called.');
&status("!!! $event->args");
}
my $nick = $event->nick;
my $t = ( $event->args )[1];
if ( !defined $t ) {
- &WARN("on_ping_reply: t == undefined.");
+ &WARN('on_ping_reply: t == undefined.');
return;
}
# rare case should this happen - catch it just in case.
if ( $bot_pid != $$ ) {
- &ERROR("run-away fork; exiting.");
+ &ERROR('run-away fork; exiting.');
&delForked($forker);
}
# cache it.
my $time = time();
if ( !$cache{ircTextCounters} ) {
- &DEBUG("caching ircTextCounters for first time.");
+ &DEBUG('caching ircTextCounters for first time.');
my @str = split( /\s+/, &getChanConf('ircTextCounters') );
for (@str) { $_ = quotemeta($_); }
$cache{ircTextCounters} = join( '|', @str );
&VERB( "textcounters: $x matched for $who", 2 );
my $c = $chan || 'PRIVATE';
- # better to do "counter=counter+1".
+ # better to do 'counter=counter+1'.
# but that will avoid time check.
my ( $v, $t ) = &sqlSelect(
'stats',
#};
sub setupSchedulers {
- &VERB( "Starting schedulers...", 2 );
+ &VERB( 'Starting schedulers...', 2 );
# ONCE OFF.
if ( defined $time and $time > time() ) {
&WARN( "Sched for $codename already exists in "
. &Time2String( time() - $time )
- . "." );
+ . '.' );
return;
}
&DEBUG(
"Scheduling \&$codename() "
- . \&$codename . " for "
+ . \&$codename . ' for '
. &Time2String($waittime),
3
);
next unless ( &validChan($_) );
my $line =
- &getRandomLineFromFile( $bot_data_dir . "/infobot.randtext" );
+ &getRandomLineFromFile( $bot_data_dir . '/infobot.randtext' );
if ( !defined $line ) {
- &ERROR("random Quote: weird error?");
+ &ERROR('random Quote: weird error?');
return;
}
&status("sending random Quote to $_.");
- &action( $_, "Ponders: " . $line );
+ &action( $_, 'Ponders: ' . $line );
}
### TODO: if there were no channels, don't reschedule until channel
### configuration is modified.
&status("sending random Factoid to $_.");
while (1) {
( $key, $val ) =
- &randKey( 'factoids', "factoid_key,factoid_value" );
+ &randKey( 'factoids', 'factoid_key,factoid_value' );
&DEBUG("rF: $key, $val");
### $val =~ tr/^[A-Z]/[a-z]/; # blah is Good => blah is good.
last
$error++;
if ( $error == 5 ) {
- &ERROR("rF: tried 5 times but failed.");
+ &ERROR('rF: tried 5 times but failed.');
return;
}
}
### check if current size is too large.
if ( -s $file{log} > $param{'maxLogSize'} ) {
- my $date = sprintf( "%04d%02d%02d", (gmtime)[ 5, 4, 3 ] );
- $file{log} = $param{'logfile'} . "-" . $date;
- &status("cycling log file.");
+ my $date = sprintf( '%04d%02d%02d', (gmtime)[ 5, 4, 3 ] );
+ $file{log} = $param{'logfile'} . '-' . $date;
+ &status('cycling log file.');
if ( -e $file{log} ) {
my $i = 1;
my $newlog;
while () {
- $newlog = $file{log} . "-" . $i;
+ $newlog = $file{log} . '-' . $i;
last if ( !-e $newlog );
$i++;
}
CORE::system("/bin/mv '$param{'logfile'}' '$file{log}'");
&compress( $file{log} );
&openLog();
- &status("cycling log file.");
+ &status('cycling log file.');
}
### check if all the logs exceed size.
if ( $param{'DBType'} =~ /^mysql$/i ) {
$query =
- "SELECT nick,time FROM seen GROUP BY nick HAVING "
+ 'SELECT nick,time FROM seen GROUP BY nick HAVING '
. "UNIX_TIMESTAMP() - time > $max_time";
}
elsif ( $param{'DBType'} =~ /^sqlite(2)?$/i ) {
$query =
- "SELECT nick,time FROM seen GROUP BY nick HAVING "
+ 'SELECT nick,time FROM seen GROUP BY nick HAVING '
. "strftime('%s','now','localtime') - time > $max_time";
}
else { # pgsql.
$query =
- "SELECT nick,time FROM seen WHERE "
+ 'SELECT nick,time FROM seen WHERE '
. "extract(epoch from timestamp 'now') - time > $max_time";
}
}
}
else {
- &FIXME( "seenFlushOld: for bad DBType:" . $param{'DBType'} . "." );
+ &FIXME( 'seenFlushOld: for bad DBType:' . $param{'DBType'} . '.' );
}
&VERB( "SEEN deleted $delete seen entries.", 2 );
if ( scalar keys %netsplitservers ) {
if ( defined $limit ) {
&status("chanlimit: netsplit; removing it for $chan.");
- $conn->mode( $chan, "-l" );
+ $conn->mode( $chan, '-l' );
$cache{chanlimitChange}{$chan} = time();
- &status("chanlimit: netsplit; removed.");
+ &status('chanlimit: netsplit; removed.');
}
next;
if ( defined $limit and scalar keys %{ $channels{$chan}{''} } > $limit )
{
- &FIXME("LIMIT: set too low!!!");
+ &FIXME('LIMIT: set too low!!!');
### run NAMES again and flush it.
}
}
}
- $conn->mode( $chan, "+l", $newlimit );
+ $conn->mode( $chan, '+l', $newlimit );
$cache{chanlimitChange}{$chan} = time();
}
}
# &DEBUG("running netsplitCheck... $cache{netsplitCache}");
if ( !scalar %netsplit and scalar %netsplitservers ) {
- &DEBUG("nsC: !hash netsplit but hash netsplitservers <- removing!");
+ &DEBUG('nsC: !hash netsplit but hash netsplitservers <- removing!');
undef %netsplitservers;
return;
}
}
if ( !scalar %netsplit and scalar %netsplitservers ) {
- &DEBUG("nsC: ok hash netsplit is NULL; purging hash netsplitservers");
+ &DEBUG('nsC: ok hash netsplit is NULL; purging hash netsplitservers');
undef %netsplitservers;
}
if ( $count and !scalar keys %netsplit ) {
- &DEBUG("nsC: netsplit is hopefully gone. reinstating chanlimit check.");
+ &DEBUG('nsC: netsplit is hopefully gone. reinstating chanlimit check.');
&chanlimitCheck();
}
}
}
}
else {
- &DEBUG("seenFlush: NO VALID FACTOID SUPPORT?");
+ &DEBUG('seenFlush: NO VALID FACTOID SUPPORT?');
}
&status("Seen: Flushed $flushed entries.") if ($flushed);
&VERB(
sprintf(
- " new seen: %03.01f%% (%d/%d)",
+ ' new seen: %03.01f%% (%d/%d)',
$stats{'new'} * 100 / ( $stats{'count_old'} || 1 ),
$stats{'new'},
( $stats{'count_old'} || 1 )
) if ( $stats{'new'} );
&VERB(
sprintf(
- " now seen: %3.1f%% (%d/%d)",
+ ' now seen: %3.1f%% (%d/%d)',
$stats{'old'} * 100 / ( &countKeys('seen') || 1 ), $stats{'old'},
&countKeys('seen')
),
2
) if ( $stats{'old'} );
- &WARN("scalar keys seenflush != 0!") if ( scalar keys %seenflush );
+ &WARN('scalar keys seenflush != 0!') if ( scalar keys %seenflush );
}
sub leakCheck {
# SHM check.
my @ipcs;
- if ( -x "/usr/bin/ipcs" ) {
+ if ( -x '/usr/bin/ipcs' ) {
@ipcs = `/usr/bin/ipcs`;
}
else {
}
# make backup of important files.
- &mkBackup( $bot_state_dir . "/infobot.chan", 60 * 60 * 24 * 3 );
- &mkBackup( $bot_state_dir . "/infobot.users", 60 * 60 * 24 * 3 );
- &mkBackup( $bot_base_dir . "/infobot-news.txt", 60 * 60 * 24 * 1 );
+ &mkBackup( $bot_state_dir . '/infobot.chan', 60 * 60 * 24 * 3 );
+ &mkBackup( $bot_state_dir . '/infobot.users', 60 * 60 * 24 * 3 );
+ &mkBackup( $bot_base_dir . '/infobot-news.txt', 60 * 60 * 24 * 1 );
# flush cache{lobotomy}
foreach ( keys %{ $cache{lobotomy} } ) {
# compress logs that should have been compressed.
# TODO: use strftime?
my ( $day, $month, $year ) = ( gmtime( time() ) )[ 3, 4, 5 ];
- my $date = sprintf( "%04d%02d%02d", $year + 1900, $month + 1, $day );
+ my $date = sprintf( '%04d%02d%02d', $year + 1900, $month + 1, $day );
if ( !opendir( DIR, "$bot_log_dir" ) ) {
&ERROR("misccheck2: log dir $bot_log_dir does not exist.");
# FIXME: broken for multiple connects
# if ($ident eq $param{'ircNick'}) {
- # &status("okay, got my nick back.");
+ # &status('okay, got my nick back.');
# return;
# }
#
}
my @list =
- &searchTable( 'factoids', 'factoid_key', 'factoid_key', " #DEL#" );
+ &searchTable( 'factoids', 'factoid_key', 'factoid_key', ' #DEL#' );
my $stale =
&getChanConfDefault( 'factoidDeleteDelay', 14, $chan ) * 60 * 60 * 24;
if ( $stale < 1 ) {
if ( !defined $age or $age !~ /^\d+$/ ) {
if ( scalar @list > 50 ) {
if ( !$cache{warnDel} ) {
- &WARN( "list is over 50 ("
+ &WARN( 'list is over 50 ('
. scalar(@list)
- . "... giving it a miss." );
+ . '... giving it a miss.' );
$cache{warnDel} = 1;
last;
}
return if ( $_[0] eq '2' ); # defer.
}
- my $time = strftime( "%H:%M", gmtime( time() ) );
+ my $time = strftime( '%H:%M', gmtime( time() ) );
my $c;
foreach ( keys %channels ) {
# b - weird time.
###
- my $reply = "sched:";
+ my $reply = 'sched:';
foreach ( keys %{ $irc->{_queue} } ) {
my $q = $_;
my $coderef = $irc->{_queue}->{$q}->[1];
my ( $host, $dir, $file, $lfile ) = @_;
my $verbose_ftp = 1;
- return unless &loadPerlModule("Net::FTP");
+ return unless &loadPerlModule('Net::FTP');
&status("FTP: opening connection to $host.") if ($verbose_ftp);
my $ftp = Net::FTP->new(
# login.
if ( $ftp->login() ) {
- &status("FTP: logged in successfully.") if ($verbose_ftp);
+ &status('FTP: logged in successfully.') if ($verbose_ftp);
}
else {
- &status("FTP: login failed.");
+ &status('FTP: login failed.');
$ftp->quit();
return 0;
}
if ($verbose_ftp);
}
else {
- &status("FTP: same size; skipping.");
+ &status('FTP: same size; skipping.');
system("touch $thisfile"); # lame hack.
$ftp->quit();
return 1;
}
}
else {
- &status("FTP: file does not exist.");
+ &status('FTP: file does not exist.');
$ftp->quit();
return 0;
}
if ( defined $lsize ) {
&DEBUG("FTP: locsize => '$lsize'.");
if ( $size != $lsize ) {
- &FIXME("FTP: downloaded file seems truncated.");
+ &FIXME('FTP: downloaded file seems truncated.');
}
}
my $delta_time = &timedelta($start_time);
if ( $delta_time > 0 and $verbose_ftp ) {
- &status( sprintf( "FTP: %.02f sec to complete.", $delta_time ) );
+ &status( sprintf( 'FTP: %.02f sec to complete.', $delta_time ) );
my ( $rateunit, $rate ) = ( 'B', $size / $delta_time );
if ( $rate > 1024 ) {
$rate /= 1024;
my ( $host, $dir ) = @_;
my $verbose_ftp = 1;
- return unless &loadPerlModule("Net::FTP");
+ return unless &loadPerlModule('Net::FTP');
&status("FTP: opening connection to $host.") if ($verbose_ftp);
my $ftp = Net::FTP->new( $host, 'Timeout' => 60 );
# login.
if ( $ftp->login() ) {
- &status("FTP: logged in successfully.") if ($verbose_ftp);
+ &status('FTP: logged in successfully.') if ($verbose_ftp);
}
else {
- &status("FTP: login failed.");
+ &status('FTP: login failed.');
$ftp->quit();
return;
}
return;
}
- &status("FTP: doing ls.") if ($verbose_ftp);
+ &status('FTP: doing ls.') if ($verbose_ftp);
foreach ( $ftp->dir() ) {
# modes d uid gid size month day time file.
&DEBUG("FTP: UNKNOWN => '$_'.");
}
}
- &status( "FTP: ls done. " . scalar( keys %ftp ) . " entries." );
+ &status( 'FTP: ls done. ' . scalar( keys %ftp ) . ' entries.' );
$ftp->quit();
return %ftp;
my ( $url, $post ) = @_;
my ( $ua, $res, $req );
- return unless &loadPerlModule("LWP::UserAgent");
+ return unless &loadPerlModule('LWP::UserAgent');
$ua = new LWP::UserAgent;
$ua->proxy( 'http', $param{'httpProxy'} ) if &IsParam('httpProxy');
my $size = length( $res->content );
if ( $size and time - $time ) {
my $rate = int( $size / 1000 / ( time - $time ) );
- &status("getURL: Done (took "
+ &status('getURL: Done (took '
. &Time2String( time - $time )
. ", $rate k/sec)" );
}
&shmFlush(); # hack.
- # hack to support channel +o as "+o" in bot user file.
+ # hack to support channel +o as '+o' in bot user file.
# requires +O in user file.
# is $who arg lowercase?
if ( exists $channels{$chan}{o}{ $orig{who} } && &IsFlag('O') eq 'O' ) {
if ($lobotomized) {
if ( $addressed and IsFlag('o') eq 'o' ) {
my $delta_time = time() - ( $cache{lobotomy}{$who} || 0 );
- &msg( $who, "give me an unlobotomy." ) if ( $delta_time > 60 * 60 );
+ &msg( $who, 'give me an unlobotomy.' ) if ( $delta_time > 60 * 60 );
$cache{lobotomy}{$who} = time();
}
return 'LOBOTOMY' unless IsFlag('A');
my @array = split / /, $message;
if ( $who =~ /^_default$/i ) {
- &performStrictReply("you are too eleet.");
+ &performStrictReply('you are too eleet.');
return;
}
my @array = split ' ', $message;
if ( $who =~ /^_default$/i ) {
- &performStrictReply("you are too eleet.");
+ &performStrictReply('you are too eleet.');
return;
}
}
if ($first) {
- &performStrictReply("First time user... adding you as Master.");
+ &performStrictReply('First time user... adding you as Master.');
$users{$who}{FLAGS} = 'aemnorst';
}
}
if ( !defined $host ) {
- &WARN("pass: host == NULL.");
+ &WARN('pass: host == NULL.');
return;
}
return '' unless ($talkok);
# 'mynick: hi' or 'hi mynick' or 'hi'.
- &status("somebody said hello");
+ &status('somebody said hello');
# 50% chance of replying to a random greeting when not addressed
if ( !defined $5 and $addressed == 0 and rand() < 0.5 ) {
- &status("not returning unaddressed greeting");
+ &status('not returning unaddressed greeting');
return;
}
&& &IsChanConfOrWarn('karma') )
{
- # to request factoids such as "g++" or "libstdc++", append "?" to the query.
+ # to request factoids such as 'g++' or 'libstdc++', append '?' to the query.
my ( $term, $inc ) = ( lc $1, $2 );
if ( lc $term eq lc $who ) {
&FactoidStuff();
}
elsif ( $param{'DBType'} =~ /^none$/i ) {
- return "NO FACTOIDS.";
+ return 'NO FACTOIDS.';
}
else {
&ERROR("INVALID FACTOID SUPPORT? ($param{'DBType'})");
my $size = 2000;
if ( &IsParam('noSHM') ) {
- &status("Shared memory: Disabled. WARNING: bot may become unreliable");
+ &status('Shared memory: Disabled. WARNING: bot may become unreliable');
return 0;
}
return $_;
}
else {
- &ERROR("openSHM: failed.");
- &ERROR("Please delete some shared memory with ipcs or ipcrm.");
+ &ERROR('openSHM: failed.');
+ &ERROR('Please delete some shared memory with ipcs or ipcrm.');
exit 1;
}
}
my $read = &shmRead($key);
$read =~ s/\0+//g;
if ( $read eq '' ) {
- $str = sprintf( "%s:%d:%d: ", $param{ircUser}, $bot_pid, time() );
+ $str = sprintf( '%s:%d:%d: ', $param{ircUser}, $bot_pid, time() );
}
else {
- $str = $read . "||" . $str;
+ $str = $read . '||' . $str;
}
if ( !shmwrite( $key, $str, $position, $size ) ) {
$forker = $name;
if ( !defined $name ) {
- &WARN("addForked: name == NULL.");
+ &WARN('addForked: name == NULL.');
return 0;
}
}
elsif ( -d "/proc/$forked{$name}{PID}" ) {
- &status("fork: still running; good. BAIL OUT.");
+ &status('fork: still running; good. BAIL OUT.');
return 0;
}
else {
- &WARN("Found dead fork; removing and resetting.");
+ &WARN('Found dead fork; removing and resetting.');
$continue = 1;
}
return if ( $$ == $bot_pid );
if ( !defined $name ) {
- &WARN("delForked: name == NULL.");
+ &WARN('delForked: name == NULL.');
POSIX::_exit(0);
}
if (/^DCC SEND (\S+) (\S+)$/) {
my ( $nick, $file ) = ( $1, $2 );
if ( exists $dcc{'SEND'}{$who} ) {
- &msg( $nick, "DCC already active." );
+ &msg( $nick, 'DCC already active.' );
}
else {
&DEBUG("shm: dcc sending $2 to $1.");
### line 1.
foreach ( keys %channels ) {
if ( /^\s*$/ or / / ) {
- &status("chanstats: fe channels: chan == NULL.");
+ &status('chanstats: fe channels: chan == NULL.');
#&ircCheck();
next;
foreach $chan ( sort { $chans{$b} <=> $chans{$a} } keys %chans ) {
push( @array, "$chan/" . $chans{$chan} );
}
- &performStrictReply( $reply . ": " . join( ', ', @array ) );
+ &performStrictReply( $reply . ': ' . join( ', ', @array ) );
### total user count.
foreach $chan ( keys %channels ) {
. &fixPlural( 'user', $uucount )
. ", distributed over \002$chans\002 "
. &fixPlural( 'channel', $chans )
- . "." );
+ . '.' );
&ircCheck();
return;
my $reply =
"On \002$chan\002, there "
. &fixPlural( 'has', scalar(@array) )
- . " been "
+ . ' been '
. &IJoin(@array);
# Step 1b: check channel inconstencies.
);
if ( $delta_stats > $total ) {
- &ERROR("chaninfo: delta_stats exceeds total users.");
+ &ERROR('chaninfo: delta_stats exceeds total users.');
}
}
push( @array, "\002$int\002 $type" );
}
- $reply .= ". At the moment, " . &IJoin(@array);
+ $reply .= '. At the moment, ' . &IJoin(@array);
# Step 3:
my %new;
my @array;
if ( !scalar( keys %cmdstats ) ) {
- &performReply("no-one has run any commands yet");
+ &performReply('no-one has run any commands yet');
return;
}
push( @array, "\002$int\002 of $_" );
}
}
- &performStrictReply( "command usage include " . &IJoin(@array) . "." );
+ &performStrictReply( 'command usage include ' . &IJoin(@array) . '.' );
}
# Factoid extension info. xk++
if ( $faqtoid =~ /^\-(\S+)(\s+(.*))$/ ) {
&msg( $who,
- "error: individual factoid info queries not supported as yet." );
+ 'error: individual factoid info queries not supported as yet.' );
&msg( $who,
"it's possible that the factoid mistakenly begins with '-'." );
return;
$message = $tell_obj;
$done++ unless ( &Modules() );
- &VERB( "tell: setting old values of who and msgType.", 2 );
+ &VERB( 'tell: setting old values of who and msgType.', 2 );
$who = $oldwho;
$msgType = $oldmtype;
sub countryStats {
if ( exists $cache{countryStats} ) {
- &msg( $who, "countrystats is already running!" );
+ &msg( $who, 'countrystats is already running!' );
return;
}
my @list;
foreach ( sort { $b <=> $a } keys %count ) {
- my $str = join( ", ", sort keys %{ $count{$_} } );
+ my $str = join( ', ', sort keys %{ $count{$_} } );
# push(@list, "$str ($_)");
- my $perc = sprintf( "%.01f", 100 * $_ / $total );
+ my $perc = sprintf( '%.01f', 100 * $_ / $total );
$perc =~ s/\.0+$//;
push( @list, "$str ($_, $perc %)" );
}
# TODO: move this into a scheduler
$msgType = 'private';
- &performStrictReply( &formListReply( 0, "Country Stats ", @list ) );
+ &performStrictReply( &formListReply( 0, 'Country Stats ', @list ) );
delete $cache{countryStats};
delete $cache{on_who_Hack};
# conversion: ascii.
if ( $message =~ /^(asci*|chr) (\d+)$/ ) {
- &DEBUG("ascii/chr called ...");
+ &DEBUG('ascii/chr called ...');
return unless ( &IsChanConfOrWarn('allowConv') );
- &DEBUG("ascii/chr called");
+ &DEBUG('ascii/chr called');
$arg = $2;
$result = chr($arg);
}
if ( length $arg > 80 ) {
- &msg( $who, "Too long." );
+ &msg( $who, 'Too long.' );
return;
}
my $retval;
foreach ( split //, $arg ) {
- $retval .= sprintf( " %X", ord($_) );
+ $retval .= sprintf( ' %X', ord($_) );
}
&performStrictReply("$arg is$retval");
return unless ( &hasFlag('n') );
&status("USER reload $who");
- &performStrictReply("reloading...");
+ &performStrictReply('reloading...');
my $modules = &reloadAllModules();
&performStrictReply("reloaded:$modules");
return;
return;
}
- my $val = &getFactInfo( $factoid, "factoid_value" );
+ my $val = &getFactInfo( $factoid, 'factoid_value' );
if ( !defined $val or $val eq '' ) {
&msg( $who, "error: '$factoid' does not exist." );
return;
}
&DEBUG("val => '$val'.");
my @list =
- &searchTable( 'factoids', "factoid_key", "factoid_value", "^$val\$" );
+ &searchTable( 'factoids', 'factoid_key', 'factoid_value', "^$val\$" );
if ( scalar @list == 1 ) {
&msg( $who, "hrm... '$factoid' is unique." );
return;
}
if ( scalar @list > 5 ) {
- &msg( $who, "A bit too many factoids to be redirected, hey?" );
+ &msg( $who, 'A bit too many factoids to be redirected, hey?' );
return;
}
my @redir;
- &status( "Redirect '$factoid' (" . ($#list) . ")..." );
+ &status( "Redirect '$factoid' (" . ($#list) . ')...' );
for (@list) {
my $x = $_;
next if (/^\Q$factoid\E$/i);
&status(" Redirecting '$_'.");
my $was = &getFactoid($_);
if ( $was =~ /<REPLY> see/i ) {
- &status("warn: not redirecting a redirection.");
+ &status('warn: not redirecting a redirection.');
next;
}
&DEBUG(" was '$was'.");
push( @redir, $x );
- &setFactInfo( $x, "factoid_value", "<REPLY> see $factoid" );
+ &setFactInfo( $x, 'factoid_value', "<REPLY> see $factoid" );
}
- &status("Done.");
+ &status('Done.');
&msg( $who,
&formListReply( 0, "'$factoid' is redirected to by '", @redir ) );
# cpustats.
if ( $message =~ /^cpustats$/i ) {
if ( $^O !~ /linux/ ) {
- &ERROR("cpustats: your OS is not supported yet.");
+ &ERROR('cpustats: your OS is not supported yet.');
return;
}
close STAT;
# utime(13) + stime(14).
- my $cpu_usage = sprintf( "%.01f", ( $data[13] + $data[14] ) / 100 );
+ my $cpu_usage = sprintf( '%.01f', ( $data[13] + $data[14] ) / 100 );
# cutime(15) + cstime (16).
- my $cpu_usage2 = sprintf( "%.01f", ( $data[15] + $data[16] ) / 100 );
+ my $cpu_usage2 = sprintf( '%.01f', ( $data[15] + $data[16] ) / 100 );
my $time = time() - $^T;
my $raw_perc = $cpu_usage * 100 / $time;
my $raw_perc2 = $cpu_usage2 * 100 / $time;
my $ratio;
if ( $raw_perc > 1 ) {
- $perc = sprintf( "%.01f", $raw_perc );
- $perc2 = sprintf( "%.01f", $raw_perc2 );
- $total = sprintf( "%.01f", $raw_perc + $raw_perc2 );
+ $perc = sprintf( '%.01f', $raw_perc );
+ $perc2 = sprintf( '%.01f', $raw_perc2 );
+ $total = sprintf( '%.01f', $raw_perc + $raw_perc2 );
}
elsif ( $raw_perc > 0.1 ) {
- $perc = sprintf( "%.02f", $raw_perc );
- $perc2 = sprintf( "%.02f", $raw_perc2 );
- $total = sprintf( "%.02f", $raw_perc + $raw_perc2 );
+ $perc = sprintf( '%.02f', $raw_perc );
+ $perc2 = sprintf( '%.02f', $raw_perc2 );
+ $total = sprintf( '%.02f', $raw_perc + $raw_perc2 );
}
else { # <=0.1
- $perc = sprintf( "%.03f", $raw_perc );
- $perc2 = sprintf( "%.03f", $raw_perc2 );
- $total = sprintf( "%.03f", $raw_perc + $raw_perc2 );
+ $perc = sprintf( '%.03f', $raw_perc );
+ $perc2 = sprintf( '%.03f', $raw_perc2 );
+ $total = sprintf( '%.03f', $raw_perc + $raw_perc2 );
}
- $ratio = sprintf( "%.01f", 100 * $perc / ( $perc + $perc2 ) );
+ $ratio = sprintf( '%.01f', 100 * $perc / ( $perc + $perc2 ) );
&performStrictReply( "Total CPU usage: \002$cpu_usage\002 s ... "
. "Total used: \002$total\002 % "
my $connectivity =
100 * ( $total_time - $ircstats{'OffTime'} ) / $total_time;
- my $p = sprintf( "%.03f", $connectivity );
+ my $p = sprintf( '%.03f', $connectivity );
$p =~ s/(\.\d*)0+$/$1/;
if ( $p =~ s/\.0$// ) {
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 );
+ $logDate = sprintf( '%04d%02d%02d', $year + 1900, $month + 1, $day );
$file{log} .= $logDate;
}
if ( open( LOG, ">>$file{log}" ) ) {
- binmode( LOG, ":encoding(UTF-8)" );
+ binmode( LOG, ':encoding(UTF-8)' );
&status("Opened logfile $file{log}.");
LOG->autoflush(1);
}
}
if ( -f "$file.gz" or -f "$file.bz2" ) {
- &WARN("compress: file.(gz|bz2) already exists.");
+ &WARN('compress: file.(gz|bz2) already exists.');
return 0;
}
}
if ( !$okay ) {
- &ERROR("no compress program found.");
+ &ERROR('no compress program found.');
return 0;
}
# Something is using this w/ NULL.
if ( !defined $input or $input =~ /^\s*$/ ) {
- $input = "ERROR: Blank status call? HELP HELP HELP";
+ $input = 'ERROR: Blank status call? HELP HELP HELP';
}
for ($input) {
}
else {
sleep 1;
- &status("LOG: Throttling.");
+ &status('LOG: Throttling.');
$reset++;
}
}
$status = "!$statcount! " . $input;
if ( $statcount > 1000 ) {
print LOG "ERROR: FORKED PROCESS RAN AWAY; KILLING.\n";
- print LOG "VERB: " . ( &Time2String( $time - $forkedtime ) ) . "\n";
+ print LOG 'VERB: ' . ( &Time2String( $time - $forkedtime ) ) . "\n";
exit 0;
}
}
if ( &IsParam('VERBOSITY') ) {
if ($statcountfix) {
- printf $_red. "!%6d!" . $ob . " ", $statcount;
+ printf $_red. '!%6d!' . $ob . ' ', $statcount;
}
else {
- printf $_green. "[%6d]" . $ob . " ", $statcount;
+ printf $_green. '[%6d]' . $ob . ' ', $statcount;
}
# three uberstabs to Derek Moeller. I don't remember why but he
my $date;
if ( &IsParam('logType') and $param{'logType'} =~ /DAILY/i ) {
- $date = sprintf( "%02d:%02d.%02d", ( gmtime $time )[ 2, 1, 0 ] );
+ $date = sprintf( '%02d:%02d.%02d', ( gmtime $time )[ 2, 1, 0 ] );
my ( $day, $month, $year ) = ( gmtime $time )[ 3, 4, 5 ];
my $newlogDate =
- sprintf( "%04d%02d%02d", $year + 1900, $month + 1, $day );
+ sprintf( '%04d%02d%02d', $year + 1900, $month + 1, $day );
if ( defined $logDate and $newlogDate != $logDate ) {
&closeLog();
&compress( $file{log} );
&status("WARN: cannot open $file: $!");
return;
}
- binmode( IN, ":encoding(UTF-8)" );
+ binmode( IN, ':encoding(UTF-8)' );
# TODO: better filename.
- open( OUT, ">>debug.log" );
- binmode( OUT, ":encoding(UTF-8)" );
+ open( OUT, '>>debug.log' );
+ binmode( OUT, ':encoding(UTF-8)' );
print OUT "DEBUG: $str\n";
# note: cannot call external functions because SIG{} does not allow us to.
delete $param{'SQLDebug'};
return 0;
}
- binmode( SQLDEBUG, ":encoding(UTF-8)" );
+ binmode( SQLDEBUG, ':encoding(UTF-8)' );
&status("Opened SQL Debug file: $param{'SQLDebug'}");
return 1;
### REQUIRED MODULES.
###
-eval "use IO::Socket";
+eval 'use IO::Socket';
if ($@) {
- &ERROR("no IO::Socket?");
+ &ERROR('no IO::Socket?');
exit 1;
}
-&showProc(" (IO::Socket)");
+&showProc(' (IO::Socket)');
### THIS IS NOT LOADED ON RELOAD :(
my @myModulesLoadNow;
sub loadCoreModules {
my @mods = &getPerlFiles($bot_src_dir);
- &status("Loading CORE modules...");
+ &status('Loading CORE modules...');
foreach ( sort @mods ) {
my $mod = "$bot_src_dir/$_";
# TODO: use function to load module.
if ( $param{'DBType'} =~ /^(mysql|SQLite(2)?|pgsql)$/i ) {
- eval "use DBI";
+ eval 'use DBI';
if ($@) {
- &ERROR( "No support for DBI::" . $param{'DBType'} . ", exiting!" );
+ &ERROR( 'No support for DBI::' . $param{'DBType'} . ', exiting!' );
exit 1;
}
- &status( "Loading " . $param{'DBType'} . " support." );
+ &status( 'Loading ' . $param{'DBType'} . ' support.' );
$f = "$bot_src_dir/dbi.pl";
require $f;
$moduleAge{$f} = ( stat $f )[9];
- &showProc( " (DBI::" . $param{'DBType'} . ")" );
+ &showProc( ' (DBI::' . $param{'DBType'} . ')' );
}
else {
- &WARN("DB support DISABLED.");
+ &WARN('DB support DISABLED.');
return;
}
}
sub loadFactoidsModules {
if ( !&IsParam('factoids') ) {
- &status("Factoid support DISABLED.");
+ &status('Factoid support DISABLED.');
return;
}
- &status("Loading Factoids modules...");
+ &status('Loading Factoids modules...');
foreach ( &getPerlFiles("$bot_src_dir/Factoids") ) {
my $mod = "$bot_src_dir/Factoids/$_";
sub loadIRCModules {
my ($interface) = &whatInterface();
if ( $interface =~ /IRC/ ) {
- &status("Loading IRC modules...");
+ &status('Loading IRC modules...');
- eval "use Net::IRC";
+ eval 'use Net::IRC';
if ($@) {
- &ERROR("libnet-irc-perl is not installed!");
+ &ERROR('libnet-irc-perl is not installed!');
exit 1;
}
- &showProc(" (Net::IRC)");
+ &showProc(' (Net::IRC)');
}
else {
- &status("IRC support DISABLED.");
+ &status('IRC support DISABLED.');
# disabling forking. Why?
#$param{forking} = 0;
my $loaded = 0;
my $total = 0;
- &status("Loading MyModules...");
+ &status('Loading MyModules...');
foreach (@myModulesLoadNow) {
$total++;
if ( !defined $_ ) {
- &WARN("mMLN: null element.");
+ &WARN('mMLN: null element.');
next;
}
sub reloadAllModules {
my $retval = '';
- &VERB( "Module: reloading all.", 2 );
+ &VERB( 'Module: reloading all.', 2 );
# Reload version and save
- open( VERSION, "<VERSION" );
- $bot_release = <VERSION> || "(unknown version)";
+ open( VERSION, '<VERSION' );
+ $bot_release = <VERSION> || '(unknown version)';
chomp($bot_release);
$bot_version = "infobot $bot_release -- $^O";
close(VERSION);
$retval .= &reloadModule($_);
}
- &VERB( "Module: reloading done.", 2 );
+ &VERB( 'Module: reloading done.', 2 );
return $retval;
}
sub loadMyModule {
my ($modulename) = @_;
if ( !defined $modulename ) {
- &WARN("loadMyModule: module is NULL.");
+ &WARN('loadMyModule: module is NULL.');
return 0;
}
&shutdown() if ( defined $shm and defined $dbh );
}
else { # child.
- &DEBUG("b4 delfork 1");
+ &DEBUG('b4 delfork 1');
&delForked($modulename);
}
if ($@) {
&ERROR("cannot load my module: $modulename");
if ( $bot_pid != $$ ) { # child.
- &DEBUG("b4 delfork 2");
+ &DEBUG('b4 delfork 2');
&delForked($modulename);
exit 1;
}
}
$no_timehires = 0;
-eval "use Time::HiRes qw(gettimeofday tv_interval)";
+eval 'use Time::HiRes qw(gettimeofday tv_interval)';
if ($@) {
- &WARN("No Time::HiRes?");
+ &WARN('No Time::HiRes?');
$no_timehires = 1;
}
-&showProc(" (Time::HiRes)");
+&showProc(' (Time::HiRes)');
sub AUTOLOAD {
if ( !defined $AUTOLOAD and defined $::AUTOLOAD ) {
- &DEBUG("AUTOLOAD: hrm.. ::AUTOLOAD defined!");
+ &DEBUG('AUTOLOAD: hrm.. ::AUTOLOAD defined!');
}
return unless ( defined $AUTOLOAD );
return if ( $AUTOLOAD =~ /__/ ); # internal.
projects / infobot.git / commitdiff