File Coverage

blib/lib/Log/Agent/Stamping.pm
Criterion Covered Total %
statement 11 16 68.7
branch 1 2 50.0
condition 1 3 33.3
subroutine 4 7 57.1
pod 0 5 0.0
total 17 33 51.5


line stmt bran cond sub pod time code
1             ###########################################################################
2             #
3             # Stamping.pm
4             #
5             # Copyright (C) 1999 Raphael Manfredi.
6             # Copyright (C) 2002-2015 Mark Rogaski, mrogaski@cpan.org;
7             # all rights reserved.
8             #
9             # See the README file included with the
10             # distribution for license information.
11             #
12             ##########################################################################
13              
14 8     8   41 use strict;
  8         30  
  8         363  
15             require Exporter;
16              
17             ########################################################################
18             package Log::Agent::Stamping;
19              
20             #
21             # Common time-stamping routines
22             #
23              
24 8     8   40 use vars qw(@ISA @EXPORT);
  8         12  
  8         2944  
25             @ISA = qw(Exporter);
26              
27             @EXPORT = qw(stamping_fn);
28              
29             my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
30             my @days = qw(Sun Mon Tue Wed Thu Fri Sat);
31              
32             #
33             # stamp_none
34             #
35             # No timestamp
36             #
37             sub stamp_none {
38 0     0 0 0 return '';
39             }
40              
41             #
42             # stamp_syslog
43             #
44             # Syslog-like stamping: "Oct 27 21:09:33"
45             #
46             sub stamp_syslog {
47 0     0 0 0 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
48 0         0 return sprintf "%s %2d %.2d:%.2d:%.2d",
49             $months[$mon], $mday, $hour, $min, $sec;
50             }
51              
52             #
53             # stamp_date
54             #
55             # Date format: "[Fri Oct 22 16:23:10 1999]"
56             #
57             sub stamp_date {
58 0     0 0 0 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
59 0         0 return sprintf "[%s %s %2d %.2d:%.2d:%.2d %d]",
60             $days[$wday], $months[$mon], $mday, $hour, $min, $sec, 1900 + $year;
61             }
62              
63             #
64             # stamp_own
65             #
66             # Own format: "99/10/24 09:43:49"
67             #
68             sub stamp_own {
69 53     53 0 1769 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
70 53         392 return sprintf "%.2d/%.2d/%.2d %.2d:%.2d:%.2d",
71             $year % 100, ++$mon, $mday, $hour, $min, $sec;
72             }
73              
74             my %stamping = (
75             'none' => \&stamp_none,
76             'syslog' => \&stamp_syslog,
77             'date' => \&stamp_date,
78             'own' => \&stamp_own,
79             );
80              
81             #
82             # stamping_fn
83             #
84             # Return proper time stamping function based on its 'tag'
85             # If tag is unknown, use stamp_own.
86             #
87             sub stamping_fn {
88 29     29 0 45 my ($tag) = @_;
89 29 50 33     91 return $stamping{$tag} if defined $tag && defined $stamping{$tag};
90 29         84 return \&stamp_own;
91             }
92              
93             1; # for require
94             __END__