File Coverage

blib/lib/Locale/Utils/PlaceholderNamed.pm
Criterion Covered Total %
statement 37 37 100.0
branch 13 16 81.2
condition n/a
subroutine 9 9 100.0
pod 1 1 100.0
total 60 63 95.2


line stmt bran cond sub pod time code
1             package Locale::Utils::PlaceholderNamed; ## no critic (TidyCode)
2            
3 4     4   110417 use strict;
  4         12  
  4         107  
4 4     4   22 use warnings;
  4         10  
  4         108  
5 4     4   20 use Carp qw(confess);
  4         12  
  4         170  
6 4     4   2115 use Moo;
  4         45361  
  4         22  
7 4     4   6744 use MooX::StrictConstructor;
  4         46735  
  4         22  
8 4     4   81234 use MooX::Types::MooseLike::Base qw(Bool CodeRef);
  4         23142  
  4         331  
9 4     4   2091 use namespace::autoclean;
  4         49528  
  4         18  
10            
11             our $VERSION = '1.004';
12            
13             has is_strict => (
14             is => 'rw',
15             isa => Bool,
16             );
17            
18             has modifier_code => (
19             is => 'rw',
20             isa => CodeRef,
21             clearer => 'clear_modifier_code',
22             );
23            
24             sub _mangle_value {
25 17     17   55 my ($self, $placeholder, $value, $attribute) = @_;
26            
27 17 100       83 defined $value
    100          
28             or return $self->is_strict ? $placeholder : q{};
29 15 100       69 defined $attribute
30             or return $value;
31 2 50       35 $self->modifier_code
32             or return $value;
33 2         39 $value = $self->modifier_code->($value, $attribute);
34 2 50       28 defined $value
35             or confess 'modifier_code returns nothing or undef';
36            
37 2         8 return $value;
38             }
39            
40             sub expand_named {
41 10     10 1 3432 my ($self, $text, @args) = @_;
42            
43 10 100       36 defined $text
44             or return $text;
45 9 50       41 my $arg_ref = @args == 1
    100          
46             ? $args[0]
47             : {
48             @args % 2
49             ? confess 'Arguments expected pairwise'
50             : @args
51             };
52            
53 9         19 my $regex = join q{|}, map { quotemeta } keys %{$arg_ref};
  16         40  
  9         30  
54             ## no critic (EscapedMetacharacters)
55 9         288 $text =~ s{
56             (
57             \{
58             ( $regex )
59             (?: [ ]* [:] ( [^\}]+ ) )?
60             \}
61             )
62             }
63             {
64 17         55 $self->_mangle_value($1, $arg_ref->{$2}, $3)
65             }xmsge;
66             ## use critic (EscapedMetacharacters)
67            
68 9         82 return $text;
69             }
70            
71             __PACKAGE__->meta->make_immutable;
72            
73             1;
74            
75             __END__