Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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!

In reply to Log4perl log rotation in threadpool environment by rmahin

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others scrutinizing the Monastery: (10)
    As of 2014-09-16 20:27 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      How do you remember the number of days in each month?











      Results (47 votes), past polls