Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

initial commit

  • Loading branch information...
commit 53c4aef9c9d7850a77dc531ca061a63372de510c 0 parents
@kazeburo authored
11 .gitignore
@@ -0,0 +1,11 @@
+cover_db
+META.yml
+Makefile
+blib
+inc
+pm_to_blib
+MANIFEST
+Makefile.old
+nytprof.out
+MANIFEST.bak
+*.sw[po]
1  .shipit
@@ -0,0 +1 @@
+steps = FindVersion, ChangeVersion, CheckChangeLog, DistTest, Commit, Tag, MakeDist, UploadCPAN
4 Changes
@@ -0,0 +1,4 @@
+Revision history for Perl extension File::RotateLogs
+
+0.01 Thu Aug 30 13:54:00 2012
+ - original version
21 MANIFEST.SKIP
@@ -0,0 +1,21 @@
+\bRCS\b
+\bCVS\b
+^MANIFEST\.
+^Makefile$
+~$
+^#
+\.old$
+^blib/
+^pm_to_blib
+^MakeMaker-\d
+\.gz$
+\.cvsignore
+^t/9\d_.*\.t
+^t/perlcritic
+^tools/
+\.svn/
+^[^/]+\.yaml$
+^[^/]+\.pl$
+^\.shipit$
+^\.git/
+\.sw[po]$
14 Makefile.PL
@@ -0,0 +1,14 @@
+use inc::Module::Install;
+name 'File-RotateLogs';
+all_from 'lib/File/RotateLogs.pm';
+
+requires 'Proc::Daemon';
+requires 'Mouse';
+
+tests 't/*.t';
+author_tests 'xt';
+
+test_requires 'Test::More';
+auto_set_repository;
+#auto_include;
+WriteAll;
13 Makefile.PL~
@@ -0,0 +1,13 @@
+use inc::Module::Install;
+name 'File-RotateLogs';
+all_from 'lib/File/RotateLogs.pm';
+
+# requires '';
+
+tests 't/*.t';
+author_tests 'xt';
+
+test_requires 'Test::More';
+auto_set_repository;
+#auto_include;
+WriteAll;
27 README
@@ -0,0 +1,27 @@
+This is Perl module File::RotateLogs.
+
+INSTALLATION
+
+File::RotateLogs installation is straightforward. If your CPAN shell is set up,
+you should just be able to do
+
+ % cpan File::RotateLogs
+
+Download it, unpack it, then build it as per the usual:
+
+ % perl Makefile.PL
+ % make && make test
+
+Then install it:
+
+ % make install
+
+DOCUMENTATION
+
+File::RotateLogs documentation is available as in POD. So you can do:
+
+ % perldoc File::RotateLogs
+
+to read the documentation online with your favorite pager.
+
+Masahiro Nagano
206 lib/File/RotateLogs.pm
@@ -0,0 +1,206 @@
+package File::RotateLogs;
+
+use strict;
+use warnings;
+use POSIX qw//;
+use Fcntl qw/:DEFAULT/;
+use Proc::Daemon;
+use File::Spec;
+use Mouse;
+
+our $VERSION = '0.01';
+
+has 'logfile' => (
+ is => 'ro',
+ isa => 'Str',
+ required => 1,
+);
+
+has 'linkname' => (
+ is => 'ro',
+ isa => 'Str',
+ required => 0,
+)
+
+has 'rotationtime' => (
+ is => 'ro',
+ isa => 'Int',
+ default => 86400
+);
+
+has 'maxage' => (
+ is => 'ro',
+ isa => 'Int',
+ default => 0,
+);
+
+has 'sleep_before_remove' => (
+ is => 'ro',
+ isa => 'Int',
+ default => 3,
+);
+
+sub _gen_filename {
+ my $self = shift;
+ my $now = time;
+ my $time = $now - ($now % $self->rotationtime);
+ return POSIX::strftime($self->logfile, localtime($time));
+}
+
+sub print {
+ my ($self,$log) = @_;
+ my $fname = $self->_gen_filename;
+
+ my $fh;
+ if ( $self->{fh} ) {
+ if ( $fname eq $self->{fname} && $self->{pid} == $$ ) {
+ $fh = delete $self->{fh};
+ }
+ else {
+ $fh = delete $self->{fh};
+ close $fh if $fh;
+ undef $fh;
+ }
+ }
+
+ unless ($fh) {
+ my $is_new = ( ! -f $fname || ! -l $self->filename ) ? 1 : 0;
+ open $fh, '>>:unix', $fname or die "Cannot open file($fname): $!";
+ if ( $is_new ) {
+ eval {
+ $self->rotation($fname);
+ };
+ warn "failed rotation or symlink: $@" if $@;
+ }
+ }
+
+ $fh->print($log)
+ or die "Cannot write to $fname: $!";
+
+ $self->{fh} = $fh;
+ $self->{fname} = $fname;
+ $self->{pid} = $$;
+}
+
+sub rotation {
+ my ($self, $fname) = @_;
+
+ my $lock = $fname .'_lock';
+ sysopen(my $lockfh, $lock, O_CREAT|O_EXCL) or return;
+ close($lockfh);
+ if ( $sefl->linkname ) {
+ my $symlink = $fname .'_symlink';
+ symlink($fname, $symlink) or die $!;
+ rename($symlink, $self->linkname) or die $!;
+ }
+
+ if ( ! $self->maxage ) {
+ unlink $lock;
+ return;
+ }
+
+ my $time = time;
+ my @to_unlink = grep { $time - [stat($_)]->[9] > $self->maxage }
+ glob($self->filename . '.*');
+ if ( ! @to_unlink ) {
+ unlink $symlock;
+ return;
+ }
+
+ if ( $self->sleep_before_remove ) {
+ $self->unlink_background(@to_unlink,$symlock);
+ }
+ else {
+ unlink $_ for @to_unlink;
+ unlink $symlock;
+ }
+}
+
+sub unlink_background {
+ my ($self, @files) = @_;
+ my $daemon = Proc::Daemon->new();
+ @files = map { File::Spec->rel2abs($_) } @files;
+ if ( ! $daemon->Init ) {
+ $0 = "$0 rotatelogs unlink worker";
+ sleep $self->sleep_before_remove;
+ unlink $_ for @files;
+ POSIX::_exit(0);
+ }
+}
+
+__PACKAGE__->meta->make_immutable();
+
+1;
+__END__
+
+=head1 NAME
+
+File::RotateLogs - rotate log file
+
+=head1 SYNOPSIS
+
+ use File::RotateLogs;
+ use Plack::Builder;
+
+ my $rotatelogs = File::RotateLogs->new(
+ logfile => '/path/to/access_log.%Y%m%d%H%M',
+ linkname => '/path/to/access_log',
+ rotationtime => 3600,
+ maxage => 86400, #1day
+ );
+
+ builder {
+ enable 'AccessLog',
+ logger => sub { $rotatelogs->print(@_) };
+ $app;
+ };
+
+=head1 DESCRIPTION
+
+File::RotateLogs is utility for file logger.
+Supports logfile rotation and makes symlink to newest logfile.
+
+=head1 CONFIGURATION
+
+=over 4
+
+=item logfile
+
+This is file name pattern. It is the pattern for filename. The format is POSIX::strftime(), see also L<POSIX>.
+
+=item linkname
+
+Filename to symlink to newest logfile. default: none
+
+=item rotationtime
+
+default: 86400 (1day)
+
+=item maxage
+
+Maximum age of files (based on mtime), in seconds. After the age is surpassed,
+files older than this age will be deleted. Optional. Default is undefined, which means unlimited.
+old files are removed at a background unlink worker.
+
+=item sleep_before_remove
+
+Sleep seconds before remove old log files. default: 3
+If sleep_before_remove == 0, files are removed within plack processes. Does not fork background
+unlink worker.
+
+=back
+
+=head1 AUTHOR
+
+Masahiro Nagano E<lt>kazeburo {at} gmail.comE<gt>
+
+=head1 SEE ALSO
+
+L<File::Stamped>
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
32 lib/File/RotateLogs.pm~
@@ -0,0 +1,32 @@
+package File::RotateLogs;
+use strict;
+use warnings;
+our $VERSION = '0.01';
+
+1;
+__END__
+
+=head1 NAME
+
+File::RotateLogs -
+
+=head1 SYNOPSIS
+
+ use File::RotateLogs;
+
+=head1 DESCRIPTION
+
+File::RotateLogs is
+
+=head1 AUTHOR
+
+Masahiro Nagano E<lt>kazeburo {at} gmail.comE<gt>
+
+=head1 SEE ALSO
+
+=head1 LICENSE
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
4 t/00_compile.t
@@ -0,0 +1,4 @@
+use strict;
+use Test::More tests => 1;
+
+BEGIN { use_ok 'File::RotateLogs' }
11 xt/01_podspell.t
@@ -0,0 +1,11 @@
+use Test::More;
+eval q{ use Test::Spelling };
+plan skip_all => "Test::Spelling is not installed." if $@;
+add_stopwords(map { split /[\s\:\-]/ } <DATA>);
+$ENV{LANG} = 'C';
+set_spell_cmd("aspell -l en list") if `which aspell`;
+all_pod_files_spelling_ok('lib');
+__DATA__
+Masahiro Nagano
+kazeburo {at} gmail.com
+File::RotateLogs
8 xt/02_perlcritic.t
@@ -0,0 +1,8 @@
+use strict;
+use Test::More;
+eval {
+ require Test::Perl::Critic;
+ Test::Perl::Critic->import( -profile => 'xt/perlcriticrc');
+};
+plan skip_all => "Test::Perl::Critic is not installed." if $@;
+all_critic_ok('lib');
4 xt/03_pod.t
@@ -0,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.00";
+plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
+all_pod_files_ok();
2  xt/perlcriticrc
@@ -0,0 +1,2 @@
+[TestingAndDebugging::ProhibitNoStrict]
+allow=refs
Please sign in to comment.
Something went wrong with that request. Please try again.