From dd3a610c735093c82495a37a26a6353fd776dc43 Mon Sep 17 00:00:00 2001 From: timriker Date: Fri, 18 Apr 2008 23:44:54 +0000 Subject: [PATCH] more lame "s git-svn-id: https://svn.code.sf.net/p/infobot/code/trunk@1771 c11ca15a-4712-0410-83d8-924469b57eb5 --- src/CLI/Support.pl | 12 +++---- src/DynaConfig.pl | 54 ++++++++++++++--------------- src/IRC/Irc.pl | 68 ++++++++++++++++++------------------ src/IRC/IrcHelpers.pl | 28 +++++++-------- src/IRC/IrcHooks.pl | 18 +++++----- src/IRC/Schedulers.pl | 78 ++++++++++++++++++++--------------------- src/Net.pl | 28 +++++++-------- src/Process.pl | 20 +++++------ src/Shm.pl | 20 +++++------ src/UserExtra.pl | 80 +++++++++++++++++++++---------------------- src/logger.pl | 30 ++++++++-------- src/modules.pl | 58 +++++++++++++++---------------- 12 files changed, 247 insertions(+), 247 deletions(-) diff --git a/src/CLI/Support.pl b/src/CLI/Support.pl index fd2d8c5..849e438 100644 --- a/src/CLI/Support.pl +++ b/src/CLI/Support.pl @@ -11,15 +11,15 @@ my $postprocess; 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'; @@ -43,7 +43,7 @@ sub cliloop { sub msg { my ( $nick, $msg ) = @_; if ( !defined $nick ) { - &ERROR("msg: nick == NULL."); + &ERROR('msg: nick == NULL.'); return; } @@ -72,12 +72,12 @@ sub msg { 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 ); } diff --git a/src/DynaConfig.pl b/src/DynaConfig.pl index f272c53..e52a2ea 100644 --- a/src/DynaConfig.pl +++ b/src/DynaConfig.pl @@ -42,7 +42,7 @@ sub readUserFile { 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; } @@ -51,7 +51,7 @@ sub readUserFile { my $s2 = -s "$f~"; if ( $s2 > $s1 * 3 ) { - &FIXME("rUF: backup file bigger than current file."); + &FIXME('rUF: backup file bigger than current file.'); } } @@ -67,7 +67,7 @@ sub readUserFile { my $ver = ; if ( $ver !~ /^#v1/ ) { - &ERROR("old or invalid user file found."); + &ERROR('old or invalid user file found.'); &closeLog(); exit 1; # correct? } @@ -145,7 +145,7 @@ sub readUserFile { &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 ), # ?? @@ -155,7 +155,7 @@ sub readUserFile { sub writeUserFile { if ( !scalar keys %users ) { - &DEBUG("wUF: nothing to write."); + &DEBUG('wUF: nothing to write.'); return; } @@ -263,7 +263,7 @@ sub writeUserFile { "--- Saved USERFILE ($cusers users; $cbans bans; $cignore ignore) at $time" ); if ( defined $msgType and $msgType =~ /^chat$/ ) { - &performStrictReply("--- Writing user file..."); + &performStrictReply('--- Writing user file...'); } } @@ -278,7 +278,7 @@ sub readChanFile { my $s2 = -s "$f~"; if ( $s2 > $s1 * 3 ) { - &FIXME("rCF: backup file bigger than current file."); + &FIXME('rCF: backup file bigger than current file.'); } } @@ -336,12 +336,12 @@ sub readChanFile { } &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; } @@ -365,7 +365,7 @@ sub writeChanFile { 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} ); @@ -385,7 +385,7 @@ sub writeChanFile { my ( %optsval, %opts ); foreach ( keys %chanconf ) { $chan = $_; - next if ( $chan eq "_default" ); + next if ( $chan eq '_default' ); my $opt; foreach ( keys %{ $chanconf{$chan} } ) { @@ -438,12 +438,12 @@ sub writeChanFile { 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...'); } } @@ -483,7 +483,7 @@ sub verifyUser { $userHandle = ''; foreach $user ( keys %users ) { - next if ( $user eq "_default" ); + next if ( $user eq '_default' ); foreach $m ( keys %{ $users{$user}{HOSTS} } ) { $m =~ s/\?/./g; @@ -510,7 +510,7 @@ sub verifyUser { } } - $userHandle ||= "_default"; + $userHandle ||= '_default'; # what's talkchannel for? $talkWho{$talkchannel} = $who if ( defined $talkchannel ); @@ -616,7 +616,7 @@ sub ignoreDel { push( @match, $chan ); } - &DEBUG( "iD: scalar => " . scalar( keys %{ $ignore{$chan} } ) ); + &DEBUG( 'iD: scalar => ' . scalar( keys %{ $ignore{$chan} } ) ); } if ( scalar @match ) { @@ -710,7 +710,7 @@ sub banDel { push( @match, $chan ); } - &DEBUG( "bans: scalar => " . scalar( keys %{ $bans{$chan} } ) ); + &DEBUG( 'bans: scalar => ' . scalar( keys %{ $bans{$chan} } ) ); } if ( scalar @match ) { @@ -736,7 +736,7 @@ sub getUser { my ($user) = @_; if ( !defined $user ) { - &WARN("getUser: user == NULL."); + &WARN('getUser: user == NULL.'); return; } @@ -757,7 +757,7 @@ sub getUser { 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; @@ -779,10 +779,10 @@ sub chanSet { 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. @@ -821,7 +821,7 @@ sub chanSet { } elsif ( defined $val ) { - ### ".chanset blah testing" + ### '.chanset blah testing' my $was = $chanconf{$chan}{$what}; if ( defined $was and $was eq $val ) { @@ -838,11 +838,11 @@ sub chanSet { } else { # read only. - ### ".chanset" - ### ".chanset blah" + ### '.chanset' + ### '.chanset blah' if ( !defined $what ) { - &WARN("chanset/DC: what == undefine."); + &WARN('chanset/DC: what == undefine.'); return; } @@ -892,7 +892,7 @@ sub rehashConfVars { } } - &DEBUG("end of rehashConfVars"); + &DEBUG('end of rehashConfVars'); delete $cache{confvars}; } diff --git a/src/IRC/Irc.pl b/src/IRC/Irc.pl index 82542af..e4c43a8 100644 --- a/src/IRC/Irc.pl +++ b/src/IRC/Irc.pl @@ -39,14 +39,14 @@ sub ircloop { # 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; } @@ -57,19 +57,19 @@ sub ircloop { $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; @@ -119,16 +119,16 @@ sub irc { $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); @@ -200,7 +200,7 @@ sub irc { # should likely listen on a tcp port instead #$irc->addfh(STDIN, \&on_stdin, 'r'); - &status("starting main loop"); + &status('starting main loop'); $irc->start; } @@ -234,7 +234,7 @@ sub say { } 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; @@ -286,7 +286,7 @@ sub say { sub msg { my ( $nick, $msg ) = @_; if ( !defined $nick ) { - &ERROR("msg: nick == NULL."); + &ERROR('msg: nick == NULL.'); return; } @@ -298,7 +298,7 @@ sub msg { # 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; @@ -338,19 +338,19 @@ sub action { 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 ); } @@ -362,7 +362,7 @@ sub action { sub notice { my ( $target, $txt ) = @_; if ( !defined $txt ) { - &WARN("notice: txt == NULL."); + &WARN('notice: txt == NULL.'); return; } @@ -414,7 +414,7 @@ sub performReply { my ($reply) = @_; if ( !defined $reply or $reply =~ /^\s*$/ ) { - &DEBUG("performReply: reply == NULL."); + &DEBUG('performReply: reply == NULL.'); return; } @@ -492,7 +492,7 @@ sub dccsay { my ( $who, $reply ) = @_; if ( !defined $reply or $reply =~ /^\s*$/ ) { - &WARN("dccsay: reply == NULL."); + &WARN('dccsay: reply == NULL.'); return; } @@ -537,7 +537,7 @@ sub joinchan { 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(); @@ -571,7 +571,7 @@ sub part { sub mode { my ( $chan, @modes ) = @_; - my $modes = join( " ", @modes ); + my $modes = join( ' ', @modes ); if ( &validChan($chan) == 0 ) { &ERROR("mode: invalid chan => '$chan'."); @@ -676,11 +676,11 @@ sub unban { 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!'); } } @@ -689,12 +689,12 @@ sub nick { 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; } @@ -705,7 +705,7 @@ sub nick { 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; @@ -759,8 +759,8 @@ sub joinNextChan { 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"); @@ -799,7 +799,7 @@ sub IsNickInChan { $chan =~ tr/A-Z/a-z/; # not lowercase unfortunately. if ( $chan =~ /^$/ ) { - &DEBUG("INIC: chan == NULL."); + &DEBUG('INIC: chan == NULL.'); return 0; } @@ -814,7 +814,7 @@ sub IsNickInChan { 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; } @@ -850,7 +850,7 @@ sub validChan { 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; } @@ -901,7 +901,7 @@ sub getJoinChans { 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(); } @@ -959,7 +959,7 @@ sub getJoinChans { sub closeDCC { - # &DEBUG("closeDCC called."); + # &DEBUG('closeDCC called.'); my $type; foreach $type ( keys %dcc ) { diff --git a/src/IRC/IrcHelpers.pl b/src/IRC/IrcHelpers.pl index 187df0a..67487a2 100644 --- a/src/IRC/IrcHelpers.pl +++ b/src/IRC/IrcHelpers.pl @@ -21,8 +21,8 @@ sub hookMode { # 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; } @@ -47,7 +47,7 @@ sub hookMode { # 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); } @@ -141,10 +141,10 @@ sub hookMsg { 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. @@ -171,9 +171,9 @@ sub hookMsg { } &msg( $who, join( ' ', @who ) - . " already said that " + . ' already said that ' . ( time - $time ) - . " seconds ago" ); + . ' seconds ago' ); ### TODO: delete old floodwarn{} keys. my $floodwarn = 0; @@ -208,12 +208,12 @@ sub hookMsg { # 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. @@ -233,7 +233,7 @@ sub hookMsg { &status("FLOOD overflow detected from $floodwho; ignoring"); &ignoreAdd( "*!$uh", $chan, $expire, - "flood overflow auto-detected." ); + 'flood overflow auto-detected.' ); return; } @@ -312,7 +312,7 @@ sub hookMsg { if ( defined $nuh ) { if ( !defined $userHandle ) { - &DEBUG("line 1074: need verifyUser?"); + &DEBUG('line 1074: need verifyUser?'); &verifyUser( $who, $nuh ); } } @@ -383,9 +383,9 @@ sub chanLimitVerify { &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(); } @@ -393,7 +393,7 @@ sub chanServCheck { ($chan) = @_; if ( !defined $chan or $chan =~ /^\s*$/ ) { - &WARN("chanServCheck: chan == NULL."); + &WARN('chanServCheck: chan == NULL.'); return 0; } diff --git a/src/IRC/IrcHooks.pl b/src/IRC/IrcHooks.pl index 9fee830..af96470 100644 --- a/src/IRC/IrcHooks.pl +++ b/src/IRC/IrcHooks.pl @@ -468,7 +468,7 @@ sub on_endofnames { &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(); } ); } @@ -825,10 +825,10 @@ sub on_notice { $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; } @@ -845,7 +845,7 @@ sub on_notice { next unless &chanServCheck($_); next if ($done); &DEBUG( - "nickserv activated or restarted; doing chanserv check."); + 'nickserv activated or restarted; doing chanserv check.'); $done++; } @@ -874,7 +874,7 @@ sub on_other { my $chan = ( $event->to )[0]; my $nick = $event->nick; - &status("!!! other called."); + &status('!!! other called.'); &status("!!! $event->args"); } @@ -928,7 +928,7 @@ sub on_ping_reply { 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; } @@ -954,7 +954,7 @@ sub on_public { # 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); } @@ -969,7 +969,7 @@ sub on_public { # 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 ); @@ -982,7 +982,7 @@ sub on_public { &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', diff --git a/src/IRC/Schedulers.pl b/src/IRC/Schedulers.pl index 3fd89ba..2436151 100644 --- a/src/IRC/Schedulers.pl +++ b/src/IRC/Schedulers.pl @@ -22,7 +22,7 @@ use vars qw(%sched %schedule); #}; sub setupSchedulers { - &VERB( "Starting schedulers...", 2 ); + &VERB( 'Starting schedulers...', 2 ); # ONCE OFF. @@ -86,13 +86,13 @@ sub ScheduleThis { 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 ); @@ -134,14 +134,14 @@ sub randomQuote { 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. @@ -163,7 +163,7 @@ sub randomFactoid { &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 @@ -174,7 +174,7 @@ sub randomFactoid { $error++; if ( $error == 5 ) { - &ERROR("rF: tried 5 times but failed."); + &ERROR('rF: tried 5 times but failed.'); return; } } @@ -196,15 +196,15 @@ sub logLoop { ### 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++; } @@ -215,7 +215,7 @@ sub logLoop { 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. @@ -273,17 +273,17 @@ sub seenFlushOld { 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"; } @@ -299,7 +299,7 @@ sub seenFlushOld { } } else { - &FIXME( "seenFlushOld: for bad DBType:" . $param{'DBType'} . "." ); + &FIXME( 'seenFlushOld: for bad DBType:' . $param{'DBType'} . '.' ); } &VERB( "SEEN deleted $delete seen entries.", 2 ); @@ -412,9 +412,9 @@ sub chanlimitCheck { 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; @@ -422,7 +422,7 @@ sub chanlimitCheck { 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. } @@ -455,7 +455,7 @@ sub chanlimitCheck { } } - $conn->mode( $chan, "+l", $newlimit ); + $conn->mode( $chan, '+l', $newlimit ); $cache{chanlimitChange}{$chan} = time(); } } @@ -473,7 +473,7 @@ sub netsplitCheck { # &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; } @@ -529,12 +529,12 @@ sub netsplitCheck { } 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(); } } @@ -599,13 +599,13 @@ sub seenFlush { } } 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 ) @@ -614,14 +614,14 @@ sub seenFlush { ) 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 { @@ -796,7 +796,7 @@ sub miscCheck { # SHM check. my @ipcs; - if ( -x "/usr/bin/ipcs" ) { + if ( -x '/usr/bin/ipcs' ) { @ipcs = `/usr/bin/ipcs`; } else { @@ -805,9 +805,9 @@ sub miscCheck { } # 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} } ) { @@ -870,7 +870,7 @@ sub miscCheck2 { # 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."); @@ -894,7 +894,7 @@ sub getNickInUse { # FIXME: broken for multiple connects # if ($ident eq $param{'ircNick'}) { - # &status("okay, got my nick back."); + # &status('okay, got my nick back.'); # return; # } # @@ -1073,7 +1073,7 @@ sub factoidCheck { } 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 ) { @@ -1090,9 +1090,9 @@ sub factoidCheck { 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; } @@ -1122,7 +1122,7 @@ sub dccStatus { 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 ) { @@ -1146,7 +1146,7 @@ sub scheduleList { # b - weird time. ### - my $reply = "sched:"; + my $reply = 'sched:'; foreach ( keys %{ $irc->{_queue} } ) { my $q = $_; my $coderef = $irc->{_queue}->{$q}->[1]; diff --git a/src/Net.pl b/src/Net.pl index 6fee231..1cd24ab 100644 --- a/src/Net.pl +++ b/src/Net.pl @@ -14,7 +14,7 @@ sub ftpGet { 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( @@ -27,10 +27,10 @@ sub ftpGet { # 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; } @@ -58,7 +58,7 @@ sub ftpGet { if ($verbose_ftp); } else { - &status("FTP: same size; skipping."); + &status('FTP: same size; skipping.'); system("touch $thisfile"); # lame hack. $ftp->quit(); return 1; @@ -66,7 +66,7 @@ sub ftpGet { } } else { - &status("FTP: file does not exist."); + &status('FTP: file does not exist.'); $ftp->quit(); return 0; } @@ -84,13 +84,13 @@ sub ftpGet { 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; @@ -109,7 +109,7 @@ sub ftpList { 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 ); @@ -118,10 +118,10 @@ sub ftpList { # 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; } @@ -136,7 +136,7 @@ sub ftpList { 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. @@ -152,7 +152,7 @@ sub ftpList { &DEBUG("FTP: UNKNOWN => '$_'."); } } - &status( "FTP: ls done. " . scalar( keys %ftp ) . " entries." ); + &status( 'FTP: ls done. ' . scalar( keys %ftp ) . ' entries.' ); $ftp->quit(); return %ftp; @@ -165,7 +165,7 @@ sub getURL { 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'); @@ -185,7 +185,7 @@ sub getURL { 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)" ); } diff --git a/src/Process.pl b/src/Process.pl index d493346..91b3f9d 100644 --- a/src/Process.pl +++ b/src/Process.pl @@ -32,7 +32,7 @@ sub process { &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' ) { @@ -44,7 +44,7 @@ sub process { 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'); @@ -105,7 +105,7 @@ sub process { my @array = split / /, $message; if ( $who =~ /^_default$/i ) { - &performStrictReply("you are too eleet."); + &performStrictReply('you are too eleet.'); return; } @@ -147,7 +147,7 @@ sub process { my @array = split ' ', $message; if ( $who =~ /^_default$/i ) { - &performStrictReply("you are too eleet."); + &performStrictReply('you are too eleet.'); return; } @@ -171,7 +171,7 @@ sub process { } if ($first) { - &performStrictReply("First time user... adding you as Master."); + &performStrictReply('First time user... adding you as Master.'); $users{$who}{FLAGS} = 'aemnorst'; } @@ -182,7 +182,7 @@ sub process { } if ( !defined $host ) { - &WARN("pass: host == NULL."); + &WARN('pass: host == NULL.'); return; } @@ -259,11 +259,11 @@ sub process { 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; } @@ -309,7 +309,7 @@ sub process { && &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 ) { @@ -370,7 +370,7 @@ sub process { &FactoidStuff(); } elsif ( $param{'DBType'} =~ /^none$/i ) { - return "NO FACTOIDS."; + return 'NO FACTOIDS.'; } else { &ERROR("INVALID FACTOID SUPPORT? ($param{'DBType'})"); diff --git a/src/Shm.pl b/src/Shm.pl index 4cfd4e0..9717b46 100644 --- a/src/Shm.pl +++ b/src/Shm.pl @@ -16,7 +16,7 @@ sub openSHM { 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; } @@ -30,8 +30,8 @@ sub openSHM { 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; } } @@ -99,10 +99,10 @@ sub shmWrite { 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 ) ) { @@ -123,7 +123,7 @@ sub addForked { $forker = $name; if ( !defined $name ) { - &WARN("addForked: name == NULL."); + &WARN('addForked: name == NULL.'); return 0; } @@ -193,12 +193,12 @@ sub addForked { } 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; } @@ -233,7 +233,7 @@ sub delForked { return if ( $$ == $bot_pid ); if ( !defined $name ) { - &WARN("delForked: name == NULL."); + &WARN('delForked: name == NULL.'); POSIX::_exit(0); } @@ -288,7 +288,7 @@ sub shmFlush { 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."); diff --git a/src/UserExtra.pl b/src/UserExtra.pl index ee004db..47551b5 100644 --- a/src/UserExtra.pl +++ b/src/UserExtra.pl @@ -30,7 +30,7 @@ sub chaninfo { ### line 1. foreach ( keys %channels ) { if ( /^\s*$/ or / / ) { - &status("chanstats: fe channels: chan == NULL."); + &status('chanstats: fe channels: chan == NULL.'); #&ircCheck(); next; @@ -42,7 +42,7 @@ sub chaninfo { 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 ) { @@ -66,7 +66,7 @@ sub chaninfo { . &fixPlural( 'user', $uucount ) . ", distributed over \002$chans\002 " . &fixPlural( 'channel', $chans ) - . "." ); + . '.' ); &ircCheck(); return; @@ -90,7 +90,7 @@ sub chaninfo { my $reply = "On \002$chan\002, there " . &fixPlural( 'has', scalar(@array) ) - . " been " + . ' been ' . &IJoin(@array); # Step 1b: check channel inconstencies. @@ -108,7 +108,7 @@ sub chaninfo { ); if ( $delta_stats > $total ) { - &ERROR("chaninfo: delta_stats exceeds total users."); + &ERROR('chaninfo: delta_stats exceeds total users.'); } } @@ -125,7 +125,7 @@ sub chaninfo { push( @array, "\002$int\002 $type" ); } - $reply .= ". At the moment, " . &IJoin(@array); + $reply .= '. At the moment, ' . &IJoin(@array); # Step 3: my %new; @@ -153,7 +153,7 @@ sub cmdstats { my @array; if ( !scalar( keys %cmdstats ) ) { - &performReply("no-one has run any commands yet"); + &performReply('no-one has run any commands yet'); return; } @@ -170,7 +170,7 @@ sub cmdstats { push( @array, "\002$int\002 of $_" ); } } - &performStrictReply( "command usage include " . &IJoin(@array) . "." ); + &performStrictReply( 'command usage include ' . &IJoin(@array) . '.' ); } # Factoid extension info. xk++ @@ -180,7 +180,7 @@ sub factinfo { 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; @@ -301,7 +301,7 @@ sub tell { $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; @@ -336,7 +336,7 @@ sub tell { sub countryStats { if ( exists $cache{countryStats} ) { - &msg( $who, "countrystats is already running!" ); + &msg( $who, 'countrystats is already running!' ); return; } @@ -381,17 +381,17 @@ sub do_countrystats { 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}; @@ -405,10 +405,10 @@ sub userCommands { # 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); @@ -455,13 +455,13 @@ sub userCommands { } 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"); @@ -516,7 +516,7 @@ sub userCommands { return unless ( &hasFlag('n') ); &status("USER reload $who"); - &performStrictReply("reloading..."); + &performStrictReply('reloading...'); my $modules = &reloadAllModules(); &performStrictReply("reloaded:$modules"); return; @@ -532,26 +532,26 @@ sub userCommands { 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); @@ -559,15 +559,15 @@ sub userCommands { &status(" Redirecting '$_'."); my $was = &getFactoid($_); if ( $was =~ / 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", " see $factoid" ); + &setFactInfo( $x, 'factoid_value', " see $factoid" ); } - &status("Done."); + &status('Done.'); &msg( $who, &formListReply( 0, "'$factoid' is redirected to by '", @redir ) ); @@ -602,7 +602,7 @@ sub userCommands { # 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; } @@ -614,10 +614,10 @@ sub userCommands { 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; @@ -627,21 +627,21 @@ sub userCommands { 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 % " @@ -663,7 +663,7 @@ sub userCommands { 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$// ) { diff --git a/src/logger.pl b/src/logger.pl index 40a30ec..fd3d6a7 100644 --- a/src/logger.pl +++ b/src/logger.pl @@ -110,12 +110,12 @@ sub openLog { 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); } @@ -147,7 +147,7 @@ sub compress { } if ( -f "$file.gz" or -f "$file.bz2" ) { - &WARN("compress: file.(gz|bz2) already exists."); + &WARN('compress: file.(gz|bz2) already exists.'); return 0; } @@ -161,7 +161,7 @@ sub compress { } if ( !$okay ) { - &ERROR("no compress program found."); + &ERROR('no compress program found.'); return 0; } @@ -243,7 +243,7 @@ sub status { # 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) { @@ -279,7 +279,7 @@ sub status { } else { sleep 1; - &status("LOG: Throttling."); + &status('LOG: Throttling.'); $reset++; } } @@ -297,7 +297,7 @@ sub status { $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; } } @@ -312,10 +312,10 @@ sub status { 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 @@ -396,11 +396,11 @@ sub status { 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} ); @@ -425,11 +425,11 @@ sub debug_perl { &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. @@ -465,7 +465,7 @@ sub openSQLDebug { delete $param{'SQLDebug'}; return 0; } - binmode( SQLDEBUG, ":encoding(UTF-8)" ); + binmode( SQLDEBUG, ':encoding(UTF-8)' ); &status("Opened SQL Debug file: $param{'SQLDebug'}"); return 1; diff --git a/src/modules.pl b/src/modules.pl index f66237d..2179b96 100644 --- a/src/modules.pl +++ b/src/modules.pl @@ -13,12 +13,12 @@ use vars qw($AUTOLOAD $no_timehires $bot_version $bot_release); ### 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; @@ -35,7 +35,7 @@ BEGIN { sub loadCoreModules { my @mods = &getPerlFiles($bot_src_dir); - &status("Loading CORE modules..."); + &status('Loading CORE modules...'); foreach ( sort @mods ) { my $mod = "$bot_src_dir/$_"; @@ -58,31 +58,31 @@ sub loadDBModules { # 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/$_"; @@ -101,17 +101,17 @@ sub loadFactoidsModules { 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; @@ -140,11 +140,11 @@ sub loadMyModulesNow { 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; } @@ -165,11 +165,11 @@ sub loadMyModulesNow { sub reloadAllModules { my $retval = ''; - &VERB( "Module: reloading all.", 2 ); + &VERB( 'Module: reloading all.', 2 ); # Reload version and save - open( VERSION, " || "(unknown version)"; + open( VERSION, ' || '(unknown version)'; chomp($bot_release); $bot_version = "infobot $bot_release -- $^O"; close(VERSION); @@ -179,7 +179,7 @@ sub reloadAllModules { $retval .= &reloadModule($_); } - &VERB( "Module: reloading done.", 2 ); + &VERB( 'Module: reloading done.', 2 ); return $retval; } @@ -277,7 +277,7 @@ sub loadPerlModule { sub loadMyModule { my ($modulename) = @_; if ( !defined $modulename ) { - &WARN("loadMyModule: module is NULL."); + &WARN('loadMyModule: module is NULL.'); return 0; } @@ -295,7 +295,7 @@ sub loadMyModule { &shutdown() if ( defined $shm and defined $dbh ); } else { # child. - &DEBUG("b4 delfork 1"); + &DEBUG('b4 delfork 1'); &delForked($modulename); } @@ -306,7 +306,7 @@ sub loadMyModule { if ($@) { &ERROR("cannot load my module: $modulename"); if ( $bot_pid != $$ ) { # child. - &DEBUG("b4 delfork 2"); + &DEBUG('b4 delfork 2'); &delForked($modulename); exit 1; } @@ -323,16 +323,16 @@ sub loadMyModule { } $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. -- 2.39.2