line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Data::Unixish::bool; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
391
|
use 5.010; |
|
1
|
|
|
|
|
6
|
|
4
|
1
|
|
|
1
|
|
4
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
18
|
|
5
|
1
|
|
|
1
|
|
313
|
use syntax 'each_on_array'; # to support perl < 5.12 |
|
1
|
|
|
|
|
18848
|
|
|
1
|
|
|
|
|
4
|
|
6
|
1
|
|
|
1
|
|
2954
|
use utf8; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
6
|
|
7
|
1
|
|
|
1
|
|
68
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
30
|
|
8
|
|
|
|
|
|
|
#use Log::Any '$log'; |
9
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
382
|
use Data::Unixish::Util qw(%common_args); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
570
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '1.570'; # VERSION |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our %SPEC; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
sub _is_true { |
17
|
38
|
|
|
38
|
|
50
|
my ($val, $notion) = @_; |
18
|
|
|
|
|
|
|
|
19
|
38
|
100
|
|
|
|
53
|
if ($notion eq 'n1') { |
20
|
18
|
100
|
|
|
|
29
|
return undef unless defined($val); |
21
|
16
|
100
|
100
|
|
|
31
|
return 0 if ref($val) eq 'ARRAY' && !@$val; |
22
|
14
|
100
|
100
|
|
|
30
|
return 0 if ref($val) eq 'HASH' && !keys(%$val); |
23
|
12
|
100
|
|
|
|
20
|
return $val ? 1:0; |
24
|
|
|
|
|
|
|
} else { |
25
|
|
|
|
|
|
|
# perl |
26
|
20
|
100
|
|
|
|
33
|
return undef unless defined($val); |
27
|
16
|
100
|
|
|
|
27
|
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
|
9
|
my %args = @_; |
91
|
3
|
|
|
|
|
8
|
my ($in, $out) = ($args{in}, $args{out}); |
92
|
|
|
|
|
|
|
|
93
|
3
|
|
|
|
|
7
|
_bool_begin(\%args); |
94
|
3
|
|
|
|
|
22
|
while (my ($index, $item) = each @$in) { |
95
|
19
|
|
|
|
|
26
|
push @$out, _bool_item($item, \%args); |
96
|
|
|
|
|
|
|
} |
97
|
|
|
|
|
|
|
|
98
|
3
|
|
|
|
|
12
|
[200, "OK"]; |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
sub _bool_begin { |
102
|
6
|
|
|
6
|
|
9
|
my $args = shift; |
103
|
|
|
|
|
|
|
|
104
|
6
|
|
100
|
|
|
30
|
$args->{notion} //= 'perl'; |
105
|
6
|
|
100
|
|
|
18
|
$args->{style} //= 'one_zero'; |
106
|
6
|
50
|
|
|
|
15
|
$args->{style} = 'one_zero' if !$styles{$args->{style}}; |
107
|
|
|
|
|
|
|
|
108
|
6
|
|
66
|
|
|
26
|
$args->{true_char} //= $styles{$args->{style}}[0]; |
109
|
6
|
|
100
|
|
|
29
|
$args->{false_char} //= $styles{$args->{style}}[1]; |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub _bool_item { |
113
|
38
|
|
|
38
|
|
56
|
my ($item, $args) = @_; |
114
|
|
|
|
|
|
|
|
115
|
38
|
|
|
|
|
45
|
my $t = _is_true($item, $args->{notion}); |
116
|
38
|
100
|
|
|
|
112
|
$t ? $args->{true_char} : defined($t) ? $args->{false_char} : undef; |
|
|
100
|
|
|
|
|
|
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
1; |
120
|
|
|
|
|
|
|
# ABSTRACT: Format boolean |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
__END__ |