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