Merge branch 'rabx-column-refactor'

7 files changed, 176 insertions, 106 deletions

diff --git a/perllib/FixMyStreet/DB/RABXColumn.pm b/perllib/FixMyStreet/DB/RABXColumn.pm
new file mode 100644
index 000000000..5f1583018
--- /dev/null
+++ b/perllib/FixMyStreet/DB/RABXColumn.pm
@@ -0,0 +1,98 @@
+package FixMyStreet::DB::RABXColumn;
+
+use strict;
+use warnings;
+
+use IO::String;
+use RABX;
+
+=head1 NAME
+
+FixMyStreet::DB::RABXColumn
+
+=head2 DESCRIPTION
+
+This is a helper component that will setup the RABX serialisation for some
+fields. This is useful for when you want to persist some data structure such as
+hashrefs etc.
+
+This code will also change the default FilterColumn behaviour so that whenever
+your set a column, or specify a RABX'd column in an ->update the value is saved
+to the database. The default behaviour is to check if the value is already set,
+and for hashrefs this means that changes to the contents are missed as it is
+still the same hashref.
+
+By putting all this code in one place there is also much less repetition.
+
+=cut
+
+# Store which columns are RABX cols.
+# $RABX_COLUMNS{$class}{$col} = 1
+my %RABX_COLUMNS = ();
+
+sub _get_class_identifier {
+    my $class = ref $_[0] || $_[0];
+    $class =~ s/.*?(\w+)$/$1/;
+    return $class;
+}
+
+=head1 METHODS
+
+=head2 rabx_column
+
+    # In one of your ::Result:: modules
+    __PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+    __PACKAGE__->rabx_column('data');
+
+This sets up the filtering to and from the database, and also changes the
+set_filtered_column behaviour to not trust the cache.
+
+=cut
+
+sub rabx_column {
+    my ($class, $col) = @_;
+
+    # Apply the filtering for this column
+    $class->filter_column(
+        $col => {
+            filter_from_storage => sub {
+                my $self = shift;
+                my $ser  = shift;
+                return undef unless defined $ser;
+                utf8::encode($ser) if utf8::is_utf8($ser);
+                my $h = new IO::String($ser);
+                return RABX::wire_rd($h);
+            },
+            filter_to_storage => sub {
+                my $self = shift;
+                my $data = shift;
+                my $ser  = '';
+                my $h    = new IO::String($ser);
+                RABX::wire_wr( $data, $h );
+                return $ser;
+            },
+        }
+    );
+
+    # store that this column is a RABX column.
+    $RABX_COLUMNS{ _get_class_identifier($class) }{$col} = 1;
+}
+
+
+sub set_filtered_column {
+    my ($self, $col, $val) = @_;
+
+    my $class = ref $self;
+
+    # because filtered objects may be expensive to marshall for storage there
+    # is a cache that attempts to detect if they have changed or not. For us
+    # this cache breaks things and our marshalling is cheap, so clear it when
+    # trying set a column.
+    delete $self->{_filtered_column}{$col}
+        if $RABX_COLUMNS{ _get_class_identifier($class) }{$col};
+
+    return $self->next::method($col, $val);
+}
+
+
+1;
diff --git a/perllib/FixMyStreet/DB/Result/Comment.pm b/perllib/FixMyStreet/DB/Result/Comment.pm
index c712ad4e1..2d5b6b2c3 100644
--- a/perllib/FixMyStreet/DB/Result/Comment.pm
+++ b/perllib/FixMyStreet/DB/Result/Comment.pm
@@ -85,32 +85,13 @@ __PACKAGE__->belongs_to(
 # Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:D/+UWcF7JO/EkCiJaAHUOw
 
-__PACKAGE__->filter_column(
-    extra => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
+__PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+__PACKAGE__->rabx_column('extra');
 
 use DateTime::TimeZone;
 use Image::Size;
 use Moose;
 use namespace::clean -except => [ 'meta' ];
-use RABX;
 
 with 'FixMyStreet::Roles::Abuser';
 
diff --git a/perllib/FixMyStreet/DB/Result/Contact.pm b/perllib/FixMyStreet/DB/Result/Contact.pm
index 2e1287a21..eca028c9b 100644
--- a/perllib/FixMyStreet/DB/Result/Contact.pm
+++ b/perllib/FixMyStreet/DB/Result/Contact.pm
@@ -60,25 +60,7 @@ __PACKAGE__->belongs_to(
 # Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
 # DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:hq/BFHDEu4OUI4MSy3OyHg
 
-__PACKAGE__->filter_column(
-    extra => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
+__PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+__PACKAGE__->rabx_column('extra');
 
 1;
diff --git a/perllib/FixMyStreet/DB/Result/Problem.pm b/perllib/FixMyStreet/DB/Result/Problem.pm
index c8b53e2d1..f14a29f56 100644
--- a/perllib/FixMyStreet/DB/Result/Problem.pm
+++ b/perllib/FixMyStreet/DB/Result/Problem.pm
@@ -135,54 +135,15 @@ __PACKAGE__->has_one(
   { cascade_copy => 0, cascade_delete => 0 },
 );
 
-__PACKAGE__->filter_column(
-    extra => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
-
-__PACKAGE__->filter_column(
-    geocode => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
+__PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+__PACKAGE__->rabx_column('extra');
+__PACKAGE__->rabx_column('geocode');
 
 use DateTime::TimeZone;
 use Image::Size;
 use Moose;
 use namespace::clean -except => [ 'meta' ];
 use Utils;
-use RABX;
 
 with 'FixMyStreet::Roles::Abuser';
 
diff --git a/perllib/FixMyStreet/DB/Result/Token.pm b/perllib/FixMyStreet/DB/Result/Token.pm
index 028300842..5525fe7a5 100644
--- a/perllib/FixMyStreet/DB/Result/Token.pm
+++ b/perllib/FixMyStreet/DB/Result/Token.pm
@@ -34,8 +34,6 @@ __PACKAGE__->set_primary_key("scope", "token");
 # use mySociety::DBHandle qw(dbh);
 
 use mySociety::AuthToken;
-use IO::String;
-use RABX;
 
 =head1 NAME
 
@@ -54,26 +52,9 @@ ms_current_timestamp.
 
 =cut
 
-__PACKAGE__->filter_column(
-    data => {
-        filter_from_storage => sub {
-            my $self = shift;
-            my $ser  = shift;
-            return undef unless defined $ser;
-            utf8::encode($ser) if utf8::is_utf8($ser);
-            my $h = new IO::String($ser);
-            return RABX::wire_rd($h);
-        },
-        filter_to_storage => sub {
-            my $self = shift;
-            my $data = shift;
-            my $ser  = '';
-            my $h    = new IO::String($ser);
-            RABX::wire_wr( $data, $h );
-            return $ser;
-        },
-    }
-);
+__PACKAGE__->load_components("+FixMyStreet::DB::RABXColumn");
+__PACKAGE__->rabx_column('data');
+
 
 sub new {
     my ( $class, $attrs ) = @_;
diff --git a/t/app/model/rabx_column.t b/t/app/model/rabx_column.t
new file mode 100644
index 000000000..607d578ce
--- /dev/null
+++ b/t/app/model/rabx_column.t
@@ -0,0 +1,23 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok "FixMyStreet::DB::RABXColumn";
+
+# Test that the class names are correctly normalised
+my @tests = (
+    ["FixMyStreet::DB::Result::Token",     "Token"],
+    ["FixMyStreet::App::Model::DB::Token", "Token"],
+);
+
+foreach my $test (@tests) {
+    my ($input, $expected) = @$test;
+    is(
+        FixMyStreet::DB::RABXColumn::_get_class_identifier($input),
+        $expected,
+        "$input -> $expected"
+    );
+}
+
+done_testing();
diff --git a/t/app/model/token.t b/t/app/model/token.t
index 12945975e..637477fa3 100644
--- a/t/app/model/token.t
+++ b/t/app/model/token.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 45;
+use Test::More;
 
 use FixMyStreet;
 use FixMyStreet::App;
@@ -94,3 +94,47 @@ foreach my $test_data_name ( sort keys %tests ) {
       undef, "token gone with m::AT";
 
 }
+
+
+
+# Test that the inflation and deflation works as expected
+{
+    my $token =
+      $token_rs->create( { scope => 'testing', data => {} } );
+    END { $token->delete() };
+
+    # Add in temporary check to test that the data is updated as expected.
+    is_deeply($token->data, {}, "data is empty");
+
+    # store something in it
+    $token->update({ data => { foo => 'bar' } });
+    $token->discard_changes();
+    is_deeply($token->data, { foo => 'bar' }, "data has content");
+
+    # change the hash stored
+    $token->update({ data => { baz => 'bundy' } });
+    $token->discard_changes();
+    is_deeply($token->data, { baz => 'bundy' }, "data has new content");
+
+    # change the hashref in place
+    {
+        my $data = $token->data;
+        $data->{baz} = 'new';
+        $token->data( $data );
+        $token->update();
+        $token->discard_changes();
+        is_deeply($token->data, { baz => 'new' }, "data has been updated");
+    }
+
+    # change the hashref in place
+    {
+        my $data = $token->data;
+        $data->{baz} = 'new';
+        $token->update({ data => $data });
+        $token->discard_changes();
+        is_deeply($token->data, { baz => 'new' }, "data has been updated");
+    }
+
+}
+
+done_testing();