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 |