File Coverage

blib/lib/Class/Meta/Types/Boolean.pm
Criterion Covered Total %
statement 36 36 100.0
branch 14 18 77.7
condition 2 2 100.0
subroutine 8 8 100.0
pod 0 3 0.0
total 60 67 89.5


line stmt bran cond sub pod time code
1             package Class::Meta::Types::Boolean;
2              
3             =head1 NAME
4              
5             Class::Meta::Types::Boolean - Boolean data types
6              
7             =head1 SYNOPSIS
8              
9             package MyApp::Thingy;
10             use strict;
11             use Class::Meta;
12             use Class::Meta::Types::Boolean;
13             # OR...
14             # use Class::Meta::Types::Boolean 'affordance';
15             # OR...
16             # use Class::Meta::Types::Boolean 'semi-affordance';
17              
18             BEGIN {
19             # Create a Class::Meta object for this class.
20             my $cm = Class::Meta->new( key => 'thingy' );
21              
22             # Add a boolean attribute.
23             $cm->add_attribute( name => 'alive',
24             type => 'boolean' );
25             $cm->build;
26             }
27              
28             =head1 DESCRIPTION
29              
30             This module provides a boolean data type for use with Class::Meta attributes.
31             Simply load it, then pass "boolean" (or the alias "bool") to the
32             C method of a Class::Meta object to create an attribute of
33             the boolean data type. See L for more
34             information on using and creating data types.
35              
36             =head2 Accessors
37              
38             Although the boolean data type has both "default" and "affordance" accessor
39             options available, unlike the other data types that ship with Class::Meta,
40             they have different implementations. The reason for this is to ensure that
41             the value of a boolean attribute is always 0 or 1.
42              
43             For the "default" accessor style, there is no difference in the interface from
44             the default accessors for other data types. The default accessor merely checks
45             the truth of the new value, and assigns 1 if it's a true value, and 0 if it's
46             a false value. The result is an efficient accessor that maintains the
47             consistency of the data.
48              
49             For the "affordance" accessor style, however, the boolean data type varies in
50             the accessors it creates. For example, for a boolean attributed named "alive",
51             instead of creating the C and C accessors common to
52             other affordance-style accessors, it instead creates three:
53              
54             =over 4
55              
56             =item C
57              
58             =item C
59              
60             =item C
61              
62             =back
63              
64             The result is highly efficient accessors that ensure the integrity of the data
65             without the overhead of validation checks.
66              
67             =cut
68              
69 6     6   7304 use strict;
  6         12  
  6         195  
70 6     6   33 use Class::Meta::Type;
  6         10  
  6         1311  
71             our $VERSION = '0.66';
72              
73             sub import {
74 6     6   59 my ($pkg, $builder) = @_;
75 6   100     33 $builder ||= 'default';
76 6 50       388 return if eval "Class::Meta::Type->new('boolean')";
77              
78 6 100       32 if ($builder eq 'default') {
79 2 100   2 0 12 eval q|
  2 100   15 0 4  
  2 100   6   560  
  2 50   8   312  
  15 50       4775  
  20 50       94  
  11         61  
  6         36  
  4         20  
  6         27  
  6         28  
  6         56  
  4         25  
  4         21  
  4         30  
  4         23  
  6         41  
  6         136  
  8         40  
80             sub build_attr_get {
81             UNIVERSAL::can($_[0]->package, $_[0]->name);
82             }
83              
84             *build_attr_set = \&build_attr_get;
85              
86             sub build {
87             my ($pkg, $attr, $create) = @_;
88             $attr = $attr->name;
89              
90             no strict 'refs';
91             if ($create == Class::Meta::GET) {
92             # Create GET accessor.
93             *{"${pkg}::$attr"} = sub { $_[0]->{$attr} };
94              
95             } elsif ($create == Class::Meta::SET) {
96             # Create SET accessor.
97             *{"${pkg}::$attr"} = sub { $_[0]->{$attr} = $_[1] ? 1 : 0 };
98              
99             } elsif ($create == Class::Meta::GETSET) {
100             # Create GETSET accessor.
101             *{"${pkg}::$attr"} = sub {
102             my $self = shift;
103             return $self->{$attr} unless @_;
104             $self->{$attr} = $_[0] ? 1 : 0
105             };
106             } else {
107             # Well, nothing I guess.
108             }
109             }|
110             } else {
111              
112 4         9 my $code = q|
113             sub build_attr_get {
114             UNIVERSAL::can($_[0]->package, 'is_' . $_[0]->name);
115             }
116              
117             sub build_attr_set {
118             my $name = shift->name;
119             eval "sub { \$_[1] ? \$_[0]->set_$name\_on : \$_[0]->set_$name\_off }";
120             }
121              
122             sub build {
123             my ($pkg, $attr, $create) = @_;
124             $attr = $attr->name;
125              
126             no strict 'refs';
127             if ($create >= Class::Meta::GET) {
128             # Create GET accessor.
129             *{"${pkg}::is_$attr"} = sub { $_[0]->{$attr} };
130             }
131             if ($create >= Class::Meta::SET) {
132             # Create SET accessors.
133             *{"${pkg}::set_$attr\_on"} = sub { $_[0]->{$attr} = 1 };
134             *{"${pkg}::set_$attr\_off"} = sub { $_[0]->{$attr} = 0 };
135             }
136             }|;
137              
138 4 100       19 $code =~ s/get_//g unless $builder eq 'affordance';
139 4     8 0 870 eval $code;
  8         440  
  4         7  
  4         706  
140             }
141              
142 6         40 Class::Meta::Type->add(
143             key => "boolean",
144             name => "Boolean",
145             desc => "Boolean",
146             alias => 'bool',
147             builder => __PACKAGE__
148             );
149             }
150              
151             1;
152             __END__