File Coverage

blib/lib/Log/ger/Output/LogDispatchOutput.pm
Criterion Covered Total %
statement 25 25 100.0
branch 5 8 62.5
condition 2 6 33.3
subroutine 5 5 100.0
pod 0 1 0.0
total 37 45 82.2


line stmt bran cond sub pod time code
1             package Log::ger::Output::LogDispatchOutput;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2020-03-07'; # DATE
5             our $DIST = 'Log-ger-Output-LogDispatchOutput'; # DIST
6             our $VERSION = '0.004'; # VERSION
7              
8 1     1   2057 use strict;
  1         3  
  1         32  
9 1     1   5 use warnings;
  1         2  
  1         28  
10              
11 1     1   5 use Log::ger::Util;
  1         2  
  1         312  
12              
13             sub get_hooks {
14 1     1 0 16 my %plugin_conf = @_;
15              
16 1 50       4 $plugin_conf{output} or die "Please specify output (e.g. ".
17             "ArrayWithLimits for Log::Dispatch::ArrayWithLimits)";
18              
19 1         514 require Log::Dispatch;
20 1         251216 my $mod = "Log::Dispatch::$plugin_conf{output}";
21 1         7 (my $mod_pm = "$mod.pm") =~ s!::!/!g;
22 1         504 require $mod_pm;
23              
24             return {
25             create_outputter => [
26             __PACKAGE__, # key
27             # we want to handle all levels, thus we need to be higher priority
28             # than default Log::ger hooks (10) which will install null loggers
29             # for less severe levels.
30             9, # priority
31             sub { # hook
32 12     12   1999 my %hook_args = @_; # see Log::ger::Manual::Internals/"Arguments passed to hook"
33              
34             my $outputter = sub {
35 3         766 my ($per_target_conf, $msg, $per_msg_conf) = @_;
36 3   33     18 my $level = $per_msg_conf->{level} // $hook_args{level};
37              
38 3 100       11 return if $level > $Log::ger::Current_Level;
39              
40             # we can use per-target conf to store per-target stuffs
41             $hook_args{per_target_conf}{_ld} ||= Log::Dispatch->new(
42             outputs => [
43             $plugin_conf{_output} ? $plugin_conf{_output} :
44             [
45             $plugin_conf{output},
46             min_level => 'warning',
47 2 50 33     12 %{ $plugin_conf{args} || {} },
  2 50       15  
48             ],
49             ],
50             );
51 2         571 $hook_args{per_target_conf}{_ld}->warning($msg);
52 12         47 };
53 12         33 [$outputter];
54 1         35950 }],
55             };
56             }
57              
58             1;
59             # ABSTRACT: Send logs to a Log::Dispatch output
60              
61             __END__
62              
63             =pod
64              
65             =encoding UTF-8
66              
67             =head1 NAME
68              
69             Log::ger::Output::LogDispatchOutput - Send logs to a Log::Dispatch output
70              
71             =head1 VERSION
72              
73             This document describes version 0.004 of Log::ger::Output::LogDispatchOutput (from Perl distribution Log-ger-Output-LogDispatchOutput), released on 2020-03-07.
74              
75             =head1 SYNOPSIS
76              
77             use Log::ger::Output LogDispatchOutput => (
78             output => 'Screen', # choose Log::Dispatch::Screen
79             args => {stderr=>1, newline=>1},
80             );
81              
82             =head1 DESCRIPTION
83              
84             This output sends logs to a Log::Dispatch output.
85              
86             =for Pod::Coverage ^(.+)$
87              
88             =head1 CONFIGURATION
89              
90             =head2 output
91              
92             =head2 args
93              
94             =head1 HOMEPAGE
95              
96             Please visit the project's homepage at L<https://metacpan.org/release/Log-ger-Output-LogDispatchOutput>.
97              
98             =head1 SOURCE
99              
100             Source repository is at L<https://github.com/perlancar/perl-Log-ger-Output-LogDispatchOutput>.
101              
102             =head1 BUGS
103              
104             Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Log-ger-Output-LogDispatchOutput>
105              
106             When submitting a bug or request, please include a test-file or a
107             patch to an existing test-file that illustrates the bug or desired
108             feature.
109              
110             =head1 SEE ALSO
111              
112             L<Log::ger::Output::LogDispatch>
113              
114             L<Log::ger>
115              
116             L<Log::Dispatch>
117              
118             =head1 AUTHOR
119              
120             perlancar <perlancar@cpan.org>
121              
122             =head1 COPYRIGHT AND LICENSE
123              
124             This software is copyright (c) 2020, 2017 by perlancar@cpan.org.
125              
126             This is free software; you can redistribute it and/or modify it under
127             the same terms as the Perl 5 programming language system itself.
128              
129             =cut