File Coverage

blib/lib/Types/Bool.pm
Criterion Covered Total %
statement 29 54 53.7
branch 14 32 43.7
condition 1 5 20.0
subroutine 13 17 76.4
pod 2 2 100.0
total 59 110 53.6


line stmt bran cond sub pod time code
1              
2 23     23   1573457 use 5.005;
  23         265  
3              
4             package Types::Bool;
5             $Types::Bool::VERSION = '2.98011';
6              
7             # ABSTRACT: Booleans as objects for Perl
8              
9             BEGIN {
10              
11             # For historical reasons, alias *Types::Bool::Impl with JSON::PP::Boolean
12 23     23   269 *Types::Bool::Impl:: = *JSON::PP::Boolean::;
13              
14             # JSON/PP/Boolean.pm is redundant
15             $INC{'JSON/PP/Boolean.pm'} ||= __FILE__
16 23 50 50     8261 unless $ENV{TYPES_BOOL_NICE};
17             }
18              
19             package #
20             Types::Bool::Impl;
21              
22             BEGIN {
23 23     23   25529 require overload;
24 23 50       21377 if ( $ENV{TYPES_BOOL_LOUD} ) {
25 0         0 my @o = grep __PACKAGE__->overload::Method($_), qw(0+ ++ --);
26 0         0 my @s = grep __PACKAGE__->can($_), qw(new);
27 0 0       0 push @s, '$VERSION' if $Types::Bool::VERSION;
28 0 0 0     0 if ( @o || @s ) {
29 0         0 my $p = ref do { bless \( my $dummy ), __PACKAGE__ };
  0         0  
30 0         0 my @f;
31 0 0       0 push @f, join( ', ', @s ) if @s;
32 0 0       0 push @f, 'overloads on ' . join( ', ', @o ) if @o;
33 0         0 warn join( ' and ', @f ), qq{ defined for $p elsewhere};
34             }
35             }
36              
37             overload->import(
38 0     0   0 '0+' => sub { ${ $_[0] } },
  0         0  
39 0     0   0 '++' => sub { $_[0] = ${ $_[0] } + 1 },
  0         0  
40 0     0   0 '--' => sub { $_[0] = ${ $_[0] } - 1 },
  0         0  
41 23 100       175 fallback => 1,
42             ) unless __PACKAGE__->overload::Method('0+');
43              
44 46 100   46   3540 *new = sub { bless \( my $dummy = $_[1] ? 1 : 0 ), $_[0] }
45 23 50       2716 unless __PACKAGE__->can('new');
46              
47 23 50       734 $Types::Bool::Impl::VERSION = '2.98011'
48             unless $Types::Bool::Impl::VERSION;
49             }
50              
51             package Types::Bool;
52              
53 23     23   158 use Scalar::Util ();
  23         47  
  23         811  
54              
55 23     23   141 use constant true => Types::Bool::Impl->new(1);
  23         43  
  23         114  
56 23     23   159 use constant false => Types::Bool::Impl->new(0);
  23         45  
  23         72  
57              
58 23     23   141 use constant BOOL_CORE => ref true;
  23         41  
  23         4676  
59              
60 175 100   175 1 85951 sub is_bool ($) { Scalar::Util::blessed( $_[0] ) and $_[0]->isa(BOOL_CORE) }
61              
62 50 100   50 1 60807 sub to_bool ($) { $_[0] ? true : false }
63              
64             @Types::Bool::EXPORT_OK = qw(true false is_bool to_bool);
65              
66             BEGIN {
67 23 50   23   1184 if ( "$]" < 5.008003 ) { # Inherit from Exporter (if needed)
68 0         0 require Exporter;
69 0         0 my $EXPORTER_VERSION = Exporter->VERSION;
70 0         0 $EXPORTER_VERSION =~ tr/_//d;
71 0 0       0 push @Types::Bool::ISA, qw(Exporter) if $EXPORTER_VERSION < 5.57;
72             }
73             }
74              
75             sub import { # Load Exporter only if needed
76 7 50   7   10590 return unless @_ > 1;
77              
78 0           require Exporter;
79              
80 23     23   172 no warnings 'redefine';
  23         53  
  23         2334  
81             *import = sub {
82 0 0   0     return unless @_ > 1;
83 0           goto &Exporter::import;
84 0           };
85 0           goto &Exporter::import;
86             }
87              
88             1;