File Coverage

blib/lib/Data/Unixish/bool.pm
Criterion Covered Total %
statement 40 40 100.0
branch 19 20 95.0
condition 15 16 93.7
subroutine 10 10 100.0
pod 1 1 100.0
total 85 87 97.7


line stmt bran cond sub pod time code
1             package Data::Unixish::bool;
2              
3 1     1   428 use 5.010;
  1         5  
4 1     1   5 use strict;
  1         1  
  1         19  
5 1     1   342 use syntax 'each_on_array'; # to support perl < 5.12
  1         19683  
  1         4  
6 1     1   2977 use utf8;
  1         2  
  1         8  
7 1     1   19 use warnings;
  1         1  
  1         22  
8             #use Log::Any '$log';
9              
10 1     1   379 use Data::Unixish::Util qw(%common_args);
  1         2  
  1         580  
11              
12             our $VERSION = '1.572'; # VERSION
13              
14             our %SPEC;
15              
16             sub _is_true {
17 38     38   43 my ($val, $notion) = @_;
18              
19 38 100       56 if ($notion eq 'n1') {
20 18 100       26 return undef unless defined($val);
21 16 100 100     44 return 0 if ref($val) eq 'ARRAY' && !@$val;
22 14 100 100     32 return 0 if ref($val) eq 'HASH' && !keys(%$val);
23 12 100       21 return $val ? 1:0;
24             } else {
25             # perl
26 20 100       33 return undef unless defined($val);
27 16 100       24 return $val ? 1:0;
28             }
29             }
30              
31             my %styles = (
32             one_zero => ['1', '0'],
33             t_f => ['t', 'f'],
34             true_false => ['true', 'false'],
35             y_n => ['y', 'n'],
36             Y_N => ['Y', 'N'],
37             yes_no => ['yes', 'no'],
38             v_X => ['v', 'X'],
39             check => ['✓', ' ', 'uses Unicode'],
40             check_cross => ['✓', '✕', 'uses Unicode'],
41             heavy_check_cross => ['✔', '✘', 'uses Unicode'],
42             dot => ['●', ' ', 'uses Unicode'],
43             dot_cross => ['●', '✘', 'uses Unicode'],
44              
45             );
46              
47             $SPEC{bool} = {
48             v => 1.1,
49             summary => 'Format boolean',
50             description => <<'_',
51              
52             _
53             args => {
54             %common_args,
55             style => {
56             schema=>[str => in=>[keys %styles], default=>'one_zero'],
57             description => "Available styles:\n\n".
58             join("", map {" * $_" . ($styles{$_}[2] ? " ($styles{$_}[2])":"").": $styles{$_}[1] $styles{$_}[0]\n"} sort keys %styles),
59             cmdline_aliases => { s=>{} },
60             },
61             true_char => {
62             summary => 'Instead of style, you can also specify character for true value',
63             schema=>['str*'],
64             cmdline_aliases => { t => {} },
65             },
66             false_char => {
67             summary => 'Instead of style, you can also specify character for true value',
68             schema=>['str*'],
69             cmdline_aliases => { f => {} },
70             },
71             notion => {
72             summary => 'What notion to use to determine true/false',
73             schema => [str => in=>[qw/perl n1/], default => 'perl'],
74             description => <<'_',
75              
76             `perl` uses Perl notion.
77              
78             `n1` (for lack of better name) is just like Perl notion, but empty array and
79             empty hash is considered false.
80              
81             TODO: add Ruby, Python, PHP, JavaScript, etc notion.
82              
83             _
84             },
85             # XXX: flag to ignore references
86             },
87             tags => [qw/datatype:bool itemfunc formatting/],
88             };
89             sub bool {
90 3     3 1 10 my %args = @_;
91 3         6 my ($in, $out) = ($args{in}, $args{out});
92              
93 3         5 _bool_begin(\%args);
94 3         13 while (my ($index, $item) = each @$in) {
95 19         32 push @$out, _bool_item($item, \%args);
96             }
97              
98 3         10 [200, "OK"];
99             }
100              
101             sub _bool_begin {
102 6     6   10 my $args = shift;
103              
104 6   100     22 $args->{notion} //= 'perl';
105 6   100     16 $args->{style} //= 'one_zero';
106 6 50       14 $args->{style} = 'one_zero' if !$styles{$args->{style}};
107              
108 6   66     29 $args->{true_char} //= $styles{$args->{style}}[0];
109 6   100     30 $args->{false_char} //= $styles{$args->{style}}[1];
110             }
111              
112             sub _bool_item {
113 38     38   49 my ($item, $args) = @_;
114              
115 38         51 my $t = _is_true($item, $args->{notion});
116 38 100       114 $t ? $args->{true_char} : defined($t) ? $args->{false_char} : undef;
    100          
117             }
118              
119             1;
120             # ABSTRACT: Format boolean
121              
122             __END__