line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Log::QnD; |
2
|
1
|
|
|
1
|
|
2354
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
38
|
|
3
|
1
|
|
|
1
|
|
6
|
use Carp 'croak'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
73
|
|
4
|
1
|
|
|
1
|
|
1052
|
use String::Util ':all'; |
|
1
|
|
|
|
|
6825
|
|
|
1
|
|
|
|
|
378
|
|
5
|
1
|
|
|
1
|
|
1480
|
use JSON qw{to_json -convert_blessed_universally}; |
|
1
|
|
|
|
|
15341
|
|
|
1
|
|
|
|
|
6
|
|
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
# debugging |
8
|
|
|
|
|
|
|
# use Debug::ShowStuff ':all'; |
9
|
|
|
|
|
|
|
# use Debug::ShowStuff::ShowVar; |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
# version |
12
|
|
|
|
|
|
|
our $VERSION = '0.17'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
# extend Class::PublicPrivate |
15
|
1
|
|
|
1
|
|
332
|
use base 'Class::PublicPrivate'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
1092
|
|
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
=head1 NAME |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
Log::QnD - Quick and dirty logging system |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
use Log::QnD; |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
# create log entry |
26
|
|
|
|
|
|
|
my $qnd = Log::QnD->new('./log-file'); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
# save stuff into the log entry |
29
|
|
|
|
|
|
|
$qnd->{'stage'} = 1; |
30
|
|
|
|
|
|
|
$qnd->{'tracks'} = [qw{1 4}]; |
31
|
|
|
|
|
|
|
$qnd->{'coord'} = {x=>1, z=>42}; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
# undef the log entry or let it go out of scope |
34
|
|
|
|
|
|
|
undef $qnd; |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# the log entry looks like this: |
37
|
|
|
|
|
|
|
# {"stage":1,"tracks":["1","4"],"time":"Tue May 20 17:13:22 2014","coord":{"x":1,"z":42},"entry_id":"7WHHJ"} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
# get a log file object |
40
|
|
|
|
|
|
|
$log = Log::QnD::LogFile->new($log_path); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# get first entry from log |
43
|
|
|
|
|
|
|
$from_log = $log->read_forward(); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# get latest entry from log |
46
|
|
|
|
|
|
|
$from_log = $log->read_backward(); |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 DESCRIPTION |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Log::QnD is for creating quickly creating log files without a lot of setup. |
51
|
|
|
|
|
|
|
All you have to do is create a Log::QnD object with a file path. The returned |
52
|
|
|
|
|
|
|
object is a hashref into which you can save any data you want, including data |
53
|
|
|
|
|
|
|
nested in arrays and hashrefs. When the object goes out of scope its contents |
54
|
|
|
|
|
|
|
are saved to the log as a JSON string. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
PLEASE NOTE: Until this module reaches version 1.0, I might make some |
57
|
|
|
|
|
|
|
non-backwards-compatible changes. See Versions notes for such changes. |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
=head1 INSTALLATION |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
Log::QnD can be installed with the usual routine: |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
perl Makefile.PL |
64
|
|
|
|
|
|
|
make |
65
|
|
|
|
|
|
|
make test |
66
|
|
|
|
|
|
|
make install |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
=head1 Log::QnD |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
A Log::QnD object represents a single log entry in a log file. It is created |
71
|
|
|
|
|
|
|
by calling Log::QnD->new() with the path to the log file: |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
my $qnd = Log::QnD->new('./log-file'); |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
That command alone is enough to create the log file if necessary and an entry |
76
|
|
|
|
|
|
|
into the log. It is not necessary to explicitly save the log entry; it will be |
77
|
|
|
|
|
|
|
saved when the Log::QnD object goes out of scope. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
By default, each log entry has two properties when it is created: the time the |
80
|
|
|
|
|
|
|
object was created ('time') and a (probably) unique ID ('entry_id'). The |
81
|
|
|
|
|
|
|
structure looks like this: |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
{ |
84
|
|
|
|
|
|
|
'time' => 'Mon May 19 19:22:22 2014', |
85
|
|
|
|
|
|
|
'entry_id' => 'JNnwk' |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
The 'time' field is the time the log entry was created. The 'entry_id' field is |
89
|
|
|
|
|
|
|
just a random five-character string. It is not checked for uniqueness, it is |
90
|
|
|
|
|
|
|
just probable that there is no other entry in the log with the same ID. |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
Each log entry is stored as a single line in the log to make it easy to parse. |
93
|
|
|
|
|
|
|
Entries are separated by a blank line to make them more human-readable. So the |
94
|
|
|
|
|
|
|
entry above and another entry would be stored like this: |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
{"time":"Mon May 19 19:22:22 2014","entry_id":"JNnwk"} |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
{"time":"Mon May 19 19:22:23 2014","entry_id":"kjH0c"} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
You can save other values into the hash, including nested hashes and arrays: |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
$qnd->{'stage'} = 1; |
103
|
|
|
|
|
|
|
$qnd->{'tracks'} = [qw{1 4}]; |
104
|
|
|
|
|
|
|
$qnd->{'coord'} = {x=>1, z=>42}; |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
which results in a JSON string like this: |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
{"stage":1,"tracks":["1","4"],"time":"Tue May 20 17:13:22 2014","coord":{"x":1,"z":42},"entry_id":"7WHHJ"} |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=cut |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
115
|
|
|
|
|
|
|
# new |
116
|
|
|
|
|
|
|
# |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head2 Log::QnD->new($log_file_path) |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
Create a new Log::QnD object. The only param for this method is the path to |
121
|
|
|
|
|
|
|
the log file. The log file does not need to actually exist yet; if necessary |
122
|
|
|
|
|
|
|
it will be created when the QnD object saves itself. |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
=cut |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub new { |
127
|
252
|
|
|
252
|
1
|
16586
|
my $class = shift(@_); |
128
|
252
|
|
|
|
|
964
|
my $qnd = $class->SUPER::new(); |
129
|
252
|
|
|
|
|
4971
|
my ($path) = @_; |
130
|
252
|
|
|
|
|
347
|
my ($private); |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
# must get path to log file |
133
|
252
|
100
|
|
|
|
607
|
unless (defined $path) |
134
|
1
|
|
|
|
|
226
|
{ croak 'did not get defined path to log file' } |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# get private values |
137
|
251
|
|
|
|
|
680
|
$private = $qnd->private(); |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# hold on to path |
140
|
251
|
|
|
|
|
1470
|
$private->{'path'} = $path; |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# set date/time of entry |
143
|
251
|
|
|
|
|
7304
|
$qnd->{'time'} = localtime; |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# set id |
146
|
251
|
|
|
|
|
1975
|
$qnd->{'entry_id'} = randword(5); |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
# autosave |
149
|
251
|
|
|
|
|
18527
|
$private->{'autosave'} = 1; |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
# return |
152
|
251
|
|
|
|
|
702
|
return $qnd; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
# |
155
|
|
|
|
|
|
|
# new |
156
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
160
|
|
|
|
|
|
|
# cancel, uncancel |
161
|
|
|
|
|
|
|
# |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
=head2 $qnd->cancel() |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
Cancels the automatic save. By default the $qnd object saves to the log when |
166
|
|
|
|
|
|
|
it goes out of scope, undeffing it won't cancel the save. $qnd->cancel() |
167
|
|
|
|
|
|
|
causes the object to not save when it goes out of scope. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=head2 $qnd->uncancel() |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
Sets the log entry object to automatically save when the object goes out of scope. |
172
|
|
|
|
|
|
|
By default the object is set to autosave, so uncancel() is only useful if you |
173
|
|
|
|
|
|
|
have cancelled the autosave in some way, such as with $qnd-Ecancel(). |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=cut |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub cancel { |
178
|
2
|
|
|
2
|
1
|
281
|
my ($qnd) = @_; |
179
|
2
|
|
|
|
|
5
|
$qnd->private->{'autosave'} = 0; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
sub uncancel { |
183
|
1
|
|
|
1
|
1
|
9
|
my ($qnd) = @_; |
184
|
1
|
|
|
|
|
4
|
$qnd->private->{'autosave'} = 1; |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
# |
187
|
|
|
|
|
|
|
# cancel, uncancel |
188
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
192
|
|
|
|
|
|
|
# save |
193
|
|
|
|
|
|
|
# |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head2 $qnd->save() |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Saves the Log::QnD log entry. By default, this method is called when the |
198
|
|
|
|
|
|
|
object goes out of scope. If you've used $qnd-Ecancel() to cancel |
199
|
|
|
|
|
|
|
autosave then you can use $qnd->save() to explicitly save the log entry. |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=cut |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
sub save { |
204
|
251
|
|
|
251
|
1
|
393
|
my ($qnd) = @_; |
205
|
251
|
|
|
|
|
286
|
my ($log, $json); |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
# get log object |
208
|
251
|
|
|
|
|
749
|
$log = $qnd->log_file(); |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
# get json string |
211
|
251
|
|
|
|
|
1168
|
$json = to_json($qnd, {convert_blessed=>1}); |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
# change newlines to spaces to ensure the log entry is a single line |
214
|
251
|
|
|
|
|
23138
|
$json =~ s|[\r\n]| |gs; |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# write entry to log |
217
|
251
|
50
|
|
|
|
572
|
$log->write_entry($json) or return 0; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
# return success |
220
|
251
|
|
|
|
|
717
|
return 1; |
221
|
|
|
|
|
|
|
} |
222
|
|
|
|
|
|
|
# |
223
|
|
|
|
|
|
|
# save |
224
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
225
|
|
|
|
|
|
|
|
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
228
|
|
|
|
|
|
|
# log_file |
229
|
|
|
|
|
|
|
# |
230
|
|
|
|
|
|
|
|
231
|
|
|
|
|
|
|
=head2 $qnd->log_file() |
232
|
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
Returns a Log::QnD::LogFile object. The log entry object does not hold on to |
234
|
|
|
|
|
|
|
the log file object, nor does the log file object "know" about the entry |
235
|
|
|
|
|
|
|
object. |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
=cut |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
sub log_file { |
240
|
251
|
|
|
251
|
1
|
288
|
my ($qnd) = @_; |
241
|
251
|
|
|
|
|
270
|
my ($log_class, $log); |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
# get log file object |
244
|
251
|
|
|
|
|
396
|
$log_class = ref($qnd) . '::LogFile'; |
245
|
251
|
|
|
|
|
674
|
$log = $log_class->new($qnd->private->{'path'}); |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
# return |
248
|
251
|
|
|
|
|
444
|
return $log; |
249
|
|
|
|
|
|
|
} |
250
|
|
|
|
|
|
|
# |
251
|
|
|
|
|
|
|
# log_file |
252
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
256
|
|
|
|
|
|
|
# catch_stderr |
257
|
|
|
|
|
|
|
# |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=head2 $qnd->catch_stderr() |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
Closes the existing STDERR, redirects new STDERR to the C element in |
262
|
|
|
|
|
|
|
the log entry. STDERR is release when the log object goes out of scope. |
263
|
|
|
|
|
|
|
|
264
|
|
|
|
|
|
|
Currently it's undefined what should or will happen if too log entries both |
265
|
|
|
|
|
|
|
try to catch STDERR. Either don't do that or solve this dilemna and submit your |
266
|
|
|
|
|
|
|
ideas back to me. |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
=cut |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
sub catch_stderr { |
271
|
1
|
|
|
1
|
1
|
4
|
my ($qnd) = @_; |
272
|
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
# TESTING |
274
|
|
|
|
|
|
|
# println subname(); ##i |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# require necessary module |
277
|
1
|
|
|
|
|
1125
|
require IO::Scalar; |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
# catch STDERR |
280
|
1
|
|
|
|
|
5145
|
tie *STDERR, 'IO::Scalar', \$qnd->{'stderr'}; |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
# |
283
|
|
|
|
|
|
|
# catch_stderr |
284
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
288
|
|
|
|
|
|
|
# private |
289
|
|
|
|
|
|
|
# NOTE: There is no subroutine in this section, just POD to document the |
290
|
|
|
|
|
|
|
# $qnd->private() method that is inherited from Class::PublicPrivate. |
291
|
|
|
|
|
|
|
# |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
=head2 $qnd->private() |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
$qnd->private() is a method inherited from |
296
|
|
|
|
|
|
|
L. This |
297
|
|
|
|
|
|
|
method is used to store private properties such as the location of the log |
298
|
|
|
|
|
|
|
file. Unless you want to tinker around with the log entry's internals you can |
299
|
|
|
|
|
|
|
ignore this method. |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
=cut |
302
|
|
|
|
|
|
|
|
303
|
|
|
|
|
|
|
# |
304
|
|
|
|
|
|
|
# private |
305
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
309
|
|
|
|
|
|
|
# DESTROY |
310
|
|
|
|
|
|
|
# |
311
|
|
|
|
|
|
|
sub DESTROY { |
312
|
252
|
|
|
252
|
|
11550
|
my ($qnd) = @_; |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
# autosave if set to do so |
315
|
252
|
100
|
|
|
|
707
|
if ($qnd->private->{'autosave'}) { |
316
|
250
|
|
|
|
|
1625
|
$qnd->save(); |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
|
319
|
|
|
|
|
|
|
# release stderr |
320
|
252
|
100
|
|
|
|
1494
|
if (exists $qnd->{'stderr'}) { |
321
|
1
|
|
|
|
|
19
|
untie *STDERR; |
322
|
|
|
|
|
|
|
} |
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
# |
325
|
|
|
|
|
|
|
# DESTROY |
326
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
|
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
############################################################################### |
331
|
|
|
|
|
|
|
# Log::QnD::LogFile |
332
|
|
|
|
|
|
|
# |
333
|
|
|
|
|
|
|
package Log::QnD::LogFile; |
334
|
1
|
|
|
1
|
|
1088
|
use strict; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
35
|
|
335
|
1
|
|
|
1
|
|
7
|
use Carp 'croak'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
77
|
|
336
|
1
|
|
|
1
|
|
919
|
use FileHandle; |
|
1
|
|
|
|
|
20535
|
|
|
1
|
|
|
|
|
6
|
|
337
|
1
|
|
|
1
|
|
367
|
use String::Util ':all'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
204
|
|
338
|
1
|
|
|
1
|
|
5
|
use Fcntl ':mode', ':flock', 'SEEK_END'; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
344
|
|
339
|
1
|
|
|
1
|
|
10
|
use JSON 'from_json'; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
9
|
|
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# debugging |
342
|
|
|
|
|
|
|
# use Debug::ShowStuff ':all'; |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=head1 Log::QnD::LogFile |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
A Log::QnD::LogFile object represents the log file to which the log entry is |
347
|
|
|
|
|
|
|
saved. The LogFile object does the actual work of saving the log entry. It |
348
|
|
|
|
|
|
|
also provides a mechanism for retrieving information from the log. If you use |
349
|
|
|
|
|
|
|
Log::QnD in its simplest form by just creating Log::QnD objects and allowing |
350
|
|
|
|
|
|
|
them to save themselves when they go out of scope then you don't need to |
351
|
|
|
|
|
|
|
explicitly use Log::QnD::LogFile. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=cut |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
356
|
|
|
|
|
|
|
# new |
357
|
|
|
|
|
|
|
# |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
=head2 Log::QnD::LogFile->new($log_file_path) |
360
|
|
|
|
|
|
|
|
361
|
|
|
|
|
|
|
Create a new Log::QnD::LogFile object. The only param for this method is the |
362
|
|
|
|
|
|
|
path to the log file. |
363
|
|
|
|
|
|
|
|
364
|
|
|
|
|
|
|
=cut |
365
|
|
|
|
|
|
|
|
366
|
|
|
|
|
|
|
sub new { |
367
|
265
|
|
|
265
|
|
2983
|
my ($class, $path) = @_; |
368
|
265
|
|
|
|
|
643
|
my $log = bless({}, $class); |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
# must get path to log file |
371
|
265
|
100
|
|
|
|
660
|
unless (defined $path) |
372
|
1
|
|
|
|
|
206
|
{ croak 'did not get defined path to log file' } |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
# hold on to log path |
375
|
264
|
|
|
|
|
542
|
$log->{'path'} = $path; |
376
|
|
|
|
|
|
|
|
377
|
|
|
|
|
|
|
# return |
378
|
264
|
|
|
|
|
528
|
return $log; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
# |
381
|
|
|
|
|
|
|
# new |
382
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
387
|
|
|
|
|
|
|
# write_entry |
388
|
|
|
|
|
|
|
# |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
=head2 $log->write_entry($string) |
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
This method writes the log entry to the log file. The log file is created if |
393
|
|
|
|
|
|
|
it doesn't already exist. |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
The only input for this method is the string to write to the log. The string |
396
|
|
|
|
|
|
|
should already be in JSON format and should have no newline. C |
397
|
|
|
|
|
|
|
doesn't do anything about formatting the string, it just spits it into the |
398
|
|
|
|
|
|
|
log. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
=cut |
401
|
|
|
|
|
|
|
|
402
|
|
|
|
|
|
|
sub write_entry { |
403
|
254
|
|
|
254
|
|
515
|
my ($log, $entry_str) = @_; |
404
|
254
|
|
|
|
|
307
|
my ($out); |
405
|
|
|
|
|
|
|
|
406
|
|
|
|
|
|
|
# get write handle |
407
|
254
|
50
|
|
|
|
1366
|
$out = FileHandle->new(">> $log->{'path'}") |
408
|
|
|
|
|
|
|
or die "unable to get write handle: $!"; |
409
|
|
|
|
|
|
|
|
410
|
|
|
|
|
|
|
# get lock |
411
|
254
|
50
|
|
|
|
20520
|
flock($out, LOCK_EX) or |
412
|
|
|
|
|
|
|
die "unable to lock file: $!"; |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
# seek end of file |
415
|
254
|
50
|
|
|
|
868
|
$out->seek(0, SEEK_END) or die "cannot seek end of file: $!"; |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
# unless the file is empty, output a newline |
418
|
254
|
100
|
|
|
|
2878
|
if (tell $out) { |
419
|
242
|
|
|
|
|
1627
|
print $out "\n"; |
420
|
|
|
|
|
|
|
} |
421
|
|
|
|
|
|
|
|
422
|
|
|
|
|
|
|
# output |
423
|
254
|
|
|
|
|
773
|
print $out $entry_str, "\n"; |
424
|
|
|
|
|
|
|
|
425
|
|
|
|
|
|
|
# return success |
426
|
254
|
|
|
|
|
7839
|
return 1; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
# |
429
|
|
|
|
|
|
|
# write_entry |
430
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
|
433
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
434
|
|
|
|
|
|
|
# entry_count |
435
|
|
|
|
|
|
|
# |
436
|
|
|
|
|
|
|
|
437
|
|
|
|
|
|
|
=head2 $log->entry_count() |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
This method returns the number of entries in the log file. If the log file |
440
|
|
|
|
|
|
|
doesn't exist then this method returns undef. |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=cut |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
sub entry_count { |
445
|
3
|
|
|
3
|
|
17
|
my ($log) = @_; |
446
|
3
|
|
|
|
|
5
|
my ($read, $count); |
447
|
|
|
|
|
|
|
|
448
|
|
|
|
|
|
|
# special case: log file doesn't actually exist |
449
|
3
|
100
|
|
|
|
45
|
if (! -e $log->{'path'}) |
450
|
1
|
|
|
|
|
5
|
{ return undef } |
451
|
|
|
|
|
|
|
|
452
|
|
|
|
|
|
|
# get lock |
453
|
2
|
50
|
|
|
|
13
|
$read = FileHandle->new($log->{'path'}) or die "unable to get read handle: $!"; |
454
|
2
|
50
|
|
|
|
176
|
flock($read, LOCK_SH) or die "unable to lock file: $!"; |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
# initialize count to zero |
457
|
2
|
|
|
|
|
4
|
$count = 0; |
458
|
|
|
|
|
|
|
|
459
|
|
|
|
|
|
|
LOG_LOOP: |
460
|
2
|
|
|
|
|
99
|
while( defined( my $line = $read->getline ) ) { |
461
|
398
|
|
|
|
|
20723
|
my ($entry); |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
# skip empty lines |
464
|
398
|
100
|
|
|
|
927
|
hascontent($line) or next LOG_LOOP; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
# increment count |
467
|
200
|
|
|
|
|
9314
|
$count++; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
# return |
471
|
2
|
|
|
|
|
135
|
return $count; |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
# |
474
|
|
|
|
|
|
|
# entry_count |
475
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
479
|
|
|
|
|
|
|
# read_entry |
480
|
|
|
|
|
|
|
# Private method for implementing readforward() and read_backward(). |
481
|
|
|
|
|
|
|
# |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
# constants for reading |
484
|
1
|
|
|
1
|
|
693
|
use constant READ_FORWARD => 1; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
223
|
|
485
|
1
|
|
|
1
|
|
6
|
use constant READ_BACKWARD => 2; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
709
|
|
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
sub read_entry { |
488
|
45
|
|
|
45
|
|
98
|
my ($log, $direction, %opts) = @_; |
489
|
45
|
|
|
|
|
60
|
my ($read, $lock, $tgt_id, $multiple, $get_count, @rv); |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
# special case: log file doesn't actually exist |
492
|
45
|
100
|
|
|
|
700
|
if (! -e $log->{'path'}) |
493
|
1
|
|
|
|
|
4
|
{ return undef } |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
# get target id |
496
|
44
|
|
|
|
|
70
|
$tgt_id = $opts{'entry_id'}; |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
# if there is already a read handle, make sure it's the correct direction |
499
|
44
|
100
|
|
|
|
122
|
if ($log->{'read'}) { |
500
|
34
|
50
|
|
|
|
173
|
if ($log->{'read'}->{'direction'} != $direction) { |
501
|
0
|
|
|
|
|
0
|
$log->end_read(); |
502
|
|
|
|
|
|
|
} |
503
|
|
|
|
|
|
|
} |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
# determine if we're fetching more than one entry |
506
|
44
|
100
|
|
|
|
120
|
if (defined ($get_count = $opts{'count'})) { |
507
|
28
|
|
|
|
|
39
|
$multiple = 1; |
508
|
|
|
|
|
|
|
} |
509
|
|
|
|
|
|
|
|
510
|
|
|
|
|
|
|
# get cached read, else create and cache |
511
|
44
|
100
|
|
|
|
109
|
unless ($read = $log->{'read'}) { |
512
|
10
|
|
|
|
|
23
|
$log->{'read'} = $read = {}; |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# set direction |
515
|
10
|
|
|
|
|
26
|
$read->{'direction'} = $direction; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
# get lock |
518
|
10
|
50
|
|
|
|
57
|
$read->{'lock'} = FileHandle->new($log->{'path'}) or die "unable to get read handle: $!"; |
519
|
10
|
50
|
|
|
|
711
|
flock($read->{'lock'}, LOCK_SH) or die "unable to lock file: $!"; |
520
|
|
|
|
|
|
|
|
521
|
|
|
|
|
|
|
# get read handle |
522
|
10
|
100
|
|
|
|
31
|
if ($direction == READ_FORWARD) { |
523
|
2
|
|
|
|
|
17
|
require FileHandle; |
524
|
2
|
|
|
|
|
11
|
$read->{'fh'} = FileHandle->new($log->{'path'}); |
525
|
|
|
|
|
|
|
} |
526
|
|
|
|
|
|
|
else { |
527
|
8
|
|
|
|
|
1267
|
require File::ReadBackwards; |
528
|
8
|
|
|
|
|
1564
|
$read->{'fh'} = File::ReadBackwards->new($log->{'path'}); |
529
|
|
|
|
|
|
|
} |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
# die on failure |
532
|
10
|
50
|
|
|
|
663
|
$read->{'fh'} or die $! |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
LOG_LOOP: |
536
|
44
|
|
|
|
|
777
|
while( defined( my $line = $read->{'fh'}->getline ) ) { |
537
|
298
|
|
|
|
|
11358
|
my ($entry); |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
# skip empty lines |
540
|
298
|
100
|
|
|
|
781
|
hascontent($line) or next LOG_LOOP; |
541
|
|
|
|
|
|
|
|
542
|
|
|
|
|
|
|
# get json object |
543
|
154
|
|
|
|
|
1311
|
$entry = from_json($line); |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
# if there is a target id, and this isn't it, next entry |
546
|
|
|
|
|
|
|
# KLUDGE: Something about this next block of code feels spaghettish, |
547
|
|
|
|
|
|
|
# though I can't quite specify why. |
548
|
154
|
100
|
|
|
|
2556
|
if ($tgt_id) { |
549
|
10
|
100
|
|
|
|
27
|
if ($entry->{'entry_id'} eq $tgt_id) { |
550
|
1
|
|
|
|
|
7
|
$log->end_read(); |
551
|
1
|
|
|
|
|
38
|
return $entry; |
552
|
|
|
|
|
|
|
} |
553
|
|
|
|
|
|
|
else { |
554
|
9
|
|
|
|
|
47
|
next LOG_LOOP; |
555
|
|
|
|
|
|
|
} |
556
|
|
|
|
|
|
|
} |
557
|
|
|
|
|
|
|
|
558
|
|
|
|
|
|
|
# if geting multiple entries |
559
|
144
|
100
|
|
|
|
249
|
if ($multiple) { |
560
|
130
|
|
|
|
|
189
|
push @rv, $entry; |
561
|
|
|
|
|
|
|
|
562
|
130
|
100
|
66
|
|
|
2775
|
if ($get_count && (@rv >= $get_count)) { |
563
|
26
|
50
|
|
|
|
174
|
wantarray() and return @rv; |
564
|
0
|
|
|
|
|
0
|
return \@rv; |
565
|
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
|
} |
567
|
|
|
|
|
|
|
|
568
|
|
|
|
|
|
|
# else just return this entry |
569
|
|
|
|
|
|
|
else { |
570
|
14
|
|
|
|
|
47
|
return $entry; |
571
|
|
|
|
|
|
|
} |
572
|
|
|
|
|
|
|
} |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
# at ending|beginning of log, so return undef |
575
|
3
|
|
|
|
|
73
|
$log->end_read(); |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
# if seeking multiple values |
578
|
3
|
100
|
|
|
|
7
|
if ($multiple) { |
579
|
2
|
50
|
|
|
|
69
|
wantarray() and return @rv; |
580
|
0
|
|
|
|
|
0
|
return \@rv; |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
# else return undef |
584
|
|
|
|
|
|
|
else { |
585
|
1
|
|
|
|
|
26
|
return undef; |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
} |
588
|
|
|
|
|
|
|
# |
589
|
|
|
|
|
|
|
# read_entry |
590
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
591
|
|
|
|
|
|
|
|
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
594
|
|
|
|
|
|
|
# read_forward, read_backward |
595
|
|
|
|
|
|
|
# |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
=head2 $log->read_forward(), $log->read_backward() |
598
|
|
|
|
|
|
|
|
599
|
|
|
|
|
|
|
C and C each return a single entry from the |
600
|
|
|
|
|
|
|
log file. The data is already parsed from JSON. So, for example, the following |
601
|
|
|
|
|
|
|
line returns an entry from the log: |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
$log->read_forward(); |
604
|
|
|
|
|
|
|
|
605
|
|
|
|
|
|
|
read_forward() starts with the first entry in the log. Each subsequent call to |
606
|
|
|
|
|
|
|
read_forward() returns the next log entry. |
607
|
|
|
|
|
|
|
|
608
|
|
|
|
|
|
|
read_backward() starts with the last log entry. Each subsequent call to |
609
|
|
|
|
|
|
|
read_backward() returns the next entry back. |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
After the latest/earliest entry in the log is returned then these methods |
612
|
|
|
|
|
|
|
return undef. |
613
|
|
|
|
|
|
|
|
614
|
|
|
|
|
|
|
It is important to know that after the first call to C or |
615
|
|
|
|
|
|
|
C is made the log file object puts a read lock on the log |
616
|
|
|
|
|
|
|
file. That means that log entry objects cannot write to the file until the |
617
|
|
|
|
|
|
|
read lock is removed. The read lock is removed when the log file object is |
618
|
|
|
|
|
|
|
detroyed, when C returns undef, or when you explicitly call |
619
|
|
|
|
|
|
|
C<$log-Eend_read>. |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
If you call one of these methods while the log object is reading through using |
622
|
|
|
|
|
|
|
the other method, then the read will reset and the end/beginning of the log |
623
|
|
|
|
|
|
|
file. |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
=over |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
=item B entry_id |
628
|
|
|
|
|
|
|
|
629
|
|
|
|
|
|
|
If you send the 'entry_id' option then the log entry specified by the given id |
630
|
|
|
|
|
|
|
will be returned. If no such entry is found then undef is returned. For |
631
|
|
|
|
|
|
|
example, the following line returns the log entry for 'fv8sd', or undef if the |
632
|
|
|
|
|
|
|
entry is not found: |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
$log->read_backward(entry_id=>'fv8sd'); |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
=item B count |
637
|
|
|
|
|
|
|
|
638
|
|
|
|
|
|
|
The C option indicates how many log entries to return. So, for |
639
|
|
|
|
|
|
|
example, the following line retrieves up to five entries, fewer if the |
640
|
|
|
|
|
|
|
ending|beginning of the file is reached: |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
@entries = $log->read_forward(count=>5) |
643
|
|
|
|
|
|
|
|
644
|
|
|
|
|
|
|
If C is 0 then all remaining entries are returned. In array context an |
645
|
|
|
|
|
|
|
array is returned. In scalar context an array reference is returned. Undef is |
646
|
|
|
|
|
|
|
never returned. Each subsequent call using count returns the next batch of |
647
|
|
|
|
|
|
|
C entries. |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
=back |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
=cut |
652
|
|
|
|
|
|
|
|
653
|
|
|
|
|
|
|
sub read_forward { |
654
|
26
|
|
|
26
|
|
669
|
my $log = shift(@_); |
655
|
26
|
|
|
|
|
65
|
return $log->read_entry(READ_FORWARD, @_); |
656
|
|
|
|
|
|
|
} |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
sub read_backward { |
659
|
19
|
|
|
19
|
|
479
|
my $log = shift(@_); |
660
|
19
|
|
|
|
|
56
|
return $log->read_entry(READ_BACKWARD, @_); |
661
|
|
|
|
|
|
|
} |
662
|
|
|
|
|
|
|
# |
663
|
|
|
|
|
|
|
# read_forward, read_backward |
664
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
|
667
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
668
|
|
|
|
|
|
|
# end_read |
669
|
|
|
|
|
|
|
# |
670
|
|
|
|
|
|
|
|
671
|
|
|
|
|
|
|
=head2 $log->end_read() |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
C explicitly closes the read handle for the log and releases the |
674
|
|
|
|
|
|
|
read lock. C always returns undef. |
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
=cut |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
sub end_read { |
679
|
4
|
|
|
4
|
|
7
|
my ($log) = @_; |
680
|
4
|
|
|
|
|
8
|
delete $log->{'read'}; |
681
|
4
|
|
|
|
|
10
|
return undef; |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
# |
684
|
|
|
|
|
|
|
# end_read |
685
|
|
|
|
|
|
|
#------------------------------------------------------------------------------ |
686
|
|
|
|
|
|
|
|
687
|
|
|
|
|
|
|
|
688
|
|
|
|
|
|
|
# |
689
|
|
|
|
|
|
|
# Log::QnD::LogFile |
690
|
|
|
|
|
|
|
############################################################################### |
691
|
|
|
|
|
|
|
|
692
|
|
|
|
|
|
|
|
693
|
|
|
|
|
|
|
# return true |
694
|
|
|
|
|
|
|
1; |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
__END__ |