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

comment on
( [id://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");

[download]

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;

[download]
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":


  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others examining the Monastery: (4)
As of 2024-04-16 05:34 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found