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 | |
a0e9a0f3 |
18 | our $VERSION = '0.04'; |
86d6940e |
19 | |
20 | |
21 | =head1 SYNOPSIS |
22 | |
23 | Load this module via load_components and utilize is_enum and values property |
24 | to define Enumuration columns via Object::Enum |
25 | |
26 | package TableClass; |
27 | |
28 | use strict; |
29 | use warnings; |
30 | use base 'DBIx::Class'; |
31 | |
32 | __PACKAGE__->load_components(qw/InflateColumn::Object::Enum Core/); |
33 | __PACKAGE__->table('testtable'); |
34 | __PACKAGE__->add_columns( |
35 | color => { |
36 | data_type => 'varchar', |
37 | is_enum => 1, |
38 | extra => { |
39 | list => [qw/red green blue/] |
40 | } |
41 | } |
42 | color_native => { # works inline with native enum type |
43 | data_type => 'enum', |
44 | is_enum => 1, |
45 | extra => { |
46 | list => [qw/red green blue/] |
47 | } |
48 | } |
49 | ); |
50 | |
51 | 1; |
52 | |
53 | Now you may treat the column as an L<Object::Enum> object. |
54 | |
55 | my $table_rs = $db->resultset('TableClass')->create({ |
56 | color => undef |
57 | }); |
58 | |
59 | $table_rs->color->set_red; # sets color to red |
60 | $table_rs->color->is_red; # would return true |
61 | $table_rs->color->is_green; # would return false |
62 | print $table_rs->color->value; # would print 'red' |
63 | $table_rs->color->unset; # set the value to 'undef' or 'null' |
64 | $table_rs->color->is_red; # returns false now |
65 | |
66 | |
67 | =head1 METHODS |
68 | |
69 | =head2 register_column |
70 | |
71 | Internal chained method with L<DBIx::Class::Row/register_column>. |
72 | Users do not call this directly! |
73 | |
74 | =cut |
75 | |
76 | sub register_column { |
a0e9a0f3 |
77 | my $self = shift; |
78 | my ($column, $info) = @_; |
86d6940e |
79 | |
a0e9a0f3 |
80 | $self->next::method(@_); |
86d6940e |
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 | |
a0e9a0f3 |
102 | $self->inflate_column( |
86d6940e |
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 |