| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package Log::Dispatch::FileRotate; |
|
2
|
|
|
|
|
|
|
$Log::Dispatch::FileRotate::VERSION = '1.38'; |
|
3
|
|
|
|
|
|
|
# ABSTRACT: Log to Files that Archive/Rotate Themselves |
|
4
|
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
require 5.005; |
|
6
|
8
|
|
|
8
|
|
2125704
|
use strict; |
|
|
8
|
|
|
|
|
48
|
|
|
|
8
|
|
|
|
|
251
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
8
|
|
|
8
|
|
43
|
use base 'Log::Dispatch::Output'; |
|
|
8
|
|
|
|
|
15
|
|
|
|
8
|
|
|
|
|
3527
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
8
|
|
|
8
|
|
868632
|
use Date::Manip; |
|
|
8
|
|
|
|
|
1141377
|
|
|
|
8
|
|
|
|
|
1074
|
|
|
11
|
8
|
|
|
8
|
|
79
|
use File::Spec; |
|
|
8
|
|
|
|
|
16
|
|
|
|
8
|
|
|
|
|
187
|
|
|
12
|
8
|
|
|
8
|
|
4030
|
use Log::Dispatch::File; |
|
|
8
|
|
|
|
|
253322
|
|
|
|
8
|
|
|
|
|
328
|
|
|
13
|
8
|
|
|
8
|
|
4315
|
use Log::Dispatch::FileRotate::Mutex; |
|
|
8
|
|
|
|
|
20
|
|
|
|
8
|
|
|
|
|
22929
|
|
|
14
|
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub DESTROY { |
|
16
|
8
|
|
|
8
|
|
151845
|
my $self = shift; |
|
17
|
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
# get rid of current LDF |
|
19
|
8
|
50
|
|
|
|
38
|
if ($self->{LDF}) { |
|
20
|
8
|
|
|
|
|
46
|
delete $self->{LDF}; |
|
21
|
|
|
|
|
|
|
} |
|
22
|
|
|
|
|
|
|
} |
|
23
|
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
sub new { |
|
26
|
9
|
|
|
9
|
1
|
63806
|
my $proto = shift; |
|
27
|
9
|
|
33
|
|
|
56
|
my $class = ref $proto || $proto; |
|
28
|
|
|
|
|
|
|
|
|
29
|
9
|
|
|
|
|
70
|
my %p = @_; |
|
30
|
|
|
|
|
|
|
|
|
31
|
9
|
|
|
|
|
37
|
my $self = bless {}, $class; |
|
32
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# Turn ON/OFF debugging as required |
|
34
|
9
|
|
|
|
|
62
|
$self->{debug} = $p{DEBUG}; |
|
35
|
9
|
|
|
|
|
76
|
$self->_basic_init(%p); |
|
36
|
9
|
|
|
|
|
1051
|
$self->{LDF} = Log::Dispatch::File->new(%p); # Our log |
|
37
|
|
|
|
|
|
|
|
|
38
|
9
|
50
|
|
|
|
3290
|
unless (defined $self->{timer}) { |
|
39
|
9
|
|
|
237
|
|
59
|
$self->{timer} = sub { time }; |
|
|
237
|
|
|
|
|
408
|
|
|
40
|
|
|
|
|
|
|
} |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# Keep a copy of interesting stuff as well |
|
43
|
9
|
|
|
|
|
32
|
$self->{params} = \%p; |
|
44
|
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# Size defaults to 10meg in all failure modes, hopefully |
|
46
|
9
|
|
|
|
|
23
|
my $ten_meg = 1024*1024*10; |
|
47
|
9
|
|
|
|
|
19
|
my $two_gig = 1024*1024*1024*2; |
|
48
|
9
|
|
|
|
|
20
|
my $size = $ten_meg; |
|
49
|
|
|
|
|
|
|
|
|
50
|
9
|
100
|
|
|
|
31
|
if (defined $p{size}) { |
|
51
|
|
|
|
|
|
|
# allow perl-literal style nubers 10_000_000 -> 10000000 |
|
52
|
6
|
|
|
|
|
23
|
$p{size} =~ s/_//g; |
|
53
|
6
|
|
|
|
|
14
|
$size = $p{size}; |
|
54
|
|
|
|
|
|
|
} |
|
55
|
|
|
|
|
|
|
|
|
56
|
9
|
50
|
33
|
|
|
112
|
unless ($size =~ /^\d+$/ && $size < $two_gig && $size > 0) { |
|
|
|
|
33
|
|
|
|
|
|
57
|
0
|
|
|
|
|
0
|
$size = $ten_meg; |
|
58
|
|
|
|
|
|
|
} |
|
59
|
|
|
|
|
|
|
|
|
60
|
9
|
|
|
|
|
28
|
$self->{size} = $size; |
|
61
|
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
# Max number of files defaults to 1. No limit enforced here. Only |
|
63
|
|
|
|
|
|
|
# positive whole numbers allowed |
|
64
|
9
|
|
|
|
|
20
|
$self->{max} = $p{max}; |
|
65
|
|
|
|
|
|
|
|
|
66
|
9
|
50
|
66
|
|
|
94
|
unless (defined $self->{max} && $self->{max} =~ /^\d+$/ && $self->{max} > 0) { |
|
|
|
|
66
|
|
|
|
|
|
67
|
2
|
|
|
|
|
3
|
$self->{max} = 1 |
|
68
|
|
|
|
|
|
|
} |
|
69
|
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# Get a name for our Lock file |
|
71
|
9
|
|
|
|
|
24
|
my $name = $self->{params}->{filename}; |
|
72
|
9
|
|
|
|
|
142
|
my ($vol, $dir, $f) = File::Spec->splitpath($name); |
|
73
|
9
|
|
50
|
|
|
30
|
$dir ||= '.'; |
|
74
|
9
|
|
33
|
|
|
24
|
$f ||= $name; |
|
75
|
|
|
|
|
|
|
|
|
76
|
9
|
|
|
|
|
83
|
$self->{lf} = File::Spec->catpath($vol, $dir, ".${f}.LCK"); |
|
77
|
9
|
|
|
|
|
54
|
$self->debug('Lock file is '.$self->{lf}); |
|
78
|
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Have we been called with a time based rotation pattern then setup |
|
80
|
|
|
|
|
|
|
# timebased stuff. TZ is important and must match current TZ or all |
|
81
|
|
|
|
|
|
|
# bets are off! |
|
82
|
9
|
100
|
|
|
|
30
|
if (defined $p{TZ}) { |
|
83
|
|
|
|
|
|
|
# Date::Manip deprecated TZ= in 6.x. In order to maintain backwards |
|
84
|
|
|
|
|
|
|
# compat with 5.8, we use TZ if setdate is not avilable. Otherwise we |
|
85
|
|
|
|
|
|
|
# use setdate. |
|
86
|
1
|
|
|
|
|
547
|
require version; |
|
87
|
1
|
50
|
|
|
|
2156
|
if (version->parse(DateManipVersion()) < version->parse('6.0')) { |
|
88
|
0
|
|
|
|
|
0
|
Date_Init("TZ=".$p{TZ}); |
|
89
|
|
|
|
|
|
|
} |
|
90
|
|
|
|
|
|
|
else { |
|
91
|
|
|
|
|
|
|
# Date::Manip 6.x deprecates TZ, use SetDate instead |
|
92
|
1
|
|
|
|
|
70
|
Date_Init("setdate=now,".$p{TZ}); |
|
93
|
|
|
|
|
|
|
} |
|
94
|
|
|
|
|
|
|
} |
|
95
|
|
|
|
|
|
|
|
|
96
|
9
|
100
|
|
|
|
1990
|
if (defined $p{DatePattern}) { |
|
97
|
7
|
|
|
|
|
39
|
$self->setDatePattern($p{DatePattern}); |
|
98
|
|
|
|
|
|
|
} |
|
99
|
|
|
|
|
|
|
|
|
100
|
9
|
50
|
|
|
|
50
|
$self->{check_both} = $p{check_both} ? 1 : 0; |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
# User callback to rotate the file. |
|
103
|
9
|
|
|
|
|
40
|
$self->{user_constraint} = $p{user_constraint}; |
|
104
|
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
# A post rotate callback. |
|
106
|
9
|
|
|
|
|
48
|
$self->{post_rotate} = $p{post_rotate}; |
|
107
|
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# Flag this as first creation point |
|
109
|
9
|
|
|
|
|
30
|
$self->{new} = 1; |
|
110
|
|
|
|
|
|
|
|
|
111
|
9
|
|
|
|
|
56
|
return $self; |
|
112
|
|
|
|
|
|
|
} |
|
113
|
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
sub filename { |
|
116
|
230
|
|
|
230
|
1
|
337
|
my $self = shift; |
|
117
|
|
|
|
|
|
|
|
|
118
|
230
|
|
|
|
|
463
|
return $self->{params}->{filename}; |
|
119
|
|
|
|
|
|
|
} |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
########################################################################### |
|
123
|
|
|
|
|
|
|
# |
|
124
|
|
|
|
|
|
|
# Subroutine setDatePattern |
|
125
|
|
|
|
|
|
|
# |
|
126
|
|
|
|
|
|
|
# Args: a single string or ArrayRef of strings |
|
127
|
|
|
|
|
|
|
# |
|
128
|
|
|
|
|
|
|
# Rtns: Nothing |
|
129
|
|
|
|
|
|
|
# |
|
130
|
|
|
|
|
|
|
# Description: |
|
131
|
|
|
|
|
|
|
# Set a recurrance for file rotation. We accept Date::Manip |
|
132
|
|
|
|
|
|
|
# recurrances and the log4j/DailyRollingFileAppender patterns |
|
133
|
|
|
|
|
|
|
# |
|
134
|
|
|
|
|
|
|
# Date:Manip => |
|
135
|
|
|
|
|
|
|
# 0:0:0:0:5:30:0 every 5 hours and 30 minutes |
|
136
|
|
|
|
|
|
|
# 0:0:0:2*12:30:0 every 2 days at 12:30 (each day) |
|
137
|
|
|
|
|
|
|
# 3*1:0:2:12:0:0 every 3 years on Jan 2 at noon |
|
138
|
|
|
|
|
|
|
# |
|
139
|
|
|
|
|
|
|
# DailyRollingFileAppender => |
|
140
|
|
|
|
|
|
|
# yyyy-MM |
|
141
|
|
|
|
|
|
|
# yyyy-ww |
|
142
|
|
|
|
|
|
|
# yyyy-MM-dd |
|
143
|
|
|
|
|
|
|
# yyyy-MM-dd-a |
|
144
|
|
|
|
|
|
|
# yyyy-MM-dd-HH |
|
145
|
|
|
|
|
|
|
# yyyy-MM-dd-HH-MM |
|
146
|
|
|
|
|
|
|
# |
|
147
|
|
|
|
|
|
|
# To specify multiple recurances in a single string seperate them with a |
|
148
|
|
|
|
|
|
|
# comma: yyyy-MM-dd,0:0:0:2*12:30:0 |
|
149
|
|
|
|
|
|
|
# |
|
150
|
|
|
|
|
|
|
sub setDatePattern { |
|
151
|
7
|
|
|
7
|
1
|
20
|
my ($self, $arg) = @_; |
|
152
|
|
|
|
|
|
|
|
|
153
|
7
|
|
|
|
|
15
|
local($_); # Don't crap on $_ |
|
154
|
7
|
|
|
|
|
25
|
my @pats = (); |
|
155
|
|
|
|
|
|
|
|
|
156
|
7
|
|
|
|
|
82
|
my %lookup = ( |
|
157
|
|
|
|
|
|
|
# Y:M:W:D:H:M:S |
|
158
|
|
|
|
|
|
|
'yyyy-mm' => '0:1*0:1:0:0:0', # Every Month |
|
159
|
|
|
|
|
|
|
'yyyy-ww' => '0:0:1*0:0:0:0', # Every week |
|
160
|
|
|
|
|
|
|
'yyyy-dd' => '0:0:0:1*0:0:0', # Every day |
|
161
|
|
|
|
|
|
|
'yyyy-mm-dd' => '0:0:0:1*0:0:0', # Every day |
|
162
|
|
|
|
|
|
|
'yyyy-dd-a' => '0:0:0:1*12:0:0', # Every day 12noon |
|
163
|
|
|
|
|
|
|
'yyyy-mm-dd-a' => '0:0:0:1*12:0:0', # Every day 12noon |
|
164
|
|
|
|
|
|
|
'yyyy-dd-hh' => '0:0:0:0:1*0:0', # Every hour |
|
165
|
|
|
|
|
|
|
'yyyy-mm-dd-hh' => '0:0:0:0:1*0:0', # Every hour |
|
166
|
|
|
|
|
|
|
'yyyy-dd-hh-mm' => '0:0:0:0:0:1*0', # Every minute |
|
167
|
|
|
|
|
|
|
'yyyy-mm-dd-hh-mm' => '0:0:0:0:0:1*0', # Every minute |
|
168
|
|
|
|
|
|
|
); |
|
169
|
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# Convert arg to array |
|
171
|
7
|
50
|
|
|
|
36
|
if (ref $arg eq 'ARRAY') { |
|
|
|
50
|
|
|
|
|
|
|
172
|
0
|
|
|
|
|
0
|
@pats = @$arg; |
|
173
|
|
|
|
|
|
|
} |
|
174
|
|
|
|
|
|
|
elsif (!ref $arg) { |
|
175
|
7
|
|
|
|
|
32
|
$arg =~ s/\s+//go; |
|
176
|
7
|
|
|
|
|
27
|
@pats = split /;/, $arg; |
|
177
|
|
|
|
|
|
|
} |
|
178
|
|
|
|
|
|
|
else { |
|
179
|
0
|
|
|
|
|
0
|
die "Bad reference type argument ".ref $arg; |
|
180
|
|
|
|
|
|
|
} |
|
181
|
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
# Handle (possibly multiple) recurrances |
|
183
|
7
|
|
|
|
|
20
|
foreach my $pat (@pats) { |
|
184
|
|
|
|
|
|
|
# Convert any log4j patterns across |
|
185
|
7
|
50
|
|
|
|
37
|
if ($pat =~ /^yyyy/i) { |
|
186
|
|
|
|
|
|
|
# log4j style |
|
187
|
7
|
|
|
|
|
25
|
$pat = $lookup{lc $pat}; |
|
188
|
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
# Default to daily on bad pattern |
|
190
|
7
|
50
|
|
|
|
29
|
unless (defined $pat) { |
|
191
|
0
|
|
|
|
|
0
|
warn "Bad Rotation pattern ($pat) using yyyy-dd\n"; |
|
192
|
0
|
|
|
|
|
0
|
$pat = 'yyyy-dd'; |
|
193
|
|
|
|
|
|
|
} |
|
194
|
|
|
|
|
|
|
} |
|
195
|
|
|
|
|
|
|
|
|
196
|
7
|
|
|
|
|
30
|
my $abs = $self->_get_next_occurance($pat); |
|
197
|
|
|
|
|
|
|
|
|
198
|
7
|
|
|
|
|
49
|
$self->debug("Adding [dates,pat] =>[$abs,$pat]"); |
|
199
|
|
|
|
|
|
|
|
|
200
|
7
|
|
|
|
|
21
|
my $ref = [$abs, $pat]; |
|
201
|
|
|
|
|
|
|
|
|
202
|
7
|
|
|
|
|
16
|
push @{$self->{recurrance}}, $ref; |
|
|
7
|
|
|
|
|
94
|
|
|
203
|
|
|
|
|
|
|
} |
|
204
|
|
|
|
|
|
|
} |
|
205
|
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
sub log_message { |
|
208
|
228
|
|
|
228
|
1
|
33346
|
my ($self, %p) = @_; |
|
209
|
|
|
|
|
|
|
|
|
210
|
228
|
|
|
|
|
556
|
my $mutex = $self->rotate(1); |
|
211
|
|
|
|
|
|
|
|
|
212
|
228
|
50
|
|
|
|
449
|
unless (defined $mutex) { |
|
213
|
0
|
|
|
|
|
0
|
$self->error('not logging'); |
|
214
|
0
|
|
|
|
|
0
|
return; |
|
215
|
|
|
|
|
|
|
} |
|
216
|
|
|
|
|
|
|
|
|
217
|
228
|
|
|
|
|
499
|
$self->debug('normal log'); |
|
218
|
|
|
|
|
|
|
|
|
219
|
228
|
|
|
|
|
662
|
$self->logit($p{message}); |
|
220
|
|
|
|
|
|
|
|
|
221
|
228
|
|
|
|
|
678
|
$self->debug('releasing lock'); |
|
222
|
|
|
|
|
|
|
|
|
223
|
228
|
|
|
|
|
618
|
$mutex->unlock; |
|
224
|
|
|
|
|
|
|
} |
|
225
|
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
sub rotate { |
|
228
|
228
|
|
|
228
|
1
|
409
|
my ($self, $hold_lock) = @_; |
|
229
|
|
|
|
|
|
|
# NOTE: $hold_lock is internal use only! |
|
230
|
|
|
|
|
|
|
|
|
231
|
228
|
|
|
|
|
449
|
my $max_size = $self->{size}; |
|
232
|
228
|
|
|
|
|
382
|
my $numfiles = $self->{max}; |
|
233
|
228
|
|
|
|
|
539
|
my $name = $self->filename(); |
|
234
|
228
|
|
|
|
|
450
|
my $fh = $self->{LDF}->{fh}; |
|
235
|
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
# Prime our time based data outside the critical code area |
|
237
|
228
|
|
|
|
|
500
|
my ($in_time_mode,$time_to_rotate) = $self->time_to_rotate(); |
|
238
|
|
|
|
|
|
|
|
|
239
|
228
|
|
|
|
|
423
|
my $user_rotation = 0; |
|
240
|
228
|
50
|
|
|
|
505
|
if (ref $self->{user_constraint} eq 'CODE') { |
|
241
|
|
|
|
|
|
|
eval { |
|
242
|
0
|
|
|
|
|
0
|
$user_rotation = &{$self->{user_constraint}}(); |
|
|
0
|
|
|
|
|
0
|
|
|
243
|
|
|
|
|
|
|
|
|
244
|
0
|
|
|
|
|
0
|
1; |
|
245
|
0
|
0
|
|
|
|
0
|
} or do { |
|
246
|
0
|
|
|
|
|
0
|
$self->error("user's callback error: $@"); |
|
247
|
|
|
|
|
|
|
}; |
|
248
|
|
|
|
|
|
|
} |
|
249
|
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
# Handle critical code for logging. No changes if someone else is in. We |
|
251
|
|
|
|
|
|
|
# lock a lockfile, not the actual log filehandle since the log filehandle |
|
252
|
|
|
|
|
|
|
# will change if we rotate the logs. |
|
253
|
228
|
|
|
|
|
518
|
my $mutex = $self->mutex_for_path($self->{lf}); |
|
254
|
|
|
|
|
|
|
|
|
255
|
228
|
50
|
|
|
|
596
|
unless ($mutex->lock) { |
|
256
|
0
|
|
|
|
|
0
|
$self->error("failed to get lock: $!"); |
|
257
|
0
|
|
|
|
|
0
|
return; |
|
258
|
|
|
|
|
|
|
} |
|
259
|
|
|
|
|
|
|
|
|
260
|
228
|
|
|
|
|
746
|
$self->debug('got lock'); |
|
261
|
|
|
|
|
|
|
|
|
262
|
228
|
|
|
|
|
368
|
my $have_to_rotate = 0; |
|
263
|
228
|
|
|
|
|
2371
|
my ($inode, $size) = (stat $fh)[1,7]; # real inode and size |
|
264
|
228
|
|
|
|
|
2984
|
my $finode = (stat $name)[1]; # inode of filename for comparision |
|
265
|
|
|
|
|
|
|
|
|
266
|
228
|
50
|
|
|
|
1617
|
$self->debug("s=$size, i=$inode, f=". |
|
267
|
|
|
|
|
|
|
(defined $finode ? $finode : "undef") . |
|
268
|
|
|
|
|
|
|
", n=$name"); |
|
269
|
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# If finode and inode are the same then nobody has done a rename |
|
271
|
|
|
|
|
|
|
# under us and we can continue. Otherwise just close and reopen. |
|
272
|
228
|
50
|
33
|
|
|
855
|
if (!defined $finode || $inode != $finode) { |
|
273
|
|
|
|
|
|
|
# Oops someone moved things on us. So just reopen our log |
|
274
|
0
|
|
|
|
|
0
|
delete $self->{LDF}; # Should get rid of current LDF |
|
275
|
0
|
|
|
|
|
0
|
$self->{LDF} = Log::Dispatch::File->new(%{$self->{params}}); # Our log |
|
|
0
|
|
|
|
|
0
|
|
|
276
|
|
|
|
|
|
|
|
|
277
|
0
|
|
|
|
|
0
|
$self->debug('Someone else rotated'); |
|
278
|
|
|
|
|
|
|
} |
|
279
|
|
|
|
|
|
|
else { |
|
280
|
228
|
|
|
|
|
389
|
my $check_both = $self->{check_both}; |
|
281
|
228
|
50
|
|
|
|
445
|
my $rotate_by_size = ($size >= $max_size) ? 1 : 0; |
|
282
|
|
|
|
|
|
|
|
|
283
|
228
|
50
|
66
|
|
|
1627
|
if(($in_time_mode && $time_to_rotate) || |
|
|
|
|
33
|
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
284
|
|
|
|
|
|
|
(!$in_time_mode && $rotate_by_size) || |
|
285
|
|
|
|
|
|
|
($rotate_by_size && $check_both) || |
|
286
|
|
|
|
|
|
|
($user_rotation)) |
|
287
|
|
|
|
|
|
|
{ |
|
288
|
1
|
|
|
|
|
2
|
$have_to_rotate = 1; |
|
289
|
|
|
|
|
|
|
} |
|
290
|
|
|
|
|
|
|
|
|
291
|
228
|
|
|
|
|
840
|
$self->debug("in time mode: $in_time_mode; time to rotate: $time_to_rotate;" |
|
292
|
|
|
|
|
|
|
." rotate by size: $rotate_by_size; check_both: $check_both;" |
|
293
|
|
|
|
|
|
|
." user rotation: $user_rotation; have to rotate: $have_to_rotate"); |
|
294
|
|
|
|
|
|
|
} |
|
295
|
|
|
|
|
|
|
|
|
296
|
228
|
100
|
|
|
|
497
|
if ($have_to_rotate) { |
|
297
|
|
|
|
|
|
|
# Shut down the log |
|
298
|
1
|
|
|
|
|
8
|
delete $self->{LDF}; # Should get rid of current LDF |
|
299
|
|
|
|
|
|
|
|
|
300
|
1
|
|
|
|
|
37
|
$self->debug('Rotating'); |
|
301
|
1
|
|
|
|
|
5
|
$self->_for_each_file(\&_move_file); |
|
302
|
1
|
|
|
|
|
4
|
$self->debug('Rotating Done'); |
|
303
|
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# reopen the logfile for writing. |
|
305
|
1
|
|
|
|
|
1
|
$self->{LDF} = Log::Dispatch::File->new(%{$self->{params}}); # Our log |
|
|
1
|
|
|
|
|
13
|
|
|
306
|
|
|
|
|
|
|
|
|
307
|
1
|
50
|
|
|
|
432
|
if (ref $self->{post_rotate} eq 'CODE') { |
|
308
|
0
|
|
|
|
|
0
|
$self->debug('Calling user post-rotate callback'); |
|
309
|
0
|
|
|
|
|
0
|
$self->_for_each_file($self->{post_rotate}); |
|
310
|
|
|
|
|
|
|
} |
|
311
|
|
|
|
|
|
|
} |
|
312
|
|
|
|
|
|
|
|
|
313
|
228
|
50
|
|
|
|
454
|
if ($hold_lock) { |
|
314
|
228
|
|
|
|
|
527
|
return $mutex; |
|
315
|
|
|
|
|
|
|
} |
|
316
|
|
|
|
|
|
|
|
|
317
|
0
|
|
|
|
|
0
|
$mutex->unlock; |
|
318
|
|
|
|
|
|
|
|
|
319
|
0
|
|
|
|
|
0
|
return $have_to_rotate; |
|
320
|
|
|
|
|
|
|
} |
|
321
|
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
sub _for_each_file { |
|
323
|
1
|
|
|
1
|
|
4
|
my ($self, $callback) = @_; |
|
324
|
|
|
|
|
|
|
|
|
325
|
1
|
|
|
|
|
3
|
my $basename = $self->filename(); |
|
326
|
1
|
|
|
|
|
3
|
my $idx = $self->{max} - 1; |
|
327
|
|
|
|
|
|
|
|
|
328
|
1
|
|
|
|
|
4
|
while ($idx >= 0) { |
|
329
|
6
|
|
|
|
|
11
|
my $filename = $basename; |
|
330
|
|
|
|
|
|
|
|
|
331
|
6
|
100
|
|
|
|
13
|
if ($idx) { |
|
332
|
5
|
|
|
|
|
12
|
$filename .= ".$idx"; |
|
333
|
|
|
|
|
|
|
} |
|
334
|
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
eval { |
|
336
|
6
|
100
|
|
|
|
96
|
if (-f $filename) { |
|
337
|
1
|
|
|
|
|
4
|
&{$callback}($filename, $idx, $self); |
|
|
1
|
|
|
|
|
4
|
|
|
338
|
|
|
|
|
|
|
} |
|
339
|
|
|
|
|
|
|
|
|
340
|
6
|
|
|
|
|
19
|
1; |
|
341
|
6
|
50
|
|
|
|
10
|
} or do { |
|
342
|
0
|
|
|
|
|
0
|
$self->error("callback error: $@"); |
|
343
|
|
|
|
|
|
|
}; |
|
344
|
|
|
|
|
|
|
|
|
345
|
6
|
|
|
|
|
16
|
$idx--; |
|
346
|
|
|
|
|
|
|
} |
|
347
|
|
|
|
|
|
|
|
|
348
|
1
|
|
|
|
|
2
|
return undef; |
|
349
|
|
|
|
|
|
|
} |
|
350
|
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
sub _move_file { |
|
352
|
1
|
|
|
1
|
|
3
|
my ($filename, $idx, $fileRotate) = @_; |
|
353
|
|
|
|
|
|
|
|
|
354
|
1
|
|
|
|
|
4
|
my $basename = $fileRotate->filename(); |
|
355
|
1
|
|
|
|
|
5
|
my $newfile = $basename . '.' . ($idx+1); |
|
356
|
|
|
|
|
|
|
|
|
357
|
1
|
|
|
|
|
7
|
$fileRotate->debug("rename $filename $newfile"); |
|
358
|
|
|
|
|
|
|
|
|
359
|
1
|
|
|
|
|
40
|
rename $filename, $newfile; |
|
360
|
|
|
|
|
|
|
|
|
361
|
1
|
|
|
|
|
14
|
return undef; |
|
362
|
|
|
|
|
|
|
} |
|
363
|
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
sub logit { |
|
365
|
228
|
|
|
228
|
0
|
366
|
my ($self, $message) = @_; |
|
366
|
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
# Make sure we are at the EOF |
|
368
|
228
|
|
|
|
|
2143
|
seek $self->{LDF}{fh}, 0, 2; |
|
369
|
|
|
|
|
|
|
|
|
370
|
228
|
|
|
|
|
1212
|
$self->{LDF}->log_message(message => $message); |
|
371
|
|
|
|
|
|
|
|
|
372
|
228
|
|
|
|
|
7070
|
return; |
|
373
|
|
|
|
|
|
|
} |
|
374
|
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
{ |
|
376
|
|
|
|
|
|
|
my %MUTEXES; |
|
377
|
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
sub mutex_for_path { |
|
379
|
228
|
|
|
228
|
0
|
422
|
my ($self, $path) = @_; |
|
380
|
|
|
|
|
|
|
|
|
381
|
228
|
|
|
|
|
295
|
my %args; |
|
382
|
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
# use same permissions for the Mutex file |
|
384
|
228
|
100
|
|
|
|
476
|
if (exists $self->{params}{permissions}) { |
|
385
|
3
|
|
|
|
|
8
|
$args{permissions} = $self->{params}{permissions}; |
|
386
|
|
|
|
|
|
|
} |
|
387
|
|
|
|
|
|
|
|
|
388
|
228
|
|
66
|
|
|
676
|
$MUTEXES{$path} ||= Log::Dispatch::FileRotate::Mutex->new($path, %args); |
|
389
|
|
|
|
|
|
|
} |
|
390
|
|
|
|
|
|
|
} |
|
391
|
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
########################################################################### |
|
393
|
|
|
|
|
|
|
# |
|
394
|
|
|
|
|
|
|
# Subroutine time_to_rotate |
|
395
|
|
|
|
|
|
|
# |
|
396
|
|
|
|
|
|
|
# Args: none |
|
397
|
|
|
|
|
|
|
# |
|
398
|
|
|
|
|
|
|
# Rtns: (1,n) if we are in time mode and its time to rotate |
|
399
|
|
|
|
|
|
|
# n defines the number of timers that expired |
|
400
|
|
|
|
|
|
|
# (1,0) if we are in time mode but not ready to rotate |
|
401
|
|
|
|
|
|
|
# (0,0) otherwise |
|
402
|
|
|
|
|
|
|
# |
|
403
|
|
|
|
|
|
|
# Description: |
|
404
|
|
|
|
|
|
|
# time_to_rotate - update internal clocks and return status as |
|
405
|
|
|
|
|
|
|
# defined above |
|
406
|
|
|
|
|
|
|
# |
|
407
|
|
|
|
|
|
|
# If we have just been created then the first recurrance is an indication |
|
408
|
|
|
|
|
|
|
# to check against the log file. |
|
409
|
|
|
|
|
|
|
# |
|
410
|
|
|
|
|
|
|
# |
|
411
|
|
|
|
|
|
|
# my ($in_time_mode,$time_to_rotate) = $self->time_to_rotate(); |
|
412
|
|
|
|
|
|
|
sub time_to_rotate { |
|
413
|
228
|
|
|
228
|
0
|
330
|
my $self = shift; |
|
414
|
|
|
|
|
|
|
|
|
415
|
228
|
|
|
|
|
404
|
my $mode = defined $self->{recurrance}; |
|
416
|
228
|
|
|
|
|
381
|
my $rotate = 0; |
|
417
|
|
|
|
|
|
|
|
|
418
|
228
|
50
|
|
|
|
556
|
if ($mode) { |
|
419
|
|
|
|
|
|
|
# Then do some checking and update ourselves if we think we need |
|
420
|
|
|
|
|
|
|
# to rotate. Wether we rotate or not is up to our caller. We |
|
421
|
|
|
|
|
|
|
# assume they know what they are doing! |
|
422
|
|
|
|
|
|
|
|
|
423
|
|
|
|
|
|
|
# Only stat the log file here if we are in our first invocation. |
|
424
|
|
|
|
|
|
|
my $ftime = $self->{new} |
|
425
|
228
|
100
|
|
|
|
639
|
? (stat $self->{LDF}{fh})[9] |
|
426
|
|
|
|
|
|
|
: 0; |
|
427
|
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
# Check need for rotation. Loop through our recurrances looking |
|
429
|
|
|
|
|
|
|
# for expiration times. Any we find that have expired we update. |
|
430
|
228
|
|
|
|
|
469
|
my $tm = $self->{timer}->(); |
|
431
|
228
|
|
|
|
|
365
|
my @recur = @{$self->{recurrance}}; |
|
|
228
|
|
|
|
|
468
|
|
|
432
|
|
|
|
|
|
|
|
|
433
|
228
|
|
|
|
|
513
|
$self->{recurrance} = []; |
|
434
|
|
|
|
|
|
|
|
|
435
|
228
|
|
|
|
|
435
|
for my $rec (@recur) { |
|
436
|
228
|
|
|
|
|
477
|
my ($abs, $pat) = @$rec; |
|
437
|
|
|
|
|
|
|
|
|
438
|
|
|
|
|
|
|
# Extra checking |
|
439
|
228
|
50
|
33
|
|
|
949
|
unless (defined $abs && $abs) { |
|
440
|
0
|
|
|
|
|
0
|
warn "Bad time found for recurrance pattern $pat: $abs\n"; |
|
441
|
0
|
|
|
|
|
0
|
next; |
|
442
|
|
|
|
|
|
|
} |
|
443
|
|
|
|
|
|
|
|
|
444
|
228
|
|
|
|
|
343
|
my $dorotate = 0; |
|
445
|
|
|
|
|
|
|
|
|
446
|
|
|
|
|
|
|
# If this is first time through |
|
447
|
228
|
100
|
|
|
|
594
|
if ($self->{new}) { |
|
|
|
100
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
# If it needs a rotate then flag it |
|
449
|
7
|
50
|
|
|
|
50
|
if ($ftime <= $abs) { |
|
450
|
|
|
|
|
|
|
# Then we need to rotate |
|
451
|
0
|
|
|
|
|
0
|
$self->debug("Need rotate file($ftime) <= $abs"); |
|
452
|
0
|
|
|
|
|
0
|
$rotate++; |
|
453
|
0
|
|
|
|
|
0
|
$dorotate++; # Just for debugging |
|
454
|
|
|
|
|
|
|
} |
|
455
|
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
# Move to next occurance regardless |
|
457
|
7
|
|
|
|
|
54
|
$self->debug("Dropping initial occurance($abs)"); |
|
458
|
7
|
|
|
|
|
32
|
$abs = $self->_get_next_occurance($pat); |
|
459
|
7
|
50
|
33
|
|
|
55
|
unless (defined $abs && $abs) { |
|
460
|
0
|
|
|
|
|
0
|
warn "Next occurance is null for $pat\n"; |
|
461
|
0
|
|
|
|
|
0
|
$abs = 0; |
|
462
|
|
|
|
|
|
|
} |
|
463
|
|
|
|
|
|
|
} |
|
464
|
|
|
|
|
|
|
elsif ($abs <= $tm) { |
|
465
|
|
|
|
|
|
|
# Then we need to rotate |
|
466
|
1
|
|
|
|
|
19
|
$self->debug("Need rotate $abs <= $tm"); |
|
467
|
1
|
|
|
|
|
10
|
$abs = $self->_get_next_occurance($pat); |
|
468
|
1
|
50
|
33
|
|
|
7
|
unless (defined $abs && $abs) { |
|
469
|
0
|
|
|
|
|
0
|
warn "Next occurance is null for $pat\n"; |
|
470
|
0
|
|
|
|
|
0
|
$abs = 0; |
|
471
|
|
|
|
|
|
|
} |
|
472
|
|
|
|
|
|
|
|
|
473
|
1
|
|
|
|
|
2
|
$rotate++; |
|
474
|
1
|
|
|
|
|
2
|
$dorotate++; # Just for debugging |
|
475
|
|
|
|
|
|
|
} |
|
476
|
|
|
|
|
|
|
|
|
477
|
228
|
50
|
|
|
|
469
|
if ($abs) { |
|
478
|
228
|
|
|
|
|
319
|
push @{$self->{recurrance}}, [$abs, $pat]; |
|
|
228
|
|
|
|
|
652
|
|
|
479
|
|
|
|
|
|
|
} |
|
480
|
|
|
|
|
|
|
|
|
481
|
228
|
|
|
|
|
804
|
$self->debug("time_to_rotate(mode,rotate,next) => ($mode,$dorotate,$abs)"); |
|
482
|
|
|
|
|
|
|
} |
|
483
|
|
|
|
|
|
|
} |
|
484
|
|
|
|
|
|
|
|
|
485
|
228
|
|
|
|
|
371
|
$self->{new} = 0; # No longer brand-spankers |
|
486
|
|
|
|
|
|
|
|
|
487
|
228
|
|
|
|
|
663
|
$self->debug("time_to_rotate(mode,rotate) => ($mode,$rotate)"); |
|
488
|
|
|
|
|
|
|
|
|
489
|
228
|
50
|
|
|
|
779
|
return wantarray ? ($mode, $rotate) : $rotate; |
|
490
|
|
|
|
|
|
|
} |
|
491
|
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
########################################################################### |
|
493
|
|
|
|
|
|
|
# |
|
494
|
|
|
|
|
|
|
# Subroutine _gen_occurance |
|
495
|
|
|
|
|
|
|
# |
|
496
|
|
|
|
|
|
|
# Args: Date::Manip occurance pattern |
|
497
|
|
|
|
|
|
|
# |
|
498
|
|
|
|
|
|
|
# Rtns: array of dates for next few events |
|
499
|
|
|
|
|
|
|
# |
|
500
|
|
|
|
|
|
|
# If asked we will return an inital occurance that is before the current |
|
501
|
|
|
|
|
|
|
# time. This can be used to see if we need to rotate on start up. We are |
|
502
|
|
|
|
|
|
|
# often called by CGI (short lived) proggies :-( |
|
503
|
|
|
|
|
|
|
# |
|
504
|
|
|
|
|
|
|
sub _gen_occurance { |
|
505
|
7
|
|
|
7
|
|
19
|
my ($self, $pat, $initial) = @_; |
|
506
|
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
# Do we return an initial occurance before the current time? |
|
508
|
7
|
|
50
|
|
|
26
|
$initial ||= 0; |
|
509
|
|
|
|
|
|
|
|
|
510
|
7
|
|
|
|
|
16
|
my $range = ''; |
|
511
|
7
|
|
|
|
|
15
|
my $base = 'now'; # default to calcs based on the current time |
|
512
|
|
|
|
|
|
|
|
|
513
|
7
|
50
|
|
|
|
45
|
if ($pat =~ /^0:0:0:0:0/) { |
|
|
|
50
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# Small recurrance less than 1 hour |
|
515
|
0
|
|
|
|
|
0
|
$range = "4 hours later"; |
|
516
|
0
|
0
|
|
|
|
0
|
$base = "1 hours ago" if $initial; |
|
517
|
|
|
|
|
|
|
} |
|
518
|
|
|
|
|
|
|
elsif ($pat =~ /^0:0:0:0/) { |
|
519
|
|
|
|
|
|
|
# recurrance less than 1 day |
|
520
|
7
|
|
|
|
|
13
|
$range = "4 days later"; |
|
521
|
7
|
50
|
|
|
|
24
|
$base = "1 days ago" if $initial; |
|
522
|
|
|
|
|
|
|
} |
|
523
|
|
|
|
|
|
|
elsif ($pat =~ /^0:0:0:/) { |
|
524
|
|
|
|
|
|
|
# recurrance less than 1 week |
|
525
|
0
|
|
|
|
|
0
|
$range = "4 weeks later"; |
|
526
|
0
|
0
|
|
|
|
0
|
$base = "1 weeks ago" if $initial; |
|
527
|
|
|
|
|
|
|
} |
|
528
|
|
|
|
|
|
|
elsif ($pat =~ /^0:0:/) { |
|
529
|
|
|
|
|
|
|
# recurrance less than 1 month |
|
530
|
0
|
|
|
|
|
0
|
$range = "4 months later"; |
|
531
|
0
|
0
|
|
|
|
0
|
$base = "1 months ago" if $initial; |
|
532
|
|
|
|
|
|
|
} |
|
533
|
|
|
|
|
|
|
elsif ($pat =~ /^0:/) { |
|
534
|
|
|
|
|
|
|
# recurrance less than 1 year |
|
535
|
0
|
|
|
|
|
0
|
$range = "24 months later"; |
|
536
|
0
|
0
|
|
|
|
0
|
$base = "24 months ago" if $initial; |
|
537
|
|
|
|
|
|
|
} |
|
538
|
|
|
|
|
|
|
else { |
|
539
|
|
|
|
|
|
|
# years |
|
540
|
0
|
|
|
|
|
0
|
my ($yrs) = $pat =~ m/^(\d+):/; |
|
541
|
|
|
|
|
|
|
|
|
542
|
0
|
|
0
|
|
|
0
|
$yrs ||= 1; |
|
543
|
|
|
|
|
|
|
|
|
544
|
0
|
|
|
|
|
0
|
my $months = $yrs * 4 * 12; |
|
545
|
|
|
|
|
|
|
|
|
546
|
0
|
|
|
|
|
0
|
$range = "$months months later"; |
|
547
|
0
|
0
|
|
|
|
0
|
$base = "$months months ago" if $initial; |
|
548
|
|
|
|
|
|
|
} |
|
549
|
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
# The next date must start at least 1 second away from now other wise |
|
551
|
|
|
|
|
|
|
# we may rotate for every message we recieve with in this second :-( |
|
552
|
7
|
|
|
|
|
47
|
my $start = DateCalc($base,"+ 1 second"); |
|
553
|
|
|
|
|
|
|
|
|
554
|
7
|
|
|
|
|
313529
|
$self->debug("ParseRecur($pat,$base,$start,$range);"); |
|
555
|
|
|
|
|
|
|
|
|
556
|
7
|
|
|
|
|
36
|
my @dates = ParseRecur($pat,$base,$start,$range); |
|
557
|
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
# Just in case we have a bad parse or our assumptions are wrong. |
|
559
|
|
|
|
|
|
|
# We default to days |
|
560
|
7
|
50
|
|
|
|
1572538
|
unless (scalar @dates >= 2) { |
|
561
|
0
|
|
|
|
|
0
|
warn "Failed to parse ($pat). Going daily\n"; |
|
562
|
|
|
|
|
|
|
|
|
563
|
0
|
0
|
|
|
|
0
|
if ($initial) { |
|
564
|
0
|
|
|
|
|
0
|
@dates = ParseRecur('0:0:0:1*0:0:0',"2 days ago","2 days ago","1 months later"); |
|
565
|
|
|
|
|
|
|
} |
|
566
|
|
|
|
|
|
|
else { |
|
567
|
0
|
|
|
|
|
0
|
@dates = ParseRecur('0:0:0:1*0:0:0',"now","now","1 months later"); |
|
568
|
|
|
|
|
|
|
} |
|
569
|
|
|
|
|
|
|
} |
|
570
|
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
# Convert the dates to seconds since the epoch so we can use |
|
572
|
|
|
|
|
|
|
# numerical comparision instead of textual |
|
573
|
7
|
|
|
|
|
27
|
my @epochs = (); |
|
574
|
7
|
|
|
|
|
37
|
my @a = ('%Y','%m','%d','%H','%M','%S'); |
|
575
|
7
|
|
|
|
|
29
|
foreach (@dates) { |
|
576
|
840
|
|
|
|
|
2288
|
my ($y,$m,$d,$h,$mn,$s) = Date::Manip::UnixDate($_, @a); |
|
577
|
|
|
|
|
|
|
|
|
578
|
840
|
|
|
|
|
612673
|
my $e = Date_SecsSince1970GMT($m,$d,$y,$h,$mn,$s); |
|
579
|
|
|
|
|
|
|
|
|
580
|
840
|
|
|
|
|
427090
|
$self->debug("Date to epochs ($_) => ($e)"); |
|
581
|
|
|
|
|
|
|
|
|
582
|
840
|
|
|
|
|
2249
|
push @epochs, $e; |
|
583
|
|
|
|
|
|
|
} |
|
584
|
|
|
|
|
|
|
|
|
585
|
|
|
|
|
|
|
# Clean out all but the one previous to now if we are doing an |
|
586
|
|
|
|
|
|
|
# initial occurance |
|
587
|
7
|
|
|
|
|
27
|
my $now = time; |
|
588
|
|
|
|
|
|
|
|
|
589
|
7
|
50
|
|
|
|
58
|
if ($initial) { |
|
590
|
7
|
|
|
|
|
21
|
my $before = ''; |
|
591
|
|
|
|
|
|
|
|
|
592
|
7
|
|
66
|
|
|
82
|
while (@epochs && $epochs[0] <= $now) { |
|
593
|
168
|
|
|
|
|
465
|
$before = shift @epochs; |
|
594
|
|
|
|
|
|
|
} |
|
595
|
|
|
|
|
|
|
|
|
596
|
7
|
50
|
|
|
|
46
|
if ($before) { |
|
597
|
7
|
|
|
|
|
21
|
unshift @epochs, $before; |
|
598
|
|
|
|
|
|
|
} |
|
599
|
|
|
|
|
|
|
} |
|
600
|
|
|
|
|
|
|
else { |
|
601
|
|
|
|
|
|
|
# Clean out dates that occur before now, being careful not to loop |
|
602
|
|
|
|
|
|
|
# forever (thanks James). |
|
603
|
0
|
|
0
|
|
|
0
|
while (@epochs && $epochs[0] <= $now) { |
|
604
|
0
|
|
|
|
|
0
|
shift @epochs; |
|
605
|
|
|
|
|
|
|
} |
|
606
|
|
|
|
|
|
|
} |
|
607
|
|
|
|
|
|
|
|
|
608
|
7
|
|
|
|
|
291
|
$self->debug("Recurrances are at: ". join "\n\t", @dates); |
|
609
|
|
|
|
|
|
|
|
|
610
|
7
|
50
|
|
|
|
55
|
warn "No recurrances found! Probably a timezone issue!\n" unless @dates; |
|
611
|
|
|
|
|
|
|
|
|
612
|
7
|
|
|
|
|
201
|
return @epochs; |
|
613
|
|
|
|
|
|
|
} |
|
614
|
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
########################################################################### |
|
616
|
|
|
|
|
|
|
# |
|
617
|
|
|
|
|
|
|
# Subroutine _get_next_occurance |
|
618
|
|
|
|
|
|
|
# |
|
619
|
|
|
|
|
|
|
# Args: Date::Manip occurance pattern |
|
620
|
|
|
|
|
|
|
# |
|
621
|
|
|
|
|
|
|
# Rtns: date |
|
622
|
|
|
|
|
|
|
# |
|
623
|
|
|
|
|
|
|
# We don't want to call Date::Manip::ParseRecur too often as it is very |
|
624
|
|
|
|
|
|
|
# expensive. So, we cache what is returned from _gen_occurance(). |
|
625
|
|
|
|
|
|
|
sub _get_next_occurance { |
|
626
|
15
|
|
|
15
|
|
50
|
my ($self, $pat) = @_; |
|
627
|
|
|
|
|
|
|
|
|
628
|
|
|
|
|
|
|
# (ms) Throw out expired occurances |
|
629
|
15
|
|
|
|
|
40
|
my $now = $self->{timer}->(); |
|
630
|
|
|
|
|
|
|
|
|
631
|
15
|
100
|
|
|
|
59
|
if (defined $self->{dates}{$pat}) { |
|
632
|
8
|
|
|
|
|
27
|
while (@{$self->{dates}{$pat}}) { |
|
|
17
|
|
|
|
|
60
|
|
|
633
|
17
|
100
|
|
|
|
56
|
last if $self->{dates}{$pat}->[0] >= $now; |
|
634
|
9
|
|
|
|
|
11
|
shift @{$self->{dates}{$pat}}; |
|
|
9
|
|
|
|
|
17
|
|
|
635
|
|
|
|
|
|
|
} |
|
636
|
|
|
|
|
|
|
} |
|
637
|
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
# If this is first time then generate some new ones including one |
|
639
|
|
|
|
|
|
|
# before our time to test against the log file |
|
640
|
15
|
100
|
33
|
|
|
55
|
unless (defined $self->{'dates'}{$pat}) { |
|
641
|
7
|
|
|
|
|
30
|
@{$self->{'dates'}{$pat}} = $self->_gen_occurance($pat,1); |
|
|
7
|
|
|
|
|
67
|
|
|
642
|
|
|
|
|
|
|
} |
|
643
|
|
|
|
|
|
|
elsif (scalar(@{$self->{'dates'}{$pat}}) < 2) { |
|
644
|
|
|
|
|
|
|
# close to the end of what we have |
|
645
|
|
|
|
|
|
|
@{$self->{'dates'}{$pat}} = $self->_gen_occurance($pat); |
|
646
|
|
|
|
|
|
|
} |
|
647
|
|
|
|
|
|
|
|
|
648
|
15
|
|
|
|
|
44
|
return shift @{$self->{'dates'}{$pat}}; |
|
|
15
|
|
|
|
|
57
|
|
|
649
|
|
|
|
|
|
|
} |
|
650
|
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
sub debug { |
|
653
|
2477
|
|
|
2477
|
1
|
4627
|
my ($self, $message) = @_; |
|
654
|
|
|
|
|
|
|
|
|
655
|
2477
|
50
|
|
|
|
6056
|
return unless $self->{debug}; |
|
656
|
|
|
|
|
|
|
|
|
657
|
0
|
|
|
|
|
|
warn localtime() . " $$ $message\n"; |
|
658
|
|
|
|
|
|
|
|
|
659
|
0
|
|
|
|
|
|
return; |
|
660
|
|
|
|
|
|
|
} |
|
661
|
|
|
|
|
|
|
|
|
662
|
|
|
|
|
|
|
sub error { |
|
663
|
0
|
|
|
0
|
0
|
|
my ($self, $message) = @_; |
|
664
|
|
|
|
|
|
|
|
|
665
|
0
|
|
|
|
|
|
chomp $message; |
|
666
|
|
|
|
|
|
|
|
|
667
|
0
|
|
|
|
|
|
warn "$$ " . __PACKAGE__ . " $message\n"; |
|
668
|
|
|
|
|
|
|
} |
|
669
|
|
|
|
|
|
|
|
|
670
|
|
|
|
|
|
|
1; |
|
671
|
|
|
|
|
|
|
|
|
672
|
|
|
|
|
|
|
__END__ |
|
673
|
|
|
|
|
|
|
|
|
674
|
|
|
|
|
|
|
=pod |
|
675
|
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=encoding UTF-8 |
|
677
|
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
=head1 NAME |
|
679
|
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
Log::Dispatch::FileRotate - Log to Files that Archive/Rotate Themselves |
|
681
|
|
|
|
|
|
|
|
|
682
|
|
|
|
|
|
|
=head1 VERSION |
|
683
|
|
|
|
|
|
|
|
|
684
|
|
|
|
|
|
|
version 1.38 |
|
685
|
|
|
|
|
|
|
|
|
686
|
|
|
|
|
|
|
=head1 SYNOPSIS |
|
687
|
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
use Log::Dispatch::FileRotate; |
|
689
|
|
|
|
|
|
|
|
|
690
|
|
|
|
|
|
|
my $logger = Log::Dispatch::FileRotate->new( |
|
691
|
|
|
|
|
|
|
name => 'file1', |
|
692
|
|
|
|
|
|
|
min_level => 'info', |
|
693
|
|
|
|
|
|
|
filename => 'Somefile.log', |
|
694
|
|
|
|
|
|
|
mode => 'append' , |
|
695
|
|
|
|
|
|
|
size => 10*1024*1024, |
|
696
|
|
|
|
|
|
|
max => 6); |
|
697
|
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
# or for a time based rotation |
|
699
|
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
my $logger = Log::Dispatch::FileRotate->new( |
|
701
|
|
|
|
|
|
|
name => 'file1', |
|
702
|
|
|
|
|
|
|
min_level => 'info', |
|
703
|
|
|
|
|
|
|
filename => 'Somefile.log', |
|
704
|
|
|
|
|
|
|
mode => 'append' , |
|
705
|
|
|
|
|
|
|
TZ => 'AEDT', |
|
706
|
|
|
|
|
|
|
DatePattern => 'yyyy-dd-HH'); |
|
707
|
|
|
|
|
|
|
|
|
708
|
|
|
|
|
|
|
# and attach to Log::Dispatch |
|
709
|
|
|
|
|
|
|
my $dispatcher = Log::Dispatch->new; |
|
710
|
|
|
|
|
|
|
$dispatcher->add($logger); |
|
711
|
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
$dispatcher->log( level => 'info', message => "your comment\n" ); |
|
713
|
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
=head1 DESCRIPTION |
|
715
|
|
|
|
|
|
|
|
|
716
|
|
|
|
|
|
|
This module extends the base class L<Log::Dispatch::Output> to provides a |
|
717
|
|
|
|
|
|
|
simple object for logging to files under the Log::Dispatch::* system, and |
|
718
|
|
|
|
|
|
|
automatically rotating them according to different constraints. This is |
|
719
|
|
|
|
|
|
|
basically a L<Log::Dispatch::File> wrapper with additions. |
|
720
|
|
|
|
|
|
|
|
|
721
|
|
|
|
|
|
|
=head2 Rotation |
|
722
|
|
|
|
|
|
|
|
|
723
|
|
|
|
|
|
|
There are three different constraints which decide when a file must be |
|
724
|
|
|
|
|
|
|
rotated. |
|
725
|
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
The first is by size: when the log file grows more than a specified |
|
727
|
|
|
|
|
|
|
size, then it's rotated. |
|
728
|
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
The second constraint is with occurrences. If a L</DatePattern> is defined, a |
|
730
|
|
|
|
|
|
|
file rotation ignores size constraint (unless C<check_both>) and uses the |
|
731
|
|
|
|
|
|
|
defined date pattern constraints. When using L</DatePattern> make sure TZ is |
|
732
|
|
|
|
|
|
|
defined correctly and that the TZ you use is understood by Date::Manip. We use |
|
733
|
|
|
|
|
|
|
Date::Manip to generate our recurrences. Bad TZ equals bad recurrences equals |
|
734
|
|
|
|
|
|
|
surprises! Read the L<Date::Manip> man page for more details on |
|
735
|
|
|
|
|
|
|
TZ. L</DatePattern> will default to a daily rotate if your entered pattern is |
|
736
|
|
|
|
|
|
|
incorrect. You will also get a warning message. |
|
737
|
|
|
|
|
|
|
|
|
738
|
|
|
|
|
|
|
You can also check both constraints together by using the C<check_both> |
|
739
|
|
|
|
|
|
|
parameter. |
|
740
|
|
|
|
|
|
|
|
|
741
|
|
|
|
|
|
|
The latter constraint is a user callback. This function is called outside the |
|
742
|
|
|
|
|
|
|
restricted area (see L</Concurrency>) and, |
|
743
|
|
|
|
|
|
|
if it returns a true value, a rotation will happen unconditionally. |
|
744
|
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
All check are made before logging. The C<rotate> method leaves us check these |
|
746
|
|
|
|
|
|
|
constraints without logging anything. |
|
747
|
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
To let more power at the user, a C<post_rotate> callback it'll call after every |
|
749
|
|
|
|
|
|
|
rotation. |
|
750
|
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
=head2 Concurrency |
|
752
|
|
|
|
|
|
|
|
|
753
|
|
|
|
|
|
|
Multiple writers are allowed by this module. There is a restricted area where |
|
754
|
|
|
|
|
|
|
only one writer can be inside. This is done by using an external lock file, |
|
755
|
|
|
|
|
|
|
which name is "C<.filename.LCK>" (never deleted). |
|
756
|
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
The user constraint and the L</DatePattern> constraint are checked outside this |
|
758
|
|
|
|
|
|
|
restricted area. So, when you write a callback, don't rely on the logging |
|
759
|
|
|
|
|
|
|
file because it can disappear under your feet. |
|
760
|
|
|
|
|
|
|
|
|
761
|
|
|
|
|
|
|
Within this restricted area we: |
|
762
|
|
|
|
|
|
|
|
|
763
|
|
|
|
|
|
|
=over 4 |
|
764
|
|
|
|
|
|
|
|
|
765
|
|
|
|
|
|
|
=item * |
|
766
|
|
|
|
|
|
|
|
|
767
|
|
|
|
|
|
|
check the size constraint |
|
768
|
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
=item * |
|
770
|
|
|
|
|
|
|
|
|
771
|
|
|
|
|
|
|
eventually rotate the log file |
|
772
|
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
=item * |
|
774
|
|
|
|
|
|
|
|
|
775
|
|
|
|
|
|
|
if it's defined, call the C<post_rotate> function |
|
776
|
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
=item * |
|
778
|
|
|
|
|
|
|
|
|
779
|
|
|
|
|
|
|
write the log message |
|
780
|
|
|
|
|
|
|
|
|
781
|
|
|
|
|
|
|
=back |
|
782
|
|
|
|
|
|
|
|
|
783
|
|
|
|
|
|
|
=head1 METHODS |
|
784
|
|
|
|
|
|
|
|
|
785
|
|
|
|
|
|
|
=head2 new(%p) |
|
786
|
|
|
|
|
|
|
|
|
787
|
|
|
|
|
|
|
The constructor takes the following parameters in addition to parameters |
|
788
|
|
|
|
|
|
|
documented in L<Log::Dispatch::File>: |
|
789
|
|
|
|
|
|
|
|
|
790
|
|
|
|
|
|
|
=over 4 |
|
791
|
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
=item max ($) |
|
793
|
|
|
|
|
|
|
|
|
794
|
|
|
|
|
|
|
The maximum number of log files to create. Default 1. |
|
795
|
|
|
|
|
|
|
|
|
796
|
|
|
|
|
|
|
=item size ($) |
|
797
|
|
|
|
|
|
|
|
|
798
|
|
|
|
|
|
|
The maximum (or close to) size the log file can grow too. Default 10M. |
|
799
|
|
|
|
|
|
|
|
|
800
|
|
|
|
|
|
|
=item DatePattern ($) |
|
801
|
|
|
|
|
|
|
|
|
802
|
|
|
|
|
|
|
The L</DatePattern> as defined above. |
|
803
|
|
|
|
|
|
|
|
|
804
|
|
|
|
|
|
|
=item TZ ($) |
|
805
|
|
|
|
|
|
|
|
|
806
|
|
|
|
|
|
|
The TimeZone time based calculations should be done in. This should match |
|
807
|
|
|
|
|
|
|
L<Date::Manip>'s concept of timezones and of course your machines timezone. |
|
808
|
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
=item check_both ($) |
|
810
|
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
1 for checking L</DatePattern> and size concurrently, 0 otherwise. Default 0. |
|
812
|
|
|
|
|
|
|
|
|
813
|
|
|
|
|
|
|
=item user_constraint (\&) |
|
814
|
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
If this callback is defined and returns true, a rotation will happen |
|
816
|
|
|
|
|
|
|
unconditionally. |
|
817
|
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=item post_rotate (\&) |
|
819
|
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
This callback is called after that all files were rotated. Will be called one |
|
821
|
|
|
|
|
|
|
time for every rotated file (in reverse order) with this arguments: |
|
822
|
|
|
|
|
|
|
|
|
823
|
|
|
|
|
|
|
=over 4 |
|
824
|
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
=item C<filename> |
|
826
|
|
|
|
|
|
|
|
|
827
|
|
|
|
|
|
|
the path of the rotated file |
|
828
|
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
=item C<index> |
|
830
|
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
the index of the rotated file from C<max>-1 to 0, in the latter case |
|
832
|
|
|
|
|
|
|
C<filename> is the new, empty, log file |
|
833
|
|
|
|
|
|
|
|
|
834
|
|
|
|
|
|
|
=item C<fileRotate> |
|
835
|
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
a object reference to this instance |
|
837
|
|
|
|
|
|
|
|
|
838
|
|
|
|
|
|
|
=back |
|
839
|
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
With this, you can have infinite files renaming each time the rotated file |
|
841
|
|
|
|
|
|
|
log. E.g: |
|
842
|
|
|
|
|
|
|
|
|
843
|
|
|
|
|
|
|
my $file = Log::Dispatch::FileRotate |
|
844
|
|
|
|
|
|
|
->new( |
|
845
|
|
|
|
|
|
|
... |
|
846
|
|
|
|
|
|
|
post_rotate => sub { |
|
847
|
|
|
|
|
|
|
my ($filename, $idx, $fileRotate) = @_; |
|
848
|
|
|
|
|
|
|
if ($idx == 1) { |
|
849
|
|
|
|
|
|
|
use POSIX qw(strftime); |
|
850
|
|
|
|
|
|
|
my $basename = $fileRotate->filename(); |
|
851
|
|
|
|
|
|
|
my $newfilename = |
|
852
|
|
|
|
|
|
|
$basename . '.' . strftime('%Y%m%d%H%M%S', localtime()); |
|
853
|
|
|
|
|
|
|
$fileRotate->debug("moving $filename to $newfilename"); |
|
854
|
|
|
|
|
|
|
rename($filename, $newfilename); |
|
855
|
|
|
|
|
|
|
} |
|
856
|
|
|
|
|
|
|
}, |
|
857
|
|
|
|
|
|
|
); |
|
858
|
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
B<Note>: this is called within the restricted area (see L</Concurrency>). This |
|
860
|
|
|
|
|
|
|
means that any other concurrent process is locked in the meanwhile. For the |
|
861
|
|
|
|
|
|
|
same reason, don't use the C<log()> or C<log_message()> methods because you |
|
862
|
|
|
|
|
|
|
will get a deadlock! |
|
863
|
|
|
|
|
|
|
|
|
864
|
|
|
|
|
|
|
=item DEBUG ($) |
|
865
|
|
|
|
|
|
|
|
|
866
|
|
|
|
|
|
|
Turn on lots of warning messages to STDERR about what this module is |
|
867
|
|
|
|
|
|
|
doing if set to 1. Really only useful to me. |
|
868
|
|
|
|
|
|
|
|
|
869
|
|
|
|
|
|
|
=back |
|
870
|
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=head2 filename() |
|
872
|
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
Returns the log filename. |
|
874
|
|
|
|
|
|
|
|
|
875
|
|
|
|
|
|
|
=head2 setDatePattern( $ or [ $, $, ... ] ) |
|
876
|
|
|
|
|
|
|
|
|
877
|
|
|
|
|
|
|
Set a new suite of recurrances for file rotation. You can pass in a |
|
878
|
|
|
|
|
|
|
single string or a reference to an array of strings. Multiple recurrences |
|
879
|
|
|
|
|
|
|
can also be define within a single string by seperating them with a |
|
880
|
|
|
|
|
|
|
semi-colon (;) |
|
881
|
|
|
|
|
|
|
|
|
882
|
|
|
|
|
|
|
See the discussion above regarding the setDatePattern paramater for more |
|
883
|
|
|
|
|
|
|
details. |
|
884
|
|
|
|
|
|
|
|
|
885
|
|
|
|
|
|
|
=head2 log_message( message => $ ) |
|
886
|
|
|
|
|
|
|
|
|
887
|
|
|
|
|
|
|
Sends a message to the appropriate output. Generally this shouldn't |
|
888
|
|
|
|
|
|
|
be called directly but should be called through the C<log()> method |
|
889
|
|
|
|
|
|
|
(in L<Log::Dispatch::Output>). |
|
890
|
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
=head2 rotate() |
|
892
|
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
Rotates the file, if it has to be done. You can call this method if you want to |
|
894
|
|
|
|
|
|
|
check, and eventually do, a rotation without logging anything. |
|
895
|
|
|
|
|
|
|
|
|
896
|
|
|
|
|
|
|
Returns 1 if a rotation was done, 0 otherwise. C<undef> on error. |
|
897
|
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
=head2 debug($) |
|
899
|
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
If C<DEBUG> is true, prints a standard warning message. |
|
901
|
|
|
|
|
|
|
|
|
902
|
|
|
|
|
|
|
=head1 Tip |
|
903
|
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
If you have multiple writers that were started at different times you |
|
905
|
|
|
|
|
|
|
will find each writer will try to rotate the log file at a recurrence |
|
906
|
|
|
|
|
|
|
calculated from its start time. To sync all the writers just use a config |
|
907
|
|
|
|
|
|
|
file and update it after starting your last writer. This will cause |
|
908
|
|
|
|
|
|
|
C<new()> to be called by each of the writers |
|
909
|
|
|
|
|
|
|
close to the same time, and if your recurrences aren't too close together |
|
910
|
|
|
|
|
|
|
all should sync up just nicely. |
|
911
|
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
I initially assumed a long running process but it seems people are using |
|
913
|
|
|
|
|
|
|
this module as part of short running CGI programs. So, now we look at the |
|
914
|
|
|
|
|
|
|
last modified time stamp of the log file and compare it to a previous |
|
915
|
|
|
|
|
|
|
occurance of a L</DatePattern>, on startup only. If the file stat shows |
|
916
|
|
|
|
|
|
|
the mtime to be earlier than the previous recurrance then I rotate the |
|
917
|
|
|
|
|
|
|
log file. |
|
918
|
|
|
|
|
|
|
|
|
919
|
|
|
|
|
|
|
=head1 DatePattern |
|
920
|
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
As I said earlier we use L<Date::Manip> for generating our recurrence |
|
922
|
|
|
|
|
|
|
events. This means we can understand L<Date::Manip>'s recurrence patterns |
|
923
|
|
|
|
|
|
|
and the normal log4j DatePatterns. We don't use DatePattern to define the |
|
924
|
|
|
|
|
|
|
extension of the log file though. |
|
925
|
|
|
|
|
|
|
|
|
926
|
|
|
|
|
|
|
DatePattern can therefore take forms like: |
|
927
|
|
|
|
|
|
|
|
|
928
|
|
|
|
|
|
|
Date::Manip style |
|
929
|
|
|
|
|
|
|
0:0:0:0:5:30:0 every 5 hours and 30 minutes |
|
930
|
|
|
|
|
|
|
0:0:0:2*12:30:0 every 2 days at 12:30 (each day) |
|
931
|
|
|
|
|
|
|
3*1:0:2:12:0:0 every 3 years on Jan 2 at noon |
|
932
|
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
DailyRollingFileAppender log4j style |
|
934
|
|
|
|
|
|
|
yyyy-MM every month |
|
935
|
|
|
|
|
|
|
yyyy-ww every week |
|
936
|
|
|
|
|
|
|
yyyy-MM-dd every day |
|
937
|
|
|
|
|
|
|
yyyy-MM-dd-a every day at noon |
|
938
|
|
|
|
|
|
|
yyyy-MM-dd-HH every hour |
|
939
|
|
|
|
|
|
|
yyyy-MM-dd-HH-MM every minute |
|
940
|
|
|
|
|
|
|
|
|
941
|
|
|
|
|
|
|
To specify multiple recurrences in a single string separate them with a |
|
942
|
|
|
|
|
|
|
semicolon: |
|
943
|
|
|
|
|
|
|
yyyy-MM-dd; 0:0:0:2*12:30:0 |
|
944
|
|
|
|
|
|
|
|
|
945
|
|
|
|
|
|
|
This says we want to rotate every day AND every 2 days at 12:30. Put in |
|
946
|
|
|
|
|
|
|
as many as you like. |
|
947
|
|
|
|
|
|
|
|
|
948
|
|
|
|
|
|
|
A complete description of L<Date::Manip> recurrences is beyond us here |
|
949
|
|
|
|
|
|
|
except to quote (from the man page): |
|
950
|
|
|
|
|
|
|
|
|
951
|
|
|
|
|
|
|
A recur description is a string of the format |
|
952
|
|
|
|
|
|
|
Y:M:W:D:H:MN:S . Exactly one of the colons may |
|
953
|
|
|
|
|
|
|
optionally be replaced by an asterisk, or an asterisk |
|
954
|
|
|
|
|
|
|
may be prepended to the string. |
|
955
|
|
|
|
|
|
|
|
|
956
|
|
|
|
|
|
|
Any value "N" to the left of the asterisk refers to |
|
957
|
|
|
|
|
|
|
the "Nth" one. Any value to the right of the asterisk |
|
958
|
|
|
|
|
|
|
refers to a value as it appears on a calendar/clock. |
|
959
|
|
|
|
|
|
|
Values to the right can be listed a single values, |
|
960
|
|
|
|
|
|
|
ranges (2 numbers separated by a dash "-"), or a comma |
|
961
|
|
|
|
|
|
|
separated list of values or ranges. In a few cases, |
|
962
|
|
|
|
|
|
|
negative values are appropriate. |
|
963
|
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
This is best illustrated by example. |
|
965
|
|
|
|
|
|
|
|
|
966
|
|
|
|
|
|
|
0:0:2:1:0:0:0 every 2 weeks and 1 day |
|
967
|
|
|
|
|
|
|
0:0:0:0:5:30:0 every 5 hours and 30 minutes |
|
968
|
|
|
|
|
|
|
0:0:0:2*12:30:0 every 2 days at 12:30 (each day) |
|
969
|
|
|
|
|
|
|
3*1:0:2:12:0:0 every 3 years on Jan 2 at noon |
|
970
|
|
|
|
|
|
|
0:1*0:2:12,14:0:0 2nd of every month at 12:00 and 14:00 |
|
971
|
|
|
|
|
|
|
1:0:0*45:0:0:0 45th day of every year |
|
972
|
|
|
|
|
|
|
0:1*4:2:0:0:0 4th tuesday (day 2) of every month |
|
973
|
|
|
|
|
|
|
0:1*-1:2:0:0:0 last tuesday of every month |
|
974
|
|
|
|
|
|
|
0:1:0*-2:0:0:0 2nd to last day of every month |
|
975
|
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=head1 TODO |
|
977
|
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
compression, signal based rotates, proper test suite |
|
979
|
|
|
|
|
|
|
|
|
980
|
|
|
|
|
|
|
Could possibly use L<Logfile::Rotate> as well/instead. |
|
981
|
|
|
|
|
|
|
|
|
982
|
|
|
|
|
|
|
=head1 SEE ALSO |
|
983
|
|
|
|
|
|
|
|
|
984
|
|
|
|
|
|
|
=over 4 |
|
985
|
|
|
|
|
|
|
|
|
986
|
|
|
|
|
|
|
=item * |
|
987
|
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
L<Log::Dispatch::File::Stamped> |
|
989
|
|
|
|
|
|
|
|
|
990
|
|
|
|
|
|
|
Log directly to timestamped files. |
|
991
|
|
|
|
|
|
|
|
|
992
|
|
|
|
|
|
|
=back |
|
993
|
|
|
|
|
|
|
|
|
994
|
|
|
|
|
|
|
=head1 HISTORY |
|
995
|
|
|
|
|
|
|
|
|
996
|
|
|
|
|
|
|
Originally written by Mark Pfeiffer, <markpf at mlp-consulting dot com dot au> |
|
997
|
|
|
|
|
|
|
inspired by Dave Rolsky's, <autarch at urth dot org>, code :-) |
|
998
|
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
Kevin Goess <cpan at goess dot org> suggested multiple writers should be |
|
1000
|
|
|
|
|
|
|
supported. He also conned me into doing the time based stuff. Thanks Kevin! |
|
1001
|
|
|
|
|
|
|
:-) |
|
1002
|
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
Thanks also to Dan Waldheim for helping with some of the locking issues in a |
|
1004
|
|
|
|
|
|
|
forked environment. |
|
1005
|
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
And thanks to Stephen Gordon for his more portable code on lockfile naming. |
|
1007
|
|
|
|
|
|
|
|
|
1008
|
|
|
|
|
|
|
=head1 SOURCE |
|
1009
|
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
The development version is on github at L<https://https://github.com/mschout/perl-log-dispatch-filerotate> |
|
1011
|
|
|
|
|
|
|
and may be cloned from L<git://https://github.com/mschout/perl-log-dispatch-filerotate.git> |
|
1012
|
|
|
|
|
|
|
|
|
1013
|
|
|
|
|
|
|
=head1 BUGS |
|
1014
|
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
Please report any bugs or feature requests on the bugtracker website |
|
1016
|
|
|
|
|
|
|
L<https://github.com/mschout/perl-log-dispatch-filerotate/issues> |
|
1017
|
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
When submitting a bug or request, please include a test-file or a |
|
1019
|
|
|
|
|
|
|
patch to an existing test-file that illustrates the bug or desired |
|
1020
|
|
|
|
|
|
|
feature. |
|
1021
|
|
|
|
|
|
|
|
|
1022
|
|
|
|
|
|
|
=head1 AUTHOR |
|
1023
|
|
|
|
|
|
|
|
|
1024
|
|
|
|
|
|
|
Michael Schout <mschout@cpan.org> |
|
1025
|
|
|
|
|
|
|
|
|
1026
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
|
1027
|
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
This software is copyright (c) 2005 by Mark Pfeiffer. |
|
1029
|
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
|
1031
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
|
1032
|
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
=cut |