File Coverage

blib/lib/Log/QnD.pm
Criterion Covered Total %
statement 147 150 98.0
branch 48 60 80.0
condition 2 3 66.6
subroutine 27 27 100.0
pod 6 6 100.0
total 230 246 93.5


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__