← Back to branch summary

~ubuntu-branches/ubuntu/jaunty/libclass-meta-perl/jaunty

« back to all changes in this revision

Viewing changes to lib/Class/Meta/Types/Boolean.pm

  • Committer: Bazaar Package Importer
  • Author(s): Krzysztof Krzyzaniak (eloy)
  • Date: 2006-01-03 17:29:20 UTC
  • Revision ID: james.westby@ubuntu.com-20060103172920-h94p8qrrav90bzq0
Tags: upstream-0.52
Import upstream version 0.52

Show diffs side-by-side

added added

removed removed

Lines of Context:
lib/Class/Meta/Types/Boolean.pm
 
1
package Class::Meta::Types::Boolean;
 
2
 
 
3
# $Id: Boolean.pm 2405 2005-12-17 03:41:09Z theory $
 
4
 
 
5
=head1 NAME
 
6
 
 
7
Class::Meta::Types::Boolean - Boolean data types
 
8
 
 
9
=head1 SYNOPSIS
 
10
 
 
11
  package MyApp::Thingy;
 
12
  use strict;
 
13
  use Class::Meta;
 
14
  use Class::Meta::Types::Boolean;
 
15
  # OR...
 
16
  # use Class::Meta::Types::Boolean 'affordance';
 
17
  # OR...
 
18
  # use Class::Meta::Types::Boolean 'semi-affordance';
 
19
 
 
20
  BEGIN {
 
21
      # Create a Class::Meta object for this class.
 
22
      my $cm = Class::Meta->new( key => 'thingy' );
 
23
 
 
24
      # Add a boolean attribute.
 
25
      $cm->add_attribute( name => 'alive',
 
26
                          type => 'boolean' );
 
27
      $cm->build;
 
28
  }
 
29
 
 
30
=head1 DESCRIPTION
 
31
 
 
32
This module provides a boolean data type for use with Class::Meta attributes.
 
33
Simply load it, then pass "boolean" (or the alias "bool") to the
 
34
C<add_attribute()> method of a Class::Meta object to create an attribute of
 
35
the boolean data type. See L<Class::Meta::Type|Class::Meta::Type> for more
 
36
information on using and creating data types.
 
37
 
 
38
=head2 Accessors
 
39
 
 
40
Although the boolean data type has both "default" and "affordance" accessor
 
41
options available, unlike the other data types that ship with Class::Meta,
 
42
they have different implementations. The reason for this is to ensure that
 
43
the value of a boolean attribute is always 0 or 1.
 
44
 
 
45
For the "default" accessor style, there is no difference in the interface from
 
46
the default accessors for other data types. The default accessor merely checks
 
47
the truth of the new value, and assigns 1 if it's a true value, and 0 if it's
 
48
a false value. The result is an efficient accessor that maintains the
 
49
consistency of the data.
 
50
 
 
51
For the "affordance" accessor style, however, the boolean data type varies in
 
52
the accessors it creates. For example, for a boolean attributed named "alive",
 
53
instead of creating the C<get_alive> and C<set_alive> accessors common to
 
54
other affordance-style accessors, it instead creates three:
 
55
 
 
56
=over 4
 
57
 
 
58
=item C<is_alive>
 
59
 
 
60
=item C<set_alive_on>
 
61
 
 
62
=item C<set_alive_off>
 
63
 
 
64
=back
 
65
 
 
66
The result is highly efficient accessors that ensure the integrity of the data
 
67
without the overhead of validation checks.
 
68
 
 
69
=cut
 
70
 
 
71
use strict;
 
72
use Class::Meta::Type;
 
73
our $VERSION = "0.52";
 
74
 
 
75
sub import {
 
76
    my ($pkg, $builder) = @_;
 
77
    $builder ||= 'default';
 
78
    return if eval "Class::Meta::Type->new('boolean')";
 
79
 
 
80
    if ($builder eq 'default') {
 
81
        eval q|
 
82
sub build_attr_get {
 
83
    UNIVERSAL::can($_[0]->package, $_[0]->name);
 
84
}
 
85
 
 
86
*build_attr_set = \&build_attr_get;
 
87
 
 
88
sub build {
 
89
    my ($pkg, $attr, $create) = @_;
 
90
    $attr = $attr->name;
 
91
 
 
92
    no strict 'refs';
 
93
    if ($create == Class::Meta::GET) {
 
94
        # Create GET accessor.
 
95
        *{"${pkg}::$attr"} = sub { $_[0]->{$attr} };
 
96
 
 
97
    } elsif ($create == Class::Meta::SET) {
 
98
        # Create SET accessor.
 
99
        *{"${pkg}::$attr"} = sub { $_[0]->{$attr} = $_[1] ? 1 : 0 };
 
100
 
 
101
    } elsif ($create == Class::Meta::GETSET) {
 
102
        # Create GETSET accessor.
 
103
        *{"${pkg}::$attr"} = sub {
 
104
            my $self = shift;
 
105
            return $self->{$attr} unless @_;
 
106
            $self->{$attr} = $_[0] ? 1 : 0
 
107
        };
 
108
    } else {
 
109
        # Well, nothing I guess.
 
110
    }
 
111
}|
 
112
    } else {
 
113
 
 
114
        my $code = q|
 
115
sub build_attr_get {
 
116
    UNIVERSAL::can($_[0]->package, 'is_' . $_[0]->name);
 
117
}
 
118
 
 
119
sub build_attr_set {
 
120
    my $name = shift->name;
 
121
    eval "sub { \$_[1] ? \$_[0]->set_$name\_on : \$_[0]->set_$name\_off }";
 
122
}
 
123
 
 
124
sub build {
 
125
    my ($pkg, $attr, $create) = @_;
 
126
    $attr = $attr->name;
 
127
 
 
128
    no strict 'refs';
 
129
    if ($create >= Class::Meta::GET) {
 
130
        # Create GET accessor.
 
131
        *{"${pkg}::is_$attr"} = sub { $_[0]->{$attr} };
 
132
    }
 
133
    if ($create >= Class::Meta::SET) {
 
134
        # Create SET accessors.
 
135
        *{"${pkg}::set_$attr\_on"} = sub { $_[0]->{$attr} = 1 };
 
136
        *{"${pkg}::set_$attr\_off"} = sub { $_[0]->{$attr} = 0 };
 
137
    }
 
138
}|;
 
139
 
 
140
        $code =~ s/get_//g unless $builder eq 'affordance';
 
141
        eval $code;
 
142
    }
 
143
 
 
144
    Class::Meta::Type->add(
 
145
        key     => "boolean",
 
146
        name    => "Boolean",
 
147
        desc    => "Boolean",
 
148
        alias   => 'bool',
 
149
        builder => __PACKAGE__
 
150
    );
 
151
}
 
152
 
 
153
1;
 
154
__END__
 
155
 
 
156
=head1 BUGS
 
157
 
 
158
Please send bug reports to <bug-class-meta@rt.cpan.org> or report them via the
 
159
CPAN Request Tracker at L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Class-Meta>.
 
160
 
 
161
=head1 AUTHOR
 
162
 
 
163
David Wheeler <david@kineticode.com>
 
164
 
 
165
=head1 SEE ALSO
 
166
 
 
167
Other classes of interest within the Class::Meta distribution include:
 
168
 
 
169
=over 4
 
170
 
 
171
=item L<Class::Meta|Class::Meta>
 
172
 
 
173
This class contains most of the documentation you need to get started with
 
174
Class::Meta.
 
175
 
 
176
=item L<Class::Meta::Type|Class::Meta::Type>
 
177
 
 
178
This class manages the creation of data types.
 
179
 
 
180
=item L<Class::Meta::Attribute|Class::Meta::Attribute>
 
181
 
 
182
This class manages Class::Meta class attributes, all of which are based on
 
183
data types.
 
184
 
 
185
=back
 
186
 
 
187
Other data type modules:
 
188
 
 
189
=over 4
 
190
 
 
191
=item L<Class::Meta::Types::Perl|Class::Meta::Types::Perl>
 
192
 
 
193
=item L<Class::Meta::Types::String|Class::Meta::Types::String>
 
194
 
 
195
=item L<Class::Meta::Types::Numeric|Class::Meta::Types::Numeric>
 
196
 
 
197
=back
 
198
 
 
199
=head1 COPYRIGHT AND LICENSE
 
200
 
 
201
Copyright (c) 2002-2005, David Wheeler. All Rights Reserved.
 
202
 
 
203
This module is free software; you can redistribute it and/or modify it under
 
204
the same terms as Perl itself.
 
205
 
 
206
=cut