From: Jason M. Mills Date: Wed, 12 Nov 2008 03:46:25 +0000 (+0000) Subject: version 0.03 - fixed error verbage as per mst req - import into new repo X-Git-Tag: v0.04~15 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=86d6940ece6598c6adeaec120b1f4ba23d4b49ae;p=dbsrgits%2FDBIx-Class-InflateColumn-Object-Enum.git version 0.03 - fixed error verbage as per mst req - import into new repo --- diff --git a/.svnignore b/.svnignore new file mode 100644 index 0000000..c9913c4 --- /dev/null +++ b/.svnignore @@ -0,0 +1,10 @@ +blib* +Makefile +Makefile.old +Build +_build* +pm_to_blib* +*.tar.gz +.lwpcookies +DBIx-Class-InflateColumn-Object-Enum-* +cover_db diff --git a/Changes b/Changes new file mode 100644 index 0000000..51daaff --- /dev/null +++ b/Changes @@ -0,0 +1,28 @@ +Revision history for DBIx-Class-InflateColumn-Object-Enum + +0.03 Nov 11th 2008 + - Modified error verbage as per request from mst + - Changed ChangeLog sorting from latest -> oldest + - Migrated from internal svn repo to dbic-class svn repo + +0.02 Oct 25th 2008 + - Expanded testing database and tap tests to test for varchar + nullable and non-nullable and database native enum nullable + and non-nullable + - Fixed a implmentation for Object::Enum->new so that columns value + on inflation is set correctly. This could have been considered + a nasty bug. Discovered through new tests. + - Added sanity check for inflation value set for invalid values so + that we don't get Object::Enum's die for invalid value as I don't + like that behavior. Maybe a column_info to control check would be + more reasonable? + - Changed allowable values usages from values column_info property + to extra->list property to make this modules usage fall more + inline with how SQL::Translator handles native enum database + types. As per suggestion from Bernhard Graf. + - Added to code to enable smarter default_value handling + +0.01 Oct 23rd 2008 + - Register_column implemented + - Test database schema implemented + - Wrote base TAP tests diff --git a/DBIx-Class-InflateColumn-Object-Enum.kpf b/DBIx-Class-InflateColumn-Object-Enum.kpf new file mode 100644 index 0000000..3dca740 --- /dev/null +++ b/DBIx-Class-InflateColumn-Object-Enum.kpf @@ -0,0 +1,12 @@ + + + + + *.*~;*.bak;*.tmp;CVS;.#*;*.pyo;*.pyc;.svn;*%*;tmp*.html;.DS_Store + + 1 + 1 + useFolders + lib:/home/jason/Desktop/cpan/trunk/DBIx-Class-InflateColumn-Object-Enum/t/lib + + diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..893946e --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,2 @@ +\.svn* +^DBIx-Class-InflateColumn-Object-Enum.kpf$ \ No newline at end of file diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..3828eb9 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,18 @@ +use inc::Module::Install; + +name 'DBIx-Class-InflateColumn-Object-Enum'; +all_from 'lib/DBIx/Class/InflateColumn/Object/Enum.pm'; +author 'Jason M. Mills '; + +requires 'DBIx::Class::Schema'; +requires 'self'; +requires 'Object::Enum'; + +build_requires 'Test::More'; +build_requires 'DBICx::TestDatabase'; + +auto_manifest; +auto_install; + +WriteAll; + diff --git a/lib/DBIx/Class/InflateColumn/Object/Enum.pm b/lib/DBIx/Class/InflateColumn/Object/Enum.pm new file mode 100644 index 0000000..2f3aaa8 --- /dev/null +++ b/lib/DBIx/Class/InflateColumn/Object/Enum.pm @@ -0,0 +1,176 @@ +package DBIx::Class::InflateColumn::Object::Enum; + +use warnings; +use strict; +use self; +use Carp qw/croak confess/; +use Object::Enum; + +=head1 NAME + +DBIx::Class::InflateColumn::Object::Enum - Allows a DBIx::Class user to define a Object::Enum column + +=head1 VERSION + +Version 0.03 + +=cut + +our $VERSION = '0.03'; + + +=head1 SYNOPSIS + +Load this module via load_components and utilize is_enum and values property +to define Enumuration columns via Object::Enum + + package TableClass; + + use strict; + use warnings; + use base 'DBIx::Class'; + + __PACKAGE__->load_components(qw/InflateColumn::Object::Enum Core/); + __PACKAGE__->table('testtable'); + __PACKAGE__->add_columns( + color => { + data_type => 'varchar', + is_enum => 1, + extra => { + list => [qw/red green blue/] + } + } + color_native => { # works inline with native enum type + data_type => 'enum', + is_enum => 1, + extra => { + list => [qw/red green blue/] + } + } + ); + + 1; + +Now you may treat the column as an L object. + + my $table_rs = $db->resultset('TableClass')->create({ + color => undef + }); + + $table_rs->color->set_red; # sets color to red + $table_rs->color->is_red; # would return true + $table_rs->color->is_green; # would return false + print $table_rs->color->value; # would print 'red' + $table_rs->color->unset; # set the value to 'undef' or 'null' + $table_rs->color->is_red; # returns false now + + +=head1 METHODS + +=head2 register_column + +Internal chained method with L. +Users do not call this directly! + +=cut + +sub register_column { + my ($column, $info) = args; + + self->next::method(args); + + return unless defined $info->{is_enum} and $info->{is_enum}; + + croak("Object::Enum '$column' missing 'extra => { list => [] }' column configuration") + unless ( + defined $info->{extra} + and ref $info->{extra} eq 'HASH' + and defined $info->{extra}->{list} + ); + + croak("Object::Enum '$column' value list (extra => { list => [] }) must be an ARRAY reference") + unless ref $info->{extra}->{list} eq 'ARRAY'; + + my $values = $info->{extra}->{list}; + my %values = map {$_=>1} @{$values}; + + if ( defined($info->{default_value}) && !exists $values{$info->{default_value}}) { + push(@{$values},$info->{default_value}); + $values->{$info->{default_value}} = 1; + } + + self->inflate_column( + $column => { + inflate => sub { + my $val = shift; + my $e = Object::Enum->new({values=>$values}); + $e->value($val) if $val and exists $values{$val}; + return $e; + }, + deflate => sub { + return shift->value + } + } + ); + +} + +=head1 AUTHOR + +Jason M. Mills, C<< >> + +=head1 BUGS + +Please report any bugs or feature requests to C, or through +the web interface at L. I will be notified, and then you'll +automatically be notified of progress on your bug as I make changes. + + + + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc DBIx::Class::InflateColumn::Object::Enum + + +You can also look for information at: + +=over 4 + +=item * RT: CPAN's request tracker + +L + +=item * AnnoCPAN: Annotated CPAN documentation + +L + +=item * CPAN Ratings + +L + +=item * Search CPAN + +L + +=back + + +=head1 SEE ALSO + +L, L, L + + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Jason M. Mills, all rights reserved. + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + + +=cut + +1; # End of DBIx::Class::InflateColumn::Object::Enum diff --git a/svn-commit.tmp b/svn-commit.tmp new file mode 100644 index 0000000..02b6235 --- /dev/null +++ b/svn-commit.tmp @@ -0,0 +1,5 @@ +version 0.03 - fixed error verbage as per mst req - import into new repo + +--This line, and those below, will be ignored-- + +A . diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..232a04e --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,7 @@ +use Test::More tests => 1; + +BEGIN { + use_ok( 'DBIx::Class::InflateColumn::Object::Enum' ); +} + +diag( "Testing DBIx::Class::InflateColumn::Object::Enum $DBIx::Class::InflateColumn::Object::Enum::VERSION, Perl $], $^X" ); diff --git a/t/01-object-enum.t b/t/01-object-enum.t new file mode 100644 index 0000000..fa7a9cb --- /dev/null +++ b/t/01-object-enum.t @@ -0,0 +1,61 @@ +use Test::More tests => 33; + +BEGIN { + use lib 't/lib'; + use_ok( 'DBICx::TestDatabase'); # test 1 + use_ok( 'TestDB' ); # test 2 + +} + +sub _check_column { # each call to this = 7 tests + my $col = shift; + my $name = shift; + ok(ref($col) =~ /^Object::Enum::/,qq($name: refereces Object::Enum)); + ok($col->can('set_red'),qq($name: has correct set method)); + ok($col->set_red,qq($name: set method contained a value)); + ok($col->is_red,qq($name: boolean return true for correct set value)); + ok($col->value eq 'red',qq($name: value access returned correct string)); + ok(!$col->unset,qq($name: unset behaved as expected)); + ok(!defined($col->value),qq($name: unset has modifed value accessor as expected)); +} + +my $rs; +my $db = new DBICx::TestDatabase('TestDB'); + +ok(ref($db) eq 'TestDB','Testing database looks good'); + +$rs = $db->resultset('VarcharEnumNullable')->create({id=>0}); +ok(defined($rs),'VarcharEnumNullable: create returned as expected'); # test 3 +ok(!defined($rs->enum),'VarcharEnumNullable: enum column is null as expected'); # test 4 + +$rs->enum(''); # initialize inflated object for nullable +_check_column($rs->enum,$rs->result_source->source_name); # tests 5 thru 12 + +undef $rs; +eval(q/$db->resultset('VarcharEnumNoneNullable')->create({id=>1})/); +ok(defined($@),'VarcharEnumNoneNullable(null enum): create with null enum failed as expected'); # test 13 + +$rs = $db->resultset('VarcharEnumNoneNullable')->create({id=>2,enum=>'none'}); +ok(defined($rs),'VarcharEnumNoneNullable(invalid enum): create with invalid enum returns row as expected'); # test 14 +_check_column($rs->enum,$rs->result_source->source_name.'(invalid enum)'); # tests 15 thru 21 + +undef $rs; +$rs = $db->resultset('VarcharEnumNoneNullable')->create({id=>3,enum=>'none'}); +ok($rs->enum->value ne 'none','VarcharEnumNoneNullable(invalid enum) value return undef on valid as expected'); # test 22 + +undef $rs; +$rs = $db->resultset('VarcharEnumNoneNullable')->create({id=>4,enum=>'red'}); +ok($rs->enum->is_red,'VarcharEnumNoneNullable(valid enum) defined correctly'); # test 23 + +undef $rs; +$rs = $db->resultset('NativeEnumNullable')->create({id=>5}); +ok(defined($rs),'NativeEnumNullable: create returned as expected'); # test 24 +ok(!defined($rs->enum),'NativeEnumNullable: enum column is null as expected'); # test 25 + +$rs->enum(''); # initialize inflated object for nullable +_check_column($rs->enum,$rs->result_source->source_name); # tests 26 thru 32 + +undef $rs; +eval(q/$db->resultset('NativeEnumNoneNullable')->create({id=>6})/); +ok(defined($@),'NativeEnumNoneNullable(null enum): create with null enum failed as expected'); # test 33 + diff --git a/t/lib/TestDB.pm b/t/lib/TestDB.pm new file mode 100644 index 0000000..db6f2a6 --- /dev/null +++ b/t/lib/TestDB.pm @@ -0,0 +1,10 @@ +package TestDB; + +use strict; +use warnings; + +use base 'DBIx::Class::Schema'; + +__PACKAGE__->load_classes; + +1; \ No newline at end of file diff --git a/t/lib/TestDB/NativeEnumNoneNullable.pm b/t/lib/TestDB/NativeEnumNoneNullable.pm new file mode 100644 index 0000000..a453fef --- /dev/null +++ b/t/lib/TestDB/NativeEnumNoneNullable.pm @@ -0,0 +1,31 @@ +package TestDB::NativeEnumNoneNullable; + +use strict; +use warnings; + +use base 'DBIx::Class'; + +__PACKAGE__->load_components(qw/ + InflateColumn::Object::Enum + PK::Auto + Core +/); +__PACKAGE__->table('nenn'); +__PACKAGE__->add_columns( + id => { + data_type => 'number', + is_auto_increment => 1, + is_nullable => 0 + }, + enum => { + data_type => 'enum', + is_enum => 1, + is_nullable => 0, + extra => { + list => [qw/red green blue/] + }, + } +); +__PACKAGE__->set_primary_key('id'); + +1; diff --git a/t/lib/TestDB/NativeEnumNullable.pm b/t/lib/TestDB/NativeEnumNullable.pm new file mode 100644 index 0000000..2cfadd6 --- /dev/null +++ b/t/lib/TestDB/NativeEnumNullable.pm @@ -0,0 +1,31 @@ +package TestDB::NativeEnumNullable; + +use strict; +use warnings; + +use base 'DBIx::Class'; + +__PACKAGE__->load_components(qw/ + InflateColumn::Object::Enum + PK::Auto + Core +/); +__PACKAGE__->table('nen'); +__PACKAGE__->add_columns( + id => { + data_type => 'number', + is_auto_increment => 1, + is_nullable => 0 + }, + enum => { + data_type => 'enum', + is_enum => 1, + is_nullable => 1, + extra => { + list => [qw/red green blue/] + }, + } +); +__PACKAGE__->set_primary_key('id'); + +1; diff --git a/t/lib/TestDB/VarcharEnumNoneNullable.pm b/t/lib/TestDB/VarcharEnumNoneNullable.pm new file mode 100644 index 0000000..93187f4 --- /dev/null +++ b/t/lib/TestDB/VarcharEnumNoneNullable.pm @@ -0,0 +1,31 @@ +package TestDB::VarcharEnumNoneNullable; + +use strict; +use warnings; + +use base 'DBIx::Class'; + +__PACKAGE__->load_components(qw/ + InflateColumn::Object::Enum + PK::Auto + Core +/); +__PACKAGE__->table('venn'); +__PACKAGE__->add_columns( + id => { + data_type => 'number', + is_auto_increment => 1, + is_nullable => 0 + }, + enum => { + data_type => 'varchar', + is_enum => 1, + is_nullable => 0, + extra => { + list => [qw/red green blue/] + }, + } +); +__PACKAGE__->set_primary_key('id'); + +1; diff --git a/t/lib/TestDB/VarcharEnumNullable.pm b/t/lib/TestDB/VarcharEnumNullable.pm new file mode 100644 index 0000000..551279f --- /dev/null +++ b/t/lib/TestDB/VarcharEnumNullable.pm @@ -0,0 +1,31 @@ +package TestDB::VarcharEnumNullable; + +use strict; +use warnings; + +use base 'DBIx::Class'; + +__PACKAGE__->load_components(qw/ + InflateColumn::Object::Enum + PK::Auto + Core +/); +__PACKAGE__->table('ven'); +__PACKAGE__->add_columns( + id => { + data_type => 'number', + is_auto_increment => 1, + is_nullable => 0 + }, + enum => { + data_type => 'varchar', + is_enum => 1, + is_nullable => 1, + extra => { + list => [qw/red green blue/] + }, + } +); +__PACKAGE__->set_primary_key('id'); + +1; diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..fc40a57 --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,18 @@ +use strict; +use warnings; +use Test::More; + +# Ensure a recent version of Test::Pod::Coverage +my $min_tpc = 1.08; +eval "use Test::Pod::Coverage $min_tpc"; +plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" + if $@; + +# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, +# but older versions don't recognize some common documentation styles +my $min_pc = 0.18; +eval "use Pod::Coverage $min_pc"; +plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" + if $@; + +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..ee8b18a --- /dev/null +++ b/t/pod.t @@ -0,0 +1,12 @@ +#!perl -T + +use strict; +use warnings; +use Test::More; + +# Ensure a recent version of Test::Pod +my $min_tp = 1.22; +eval "use Test::Pod $min_tp"; +plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; + +all_pod_files_ok();