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-2017 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 4     4   28 use warnings;
  4         8  
  4         154  
6 4     4   24 use strict;
  4         8  
  4         140  
7              
8             package Log::Report::Minimal::Domain;
9 4     4   35 use vars '$VERSION';
  4         18  
  4         210  
10             $VERSION = '1.04';
11              
12              
13 4     4   24 use String::Print 'oo';
  4         9  
  4         56  
14              
15              
16 6     6 1 18 sub new(@) { my $class = shift; (bless {}, $class)->init({@_}) }
  6         29  
17             sub init($)
18 6     6 0 20 { my ($self, $args) = @_;
19 6 50       63 $self->{LRMD_name} = $args->{name} or Log::Report::panic();
20 6         35 $self;
21             }
22              
23             #----------------
24              
25              
26 0     0 1 0 sub name() {shift->{LRMD_name}}
27 0     0 1 0 sub isConfigured() {shift->{LRMD_where}}
28              
29              
30             sub configure(%)
31 1     1 1 5 { my ($self, %args) = @_;
32              
33 1   50     11 my $here = $args{where} || [caller];
34 1 50       10 if(my $s = $self->{LRMD_where})
35 0         0 { my $domain = $self->name;
36 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";
37             }
38 1         4 my $where = $self->{LRMD_where} = $here;
39              
40             # documented in the super-class, the more useful man-page
41 1   50     5 my $format = $args{formatter} || 'PRINTI';
42 1 50       5 $format = {} if $format eq 'PRINTI';
43              
44 1 50       5 if(ref $format eq 'HASH')
    0          
45 1   50     5 { my $class = delete $format->{class} || 'String::Print';
46 1   50     5 my $method = delete $format->{method} || 'sprinti';
47 1         10 my $sp = $class->new(%$format);
48 1     3   47 $self->{LRMD_format} = sub { $sp->$method(@_) };
  3         12  
49             }
50             elsif(ref $format eq 'CODE')
51 0         0 { $self->{LRMD_format} = $format;
52             }
53             else
54 0         0 { error __x"illegal formatter `{name}' at {fn} line {line}"
55             , name => $format, fn => $where->[1], line => $where->[2];
56             }
57              
58 1         5 $self;
59             }
60              
61             #-------------------
62              
63             sub interpolate(@)
64 3     3 1 9 { my ($self, $msgid, $args) = @_;
65 3 50       10 $args->{_expand} or return $msgid;
66 3   66     13 my $f = $self->{LRMD_format} || $self->configure->{LRMD_format};
67 3         7 $f->($msgid, $args);
68             }
69              
70             1;