Log-Agent-Rotate-1.200000755000000000000 012627346374 15072 5ustar00unknownunknown000000000000Log-Agent-Rotate-1.200/Build.PL000444000000000000 246212627345755 16531 0ustar00unknownunknown000000000000#!./perl ########################################################################### # # Build.PL # # Copyright (C) 2015 Mark Rogaski (mrogaski@cpan.org); # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################## use 5.006; use strict; use warnings; use Module::Build; my $builder = Module::Build->new( module_name => 'Log::Agent::Rotate', license => 'artistic_2', dist_author => q{Mark Rogaski }, dist_version_from => 'lib/Log/Agent/Rotate.pm', license => 'artistic_2', release_status => 'stable', configure_requires => { 'Module::Build' => 0, 'Test::More' => '0', 'File::Copy' => '0', 'Compress::Zlib' => '0.4', 'Getargs::Long' => '0.103', 'LockFile::Simple' => '0.202', 'Log::Agent' => '0.201', }, requires => { 'Compress::Zlib' => '0.4', 'Getargs::Long' => '0.103', 'LockFile::Simple' => '0.202', 'Log::Agent' => '0.201', }, add_to_cleanup => [ 'Log-Agent-Rotate-*' ], create_makefile_pl => 'traditional', ); $builder->create_build_script(); Log-Agent-Rotate-1.200/CHANGELOG.md000444000000000000 437212627346231 17036 0ustar00unknownunknown000000000000# Change Log ## [1.200] - 2015-12-01 ### Changed - Converted build script to Module::Build. - Refactored to use the constant pragma. ### Fixed - Metadata files will now be generated dynamically. ## [1.001] - 2015-11-30 ### Changed - Moved change log from changes.pod to CHANGELOG.md. ### Fixed - Removed dependency on Log::Agent in Makefile.PL. ## [1.000] - 2013-08-12 ### Added - Added BUILD_REQUIRES dependencies. ### Changed - Switched to standard X.YYYZZZ versioning. Usage with previous versions will work as expected, but the documentation will be much clearer. - Replace META.yml with META.json. ### Fixed - Fixed several tests for Win32 platforms. ## [0.104] - 2002-05-14 ### Added - Allow restriction of file permissions with -file_perm argument to Log::Agent::Rotate->make(). ### Changed - Development and maintenance handed over to [Mark Rogaski](mailto:mrogaski@cpan.org). ## 0.103 - 2001-04-11 ### Added - Mark rotation in the logfile before rotating it, so that any pending "tail -f" gets to know about it. Added a regression test for it. ### Changed - Now depends on Getargs::Long for argument parsing. ## 0.102 - 2000-11-12 ### Changed - Changed pre-req on Log::Agent: must now use 0.2.1. - Changed DLSI description to match CPAN's. - New -single\_host parameter is used to optimize LockFile::Simple:. We don't supply -nfs when -single_host is true, for faster locking procedure. ### Fixed - Untaint data read or rename() complains under -T. ## 0.101 - 2000-11-06 ### Added - Added is_same() to compare rotation policies. - Added build_pm_hash() to compute PM value from MANIFEST. ### Changed - Moved to an array representation for the config object. - Updated t/badconf.t to new detection logic within Log::Agent. ### Removed - Removed reference to driver and the ability to specify -max_time in other units than seconds (e.g. "2d"). ## 0.100 - 2000-05-05 Initial revision. [1.200]: https://github.com/mrogaski/Log-Agent-Rotate/compare/v1.001...v1.200 [1.001]: https://github.com/mrogaski/Log-Agent-Rotate/compare/v1.000...v1.001 [1.000]: https://github.com/mrogaski/Log-Agent-Rotate/compare/rel0_1_4...v1.000 [0.104]: https://github.com/mrogaski/Log-Agent-Rotate/compare/rel0_1_3...rel0_1_4 Log-Agent-Rotate-1.200/Makefile.PL000444000000000000 100012627346374 17170 0ustar00unknownunknown000000000000# Note: this file was auto-generated by Module::Build::Compat version 0.4212 use ExtUtils::MakeMaker; WriteMakefile ( 'PREREQ_PM' => { 'Compress::Zlib' => '0.4', 'LockFile::Simple' => '0.202', 'Log::Agent' => '0.201', 'Getargs::Long' => '0.103' }, 'NAME' => 'Log::Agent::Rotate', 'INSTALLDIRS' => 'site', 'EXE_FILES' => [], 'PL_FILES' => {}, 'VERSION_FROM' => 'lib/Log/Agent/Rotate.pm' ) ; Log-Agent-Rotate-1.200/MANIFEST000444000000000000 34712627346374 16344 0ustar00unknownunknown000000000000Build.PL CHANGELOG.md lib/Log/Agent/File/Rotate.pm lib/Log/Agent/Rotate.pm MANIFEST This list of files README t/badconf.t t/code.pl t/hole.t t/mixed.t t/normal.t t/perm.t t/rename.t Makefile.PL META.yml META.json Log-Agent-Rotate-1.200/META.json000444000000000000 265512627346374 16660 0ustar00unknownunknown000000000000{ "abstract" : "parameters for logfile rotation", "author" : [ "Mark Rogaski " ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4212", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Log-Agent-Rotate", "prereqs" : { "configure" : { "requires" : { "Compress::Zlib" : "0.4", "File::Copy" : "0", "Getargs::Long" : "0.103", "LockFile::Simple" : "0.202", "Log::Agent" : "0.201", "Module::Build" : "0", "Test::More" : "0" } }, "runtime" : { "requires" : { "Compress::Zlib" : "0.4", "Getargs::Long" : "0.103", "LockFile::Simple" : "0.202", "Log::Agent" : "0.201" } } }, "provides" : { "Log::Agent::File::Rotate" : { "file" : "lib/Log/Agent/File/Rotate.pm" }, "Log::Agent::Rotate" : { "file" : "lib/Log/Agent/Rotate.pm", "version" : "1.200" } }, "release_status" : "stable", "resources" : { "license" : [ "http://opensource.org/licenses/artistic-license-2.0.php" ] }, "version" : "1.200", "x_serialization_backend" : "JSON version 2.90" } Log-Agent-Rotate-1.200/META.yml000444000000000000 164512627346374 16506 0ustar00unknownunknown000000000000--- abstract: parameters for logfile rotation author: - 'Mark Rogaski ' build_requires: {} configure_requires: Compress::Zlib: 0.4 File::Copy: 0 Getargs::Long: 0.103 LockFile::Simple: 0.202 Log::Agent: 0.201 Module::Build: 0 Test::More: 0 dynamic_config: 1 generated_by: 'Module::Build version 0.4212, CPAN::Meta::Converter version 2.150005' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Log-Agent-Rotate provides: Log::Agent::File::Rotate: file: lib/Log/Agent/File/Rotate.pm Log::Agent::Rotate: file: lib/Log/Agent/Rotate.pm version: 1.200 requires: Compress::Zlib: 0.4 Getargs::Long: 0.103 LockFile::Simple: 0.202 Log::Agent: 0.201 resources: license: http://opensource.org/licenses/artistic-license-2.0.php version: 1.200 x_serialization_backend: YAML version 1.15 Log-Agent-Rotate-1.200/README000444000000000000 571112627345755 16115 0ustar00unknownunknown000000000000 Log::Agent::Rotate 1.200 Copyright (c) 2000, Raphael Manfredi Copyright (c) 2002-2015 Mark Rogaski; mrogaski@cpan.org; all rights reserved. ------------------------------------------------------------------------ This program is free software; you can redistribute it and/or modify it under the terms of the Artistic License 2.0, a copy of which can be found with perl. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Artistic License 2.0 for more details. http://www.perlfoundation.org/artistic_license_2_0 ------------------------------------------------------------------------ Name DSLI Description Info ----------- ----- ------------------------------------------- ----- Log::Agent ----- A general logging framework MROGASKI ::Rotate RdpO2 Logfile rotation config and support MROGASKI The Log::Agent::Rotate module is an extension of Log::Agent that brings file-rotating features to the File logging driver. It is separated from Log::Agent itself because it has dependencies on LockFile::Simple and Compress::Zlib that Log::Agent cannot have: everyone with a plain stock Perl distribution must be able to simply install Log::Agent and start using it. This is NOT a generic all-purpose logfile rotation package. It is meant to be used only within the Log::Agent framework. SYNOPSIS use Log::Agent; require Log::Agent::Driver::File; require Log::Agent::Rotate; (my $me = $0) =~ s|.*/(.*)|$1|; my $rotate = Log::Agent::Rotate->make( -backlog => 7, # keep last seven logs + current -unzipped => 2, # don't compress last archived 2 logs -is_alone => 1, # programmer says only ONE process will run -max_size => 100_000, # file will rotate when bigger than 100K ); my $driver = Log::Agent::Driver::File->make( -prefix => $me, -showpid => 1, -rotate => $rotate, # default rotation policy -channels => { 'error' => '/tmp/output.err', 'output' => ['log.out', $rotate], # could have special policy 'debug' => '../appli.debug', }, ); logconfig(-driver => $driver, -level => 'notice'); DESCRIPTION Log::Agent::Rotate lets you specify the logfile rotation policy that will be used on the logfiles managed via a Log::Agent::Driver::File driver. It can be useful for daemon process to periodically rotate the logfiles whilst keeping some fair amount of backlog. But it can also be used by programs that run a short period of time and generate systematic logging, that would end-up eating all the disk space if not monitored. Please read the Log::Agent::Rotate(3) manpage and the related pages for more information. Log-Agent-Rotate-1.200/lib000755000000000000 012627346374 15640 5ustar00unknownunknown000000000000Log-Agent-Rotate-1.200/lib/Log000755000000000000 012627346374 16361 5ustar00unknownunknown000000000000Log-Agent-Rotate-1.200/lib/Log/Agent000755000000000000 012627346374 17417 5ustar00unknownunknown000000000000Log-Agent-Rotate-1.200/lib/Log/Agent/Rotate.pm000444000000000000 2207412627345755 21377 0ustar00unknownunknown000000000000########################################################################### # # Rotate.pm # # Copyright (c) 2000 Raphael Manfredi. # Copyright (c) 2002-2015 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### use strict; ########################################################################### package Log::Agent::Rotate; use Getargs::Long qw(ignorecase); # # File rotating policy # our $VERSION = "1.200"; $VERSION = eval $VERSION; use constant { BACKLOG => 0, UNZIPPED => 1, MAX_SIZE => 2, MAX_WRITE => 3, MAX_TIME => 4, IS_ALONE => 5, SINGLE_HOST => 6, FILE_PERM => 7, }; # # ->make # # Creation routine. # # Attributes: # backlog amount of old files to keep (0 for none) # unzipped amount of old files to NOT compress (defaults to 1) # max_size maximum amount of bytes in file # max_write maximum amount of bytes to write in file # max_time maximum amount of time to keep open # is_alone hint: only one instance is busy manipulating the logfiles # single_host hint: access to logfiles always made via one host # sub make { my $self = bless [], shift; ( $self->[BACKLOG], $self->[UNZIPPED], $self->[MAX_SIZE], $self->[MAX_WRITE], $self->[MAX_TIME], $self->[IS_ALONE], $self->[SINGLE_HOST], $self->[FILE_PERM] ) = xgetargs(@_, -backlog => ['i', 7], -unzipped => ['i', 1], -max_size => ['i', 1_048_576], -max_write => ['i', 0], -max_time => ['s', "0"], -is_alone => ['i', 0], -single_host => ['i', 0], -file_perm => ['i', 0666] ); $self->[MAX_TIME] = seconds_in_period($self->[MAX_TIME]) if $self->[MAX_TIME]; return $self; } # # seconds_in_period # # Converts a period into a number of seconds. # sub seconds_in_period { my ($p) = @_; $p =~ s|^(\d+)||; my $base = int($1); # Number of elementary periods my $u = "s"; # Default Unit $u = substr($1, 0, 1) if $p =~ /^\s*(\w+)$/; my $sec; if ($u eq 'm') { $sec = 60; # One minute = 60 seconds } elsif ($u eq 'h') { $sec = 3600; # One hour = 3600 seconds } elsif ($u eq 'd') { $sec = 86400; # One day = 24 hours } elsif ($u eq 'w') { $sec = 604800; # One week = 7 days } elsif ($u eq 'M') { $sec = 2592000; # One month = 30 days } elsif ($u eq 'y') { $sec = 31536000; # One year = 365 days } else { $sec = 1; # Unrecognized: defaults to seconds } return $base * $sec; } # # Attribute access # sub backlog { $_[0]->[BACKLOG] } sub unzipped { $_[0]->[UNZIPPED] } sub max_size { $_[0]->[MAX_SIZE] } sub max_write { $_[0]->[MAX_WRITE] } sub max_time { $_[0]->[MAX_TIME] } sub is_alone { $_[0]->[IS_ALONE] } sub single_host { $_[0]->[SINGLE_HOST] } sub file_perm { $_[0]->[FILE_PERM] } # # There's no set_xxx() routines: those objects are passed by reference and # never "expanded", i.e. passed by copy. Modifying any of the attributes # would then lead to strange effects. # # # ->is_same # # Compare settings of $self with that of $other # sub is_same { my $self = shift; my ($other) = @_; for (my $i = 0; $i < @$self; $i++) { return 0 if $self->[$i] != $other->[$i]; } return 1; } 1; # for require __END__ =head1 NAME Log::Agent::Rotate - parameters for logfile rotation =head1 SYNOPSIS require Log::Agent::Rotate; my $policy = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 2, -is_alone => 0, -max_size => 100_000, -max_time => "1w", -file_perm => 0666 ); =head1 DESCRIPTION The C class holds the parameters describing the logfile rotation policy, and is meant to be supplied to instances of C via arguments in the creation routine, such as C<-rotate>, or by using array references as values in the C<-channels> hashref: See complementary information in L. As rotation cycles are performed, the current logfile is renamed, and possibly compressed, until the maximum backlog is reached, at which time files are deleted. Assuming a backlog of 5 and that the latest 2 files are not compressed, the following files can be present on the filesystem: logfile # the current logfile logfile.0 # most recently renamed logfile logfile.1 logfile.2.gz logfile.3.gz logfile.4.gz # oldest logfile, unlinked next cycle The following I are available to the creation routine make(), listed in alphabetical order, all taking a single integer value as argument: =over 4 =item I The total amount of old logfiles to keep, besides the current logfile. Defaults to 7. =item I The file permissions, given as an octal integer value, to supply to sysopen() during file creation. This value is modified during execution by the umask of the process. In most cases, it is good practice to leave this set to the default and let the user process controll the file permissions. This option has no effect on Win32 systems. Defaults to 0666. =item I The argument is a boolean stating whether the program writing to the logfile will be the only one or not. This is a hint that drives some optimizations, but it is up to the program to B that noone else will be able to write to or unlink the current logfile when set to I. Defaults to I. =item I The maximum logfile size. This is a threshold, which will cause a logfile rotation cycle to be performed, when crossed after a write to the file. If set to C<0>, this threshold is not checked. Defaults to 1 megabyte. =item I The maximum time in seconds between the moment we opened the file and the next rotation cycle occurs. This threshold is only checked after a write to the file. The value can also be given as a string, postfixed by one of the following letters to specify the period unit (e.g. "3w"): Letter Unit ------ ------- m minutes h hours d days d days w weeks M months (30 days of 24 hours) y years Defaults to C<0>, meaning it is not checked. =item I The maximum amount of data we can write to the logfile. Like C, this is a threshold, which is only checked after a write to the logfile. This is not the total logfile size: if several programs write to the same logfile and C is not used, then the logfiles may never be rotated at all if none of the programs write at least C bytes to the logfile before exiting. Defaults to C<0>, meaning it is not checked. =item I The argument is a boolean stating whether the access to the logfiles will be made from one single host or not. This is a hint that drives some optimizations, but it is up to the program to B that it is accurately set. Defaults to I, which is always a safe value. =item I The amount of old logfiles, amongst the most recent ones, that should not be compressed but be kept as plain files. Defaults to 1. =back To test whether two configurations are strictly identical, use is_same(), as in: print "identical\n" if $x->is_same($y); where both $x and $y are C objects. All the aforementioned switches also have a corresponding querying routine that can be issued on instances of the class to get their value. It is not possible to modify those attributes. For instance: my $x = Log::Agent::Rotate->make(...); my $mwrite = $x->max_write(); would get the configured I threshold. =head1 AUTHORS Originally written by Raphael Manfredi (Raphael_Manfredi@pobox.com), currently maintained by Mark Rogaski (mrogaski@cpan.org). Thanks to Chris Meshkin for his suggestions on file permissions. =head1 COPYRIGHT Copyright (c) 2000, Raphael Manfredi. Copyright (c) 2002-2015, Mark Rogaski; all rights reserved. This program is free software; you can redistribute it and/or modify it under the terms of the Artistic License 2.0, a copy of which can be found with perl. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Artistic License 2.0 for more details. http://www.perlfoundation.org/artistic_license_2_0 =head1 SEE ALSO Log::Agent(3), Log::Agent::Driver::File(3), Log::Agent::Rotate::File(3). =cut Log-Agent-Rotate-1.200/lib/Log/Agent/File000755000000000000 012627346374 20276 5ustar00unknownunknown000000000000Log-Agent-Rotate-1.200/lib/Log/Agent/File/Rotate.pm000444000000000000 3653412627345755 22264 0ustar00unknownunknown000000000000########################################################################### # # File/Rotate.pm # # Copyright (c) 2000 Raphael Manfredi. # Copyright (c) 2002-2015 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### use strict; ########################################################################### package Log::Agent::File::Rotate; # # A rotating logfile set # use File::stat; use Fcntl; use Symbol; use Compress::Zlib; require LockFile::Simple; use Log::Agent; # We're using logerr() ourselves when safe to do so my $DEBUG = 0; # # ->make # # Creation routine. # # Attributes initialized by parameters: # path file path # config rotating configuration (a Log::Agent::Rotate object) # # Other attributes: # fd currently opened file descriptor # handle symbol used for Perl handle # warned records calls made to hardwired warn() to only do them once # written total amount written since opening # size logfile size # opened time when opening occurred # dev device holding logfile # ino inode number of logfile # lockmgr lockfile manager # rotating within the rotate() routine # sub make { my $self = bless {}, shift; my ($path, $config) = @_; $self->{'path'} = $path; $self->{'config'} = $config; $self->{'fd'} = undef; $self->{'handle'} = gensym; $self->{'warned'} = {}; $self->{'rotating'} = 0; $self->{'lockmgr'} = LockFile::Simple->make( -autoclean => 1, -delay => 1, # until sleep(.25) is supported -efunc => undef, -hold => 60, -max => 5, -nfs => !$config->single_host, -stale => 1, -warn => 0, -wfunc => undef ); return $self; } # # Attribute access # sub path { $_[0]->{'path'} } sub config { $_[0]->{'config'} } sub fd { $_[0]->{'fd'} } sub handle { $_[0]->{'handle'} } sub warned { $_[0]->{'warned'} } sub written { $_[0]->{'written'} } sub opened { $_[0]->{'opened'} } sub size { $_[0]->{'size'} } sub dev { $_[0]->{'dev'} } sub ino { $_[0]->{'ino'} } sub lockmgr { $_[0]->{'lockmgr'} } sub rotating { $_[0]->{'rotating'} } # # ->print # # Print to file. # This is where all the monitoring is performed: # # . If the file was renamed underneath us, re-open it. # This costs a stat() system call each time a log is to be emitted # and can be avoided by setting config->is_alone. # sub print { my $self = shift; my $str = join('', @_); my $fd = $self->fd; my $cf = $self->config; # # If the file was renamed underneath us, re-open it. # This costs a stat() system call each time a log is to be emitted # and can be avoided by setting config->is_alone when appropriate. # if (defined $fd && !$cf->is_alone) { my $st = stat($self->path); if (!$st || $st->dev != $self->dev || $st->ino != $self->ino) { $self->close; undef $fd; # Will be re-opened below } } # # Open file if not already done. # unless (defined $fd) { $fd = $self->open; return unless defined $fd; } # # Write to logfile # return unless syswrite($fd, $str, length $str); # # If the overall logfile size is monitored, update it. # Unless we're alone, we have to fstat() the file descriptor. # if ($cf->max_size) { if ($cf->is_alone) { $self->{'size'} += length $str; } else { my $st = stat($fd); if ($st) { $self->{'size'} = $st->size; # Paranoid test } else { $self->{'size'} += length $str; } } if ($self->size > $cf->max_size) { $self->rotate; return; } } # # If the amount of bytes written exceeds the threshold, # rotate the files. # if ($cf->max_write) { $self->{'written'} += length $str; if ($self->written > $cf->max_write) { $self->rotate; return; } } # # If the opening time is exceeded, rotate the files. # if ($cf->max_time) { if (time - $self->opened > $cf->max_time) { $self->rotate; return; } } # Did not rotate anything return; } # # ->open # # Open current logfile. # Returns opened handle, or nothing if error. # sub open { my $self = shift; my $fd = $self->handle; my $path = $self->path; my $mode = O_CREAT|O_APPEND|O_WRONLY; my $perm = ($self->config)->file_perm; warn "opening $path\n" if $DEBUG; unless (sysopen($fd, $path, $mode, $perm)) { # # Can't log errors via Log::Agent since we might recurse down here. # Therefore, use warn(), but only once, and clear condition when # opening is successful. # warn "$0: can't open logfile \"$path\": $!\n" unless $self->warned->{$path}++; return; } my $st = stat($fd); # An fstat(), really $self->warned->{$path} = 0; # Clear warning condition $self->{'fd'} = $fd; # Records: file opened $self->{'written'} = 0; # Amount written $self->{'opened'} = time; # Opening time $self->{'size'} = $st ? $st->size : 0; # Current size $self->{'dev'} = $st->dev; $self->{'ino'} = $st->ino; return $fd; } # # ->close # # Close current logfile. # sub close { my $self = shift; my $fd = $self->fd; return unless defined $fd; # Already closed warn "closing logfile\n" if $DEBUG; close($fd); $self->{'fd'} = undef; # Mark as closed } # # ->rotate # # Perform logfile rotation, as configured, and log any returned error # to the error channel. # sub rotate { my $self = shift; return if $self->rotating; # no recusion if error & limits too small $self->{'rotating'} = 1; my @errors = $self->do_rotate; unless (@errors) { $self->{'rotating'} = 0; return; } # # Errors are logged using logerr(). There's no danger we could # recurse down here since we're protected by the `rotating' flag. # my $error = @errors == 1 ? "error" : sprintf("%d errors", scalar @errors); logerr "the following $error occurred while rotating logfiles:"; foreach my $err (@errors) { logerr $err; warn "ERROR: $err\n" if $DEBUG; } $self->{'rotating'} = 0; } # # ->do_rotate # # Perform logfile rotation, as configured. # Returns nothing if OK, an array of error messages otherwise. # sub do_rotate { my $self = shift; my $path = $self->path; my $cf = $self->config; my $lock = $self->lockmgr->lock($path); # # Emission of errors has to be delayed, since we're in the middle of # logfile rotation, which could be the error channel. # my @errors = (); push(@errors, "proceeded with rotation of $path without lock") unless defined $lock; # # We're unix-centric in the following code fragment, but I don't know # how to do the same thing on non-unix operating systems. Sorry. # my ($dir, $file) = ($path =~ m|^(.*)/(.*)|); ($dir, $file) = (".", $path) unless $dir; local *DIR; unless (opendir(DIR, $dir)) { my $error = "can't open directory \"$dir\" to rotate $path: $!"; $lock->release if defined $lock; return ($error); } my @files = readdir DIR; closedir DIR; # # Identify the logfiles already present. # # We use the common convention of renaming un-compressed logfiles # as "path.0", "path.1", etc... the .0 being the more recent file, # and use "path.0.gz", "path.1.gz", etc... for compressed logfiles. # my @logfiles = (); # Logfiles to rotate my @unlink = (); # Logfiles to unlink my $lookfor = "$file."; my $unlink_at = $cf->backlog - 1; warn "unlink_at=$unlink_at\n" if $DEBUG; foreach my $f (@files) { next unless substr($f, 0, length $lookfor) eq $lookfor; my ($idx) = ($f =~ /\.(\d+)(?:\.gz)?$/); warn "f=$f, idx=$idx\n" if $DEBUG; next unless defined $idx; $f = $1 if $f =~ /^(.*)$/; # untaint if ($idx >= $unlink_at) { push(@unlink, $f); } else { $logfiles[$idx] = $f; } } if ($DEBUG) { warn "unlink=@unlink\n"; warn "logfiles=@logfiles\n"; } # # Delete old files, if any. # foreach my $f (@unlink) { unlink("$dir/$f") or push(@errors, "can't unlink $dir/$f: $!"); } # # File rotation section... # # If backlog=5 and unzipped=2, then, when things have stabilized, # we have the following logfiles: # # path.4.gz was unlinked above # path.3.gz renamed as path.4.gz # path.2.gz renamed as path.3.gz # path.1 compressed as path.2.gz # path.0 renamed as path.1 # path current logfile, closed and renamed path.0 # # The code below is prepared to deal with missing files, or policy # changes. Compressed file are not uncompressed though. # my $last = $cf->backlog - 2; # Oldest logfile already deleted my $gz_limit = $cf->unzipped; # Files up to that index are .gz warn "last=$last, gz_limit=$gz_limit\n" if $DEBUG; # # Handle renaming of compressed files # for (my $i = $last; $i >= $gz_limit; $i--) { next unless defined $logfiles[$i]; # Not that much backlog yet? my $old = "$dir/$logfiles[$i]"; my $new = "$path." . ($i+1) . ".gz"; warn "compressing old=$old, new=$new\n" if $DEBUG; if ($old =~ /\.gz$/) { rename($old, $new) or push(@errors, "can't rename $old to $new: $!"); } else { # Compression policy changed? my $err = $self->mv_gzip($old, $new); push(@errors, $err) if defined $err; } } # # Handle compression and renaming of the oldest uncompressed file # if ($gz_limit > 0 && defined $logfiles[$gz_limit-1]) { my $old = "$dir/$logfiles[$gz_limit-1]"; my $new = "$path.$gz_limit.gz"; warn "rename and compress old=$old, new=$new\n" if $DEBUG; if ($old !~ /\.gz$/) { my $err = $self->mv_gzip($old, $new); push(@errors, $err) if defined $err; } else { # Compression policy changed? rename($old, $new) or push(@errors, "can't rename $old to $new: $!"); } } # # Handle renaming of uncompressed files # for (my $i = $gz_limit - 2; $i >= 0; $i--) { next unless defined $logfiles[$i]; # Not that much backlog yet? my $old = "$dir/$logfiles[$i]"; my $new = "$path." . ($i+1); warn "rename old=$old, new=$new\n" if $DEBUG; $new .= ".gz" if $old =~ /\.gz$/; # Compression policy changed? rename($old, $new) or push(@errors, "can't rename $old to $new: $!"); } # # Mark rotation, in case they "tail -f" on it. # my $fd = $self->fd; syswrite($fd, "*** LOGFILE ROTATED ON " . scalar(localtime) . "\n"); # # Finally, close current logfile and rename it. # $self->close; if ($gz_limit) { rename($path, "$path.0") or push(@errors, "can't rename $path to $path.0: $!"); } else { my $err = $self->mv_gzip($path, "$path.0.gz"); push(@errors, $err) if defined $err; } # # Unlock logfile and propagate errors to be logged in new current file. # $lock->release if defined $lock; return @errors if @errors; return; } # # ->mv_gzip # # Compress old file into new file and unlink old file, propagating mtime. # Returns error string, nothing if OK. # sub mv_gzip { my $self = shift; my ($old, $new) = @_; local *FILE; my $st = stat($old); unless (defined $st && CORE::open(FILE, $old)) { return "can't open $old to compress into $new: $!"; } my $gz = gzopen($new, "wb9"); unless (defined $gz) { CORE::close FILE; return "can't write into $new: $gzerrno"; } local $_; my $error; while () { unless ($gz->gzwrite($_)) { $error = "error while compressing $old in $new: $gzerrno"; last; } } CORE::close FILE; $gz->gzclose(); utime $st->atime, $st->mtime, $new; # don't care if it fails unlink $old or do { $error = "can't unlink $old: $!" }; return $error if defined $error; return; } 1; # for require __END__ =head1 NAME Log::Agent::File::Rotate - a rotating logfile set =head1 SYNOPSIS # # This class is not user-visible. # # It is documented only for programmers wishing to inherit # from it to further extend its behaviour. # require Log::Agent::Driver::File; require Log::Agent::Rotate; require Log::Agent::File::Rotate; my $config = Log::Agent::Rotate->make(...); my $driver = Log::Agent::Driver::File->make(...); my $fh = Log::Agent::File::Rotate->make("file", $config, $driver); =head1 DESCRIPTION This class represents a rotating logfile and is used drivers wishing to rotate their logfiles periodically. From the outside, it exports a single C routine, just like C. Internally, it uses the parameters given by a C object to transparently close the current logfile and cycle the older logs. Before rotating the current logfile, the string: *** LOGFILE ROTATED ON is emitted, so that people monitoring the file via "tail -f" know about it and are not surprised by the sudden stop of messages. Its exported interface is: =over 4 =item make I, I This is the creation routine. The I object is an instance of C. =item print I Prints I to the file. After having printed the data, monitor the file against the thresholds defined in the configuration, and possibly rotate the logfiles according to the parameters held in the same configuration object. When the C flag is not set in the configuration, the logfile is checked everytime a C is issued to see if its inode changed. Indeed, when several instances of the same program using rotating logfiles are running, each of them may decide to cycle the logs at some point in time, and therefore our opened handle could point to an already renamed or unlinked file. =back =head1 AUTHORS Originally written by Raphael Manfredi ERaphael_Manfredi@pobox.comE, currently maintained by Mark Rogaski Emrogaski@pobox.comE. =head1 SEE ALSO Log::Agent::Rotate(3), Log::Agent::Driver::File(3). =cut Log-Agent-Rotate-1.200/t000755000000000000 012627346374 15335 5ustar00unknownunknown000000000000Log-Agent-Rotate-1.200/t/badconf.t000444000000000000 357612627337302 17255 0ustar00unknownunknown000000000000#!./perl ########################################################################### # # t/badconf.t # # Copyright (c) 2000 Raphael Manfredi. # Copyright (c) 2002-2015 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### # # Ensure possible incorrect rotation is detected whith bad Log::Agent config # print "1..6\n"; require 't/code.pl'; sub ok; sub cleanlog() { unlink ; } use Log::Agent; require Log::Agent::Driver::File; require Log::Agent::Rotate; cleanlog; my $rotate_dflt = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 2, -is_alone => 1, -max_size => 100, ); my $rotate_other = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 1, -is_alone => 1, -max_size => 100, ); my $driver = Log::Agent::Driver::File->make( -rotate => $rotate_dflt, -channels => { 'error' => ['t/logfileA', $rotate_other], 'output' => 't/logfileA', }, ); logconfig(-driver => $driver); my $message = "this is a message whose size is exactly 53 characters"; logsay $message; logwarn $message; # will bring logsize size > 100 chars ok 1, -e("t/logfileA"); ok 2, -e("t/logfileA.0"); ok 3, contains("t/logfileA.0", "Rotation for 't/logfileA' may be wrong"); cleanlog; undef $Log::Agent::Driver; # Cheat $driver = Log::Agent::Driver::File->make( -rotate => $rotate_dflt, -channels => { 'error' => ['t/logfileB', $rotate_dflt], 'output' => 't/logfileB', }, ); logconfig(-driver => $driver); logsay $message; logwarn $message; # will bring logsize size > 100 chars ok 4, !-e("t/logfileB"); ok 5, -e("t/logfileB.0"); ok 6, !contains("t/logfileB.0", "Rotation for 'error' may be wrong"); cleanlog; Log-Agent-Rotate-1.200/t/code.pl000444000000000000 134312627337302 16731 0ustar00unknownunknown000000000000#!./perl ########################################################################### # # t/code.t # # Copyright (c) 2000 Raphael Manfredi. # Copyright (c) 2002-2015 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### sub ok { my ($num, $ok) = @_; print "not " unless $ok; print "ok $num\n"; } sub contains { my ($file, $pattern) = @_; local *FILE; local $_; open(FILE, $file) || die "can't open $file: $!\n"; my $found = 0; while () { if (/$pattern/) { $found = 1; last; } } close FILE; return $found; } 1; Log-Agent-Rotate-1.200/t/hole.t000444000000000000 374212627337302 16603 0ustar00unknownunknown000000000000#!./perl ########################################################################### # # t/hole.t # # Copyright (c) 2000 Raphael Manfredi. # Copyright (c) 2002-2015 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### # # Check behaviour when archived logfiles are externally removed # print "1..21\n"; require 't/code.pl'; sub ok; sub cleanlog() { unlink ; } use Log::Agent; require Log::Agent::Driver::File; require Log::Agent::Rotate; cleanlog; my $rotate_dflt = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 2, -is_alone => 0, -max_size => 100, ); my $driver = Log::Agent::Driver::File->make( -channels => { 'error' => 't/logfile_err', 'output' => ['t/logfile', $rotate_dflt], }, ); logconfig(-driver => $driver); my $message = "this is a message whose size is exactly 53 characters"; logsay $message; logsay $message; # rotates logsay $message; logsay $message; # rotates again logsay $message; logsay $message; # rotates again logsay $message; logsay $message; # rotates again ok 1, -e("t/logfile.0"); ok 2, -e("t/logfile.1"); ok 3, -e("t/logfile.2.gz"); ok 4, -e("t/logfile.3.gz"); ok 5, !-e("t/logfile.4.gz"); ok 6, unlink "t/logfile.0"; ok 7, unlink "t/logfile.2.gz"; logsay $message; logsay $message; # rotates again ok 8, -e("t/logfile.0"); ok 9, !-e("t/logfile.1"); ok 10, -e("t/logfile.2.gz"); ok 11, !-e("t/logfile.3.gz"); ok 12, -e("t/logfile.4.gz"); ok 13, !-e("t/logfile.5.gz"); ok 14, unlink "t/logfile.2.gz"; logsay $message; logsay $message; # rotates again ok 15, -e("t/logfile.0"); ok 16, -e("t/logfile.1"); ok 17, !-e("t/logfile.2.gz"); ok 18, !-e("t/logfile.3.gz"); ok 19, !-e("t/logfile.4.gz"); ok 20, -e("t/logfile.5.gz"); ok 21, !-e("t/logfile.6.gz"); cleanlog; Log-Agent-Rotate-1.200/t/mixed.t000444000000000000 1110112627337302 16766 0ustar00unknownunknown000000000000#!./perl ########################################################################### # # t/mixed.t # # Copyright (c) 2000 Raphael Manfredi. # Copyright (c) 2002-2015 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### # # Check behaviour when mixed compressing policies are used in sequence # print "1..50\n"; require 't/code.pl'; sub ok; sub cleanlog() { unlink ; } use Log::Agent; require Log::Agent::Driver::File; require Log::Agent::Rotate; cleanlog; my $rotate_dflt = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 2, -is_alone => 1, -max_size => 100, ); my $driver = Log::Agent::Driver::File->make( -channels => { 'error' => 't/logfile_err', 'output' => ['t/logfile', $rotate_dflt], }, ); logconfig(-driver => $driver); my $message = "this is a message whose size is exactly 53 characters"; logsay $message; logsay $message; # will bring logsize size > 100 chars logsay $message; logsay $message; # rotates again, creates logfile.1 logsay $message; logsay $message; # rotates again, now has logfile.2.gz ok 1, !-e("t/logfile"); ok 2, -e("t/logfile.0"); ok 3, -e("t/logfile.1"); ok 4, -e("t/logfile.2.gz"); ok 5, !-e("t/logfile.3.gz"); undef $Log::Agent::Driver; # Cheat $rotate_dflt = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 4, -is_alone => 1, -max_size => 100, ); $driver = Log::Agent::Driver::File->make( -channels => { 'error' => 't/logfile_err', 'output' => ['t/logfile', $rotate_dflt], }, ); logconfig(-driver => $driver); logsay $message; logsay $message; # rotate, logfile.2.gz not uncompresed ok 6, !-e("t/logfile"); ok 7, -e("t/logfile.0"); ok 8, -e("t/logfile.1"); ok 9, -e("t/logfile.2"); ok 10, -e("t/logfile.3.gz"); ok 11, !-e("t/logfile.4.gz"); logsay $message; logsay $message; # rotate, logfile.3.gz not uncompresed ok 12, !-e("t/logfile"); ok 13, -e("t/logfile.0"); ok 14, -e("t/logfile.1"); ok 15, -e("t/logfile.2"); ok 16, -e("t/logfile.3"); ok 17, -e("t/logfile.4.gz"); ok 18, !-e("t/logfile.5.gz"); undef $Log::Agent::Driver; # Cheat $rotate_dflt = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 1, -is_alone => 1, -max_size => 100, ); $driver = Log::Agent::Driver::File->make( -channels => { 'error' => 't/logfile_err', 'output' => ['t/logfile', $rotate_dflt], }, ); logconfig(-driver => $driver); logsay $message; logsay $message; # rotate, re-compresses up to logfile.1.gz ok 19, !-e("t/logfile"); ok 20, -e("t/logfile.0"); ok 21, -e("t/logfile.1.gz"); ok 22, -e("t/logfile.2.gz"); ok 23, -e("t/logfile.3.gz"); ok 24, -e("t/logfile.4.gz"); ok 25, -e("t/logfile.5.gz"); ok 26, !-e("t/logfile.6.gz"); undef $Log::Agent::Driver; # Cheat $rotate_dflt = Log::Agent::Rotate->make( -backlog => 4, -unzipped => 1, -is_alone => 1, -max_size => 100, ); $driver = Log::Agent::Driver::File->make( -channels => { 'error' => 't/logfile_err', 'output' => ['t/logfile', $rotate_dflt], }, ); logconfig(-driver => $driver); logsay $message; logsay $message; # rotate, keeps only from .0 to .3.gz ok 27, !-e("t/logfile"); ok 28, -e("t/logfile.0"); ok 29, -e("t/logfile.1.gz"); ok 30, -e("t/logfile.2.gz"); ok 31, -e("t/logfile.3.gz"); ok 32, !-e("t/logfile.4.gz"); ok 33, !-e("t/logfile.5.gz"); ok 34, !-e("t/logfile.6.gz"); undef $Log::Agent::Driver; # Cheat $rotate_dflt = Log::Agent::Rotate->make( -backlog => 4, -unzipped => 4, -is_alone => 1, -max_size => 100, ); $driver = Log::Agent::Driver::File->make( -channels => { 'error' => 't/logfile_err', 'output' => ['t/logfile', $rotate_dflt], }, ); logconfig(-driver => $driver); logsay $message; logsay $message; # rotate, no compression at all ok 35, !-e("t/logfile"); ok 36, -e("t/logfile.0"); ok 37, -e("t/logfile.1"); ok 38, -e("t/logfile.2.gz"); ok 39, -e("t/logfile.3.gz"); ok 40, !-e("t/logfile.4.gz"); logsay $message; logsay $message; # rotate, no compression at all logsay $message; logsay $message; # rotate, no compression at all ok 41, !-e("t/logfile"); ok 42, -e("t/logfile.0"); ok 43, -e("t/logfile.1"); ok 44, -e("t/logfile.2"); ok 45, -e("t/logfile.3"); ok 46, !-e("t/logfile.4"); ok 47, !-e("t/logfile.3.gz"); ok 48, !-e("t/logfile.2.gz"); ok 49, !-e("t/logfile.1.gz"); ok 50, !-e("t/logfile.0.gz"); cleanlog; Log-Agent-Rotate-1.200/t/normal.t000444000000000000 462312627337302 17143 0ustar00unknownunknown000000000000#!./perl ########################################################################### # # t/normal.t # # Copyright (c) 2000 Raphael Manfredi. # Copyright (c) 2002-2015 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### # # Check normal behaviour, with 2 non-compressed files # print "1..21\n"; require 't/code.pl'; sub ok; sub cleanlog() { unlink ; } use Log::Agent; require Log::Agent::Driver::File; require Log::Agent::Rotate; cleanlog; my $rotate_dflt = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 2, -is_alone => 1, -single_host => 1, -max_size => 100, ); my $driver = Log::Agent::Driver::File->make( -rotate => $rotate_dflt, -channels => { 'error' => 't/logfile', 'output' => 't/logfile', }, ); logconfig(-driver => $driver); my $message = "this is a message whose size is exactly 53 characters"; logsay $message; logwarn $message; # will bring logsize size > 100 chars logerr "new $message"; # not enough to rotate again ok 1, -e("t/logfile"); ok 2, -e("t/logfile.0"); ok 3, !-e("t/logfile.1"); logsay $message; # rotates, creates logfile.1 logsay $message; logsay $message; # rotates again, now has logfile.2.gz, no logfile ok 4, !-e("t/logfile"); ok 5, -e("t/logfile.0"); ok 6, -e("t/logfile.1"); ok 7, -e("t/logfile.2.gz"); ok 8, !-e("t/logfile.3.gz"); logsay $message; # creates a logfile ok 9, -e("t/logfile"); logsay $message; # rotates again, now has logfile.3.gz logsay $message; logsay $message; # rotates again, now has logfile.4.gz logsay $message; logsay $message; # rotates again, now has logfile.5.gz logsay $message; logsay $message; # rotates again, now has logfile.6.gz logsay $message; logsay $message; # rotates again, no logfile.7.gz ok 10, !-e("t/logfile"); ok 11, -e("t/logfile.0"); ok 12, -e("t/logfile.1"); ok 13, -e("t/logfile.2.gz"); ok 14, -e("t/logfile.3.gz"); ok 15, -e("t/logfile.4.gz"); ok 16, -e("t/logfile.5.gz"); ok 17, -e("t/logfile.6.gz"); ok 18, !-e("t/logfile.7.gz"); logsay $message; logsay $message; # rotates again, sill no logfile.7.gz ok 19, -e("t/logfile.6.gz"); ok 20, !-e("t/logfile.7.gz"); ok 21, contains("t/logfile.0", "LOGFILE ROTATED ON"); cleanlog; Log-Agent-Rotate-1.200/t/perm.t000444000000000000 435512627337302 16620 0ustar00unknownunknown000000000000#!perl ########################################################################### # # t/perm.t # # Copyright (c) 2000 Raphael Manfredi. # Copyright (c) 2002-2015 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### use Test::More; BEGIN { plan tests => 4 } use Log::Agent; require Log::Agent::Driver::File; require Log::Agent::Rotate; sub clear_log () { unlink ; } sub perm_ok ($$) { # # Given a fileame and target permissions, checks if the file # was created with the correct permissions. # my($file, $target) = @_; $target &= ~ umask; # account for user mask my $mode = (stat $file)[2]; # find the current mode $mode &= 0777; # we only care about UGO return $mode == $target; } SKIP: { skip "file mode not supported on Win32.", 4 if $^O eq 'MSWin32'; my $rotate = Log::Agent::Rotate->make( -backlog => 2, -unzipped => 2, -is_alone => 1, -single_host => 1, -max_size => 100, -file_perm => 0600 ); my $driver = Log::Agent::Driver::File->make( -rotate => $rotate, -channels => { 'error' => 't/logfile', 'output' => 't/logfile', }, ); my $msg = '!' x 55; logconfig(-driver => $driver); clear_log; logsay $msg; ok(perm_ok("t/logfile", 0600)); logsay $msg; ok(perm_ok("t/logfile.0", 0600)); $rotate = Log::Agent::Rotate->make( -backlog => 2, -unzipped => 2, -is_alone => 1, -single_host => 1, -max_size => 100, -file_perm => 0644 ); $driver = Log::Agent::Driver::File->make( -rotate => $rotate, -channels => { 'error' => 't/logfile', 'output' => 't/logfile', }, ); logconfig(-driver => $driver); clear_log; logsay $msg; ok(perm_ok("t/logfile", 0644)); logsay $msg; ok(perm_ok("t/logfile.0", 0644)); clear_log; } Log-Agent-Rotate-1.200/t/rename.t000444000000000000 351112627337302 17115 0ustar00unknownunknown000000000000#!./perl ########################################################################### # # t/rename.t # # Copyright (c) 2000 Raphael Manfredi. # Copyright (c) 2002-2015 Mark Rogaski, mrogaski@cpan.org; # all rights reserved. # # See the README file included with the # distribution for license information. # ########################################################################### # # Check normal behaviour, with 2 non-compressed files # use Test::More tests => 10; use File::Copy 'move'; sub cleanlog() { unlink ; } use Log::Agent; require Log::Agent::Driver::File; require Log::Agent::Rotate; SKIP: { skip "file rename not supported on Win32.", 10 if $^O eq 'MSWin32'; cleanlog; my $rotate_dflt = Log::Agent::Rotate->make( -backlog => 7, -unzipped => 2, -is_alone => 0, -max_size => 100, ); my $driver = Log::Agent::Driver::File->make( -rotate => $rotate_dflt, -channels => { 'error' => 't/logfileR', 'output' => 't/logfileR', }, ); logconfig(-driver => $driver); my $message = "this is a message whose size is exactly 53 characters"; logsay $message; logwarn $message; # will bring logsize size > 100 chars logerr "new $message"; # not enough to rotate again ok(-e("t/logfileR")); ok(-e("t/logfileR.0")); ok(!-e("t/logfileR.1")); ok(move("t/logfileR", "t/logfileR.0")); logsay $message; # does not rotate, since we renamed above ok(-e("t/logfileR")); ok(-e("t/logfileR.0")); ok(!-e("t/logfileR.1")); ok(move("t/logfileR", "t/logfileR.0")); logsay $message; ok(!-e("t/logfileR.1")); logsay $message; # finally rotates ok(-e("t/logfileR.1")); cleanlog; }