File Coverage

blib/lib/Log/ger/App.pm
Criterion Covered Total %
statement 77 103 74.7
branch 34 82 41.4
condition 2 5 40.0
subroutine 7 8 87.5
pod n/a
total 120 198 60.6


line stmt bran cond sub pod time code
1             package Log::ger::App;
2              
3 1     1   484 use strict;
  1         2  
  1         26  
4 1     1   3 use warnings;
  1         2  
  1         396  
5              
6             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
7             our $DATE = '2022-02-18'; # DATE
8             our $DIST = 'Log-ger-App'; # DIST
9             our $VERSION = '0.023'; # VERSION
10              
11             our $DEBUG = defined($ENV{LOG_GER_APP_DEBUG}) ? $ENV{LOG_GER_APP_DEBUG} : 0;
12              
13             # last import args
14             our @IMPORT_ARGS;
15              
16             sub _set_level {
17 3     3   7 my $name = shift;
18              
19 3         12 while (my ($source, $param, $note) = splice @_, 0, 3) {
20 9 100       20 if ($source eq 'val') {
    50          
21 6 100       13 if (defined $param) {
22 3 50       6 warn "[lga] Setting $name to $param (from $note)\n" if $DEBUG;
23 3         7 return $param;
24             }
25             } elsif ($source eq 'envset') {
26 3         4 my $prefix = $param;
27 3 50       24 if (defined $ENV{"${prefix}LOG_LEVEL"}) {
28 0         0 my $val = $ENV{"${prefix}LOG_LEVEL"};
29 0 0       0 warn "[lga] Setting $name to $val (from environment ${prefix}LOG_LEVEL)\n" if $DEBUG;
30 0         0 return $val;
31             }
32 3 50       9 if ($ENV{"${prefix}TRACE"}) {
33 0 0       0 warn "[lga] Setting $name to trace (from environment ${prefix}TRACE)\n" if $DEBUG;
34 0         0 return 'trace';
35             }
36 3 50       9 if ($ENV{"${prefix}DEBUG"}) {
37 0 0       0 warn "[lga] Setting $name to debug (from environment ${prefix}DEBUG)\n" if $DEBUG;
38 0         0 return 'debug';
39             }
40 3 50       9 if ($ENV{"${prefix}VERBOSE"}) {
41 0 0       0 warn "[lga] Setting $name to info (from environment ${prefix}VERBOSE)\n" if $DEBUG;
42 0         0 return 'info';
43             }
44 3 50       10 if ($ENV{"${prefix}QUIET"}) {
45 0 0       0 warn "[lga] Setting $name to trace (from environment ${prefix}QUIET)\n" if $DEBUG;
46 0         0 return 'error';
47             }
48             } else {
49 0         0 die "BUG: Unknown level source '$source'";
50             }
51             }
52 0         0 'warn';
53             }
54              
55             sub _is_daemon {
56 1 50   1   2 return $main::IS_DAEMON if defined $main::IS_DAEMON;
57 1         3 for (
58             "App/Daemon.pm",
59             "Daemon/Easy.pm",
60             "Daemon/Daemonize.pm",
61             "Daemon/Generic.pm",
62             "Daemonise.pm",
63             "Daemon/Simple.pm",
64             "HTTP/Daemon.pm",
65             "IO/Socket/INET/Daemon.pm",
66             #"Mojo/Server/Daemon.pm", # simply loading Mojo::UserAgent will load this too
67             "MooseX/Daemonize.pm",
68             "Net/Daemon.pm",
69             "Net/Server.pm",
70             "Proc/Daemon.pm",
71             "Proc/PID/File.pm",
72             "Win32/Daemon/Simple.pm") {
73 14 50       27 return 1 if $INC{$_};
74             }
75 1         2 0;
76             }
77              
78             sub import {
79 1     1   6 no warnings 'once'; # $Log::ger::Current_Level
  1         2  
  1         131  
80              
81 1     1   954 my ($pkg, %args) = @_;
82              
83 1         1526 require Log::ger;
84 1         501 require Log::ger::Util;
85              
86 1         4564 my $extra_conf = delete $args{extra_conf};
87 1         3 my $level_arg = delete $args{level};
88 1         2 my $default_level_arg = delete $args{default_level};
89              
90 1         3 my $default_level_var_name = delete($args{default_level_var_name});
91 1 50       4 $default_level_var_name = "Default_Log_Level" unless defined $default_level_var_name;
92 1 50       6 $default_level_var_name = "main::$default_level_var_name" unless $default_level_var_name =~ /::/;
93 1         2 my $default_level_var_value = do {
94 1     1   7 no strict 'refs'; ## no critic: TestingAndDebugging::ProhibitNoStrict
  1         1  
  1         647  
95 1         2 ${"$default_level_var_name"};
  1         6  
96             };
97              
98 1         5 my $level = _set_level(
99             "general log level",
100             val => $level_arg, "import argument 'level'",
101             envset => "", "",
102             val => $default_level_arg, "import argument 'default_level'",
103             val => $default_level_var_value, "\$$default_level_var_name",
104             val => 'warn', "fallback value",
105             );
106 1         4 $Log::ger::Current_Level = Log::ger::Util::numeric_level($level);
107              
108 1         10 my $is_daemon = delete $args{daemon};
109 1 50       4 $is_daemon = _is_daemon() if !defined($is_daemon);
110              
111 1         3 my $is_oneliner = $0 eq '-e';
112              
113 1         2 my $progname = delete $args{name};
114 1 50       4 unless (defined $progname) {
115 1         8 ($progname = $0) =~ s!.+/!!;
116 1         4 $progname =~ s/\.pl$//;
117             }
118 1 50       2 unless (length $progname) {
119 0         0 $progname = "prog";
120             }
121              
122             # configuration for Log::ger::Output::Composite
123             my %conf = (
124             outputs => {},
125 1   50     3 %{ $extra_conf // {} },
  1         7  
126             );
127              
128 1         3 my %off_categories = (
129             # some known categories that are not normally logged to screen or
130             # (error) file log
131             #'_dumps' => 'off', # e.g. in download-bca, download-mandiri
132             '_access' => 'off', # e.g. in WWW::PAUSE::Simple
133             );
134              
135             # add Screen
136             {
137 1 50       3 last if $is_daemon;
138 1         5 my $olevel = _set_level(
139             "screen log level",
140             envset => "SCREEN_", "",
141             val => $level, "general log level",
142             );
143 1 50       4 last if $olevel eq 'off';
144             my $fmt =
145             ($ENV{LOG_ADD_STACK_TRACE} ? '[stack %T] ': '').
146             ($ENV{LOG_ADD_LOCATION} ? '[location %l] ': '').
147             ($ENV{LOG_ADD_TIMESTAMP} ? '[%d] ': '').
148 1 50       8 ($ENV{LOG_ADD_MEMORY_INFO} ? '[vmsize %_{vmsize}K] ': '').
    50          
    50          
    50          
149             '%m';
150             $conf{outputs}{Screen} = {
151 1     0   11 conf => { formatter => sub { "$progname: $_[0]" }, colorize_tags => 1 },
  0         0  
152             level => $olevel,
153             category_level => \%off_categories,
154             layout => [Pattern => {format => $fmt}],
155             };
156             }
157              
158             # add File
159             {
160 1         2 my $file_name = delete $args{file_name};
  1         2  
161 1 50       2 unless (defined $file_name) {
162 1         3 $file_name = "$progname.log";
163             }
164              
165 1         2 my $file_dir = delete $args{file_dir};
166 1 50       2 unless (defined $file_dir) {
167 1         438 require PERLANCAR::File::HomeDir;
168 1 50 33     5911 $file_dir = $> || $^O eq 'MSWin32' ?
    50          
169             PERLANCAR::File::HomeDir::get_my_home_dir() :
170             (-d "/var/log" ? "/var/log" : "/");
171             }
172              
173 1 50       8 last if $0 eq '-';
174              
175 1         5 my $file_path = "$file_dir/$file_name";
176 1         5 my $olevel = _set_level(
177             "file ($file_path) log level",
178             envset => "FILE_", "",
179             val => $level, "general log level",
180             );
181 1 50       6 last if $olevel eq 'off';
182             my $fmt =
183             '[pid %P] [%d] '.
184 1 50       5 ($ENV{LOG_ADD_MEMORY_INFO} ? '[vmsize %_{vmsize}K] ': '').
185             '%m';
186             $conf{outputs}{File} = {
187 1         9 conf => { path => $file_path },
188             level => $olevel,
189             category_level => \%off_categories,
190             layout => [Pattern => {format => $fmt}],
191             };
192             }
193              
194             # add Syslog
195             {
196 1 50       2 last unless $is_daemon;
  1         2  
  1         3  
197 0         0 my $olevel = _set_level(
198             "syslog log level",
199             envset => "SYSLOG_", "",
200             val => $level, "general log level",
201             );
202 0 0       0 last if $olevel eq 'off';
203             $conf{outputs}{Syslog} = {
204 0         0 conf => { ident => $progname, facility => 'daemon' },
205             level => $olevel,
206             category_level => \%off_categories,
207             };
208             }
209              
210 1 50       4 if (my $outputs = delete $args{outputs}) {
211 0         0 for my $o (sort keys %$outputs) {
212 0 0       0 if ($conf{outputs}{$o}) {
213 0 0       0 warn "[lga] OVERWRITING output '$o' using output from 'outputs' argument\n" if $DEBUG;
214             } else {
215 0 0       0 warn "[lga] Adding output '$o' from 'outputs' argument\n" if $DEBUG;
216             }
217 0         0 $conf{outputs}{$o} = $outputs->{$o};
218             }
219             }
220              
221 1 50       29 die "Unknown argument(s): ".join(", ", sort keys %args)
222             if keys %args;
223              
224             # save, for those who want to check or modify
225 0           @IMPORT_ARGS = @_;
226              
227 0           require Log::ger::Output;
228 0           Log::ger::Output->set('Composite', %conf);
229             }
230              
231             1;
232             # ABSTRACT: An easy way to use Log::ger in applications
233              
234             __END__