File Coverage

blib/lib/DBIx/Class/InflateColumn/Object/Enum.pm
Criterion Covered Total %
statement 28 32 87.5
branch 7 10 70.0
condition 7 15 46.6
subroutine 6 7 85.7
pod 1 1 100.0
total 49 65 75.3


line stmt bran cond sub pod time code
1             package DBIx::Class::InflateColumn::Object::Enum;
2             $DBIx::Class::InflateColumn::Object::Enum::VERSION = '0.05'; # TRIAL
3 2     2   133010 use warnings;
  2         2  
  2         69  
4 2     2   10 use strict;
  2         2  
  2         48  
5 2     2   7 use Carp qw/croak confess/;
  2         5  
  2         124  
6 2     2   868 use Object::Enum;
  2         37770  
  2         10  
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              
18             # Dist::Zill should handle this now
19             # ABSTRACT: Allows a DBIx::Class user to define a Object::Enum column
20             #our $VERSION = '0.04';
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.
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.
74             Users do not call this directly!
75              
76             =cut
77              
78             sub register_column {
79 8     8 1 78348 my $self = shift;
80 8         13 my ($column, $info) = @_;
81            
82 8         28 $self->next::method(@_);
83            
84 8 100 66     1439 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 4 50 33     55 );
      33        
92            
93             croak("Object::Enum '$column' value list (extra => { list => [] }) must be an ARRAY reference")
94 4 50       13 unless ref $info->{extra}->{list} eq 'ARRAY';
95            
96 4         9 my $values = $info->{extra}->{list};
97 4         7 my %values = map {$_=>1} @{$values};
  12         40  
  4         9  
98            
99 4 50 33     19 if ( defined($info->{default_value}) && !exists $values{$info->{default_value}}) {
100 0         0 push(@{$values},$info->{default_value});
  0         0  
101 0         0 $values->{$info->{default_value}} = 1;
102             }
103            
104             $self->inflate_column(
105             $column => {
106             inflate => sub {
107 5     5   482512 my $val = shift;
108 5         31 my $e = Object::Enum->new({values=>$values});
109 5 100 66     1882 $e->value($val) if $val and exists $values{$val};
110 5         86 return $e;
111             },
112             deflate => sub {
113             return shift->value
114 0     0     }
115             }
116 4         77 );
117            
118             }
119              
120             =head1 AUTHOR
121              
122             Jason M. Mills, C<< >>
123              
124             =head1 BUGS
125              
126             Please report any bugs or feature requests to C, or through
127             the web interface at L. I will be notified, and then you'll
128             automatically be notified of progress on your bug as I make changes.
129              
130              
131              
132              
133             =head1 SUPPORT
134              
135             You can find documentation for this module with the perldoc command.
136              
137             perldoc DBIx::Class::InflateColumn::Object::Enum
138              
139              
140             You can also look for information at:
141              
142             =over 4
143              
144             =item * RT: CPAN's request tracker
145              
146             L
147              
148             =item * AnnoCPAN: Annotated CPAN documentation
149              
150             L
151              
152             =item * CPAN Ratings
153              
154             L
155              
156             =item * Search CPAN
157              
158             L
159              
160             =back
161              
162              
163             =head1 SEE ALSO
164              
165             L, L, L
166              
167              
168             =head1 COPYRIGHT & LICENSE
169              
170             Copyright 2008 Jason M. Mills, all rights reserved.
171              
172             This program is free software; you can redistribute it and/or modify it
173             under the same terms as Perl itself.
174              
175              
176             =cut
177              
178             1; # End of DBIx::Class::InflateColumn::Object::Enum