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 2     2   390262 use 5.010001;
  2         8  
4 2     2   13 use strict;
  2         28  
  2         69  
5 2     2   10 use warnings;
  2         3  
  2         145  
6              
7 2     2   1105 use Data::Dmp;
  2         4584  
  2         511  
8              
9             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
10             our $DATE = '2024-07-17'; # DATE
11             our $DIST = 'Data-Sah-Filter'; # DIST
12             our $VERSION = '0.025'; # VERSION
13              
14             sub meta {
15             +{
16 5     5 0 55 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 5     5 0 10 my %fargs = @_;
41              
42 5         8 my $dt = $fargs{data_term};
43 5   50     8 my $gen_args = $fargs{args} // {};
44 5         8 my $width = int($gen_args->{width});
45              
46 5         7 my $res = {};
47 5         16 $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 5         10 $res;
58             }
59              
60             1;
61             # ABSTRACT: Try to center string in a width, fail if string is too long
62              
63             __END__