http://www.perlmonks.org?node_id=1004100

rmahin has asked for the wisdom of the Perl Monks concerning the following question:

Hey perlmonks,

So here is my problem. I have a program that is always running on a Windows 2008 R2 machine, and using log4perl to log all the data to the screen as well as the file. The problem is our logs get to be around 10-20gb in a week. The program has 600 threads in a thread pool, and each thread calls my $logger = Log::Log4perl->get_logger();

So I looked into log rotation. Tried using Log::Dispatch::Rotate but had no success as it seemed that it simply tries to rename the log, which doesnt ever work unless I kill the program. So no use. So the only other recommendation on the log4perl page was to use a linux utility. Also no use to me. Soo, I decided to write my own appender. Looking through the Log::Log4perl::Appender::File.pm source code, I found the subroutine file_switch(). I thought, perfect! I can use that! So after some trial and error and planning, I came up with the following solution: Define a max number of old logs to keep and increment those, and then perform a file_switch which is supposed to close the old file handle, and update the logger object to use the new filename to open the new filehandle. So, to get around the issue of renaming an open file, I decided to have 2 SWAP fails, which the logger will take turns writing to, and when it closes one, it renames that to log.old.1. Sorry if that wasnt very clear, will make more sense looking at the code.

This works! Sort of. The logic behind it is sound (i think) but, i think i have a bit of a misunderstanding of how log4perl actually works. I assumed, that the call to my $logger = Log::Log4perl->get_logger(); would always return the same logger object (ie a singleton) but this does not seem to be the case. I say that because when i run my tests, I get NUMEROUS errors about trying to write to a closed filehandle, or being unable to rename a file that is currently open. My attempt to fix the problem was to use semaphores to synchronize access to the _rotateLog() subroutine and printing to the file, in a hope that only one thread would be able to do so, and then all the others would see these effects. But this was done operating under the assumption they are all using the same $logger object. I then tried to make the appender a singleton as well, in hope that maybe THAT was what there were multiple instances of, but i saw no change.

So I am not sure where to go from here. Here is the script i used to test this. The principle is the same as my larger program and shows the same results described above.

use strict; use warnings; use threads; use threads::shared; use Thread::Queue; use Log::Log4perl; my $logOptionsFile = q( log4perl.logger=DEBUG, Screen, File #This block prints to the Screen with a msg level of INFO and higher log4perl.appender.Screen = Log::Log4perl::Appender::Screen log4perl.appender.Screen.layout=Log::Log4perl::Layout::PatternLayout log4perl.appender.Screen.layout.ConversionPattern = %-6p%12d{MM/dd HH: +mm} %X{client} %m%n log4perl.appender.Screen.Threshold = DEBUG #This block prints to the Log file with a msg level of INFO and higher log4perl.appender.File=Log::Log4perl::Appender::FileRotate # log4perl.appender.File=Log::Log4perl::Appender::File log4perl.appender.File.filename=C:/Users/RAMAHIN/Documents/Perl/logTes +ting/logSWAP0.txt log4perl.appender.File.mode=append log4perl.appender.File.max_size = 200 log4perl.appender.File.layout=Log::Log4perl::Layout::PatternLayout log4perl.appender.File.layout.ConversionPattern = %-6p%12d{MM/dd HH:mm +} %X{client} %m%n log4perl.appender.File.Threshold = DEBUG ); Log::Log4perl->init(\$logOptionsFile); my $logger = Log::Log4perl->get_logger(); Log::Log4perl::MDC->put("client", "MAIN"); $logger->info("Test Started"); my @threads; my $T //= shift || 10; my $R //= shift || 5; our $queue = Thread::Queue->new(); #create threads thats will dequeue work for(1..$T){ push @threads, async{ my $logger = Log::Log4perl->get_logger(); Log::Log4perl::MDC->put("client", threads->tid()); for my $i (1..$R){ if(my $msg = $queue->dequeue()){ $logger->debug("$i $msg"); } } }; } #Send messages for(1..($T*$R)){ $queue->enqueue("Hello World"); } $logger->info("Joining threads"); $_->join() for @threads; $logger->info("Test Ended");

And here is the appender i used. Which is basically just Log::Log4perl::Appender::File but with the changes made i described above.

################################################## package Log::Log4perl::Appender::FileRotate; ################################################## our @ISA = qw(Log::Log4perl::Appender); use warnings; use strict; use Log::Log4perl::Config::Watch; use Fcntl; use constant _INTERNAL_DEBUG => 1; use threads; use Thread::Semaphore; my $singleton; ################################################## sub new { ################################################## my($class, @options) = @_; unless(defined($singleton)){ $singleton = { name => "unknown name", umask => undef, owner => undef, group => undef, autoflush => 1, syswrite => 0, mode => "append", binmode => undef, utf8 => undef, recreate => 0, recreate_check_interval => 30, recreate_check_signal => undef, recreate_pid_write => undef, create_at_logtime => 0, header_text => undef, max_size => 1024*1024*1024, max_logs => 20, old_logs_name => "log.old", @options, }; if($singleton->{create_at_logtime}) { $singleton->{recreate} = 1; } if(defined $singleton->{umask} and $singleton->{umask} =~ /^0/ +) { # umask value is a string, meant to be an oct value $singleton->{umask} = oct($singleton->{umask}); } die "Mandatory parameter 'filename' missing" unless exists $singleton->{filename}; #initialize semaphore for synchronization my $sema = Thread::Semaphore->new(); $singleton->{sema} = $sema; bless $singleton, $class; if($singleton->{recreate_pid_write}) { print "Creating pid file", " $singleton->{recreate_pid_write}\n" if _INTERNAL_D +EBUG; open FILE, ">$singleton->{recreate_pid_write}" or die "Cannot open $singleton->{recreate_pid_write}"; print FILE "$$\n"; close FILE; } # This will die() if it fails $singleton->file_open() unless $singleton->{create_at_logtime} +; } return $singleton; } ################################################## sub filename { ################################################## my($self) = @_; return $self->{filename}; } ################################################## sub file_open { ################################################## my($self) = @_; my $arrows = ">"; my $sysmode = (O_CREAT|O_WRONLY); my $old_umask = umask(); if($self->{mode} eq "append") { $arrows = ">>"; $sysmode |= O_APPEND; } elsif ($self->{mode} eq "pipe") { $arrows = "|"; } else { $sysmode |= O_TRUNC; } my $fh = do { local *FH; *FH; }; umask($self->{umask}) if defined $self->{umask}; my $didnt_exist = ! -f $self->{filename}; if($self->{syswrite}) { sysopen $fh, "$self->{filename}", $sysmode or die "Can't sysopen $self->{filename} ($!)"; } else { open $fh, "$arrows$self->{filename}" or die "Can't open $self->{filename} ($!)"; print "Opened the filehandle using $arrows$self->{filename}\n +" if _INTERNAL_DEBUG; print "FH = " . \$fh . "\n" if _INTERNAL_DEBUG; } if($didnt_exist and ( defined $self->{owner} or defined $self->{group} ) ) { eval { $self->perms_fix() }; if($@) { # Cleanup and re-throw unlink $self->{filename}; die $@; } } if($self->{recreate}) { $self->{watcher} = Log::Log4perl::Config::Watch->new( file => $self->{filename}, (defined $self->{recreate_check_interval} ? (check_interval => $self->{recreate_check_interval}) : ( +)), (defined $self->{recreate_check_signal} ? (signal => $self->{recreate_check_signal}) : ()), ); } umask($old_umask) if defined $self->{umask}; $self->{fh} = $fh; print "Set the logger filehandle to be $self->{fh}\n" if _INTERNAL +_DEBUG; if ($self->{autoflush} and ! $self->{syswrite}) { my $oldfh = select $self->{fh}; $| = 1; select $oldfh; } if (defined $self->{binmode}) { binmode $self->{fh}, $self->{binmode}; } if (defined $self->{utf8}) { binmode $self->{fh}, ":utf8"; } if(defined $self->{header_text}) { if( $self->{header_text} !~ /\n\Z/ ) { $self->{header_text} .= "\n"; } my $fh = $self->{fh}; print $fh $self->{header_text}; } } ################################################## sub file_close { ################################################## my($self) = @_; if(defined $self->{fh}) { close $self->{fh} or die "Can't close $self->{filename} ($!)"; print "Closed the logger filehandle $self->{filename}\n" if _INTERNAL_DEBUG; } undef $self->{fh}; } ################################################## sub perms_fix { ################################################## my($self) = @_; my ($uid_org, $gid_org) = (stat $self->{filename})[4,5]; my ($uid, $gid) = ($uid_org, $gid_org); if(!defined $uid) { die "stat of $self->{filename} failed ($!)"; } my $needs_fixing = 0; if(defined $self->{owner}) { $uid = $self->{owner}; if($self->{owner} !~ /^\d+$/) { $uid = (getpwnam($self->{owner}))[2]; die "Unknown user: $self->{owner}" unless defined $uid; } } if(defined $self->{group}) { $gid = $self->{group}; if($self->{group} !~ /^\d+$/) { $gid = getgrnam($self->{group}); die "Unknown group: $self->{group}" unless defined $gid; } } if($uid != $uid_org or $gid != $gid_org) { chown($uid, $gid, $self->{filename}) or die "chown('$uid', '$gid') on '$self->{filename}' failed: +$!"; } } ################################################## sub file_switch { ################################################## my($self, $new_filename) = @_; print "Switching file from $self->{filename} to $new_filename\n" i +f _INTERNAL_DEBUG; $self->file_close(); $self->{filename} = $new_filename; $self->file_open(); } ################################################## sub log { ################################################## my($self, %params) = @_; if($self->{recreate}) { if($self->{recreate_check_signal}) { if($self->{watcher}->{signal_caught}) { $self->{watcher}->{signal_caught} = 0; $self->file_switch($self->{filename}); } } else { if(!$self->{watcher} or $self->{watcher}->file_has_moved()) { $self->file_switch($self->{filename}); } } } my $fh = $self->{fh}; $self->{sema}->down(); $self->_rotateLog(); $self->{sema}->up(); $self->{sema}->down(); if($self->{syswrite}) { defined (syswrite $fh, $params{message}) or warn "Cannot syswrite to '$self->{filename}': $!"; # die "Cannot syswrite to '$self->{filename}': $!"; } else { print $fh $params{message} or warn "Cannot write to '$self->{filename}': $!"; # die "Cannot write to '$self->{filename}': $!"; } $self->{sema}->up(); } ################################################## sub _rotateLog{ ################################################## my $self = shift; if(int(-s $self->{filename}) > $self->{max_size}){ my $logDir = ''; my $logName = ''; my $logNameNoExt = ''; my $logExt = ''; if($self->{filename} =~ /(.+[\\\/])((.+?)(\.\w+)*)$/){ $logDir = $1; $logName = $2; $logNameNoExt = $3; $logExt = $4 || ''; #just accounting for things like .log, + .txt or w/e. Handles filenames with multiple '.'s oddly, but should +still work }else{ warn "Cannot rotate the file!!!"; return; } print "Log file size limit reached. Rotating logs.\n" if _INTE +RNAL_DEBUG; # rename older logs incremented by 1 log.1 -> log.2 etc my $count = $self->{max_logs}; print "Incrementing the old logs starting at $self->{old_logs_ +name}$self->{max_logs}.\n" if _INTERNAL_DEBUG; while($count > 0){ if(-e $logDir . $self->{old_logs_name} . '.' . $count){ my $oldFile = $logDir. $self->{old_logs_name}. '.' . +$count; my $newFile = $logDir. $self->{old_logs_name}. '.' . ( +$count+1); rename($oldFile, $newFile) or warn "Unable to rename f +ile because: $!"; print "Incrementing '$oldFile' to '$newFile'.\n" if _I +NTERNAL_DEBUG; }else{ # print "'$logDir$self->{old_logs_name}.$count' did no +t exist\n" if _INTERNAL_DEBUG; } $count--; } my $currFile = $self->{filename}; my $switchFile = ''; if($self->{filename} =~ /(.+SWAP)(0|1)(.+)/){ #this should be +the case after one rotation my $newLogNum = 0 if $2 == 1; $newLogNum = 1 if $2 == 0; $switchFile = $1 . $newLogNum . $3; }else{ $switchFile = $logDir . $logNameNoExt . "SWAP0" . $logExt; } $self->file_switch($switchFile); rename($currFile, $logDir . $self->{old_logs_name} . '.' . 1) +or warn "Could not rename the log file because: $!"; } } ################################################## sub DESTROY { ################################################## my($self) = @_; if ($self->{fh}) { my $fh = $self->{fh}; close $fh; } } 1;
Any help you can give is most appreciated!

Replies are listed 'Best First'.
Re: Log4perl log rotation in threadpool environment ("share")
by tye (Sage) on Nov 16, 2012 at 04:05 UTC

    Use Win32API::File to open the log file with FILE_SHARE_DELETE enabled (which allows renaming while the file handle is still open) and tell Log4perl to log to that file handle.

    - tye        

      Interesting! Wasn't aware ya could do that. Didnt have much luck using this due to the file handle it returned not being a typical file handle. Was able to get stuff to print, but not after I set the handle as a property of the object. Could probably get it to work if I reworked more of the code, but the post below seems to work well. Thanks for you input!

        You open a file with, for example, createFile(), and then get a "typical file handle" via OsFHandleOpen(). (Win32API::File)

        I should just submit a patch to make FILE_SHARE_DELETE be the default for Perl.

        - tye        

Re: Log4perl log rotation in threadpool environment
by space_monk (Chaplain) on Nov 16, 2012 at 09:45 UTC

    Maybe you can:

    1. copy the existing log file to a new name
      e.g. copy log_file to log_file.2012-11-16
    2. truncate the log file
    3. Optionally zip the archive file

    That way the file handle for the log file doesn't change.

    A Monk aims to give answers to those who have none, and to learn from those who know more.
      Thanks! That was my original idea actually but wasnt aware I could erase (truncate was apparently the word I should have search on) the contents of the file with file handle open. Changed my obnoxious swapping code to
      copy($currFile, $logDir. $self->{old_logs_name}. '.1') or die +"Could not copy the log file because $!"; my $fh = $self->{fh}; truncate($fh, 0) or die "Could not truncate the log file becau +se $!"; seek($fh, 0, 0) or die "Could not set the position in the log +file because $!";
      Thanks again!
        Another satisfied customer :-)
        A Monk aims to give answers to those who have none, and to learn from those who know more.