Add EmailAddress result class

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]

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

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</email>.
+
+=head1 ACCESSORS
+
+=head2 email
+
+Primary Key.
+
+Lower-cased by overloaded L</insert> and L</update> methods.
+
+This is effectively the envelope 'to'.
+
+=cut
+
+primary_column email => { data_type => "varchar", size => 254 };
+
+=head2 users_id
+
+FK on L<Interchange6::Schema::Result::User/users_id>
+
+=cut
+
+column users_id => { data_type => "integer" };
+
+=head2 header_to
+
+The header 'to' which can include name, e.g.:
+
+  Dave Bean <dave.bean@example.com>
+
+See L</insert> 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<DateTime> 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<DateTime> 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<DateTime> 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<Interchange6::Schema::Result::User>
+
+=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</email> to lower case.
+
+=item Set L</header_to> to L</email> 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</email> 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;

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<Interchange6::Schema::Result::EmailAddress>
+
+=cut
+
+has_many
+  email_addresses => "Interchange6::Schema::Result::EmailAddress",
+  "users_id";
+
 =head2 orders
 
 Type: has_many

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 <BeerDrinker@example.com>'
+            }
+          ),
+    }
+    '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 <BeerDrinker@example.com>',
+      '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;