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   87950  
  1         4  
  1         6  
4             our $VERSION = '1.2019';
5              
6             use Catmandu::Util qw(as_utf8);
7 1     1   7 use Catmandu::Util::Path qw(as_path);
  1         2  
  1         55  
8 1     1   477 use Moo;
  1         2  
  1         412  
9 1     1   6 use namespace::clean;
  1         2  
  1         7  
10 1     1   344 use Catmandu::Fix::Has;
  1         2  
  1         4  
11 1     1   654  
  1         3  
  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   43 my $cb;
20 5         11  
21 5         7 if (@$args == 1) {
22             $cb = sub {
23 5 100       16 my $val = $_[0];
    100          
24             my $new_val;
25 2     2   4 eval {
26 2         3 no warnings 'substr';
27 2         3 $new_val = substr(as_utf8($val), $args->[0]);
28 1     1   409 };
  1         2  
  1         118  
29 2         5 return $new_val if defined $new_val;
30             return undef, 1, 0;
31 2 50       35 };
32 0         0 }
33 1         5 elsif (@$args == 2) {
34             $cb = sub {
35             my $val = $_[0];
36             my $new_val;
37 3     3   7 eval {
38 3         3 no warnings 'substr';
39 3         5 $new_val = substr(as_utf8($val), $args->[0], $args->[1]);
40 1     1   6 };
  1         2  
  1         123  
41 3         12 return $new_val if defined $new_val;
42             return undef, 1, 0;
43 3 100       24 };
44 2         34 }
45 3         12 else {
46             $cb = sub {
47             my $val = $_[0];
48             my $new_val = as_utf8($val);
49 1     1   3 eval {
50 1         4 no warnings 'substr';
51 1   50     2 substr($new_val, $args->[0], $args->[1]) = $args->[2];
52 1     1   7 } // return undef, 1, 0;
  1         2  
  1         139  
53 1         118 $new_val;
54             };
55 1         24 }
56 1         4  
57             as_path($self->path)->updater(if_value => $cb);
58             }
59 5         23  
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