if ( $chan eq '' ) { # all channels.
my $i = keys %channels;
- my $reply = "I'm on \002$i\002 " . &fixPlural( 'channel', $i );
my $tucount = 0; # total user count.
my $uucount = 0; # unique user count.
my %chans;
### 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 ) );
### total user count.
foreach $chan ( keys %channels ) {
$uucount = scalar( keys %nicks );
my $chans = scalar( keys %channels );
- &performStrictReply( "i've cached \002$tucount\002 "
- . &fixPlural( 'user', $tucount )
- . ", \002$uucount\002 unique "
- . &fixPlural( 'user', $uucount )
- . ", distributed over \002$chans\002 "
- . &fixPlural( 'channel', $chans )
- . "." );
- &ircCheck();
+ my $join = &ircCheck();
+ &performStrictReply(
+ "\002$chans/".($chans+$join)."\002 " . &fixPlural('channel', $chans)
+ . ", \002$tucount\002 " . &fixPlural('user', $tucount)
+ . ", \002$uucount\002 unique: "
+ . join(', ', @array));
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 includes ' . &IJoin(@array) . '.' );
+}
+
+# Command statistics.
+sub conninfo {
+ my $reply = 'conninfo:';
+ my $key;
+ foreach $key ( sort keys %::conns ) {
+ my $myconn = $::conns{$key};
+ $reply .= " $key/";
+ next if (!defined $myconn);
+ my $mynick = $myconn->nick();
+ $reply .= "$mynick";
+ }
+ &performStrictReply( "conninfo: $reply.");
}
# 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...');
+ &readUserFile();
+ &readChanFile();
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$// ) {
projects / infobot.git / blobdiff