File Coverage

blib/lib/Log/Handler/Pattern.pm
Criterion Covered Total %
statement 39 46 84.7
branch 2 8 25.0
condition n/a
subroutine 21 24 87.5
pod 1 1 100.0
total 63 79 79.7


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             Log::Handler::Output - The pattern builder class.
4              
5             =head1 DESCRIPTION
6              
7             Just for internal usage!
8              
9             =head1 FUNCTIONS
10              
11             =head2 get_pattern
12              
13             =head1 PREREQUISITES
14              
15             Carp
16             POSIX
17             Sys::Hostname
18             Time::HiRes
19             Log::Handler::Output
20              
21             =head1 AUTHOR
22              
23             Jonny Schulz .
24              
25             =head1 COPYRIGHT
26              
27             Copyright (C) 2007-2009 by Jonny Schulz. All rights reserved.
28              
29             This program is free software; you can redistribute it and/or
30             modify it under the same terms as Perl itself.
31              
32             =cut
33              
34             package Log::Handler::Pattern;
35              
36 15     15   102 use strict;
  15         36  
  15         466  
37 15     15   79 use warnings;
  15         31  
  15         385  
38 15     15   7962 use POSIX;
  15         99942  
  15         78  
39 15     15   50909 use Sys::Hostname;
  15         15596  
  15         835  
40 15     15   8410 use Time::HiRes;
  15         21273  
  15         271  
41 15     15   1630 use Log::Handler::Output;
  15         33  
  15         101  
42 15     15   503 use constant START_TIME => scalar Time::HiRes::gettimeofday;
  15         27  
  15         12563  
43              
44             our $VERSION = "0.08";
45             my $progname = $0;
46             $progname =~ s@.*[/\\]@@;
47              
48             sub get_pattern {
49             return {
50             '%L' => { name => 'level',
51             code => \&_get_level },
52             '%T' => { name => 'time',
53             code => \&_get_time },
54             '%D' => { name => 'date',
55             code => \&_get_date },
56             '%P' => { name => 'pid',
57             code => \&_get_pid },
58             '%H' => { name => 'hostname',
59 1     1   8 code => sub { Sys::Hostname::hostname() } },
60             '%N' => { name => 'newline',
61 0     0   0 code => sub { "\n" } },
62             '%S' => { name => 'progname',
63 1     1   4 code => sub { $progname } },
64 16     16 1 795 '%U' => { name => 'user',
65             code => \&_get_user },
66             '%G' => { name => 'group',
67             code => \&_get_group },
68             '%C' => { name => 'caller',
69             code => \&_get_caller },
70             '%r' => { name => 'runtime',
71             code => \&_get_runtime },
72             '%t' => { name => 'mtime',
73             code => \&_get_hires },
74             '%m' => { name => 'message',
75             code => \&_get_message },
76             '%p' => { name => 'package',
77             code => \&_get_c_pkg },
78             '%f' => { name => 'filename',
79             code => \&_get_c_file },
80             '%l' => { name => 'line',
81             code => \&_get_c_line },
82             '%s' => { name => 'subroutine',
83             code => \&_get_c_sub },
84             }
85             }
86              
87             # ------------------------------------------
88             # Arguments:
89             # $_[0] -> Log::Handler::Output object
90             # $_[1] -> Log level
91             # ------------------------------------------
92              
93 77     77   252 sub _get_level { $_[1] }
94 43     43   2412 sub _get_time { POSIX::strftime($_[0]->{timeformat}, localtime) }
95 1     1   49 sub _get_date { POSIX::strftime($_[0]->{dateformat}, localtime) }
96 1     1   5 sub _get_pid { $$ }
97 1     1   19 sub _get_caller { my @c = caller(2+$Log::Handler::CALLER_LEVEL); "$c[1], line $c[2]" }
  1         8  
98 2     2   21 sub _get_c_pkg { (caller(2+$Log::Handler::CALLER_LEVEL))[0] }
99 1     1   12 sub _get_c_file { (caller(2+$Log::Handler::CALLER_LEVEL))[1] }
100 1     1   7 sub _get_c_line { (caller(2+$Log::Handler::CALLER_LEVEL))[2] }
101 1 50   1   9 sub _get_c_sub { (caller(3+$Log::Handler::CALLER_LEVEL))[3]||"" }
102 1     1   18 sub _get_runtime { return sprintf('%.6f', Time::HiRes::gettimeofday - START_TIME) }
103 0 0   0   0 sub _get_user { getpwuid($<) || $< }
104 0 0   0   0 sub _get_group { getgrgid($(+0) || $(+0 }
105              
106             sub _get_hires {
107 1     1   2 my $self = shift;
108 1 50       4 if (!$self->{timeofday}) {
109 1         5 $self->{timeofday} = Time::HiRes::gettimeofday;
110 1         8 return sprintf('%.6f', $self->{timeofday} - START_TIME);
111             }
112 0           my $new_time = Time::HiRes::gettimeofday;
113 0           my $cur_time = $new_time - $self->{timeofday};
114 0           $self->{timeofday} = $new_time;
115 0           return sprintf('%.6f', $cur_time);
116             }
117              
118             1;