File Coverage

blib/lib/Log/Report/Minimal/Domain.pm
Criterion Covered Total %
statement 34 40 85.0
branch 5 12 41.6
condition 6 11 54.5
subroutine 9 11 81.8
pod 5 6 83.3
total 59 80 73.7


line stmt bran cond sub pod time code
1             # Copyrights 2013-2018 by [Mark Overmeer ].
2             # For other contributors see ChangeLog.
3             # See the manual pages for details on the licensing terms.
4             # Pod stripped from pm file by OODoc 2.02.
5             # This code is part of distribution Log-Report-Optional. Meta-POD processed
6             # with OODoc into POD and HTML manual-pages. See README.md
7             # Copyright Mark Overmeer. Licensed under the same terms as Perl itself.
8              
9             package Log::Report::Minimal::Domain;
10 4     4   22 use vars '$VERSION';
  4         6  
  4         191  
11             $VERSION = '1.06';
12              
13              
14 4     4   19 use warnings;
  4         5  
  4         97  
15 4     4   32 use strict;
  4         37  
  4         75  
16              
17 4     4   16 use String::Print 'oo';
  4         17  
  4         16  
18              
19              
20 6     6 1 10 sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) }
  6         17  
21             sub init($)
22 6     6 0 12 { my ($self, $args) = @_;
23 6 50       37 $self->{LRMD_name} = $args->{name} or Log::Report::panic();
24 6         19 $self;
25             }
26              
27             #----------------
28              
29              
30 0     0 1 0 sub name() {shift->{LRMD_name}}
31 0     0 1 0 sub isConfigured() {shift->{LRMD_where}}
32              
33              
34             sub configure(%)
35 1     1 1 2 { my ($self, %args) = @_;
36              
37 1   50     5 my $here = $args{where} || [caller];
38 1 50       5 if(my $s = $self->{LRMD_where})
39 0         0 { my $domain = $self->name;
40 0         0 die "only one package can contain configuration; for $domain already in $s->[0] in file $s->[1] line $s->[2]. Now also found at $here->[1] line $here->[2]\n";
41             }
42 1         2 my $where = $self->{LRMD_where} = $here;
43              
44             # documented in the super-class, the more useful man-page
45 1   50     4 my $format = $args{formatter} || 'PRINTI';
46 1 50       3 $format = {} if $format eq 'PRINTI';
47              
48 1 50       3 if(ref $format eq 'HASH')
    0          
49 1   50     4 { my $class = delete $format->{class} || 'String::Print';
50 1   50     4 my $method = delete $format->{method} || 'sprinti';
51 1         4 my $sp = $class->new(%$format);
52 1     3   32 $self->{LRMD_format} = sub { $sp->$method(@_) };
  3         9  
53             }
54             elsif(ref $format eq 'CODE')
55 0         0 { $self->{LRMD_format} = $format;
56             }
57             else
58 0         0 { error __x"illegal formatter `{name}' at {fn} line {line}"
59             , name => $format, fn => $where->[1], line => $where->[2];
60             }
61              
62 1         3 $self;
63             }
64              
65             #-------------------
66              
67             sub interpolate(@)
68 3     3 1 5 { my ($self, $msgid, $args) = @_;
69 3 50       6 $args->{_expand} or return $msgid;
70 3   66     9 my $f = $self->{LRMD_format} || $self->configure->{LRMD_format};
71 3         5 $f->($msgid, $args);
72             }
73              
74             1;