diff --git a/CHANGES b/CHANGES index 58c1650..c11c9b4 100644 --- a/CHANGES +++ b/CHANGES @@ -1,5 +1,9 @@ Revision history for Interchange6::Schema + [ENHANCEMENTS] + + * Add EmailAddress result class (Peter Mottram). + 0.132 Sat Oct 1 09:59:22 2016 CEST [ENHANCEMENTS] diff --git a/MANIFEST b/MANIFEST index 511c36b..14655d6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -21,6 +21,7 @@ lib/Interchange6/Schema/Result/AttributeValue.pm lib/Interchange6/Schema/Result/Cart.pm lib/Interchange6/Schema/Result/CartProduct.pm lib/Interchange6/Schema/Result/Country.pm +lib/Interchange6/Schema/Result/EmailAddress.pm lib/Interchange6/Schema/Result/Inventory.pm lib/Interchange6/Schema/Result/Media.pm lib/Interchange6/Schema/Result/MediaDisplay.pm @@ -97,6 +98,7 @@ t/test_sqlite.t t/lib/TestDatabase.pm t/lib/Test/BaseAttribute.pm t/lib/Test/Cart.pm +t/lib/Test/EmailAddress.pm t/lib/Test/Expire.pm t/lib/Test/Fixtures.pm t/lib/Test/Inventory.pm diff --git a/lib/Interchange6/Schema/Result/EmailAddress.pm b/lib/Interchange6/Schema/Result/EmailAddress.pm new file mode 100644 index 0000000..48c7935 --- /dev/null +++ b/lib/Interchange6/Schema/Result/EmailAddress.pm @@ -0,0 +1,167 @@ +use utf8; + +package Interchange6::Schema::Result::EmailAddress; + +=head1 NAME + +Interchange6::Schema::Result::EmailAddress - a User can have many email addresses + +=cut + +use Interchange6::Schema::Candy -components => + [qw(InflateColumn::DateTime TimeStamp)]; + +use overload '""' => sub { shift->email }, fallback => 1; + +=head1 DESCRIPTION + +Additional email addresses for users. + +Stringifies to value of L. + +=head1 ACCESSORS + +=head2 email + +Primary Key. + +Lower-cased by overloaded L and L methods. + +This is effectively the envelope 'to'. + +=cut + +primary_column email => { data_type => "varchar", size => 254 }; + +=head2 users_id + +FK on L + +=cut + +column users_id => { data_type => "integer" }; + +=head2 header_to + +The header 'to' which can include name, e.g.: + + Dave Bean + +See L regarding default value for this column. + +=cut + +column header_to => { data_type => "varchar", size => 512 }; + +=head2 type + +Type of email address, e.g.: work, personal, github + +Defaults to empty string. + +=cut + +column type => { data_type => "varchar", size => 64, default_value => '' }; + +=head2 active + +Boolean whether email address is active. Defaults to true value. + +=cut + +column active => { data_type => "boolean", default_value => 1 }; + +=head2 validated + +Whether email address has been validated in some way. Defaults to false value. + +=cut + +column validated => { data_type => "boolean", default_value => 0 }; + +=head2 validated_date + +The L when this email address was validated. Is nullable. + +=cut + +column validated_date => { data_type => "datetime", is_nullable => 1 }; + +=head2 created + +Date and time when this record was created returned as L object. +Value is auto-set on insert. + +=cut + +column created => { data_type => "datetime", set_on_create => 1 }; + +=head2 last_modified + +Date and time when this record was last modified returned as L object. +Value is auto-set on insert and update. + +=cut + +column last_modified => { + data_type => "datetime", + set_on_create => 1, + set_on_update => 1, +}; + +=head1 RELATIONS + +=head2 user + +Type: belongs_to + +Related object: L + +=cut + +belongs_to user => "Interchange6::Schema::Result::User", "users_id"; + +=head1 METHODS + +=head2 insert + +Overloaded method which performs the following additional actions: + +=over + +=item Force L to lower case. + +=item Set L to L if is has not been set. + +=back + +=cut + +sub insert { + my $self = shift; + $self->email( lc( $self->email ) ); + $self->header_to( $self->email ) unless $self->header_to; + return $self->next::method(); +} + +=head2 update + +Overloaded method to force L to lower case. + +=cut + +sub update { + my ( $self, $columns ) = @_; + + # email may have been passed as arg or previously updated + if ( exists $columns->{email} ) { + $columns->{email} = lc( $columns->{email} ); + } + elsif ( $self->is_column_changed('email') ) { + $self->email( lc( $self->email ) ); + } + + return $self->next::method($columns); +} + +1; diff --git a/lib/Interchange6/Schema/Result/User.pm b/lib/Interchange6/Schema/Result/User.pm index 7c7b2a3..695d963 100644 --- a/lib/Interchange6/Schema/Result/User.pm +++ b/lib/Interchange6/Schema/Result/User.pm @@ -272,6 +272,18 @@ has_many "users_id", { cascade_copy => 0, cascade_delete => 0 }; +=head2 email_addresses + +Type: has_many + +Related object: L + +=cut + +has_many + email_addresses => "Interchange6::Schema::Result::EmailAddress", + "users_id"; + =head2 orders Type: has_many diff --git a/t/lib/Test/EmailAddress.pm b/t/lib/Test/EmailAddress.pm new file mode 100644 index 0000000..e2f1a17 --- /dev/null +++ b/t/lib/Test/EmailAddress.pm @@ -0,0 +1,107 @@ +package Test::EmailAddress; + +use Test::Exception; +use Test::More; +use Test::Roo::Role; + +test 'email address tests' => sub { + + my $self = shift; + + # make sure there is no mess + $self->clear_users; + $self->users; + + my $schema = $self->ic6s_schema; + + my $user1 = $self->users->find( { username => 'customer1' } ); + my $user2 = $self->users->find( { username => 'customer2' } ); + + isa_ok $user1, 'Interchange6::Schema::Result::User', 'user1'; + isa_ok $user2, 'Interchange6::Schema::Result::User', 'user2'; + + my $email_rset = $schema->resultset('EmailAddress'); + + my $email; + + lives_ok { + $email = $email_rset->create( + { email => 'DaveBean@example.com', users_id => $user1->id } ), + } + 'Create with email DaveBean@example.com lives'; + + $email->discard_changes; # get defaults from DB + + cmp_ok $email->email, 'eq', 'davebean@example.com', 'email is lowercase'; + cmp_ok $email->header_to, 'eq', 'davebean@example.com', + 'header_to has been set'; + cmp_ok $email->type, 'eq', '', 'type is empty string'; + ok $email->active, 'active is true'; + ok !$email->validated, 'validated is false'; + + throws_ok { + $email = $email_rset->create( + { email => 'DaveBean@example.com', users_id => $user2->id } ), + } + qr/Exception/, 'Cannot create DaveBean@example.com a second time'; + + lives_ok { + $email = $email_rset->create( + { + email => 'BeerDrinker@example.com', + users_id => $user1->id, + header_to => 'Beer Drinker ' + } + ), + } + 'Create with email BeerDrinker@example.com plus header_to lives'; + + cmp_ok $email->email, 'eq', 'beerdrinker@example.com', 'email is lowercase'; + cmp_ok $email->header_to, 'eq', 'Beer Drinker ', + 'header_to is correct'; + + lives_ok { $email->email('CiderDrinker@example.com') } + 'change email attribute to CiderDrinker@example.com lives'; + + cmp_ok $email->email, 'eq', 'CiderDrinker@example.com', + 'email is not lowercase'; + + lives_ok { $email->update } "Now call update which should live"; + + cmp_ok $email->email, 'eq', 'ciderdrinker@example.com', + '... and email is now lowercase'; + + lives_ok { $email->discard_changes } "force reload from DB"; + + cmp_ok $email->email, 'eq', 'ciderdrinker@example.com', + '... and email is still lowercase'; + + lives_ok { $email->update( { email => 'BeerDrinker@example.com' } ) } + 'Change email to BeerDrinker@example.com directly via update method lives'; + + cmp_ok $email->email, 'eq', 'beerdrinker@example.com', 'email is lowercase'; + + lives_ok { $email->discard_changes } "force reload from DB"; + + cmp_ok $email->email, 'eq', 'beerdrinker@example.com', + '... and email is still lowercase'; + + lives_ok { + $email = $email_rset->create( + { + email => 'CiderDrinker@example.com', + users_id => $user2->id, + } + ), + } + 'Create email for users with email CiderDrinker@example.com'; + + throws_ok { + $email->update({ email => 'BeerDrinker@example.com' }) + } + qr/Exception/, + '...then trying to change email to BeerDrinker@example.com dies'; + +}; + +1;