Commit | Line | Data |
86d6940e |
1 | package DBIx::Class::InflateColumn::Object::Enum; |
2 | |
3 | use warnings; |
4 | use strict; |
86d6940e |
5 | use Carp qw/croak confess/; |
6 | use Object::Enum; |
7 | |
8 | =head1 NAME |
9 | |
10 | DBIx::Class::InflateColumn::Object::Enum - Allows a DBIx::Class user to define a Object::Enum column |
11 | |
12 | =head1 VERSION |
13 | |
14 | Version 0.03 |
15 | |
16 | =cut |
17 | |
d73b8011 |
18 | # Dist::Zill should handle this now |
74574c21 |
19 | # ABSTRACT: Allows a DBIx::Class user to define a Object::Enum column |
d73b8011 |
20 | #our $VERSION = '0.04'; |
86d6940e |
21 | |
22 | |
23 | =head1 SYNOPSIS |
24 | |
25 | Load this module via load_components and utilize is_enum and values property |
26 | to define Enumuration columns via Object::Enum |
27 | |
28 | package TableClass; |
29 | |
30 | use strict; |
31 | use warnings; |
32 | use base 'DBIx::Class'; |
33 | |
34 | __PACKAGE__->load_components(qw/InflateColumn::Object::Enum Core/); |
35 | __PACKAGE__->table('testtable'); |
36 | __PACKAGE__->add_columns( |
37 | color => { |
38 | data_type => 'varchar', |
39 | is_enum => 1, |
40 | extra => { |
41 | list => [qw/red green blue/] |
42 | } |
43 | } |
44 | color_native => { # works inline with native enum type |
45 | data_type => 'enum', |
46 | is_enum => 1, |
47 | extra => { |
48 | list => [qw/red green blue/] |
49 | } |
50 | } |
51 | ); |
52 | |
53 | 1; |
54 | |
55 | Now you may treat the column as an L<Object::Enum> object. |
56 | |
57 | my $table_rs = $db->resultset('TableClass')->create({ |
58 | color => undef |
59 | }); |
60 | |
61 | $table_rs->color->set_red; # sets color to red |
62 | $table_rs->color->is_red; # would return true |
63 | $table_rs->color->is_green; # would return false |
64 | print $table_rs->color->value; # would print 'red' |
65 | $table_rs->color->unset; # set the value to 'undef' or 'null' |
66 | $table_rs->color->is_red; # returns false now |
67 | |
68 | |
69 | =head1 METHODS |
70 | |
71 | =head2 register_column |
72 | |
73 | Internal chained method with L<DBIx::Class::Row/register_column>. |
74 | Users do not call this directly! |
75 | |
76 | =cut |
77 | |
78 | sub register_column { |
a0e9a0f3 |
79 | my $self = shift; |
80 | my ($column, $info) = @_; |
86d6940e |
81 | |
a0e9a0f3 |
82 | $self->next::method(@_); |
86d6940e |
83 | |
84 | return unless defined $info->{is_enum} and $info->{is_enum}; |
85 | |
86 | croak("Object::Enum '$column' missing 'extra => { list => [] }' column configuration") |
87 | unless ( |
88 | defined $info->{extra} |
89 | and ref $info->{extra} eq 'HASH' |
90 | and defined $info->{extra}->{list} |
91 | ); |
92 | |
93 | croak("Object::Enum '$column' value list (extra => { list => [] }) must be an ARRAY reference") |
94 | unless ref $info->{extra}->{list} eq 'ARRAY'; |
95 | |
96 | my $values = $info->{extra}->{list}; |
97 | my %values = map {$_=>1} @{$values}; |
c5f3507b |
98 | |
99 | push(@{$values},$info->{default_value}) |
100 | if defined($info->{default_value}) |
101 | && !exists $values{$info->{default_value}}; |
102 | |
b41bacc7 |
103 | push(@{$values}, undef) |
104 | if defined($info->{is_nullable}) |
105 | && $info->{is_nullable}; |
106 | |
a0e9a0f3 |
107 | $self->inflate_column( |
86d6940e |
108 | $column => { |
109 | inflate => sub { |
110 | my $val = shift; |
111 | my $e = Object::Enum->new({values=>$values}); |
5cc8e22d |
112 | $e->value($val); |
86d6940e |
113 | return $e; |
114 | }, |
115 | deflate => sub { |
116 | return shift->value |
117 | } |
118 | } |
119 | ); |
120 | |
121 | } |
122 | |
123 | =head1 AUTHOR |
124 | |
125 | Jason M. Mills, C<< <jmmills at cpan.org> >> |
126 | |
127 | =head1 BUGS |
128 | |
129 | Please report any bugs or feature requests to C<bug-dbix-class-inflatecolumn-object-enum at rt.cpan.org>, or through |
130 | the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=DBIx-Class-InflateColumn-Object-Enum>. I will be notified, and then you'll |
131 | automatically be notified of progress on your bug as I make changes. |
132 | |
133 | |
134 | |
135 | |
136 | =head1 SUPPORT |
137 | |
138 | You can find documentation for this module with the perldoc command. |
139 | |
140 | perldoc DBIx::Class::InflateColumn::Object::Enum |
141 | |
142 | |
143 | You can also look for information at: |
144 | |
145 | =over 4 |
146 | |
147 | =item * RT: CPAN's request tracker |
148 | |
149 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBIx-Class-InflateColumn-Object-Enum> |
150 | |
151 | =item * AnnoCPAN: Annotated CPAN documentation |
152 | |
153 | L<http://annocpan.org/dist/DBIx-Class-InflateColumn-Object-Enum> |
154 | |
155 | =item * CPAN Ratings |
156 | |
157 | L<http://cpanratings.perl.org/d/DBIx-Class-InflateColumn-Object-Enum> |
158 | |
159 | =item * Search CPAN |
160 | |
161 | L<http://search.cpan.org/dist/DBIx-Class-InflateColumn-Object-Enum> |
162 | |
163 | =back |
164 | |
165 | |
166 | =head1 SEE ALSO |
167 | |
168 | L<Object::Enum>, L<DBIx::Class>, L<DBIx::Class::InflateColumn::URI> |
169 | |
170 | |
171 | =head1 COPYRIGHT & LICENSE |
172 | |
173 | Copyright 2008 Jason M. Mills, all rights reserved. |
174 | |
175 | This program is free software; you can redistribute it and/or modify it |
176 | under the same terms as Perl itself. |
177 | |
178 | |
179 | =cut |
180 | |
181 | 1; # End of DBIx::Class::InflateColumn::Object::Enum |