File Coverage

blib/lib/Data/Sah/Filter/perl/Str/try_center.pm
Criterion Covered Total %
statement 19 19 100.0
branch n/a
condition 1 2 50.0
subroutine 6 6 100.0
pod 0 2 0.0
total 26 29 89.6


line stmt bran cond sub pod time code
1             package Data::Sah::Filter::perl::Str::try_center;
2              
3 1     1   18 use 5.010001;
  1         4  
4 1     1   8 use strict;
  1         2  
  1         24  
5 1     1   4 use warnings;
  1         2  
  1         35  
6              
7 1     1   531 use Data::Dmp;
  1         2103  
  1         287  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2023-04-25'; # DATE
11             our $DIST = 'Data-Sah-Filter'; # DIST
12             our $VERSION = '0.019'; # VERSION
13              
14             sub meta {
15             +{
16 4     4 0 56 v => 1,
17             summary => 'Try to center string in a width, fail if string is too long',
18             might_fail => 1,
19             args => {
20             width => {
21             schema => 'uint*',
22             req => 1,
23             },
24             },
25             examples => [
26             {value=>"12", filter_args=>{width=>4}, filtered_value=>" 12 "},
27             {value=>"12", filter_args=>{width=>3}, filtered_value=>"12 "},
28             {value=>"12", filter_args=>{width=>2}, filtered_value=>"12"},
29             {value=>"12", filter_args=>{width=>1}, valid=>0},
30             ],
31             description => <<'_',
32              
33             This filter is mainly for testing.
34              
35             _
36             };
37             }
38              
39             sub filter {
40 4     4 0 12 my %fargs = @_;
41              
42 4         7 my $dt = $fargs{data_term};
43 4   50     10 my $gen_args = $fargs{args} // {};
44 4         9 my $width = int($gen_args->{width});
45              
46 4         8 my $res = {};
47 4         18 $res->{expr_filter} = join(
48             "",
49             "do {\n",
50             " my \$tmp = $dt;\n",
51             " my \$l = $width - length(\$tmp);\n",
52             " if (\$l < 0) { ['String is too wide for width', \$tmp] }\n",
53             " else { my \$l1 = int(\$l/2); my \$l2 = \$l - \$l1; [undef, (' ' x \$l1) . \$tmp . (' ' x \$l2)] }\n",
54             "}",
55             );
56              
57 4         13 $res;
58             }
59              
60             1;
61             # ABSTRACT: Try to center string in a width, fail if string is too long
62              
63             __END__