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 # 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::Enum> 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<DBIx::Class::Row/register_column>.
  74 Users do not call this directly!
  75
  76 =cut
  77
  78 sub register_column {
  79     my $self = shift;
  80     my ($column, $info) = @_;
  81
  82     $self->next::method(@_);
  83
  84     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         );
  92
  93     croak("Object::Enum '$column' value list (extra => { list => [] }) must be an ARRAY reference")
  94         unless ref $info->{extra}->{list} eq 'ARRAY';
  95
  96     my $values = $info->{extra}->{list};
  97     my %values = map {$_=>1} @{$values};
  98
  99     push(@{$values},$info->{default_value})
 100         if defined($info->{default_value})
 101         && !exists $values{$info->{default_value}};
 102
 103     $self->inflate_column(
 104         $column => {
 105             inflate => sub {
 106                 my $val = shift;
 107                 my $e = Object::Enum->new({values=>$values});
 108                 $e->value($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