File Coverage

blib/lib/Jifty/DBI/Filter/Boolean.pm
Criterion Covered Total %
statement 43 48 89.5
branch 17 20 85.0
condition 6 8 75.0
subroutine 10 10 100.0
pod 2 2 100.0
total 78 88 88.6


line stmt bran cond sub pod time code
1             package Jifty::DBI::Filter::Boolean;
2              
3 1     1   3 use warnings;
  1         1  
  1         24  
4 1     1   3 use strict;
  1         1  
  1         23  
5              
6 1     1   3 use base 'Jifty::DBI::Filter';
  1         1  
  1         56  
7              
8 1     1   4 use constant TRUE_VALUES => qw(1 t true y yes TRUE);
  1         0  
  1         70  
9 1     1   3 use constant FALSE_VALUES => ('', qw(0 f false n no FALSE));
  1         2  
  1         48  
10              
11             sub _is_true {
12 151     151   146 my $self = shift;
13 151         176 my $value = shift;
14              
15 1     1   3 no warnings 'uninitialized';
  1         1  
  1         272  
16              
17 151         458 for ($self->TRUE_VALUES, map { "'$_'" } $self->TRUE_VALUES) {
  906         1138  
18 1072 100       1580 return 1 if $value eq $_;
19             }
20              
21 77         269 return 0;
22             }
23              
24             sub _is_false {
25 77     77   83 my $self = shift;
26 77         87 my $value = shift;
27              
28 77 100       159 return 1 if not defined $value;
29              
30 76         193 for ($self->FALSE_VALUES, map { "'$_'" } $self->FALSE_VALUES) {
  532         597  
31 244 100       481 return 1 if $value eq $_;
32             }
33              
34 0         0 return 0;
35             }
36              
37             =head1 NAME
38              
39             Jifty::DBI::Filter::Boolean - Encodes booleans
40              
41             =head1 DESCRIPTION
42              
43             =head2 decode
44              
45             Transform the value into 1 or 0 so Perl's concept of the value agrees
46             with the database's concept of the value. (For example, 't' and 'f'
47             might be used in the database, but 'f' is true in Perl)
48              
49             =cut
50              
51             sub decode {
52 56     56 1 63 my $self = shift;
53 56         149 my $value_ref = $self->value_ref;
54              
55 56 100       300 return unless defined $$value_ref;
56              
57 43 100       90 if ($self->_is_true($$value_ref)) {
    50          
58 21         87 $$value_ref = 1;
59             }
60             elsif ($self->_is_false($$value_ref)) {
61 22         123 $$value_ref = 0;
62             }
63             else {
64 0         0 $self->handle->log("The value '$$value_ref' does not look like a boolean. Defaulting to false.");
65 0         0 $$value_ref = 0;
66             }
67             }
68              
69             =head2 encode
70              
71             Transform the value to the canonical true or false value as expected by the
72             database.
73              
74             =cut
75              
76             sub encode {
77 122     122 1 109 my $self = shift;
78 122         215 my $value_ref = $self->value_ref;
79              
80 122 100 100     550 return unless defined($$value_ref) or $self->column->mandatory;
81 108 50 100     382 return if uc($$value_ref||'') eq "NULL" and not $self->column->mandatory;
      33        
82              
83 108 100       158 if ($self->_is_true($$value_ref)) {
    50          
84 53         107 $$value_ref = $self->handle->canonical_true;
85             }
86             elsif ($self->_is_false($$value_ref)) {
87 55         124 $$value_ref = $self->handle->canonical_false;
88             }
89             else {
90 0           $self->handle->log("The value '$$value_ref' does not look like a boolean. Defaulting to false.");
91 0           $$value_ref = $self->handle->canonical_false;
92             }
93             }
94              
95             =head1 SEE ALSO
96              
97             L
98              
99             =cut
100              
101             1;