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 |
19 | #our $VERSION = '0.04'; |
86d6940e |
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 { |
a0e9a0f3 |
78 | my $self = shift; |
79 | my ($column, $info) = @_; |
86d6940e |
80 | |
a0e9a0f3 |
81 | $self->next::method(@_); |
86d6940e |
82 | |
83 | return unless defined $info->{is_enum} and $info->{is_enum}; |
84 | |
85 | croak("Object::Enum '$column' missing 'extra => { list => [] }' column configuration") |
86 | unless ( |
87 | defined $info->{extra} |
88 | and ref $info->{extra} eq 'HASH' |
89 | and defined $info->{extra}->{list} |
90 | ); |
91 | |
92 | croak("Object::Enum '$column' value list (extra => { list => [] }) must be an ARRAY reference") |
93 | unless ref $info->{extra}->{list} eq 'ARRAY'; |
94 | |
95 | my $values = $info->{extra}->{list}; |
96 | my %values = map {$_=>1} @{$values}; |
97 | |
98 | if ( defined($info->{default_value}) && !exists $values{$info->{default_value}}) { |
99 | push(@{$values},$info->{default_value}); |
100 | $values->{$info->{default_value}} = 1; |
101 | } |
102 | |
a0e9a0f3 |
103 | $self->inflate_column( |
86d6940e |
104 | $column => { |
105 | inflate => sub { |
106 | my $val = shift; |
107 | my $e = Object::Enum->new({values=>$values}); |
108 | $e->value($val) if $val and exists $values{$val}; |
109 | return $e; |
110 | }, |
111 | deflate => sub { |
112 | return shift->value |
113 | } |
114 | } |
115 | ); |
116 | |
117 | } |
118 | |
119 | =head1 AUTHOR |
120 | |
121 | Jason M. Mills, C<< <jmmills at cpan.org> >> |
122 | |
123 | =head1 BUGS |
124 | |
125 | Please report any bugs or feature requests to C<bug-dbix-class-inflatecolumn-object-enum at rt.cpan.org>, or through |
126 | 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 |
127 | automatically be notified of progress on your bug as I make changes. |
128 | |
129 | |
130 | |
131 | |
132 | =head1 SUPPORT |
133 | |
134 | You can find documentation for this module with the perldoc command. |
135 | |
136 | perldoc DBIx::Class::InflateColumn::Object::Enum |
137 | |
138 | |
139 | You can also look for information at: |
140 | |
141 | =over 4 |
142 | |
143 | =item * RT: CPAN's request tracker |
144 | |
145 | L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBIx-Class-InflateColumn-Object-Enum> |
146 | |
147 | =item * AnnoCPAN: Annotated CPAN documentation |
148 | |
149 | L<http://annocpan.org/dist/DBIx-Class-InflateColumn-Object-Enum> |
150 | |
151 | =item * CPAN Ratings |
152 | |
153 | L<http://cpanratings.perl.org/d/DBIx-Class-InflateColumn-Object-Enum> |
154 | |
155 | =item * Search CPAN |
156 | |
157 | L<http://search.cpan.org/dist/DBIx-Class-InflateColumn-Object-Enum> |
158 | |
159 | =back |
160 | |
161 | |
162 | =head1 SEE ALSO |
163 | |
164 | L<Object::Enum>, L<DBIx::Class>, L<DBIx::Class::InflateColumn::URI> |
165 | |
166 | |
167 | =head1 COPYRIGHT & LICENSE |
168 | |
169 | Copyright 2008 Jason M. Mills, all rights reserved. |
170 | |
171 | This program is free software; you can redistribute it and/or modify it |
172 | under the same terms as Perl itself. |
173 | |
174 | |
175 | =cut |
176 | |
177 | 1; # End of DBIx::Class::InflateColumn::Object::Enum |