lib/DBIx/Class/InflateColumn/Object/Enum.pm

   1 package DBIx::Class::InflateColumn::Object::Enum;
   2
   3 use warnings;
   4 use strict;
   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
  18 our $VERSION = '0.04';
  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 {
  77     my $self = shift;
  78     my ($column, $info) = @_;
  79
  80     $self->next::method(@_);
  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