#
use strict;
+use utf8;
use vars qw($statcount $bot_pid $forkedtime $statcountfix $addressed);
use vars qw($logDate $logold $logcount $logtime $logrepeat $running);
# logging support.
sub openLog {
+ binmode( STDOUT, ':encoding(UTF-8)' );
return unless ( &IsParam('logfile') );
$file{log} = $param{'logfile'};
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 );
+ my $logDir = $file{log} . sprintf('%04d', $year + 1900);
+ unless(-d $logDir) {
+ &status("openLog: making $logDir.");
+ mkdir $logDir, 0755 or &status("Cannot mkdir $logDir");;
+ }
+ $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);
}
}
#####
-# Usage: &compress($file);
-sub compress {
+# Usage: &processLog($file);
+sub processLog {
my ($file) = @_;
- my @compress = ( '/usr/bin/bzip2', '/bin/bzip2', '/bin/gzip' );
+ my @processLog = ( 'scripts/processlog', '/usr/bin/bzip2', '/bin/bzip2', '/bin/gzip' );
my $okay = 0;
if ( !-f $file ) {
- &WARN("compress: file ($file) does not exist.");
+ &WARN("processLog: file ($file) does not exist.");
return 0;
}
if ( -f "$file.gz" or -f "$file.bz2" ) {
- &WARN("compress: file.(gz|bz2) already exists.");
+ &WARN('processLog: file.(gz|bz2) already exists.');
return 0;
}
- foreach (@compress) {
+ foreach (@processLog) {
next unless ( -x $_ );
- &status("Compressing '$file' with $_.");
+ &status("Processing log '$file' with $_.");
system("$_ $file &");
$okay++;
last;
}
if ( !$okay ) {
- &ERROR("no compress program found.");
+ &ERROR('no processLog program found.');
return 0;
}
sub DEBUG {
return unless ( &IsParam('DEBUG') );
+ my (undef,undef,$line,$subroutine,undef) = caller(1);
- &status("${b_green}!DEBUG!$ob $_[0]");
+ &status("${b_green}!DEBUG!$ob ".$subroutine.'['.$line."] $_[0]");
}
sub ERROR {
- &status("${b_red}!ERROR!$ob $_[0]");
+ return unless ( &IsParam('DEBUG') );
+ my (undef,undef,$line,$subroutine,undef) = caller(1);
+
+ &status("${b_red}!ERROR!$ob ".$subroutine.'['.$line."] $_[0]");
}
sub WARN {
return if ( $_[0] =~ /^PERL: Subroutine \S+ redefined at/ );
- &status("${b_yellow}!WARN!$ob $_[0]");
+ my ($package,$filename,$line,$subroutine,undef) = caller(1);
+
+ &status("${b_yellow}!WARN!$ob ".$subroutine.'['.$line."] $_[0]");
}
sub FIXME {
- &status("${b_cyan}!FIXME!$ob $_[0]");
+ my ($package,$filename,$line,$subroutine,undef) = caller(1);
+
+ &status("${b_cyan}!FIXME!$ob ".$subroutine.'['.$line."] $_[0]");
}
sub TODO {
- &status("${b_cyan}!TODO!$ob $_[0]");
+ my ($package,$filename,$line,$subroutine,undef) = caller(1);
+
+ &status("${b_cyan}!TODO!$ob ".$subroutine.'['.$line."] $_[0]");
}
sub VERB {
# 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 );
- if ( defined $logDate and $newlogDate != $logDate ) {
+ sprintf( '%04d/%02d%02d', $year + 1900, $month + 1, $day );
+ if ( defined $logDate and $newlogDate ne $logDate ) {
&closeLog();
- &compress( $file{log} );
+ &processLog( $file{log} );
&openLog();
}
}
&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;