File Coverage

blib/lib/Catmandu/Fix/substring.pm
Criterion Covered Total %
statement 51 52 98.0
branch 7 8 87.5
condition 1 2 50.0
subroutine 13 13 100.0
pod n/a
total 72 75 96.0


line stmt bran cond sub pod time code
1              
2             use Catmandu::Sane;
3 1     1   102211  
  1         3  
  1         5  
4             our $VERSION = '1.2018';
5              
6             use Catmandu::Util qw(as_utf8);
7 1     1   6 use Catmandu::Util::Path qw(as_path);
  1         3  
  1         44  
8 1     1   402 use Moo;
  1         2  
  1         45  
9 1     1   6 use namespace::clean;
  1         1  
  1         5  
10 1     1   310 use Catmandu::Fix::Has;
  1         2  
  1         3  
11 1     1   604  
  1         2  
  1         5  
12             has path => (fix_arg => 1);
13             has args => (fix_arg => 'collect');
14              
15             with 'Catmandu::Fix::Builder';
16              
17             my ($self) = @_;
18             my $args = $self->args;
19 5     5   37 my $cb;
20 5         9  
21 5         6 if (@$args == 1) {
22             $cb = sub {
23 5 100       14 my $val = $_[0];
    100          
24             my $new_val;
25 2     2   5 eval {
26 2         2 no warnings 'substr';
27 2         3 $new_val = substr(as_utf8($val), $args->[0]);
28 1     1   380 };
  1         2  
  1         118  
29 2         5 return $new_val if defined $new_val;
30             return undef, 1, 0;
31 2 50       34 };
32 0         0 }
33 1         4 elsif (@$args == 2) {
34             $cb = sub {
35             my $val = $_[0];
36             my $new_val;
37 3     3   4 eval {
38 3         4 no warnings 'substr';
39 3         4 $new_val = substr(as_utf8($val), $args->[0], $args->[1]);
40 1     1   7 };
  1         2  
  1         100  
41 3         10 return $new_val if defined $new_val;
42             return undef, 1, 0;
43 3 100       24 };
44 2         33 }
45 3         11 else {
46             $cb = sub {
47             my $val = $_[0];
48             my $new_val = as_utf8($val);
49 1     1   2 eval {
50 1         3 no warnings 'substr';
51 1   50     2 substr($new_val, $args->[0], $args->[1]) = $args->[2];
52 1     1   12 } // return undef, 1, 0;
  1         3  
  1         120  
53 1         98 $new_val;
54             };
55 1         23 }
56 1         4  
57             as_path($self->path)->updater(if_value => $cb);
58             }
59 5         19  
60             1;
61              
62              
63             =pod
64              
65             =head1 NAME
66              
67             Catmandu::Fix::substring - extract a substring out of the value of a field
68              
69             =head1 SYNOPSIS
70              
71             # Extract a substring out of the value of a field
72             # - Extact from 'initials' the characters at offset 0 (first character) with a length 3
73             substring(initials, 0, 3)
74              
75             =head1 SEE ALSO
76              
77             L<Catmandu::Fix>, substr
78              
79             =cut