File Coverage

blib/lib/Attribute/Boolean.pm
Criterion Covered Total %
statement 38 44 86.3
branch 0 4 0.0
condition n/a
subroutine 12 15 80.0
pod 0 1 0.0
total 50 64 78.1


line stmt bran cond sub pod time code
1             package Attribute::Boolean;
2              
3 1     1   13025 use strict;
  1         2  
  1         26  
4 1     1   3 use warnings FATAL => 'all';
  1         1  
  1         31  
5 1     1   9 use 5.14.0;
  1         9  
6 1     1   556 use utf8;
  1         8  
  1         4  
7              
8             =head1 NAME
9              
10             Attribute::Boolean - Mark scalars as pure booleans
11              
12             =cut
13              
14 1     1   506 use Attribute::Handlers;
  1         3653  
  1         4  
15 1     1   476 use Variable::Magic qw( wizard cast );
  1         787  
  1         55  
16 1     1   384 use parent 'Exporter';
  1         198  
  1         3  
17 1     1   411 use version;
  1         1261  
  1         4  
18              
19 1     1   416 use Attribute::Boolean::Value;
  1         1  
  1         89  
20              
21             =head1 VERSION
22              
23             Version v1.0.8
24              
25             =cut
26              
27             our $VERSION = version->declare('v1.0.8');
28             # Don't forget the version in the pod above.
29              
30             =head1 SYNOPSYS
31              
32             This allows you to flag a variable as a boolean.
33             In numeric context, it will have the value 0 or 1.
34             In string context is will have the value "false" or "true".
35             In JSON, it will correctly return false or true values.
36              
37             my $bool : Boolean;
38             print $bool; # "false"
39             $bool = (1 + 2 == 3);
40             print $bool; # "true"
41             print $bool ? "yes" : "no"; # "yes"
42             $bool = false;
43             print $bool ? "yes" : "no"; # "no"
44              
45             =head1 EXPORT
46              
47             This exports constants true and false.
48              
49             =cut
50              
51             our @EXPORT = qw{ true false };
52              
53             sub import {
54             # add this package to callers @ISA, as attributes only work via inheritance
55 1     1   6 my $class = shift;
56 1         1 my $caller = caller;
57             {
58 1     1   4 no strict 'refs';
  1         1  
  1         149  
  1         0  
59 1         1 push @{ "${ caller }::ISA" }, __PACKAGE__;
  1         9  
60             }
61 1         76 $class->export_to_level(1, $class, @_);
62             }
63              
64             =head1 USAGE
65              
66             An attribute can be declared boolean as follows:
67              
68             my $bool : Boolean;
69              
70             or
71              
72             my $bool : Boolean = true;
73              
74             If any perl B value is assigned, the variable is true; if a
75             perl B value is assigned, the variable is false.
76              
77             =head2 true
78              
79             This returns 1 in numeric context, "true" in string context.
80              
81             =head2 false
82              
83             This returns 0 in numeric context, "false" in string context.
84              
85             =head2 TO_JSON
86              
87             Provided that convert_blessed is set on the JSON (or JSON::XS) object,
88             the variable will correctly convert to JSON true or false.
89              
90             my $json = new JSON;
91             $json->pretty->convert_blessed;
92             my $bool : Boolean;
93             my %hash = (
94             value => $bool,
95             me => true,
96             );
97             print $json->encode(\%hash); # {
98             # "value" : false,
99             # "me" : true
100             # }
101            
102             =cut
103              
104             sub Boolean : ATTR(SCALAR)
105             {
106 0     0 0 0 my ($class, $symbol, $ref, $name, undef, $phase) = @_;
107             cast $$ref, wizard(
108             'set' => sub {
109 0     0   0 my $ref = shift;
110 0 0       0 $$ref = $$ref ? true : false;
111             },
112             'get' => sub {
113 0     0   0 my $ref = shift;
114 0 0       0 $$ref = $$ref ? true : false;
115             },
116 0         0 );
117 1     1   4 }
  1         1  
  1         4  
118              
119             =head1 AUTHOR
120              
121             Cliff Stanford, C<< >>
122              
123             =head1 BUGS
124              
125             Please report any bugs or feature requests to C, or through
126             the web interface at L. I will be notified, and then you'll
127             automatically be notified of progress on your bug as I make changes.
128              
129              
130              
131              
132             =head1 SUPPORT
133              
134             You can find documentation for this module with the perldoc command.
135              
136             perldoc Attribute::Boolean
137              
138             =head1 ACKNOWLEDGEMENTS
139              
140             Alan Haggai Alavi C<< >> for his
141             L module which was the inspiration
142             for this module.
143              
144             =head1 LICENCE AND COPYRIGHT
145              
146             Copyright 2014 Cliff Stanford.
147              
148             This program is free software; you can redistribute it and/or modify it
149             under the same terms as Perl itself.
150              
151             =cut
152              
153             1; # End of Attribute::Boolean
154