Proper FakeQ object to interface with old code

4 files changed, 116 insertions, 7 deletions

diff --git a/perllib/FixMyStreet/App.pm b/perllib/FixMyStreet/App.pm
index cf0157ab4..4e992d4f9 100644
--- a/perllib/FixMyStreet/App.pm
+++ b/perllib/FixMyStreet/App.pm
@@ -9,6 +9,7 @@ use Memcached;
 use Problems;
 use mySociety::Email;
 use FixMyStreet::Map;
+use FixMyStreet::FakeQ;
 
 use Catalyst (
     'Static::Simple',    #
@@ -123,7 +124,14 @@ sub _get_cobrand {
       ? FixMyStreet::Cobrand->get_class_for_moniker($override_moniker)
       : FixMyStreet::Cobrand->get_class_for_host($host);
 
-    return $cobrand_class->new( { request => $c->req, fake_q => $c->fake_q, } );
+    my $cobrand = $cobrand_class->new( { request => $c->req } );
+
+    # create the cobrand explicitly passing in the site. Avoids the chicken and
+    # egg situation where one needs to be created first. Should disappear when
+    # all instances of the old '$q' are gone.
+    $cobrand->fake_q( $c->fake_q( { site => $cobrand->moniker } ) );
+
+    return $cobrand;
 }
 
 =head2 setup_request
@@ -315,19 +323,33 @@ sub uri_for_email {
 
 =head2 fake_q
 
-    $q = $c->fake_q();
+    $q = $c->fake_q();                                   # normal usage
+    $q = $c->fake_q( { site => 'cobrand_moniker' } );    # when creating
 
 Returns a faked up object that behaves as the old code expects the old '$q' to
-behave.
+behave. Object is cached for the request. See L<FixMyStreet::FakeQ> for more
+details.
+
+The first time fake_q is called you need to pass in 'site' explicitly. This
+should normally be done automatically when the cobrand is first loaded.
 
 =cut
 
 sub fake_q {
+    my $c    = shift;
+    my $args = shift;
+
+    return $c->stash->{fakeq}    #
+      ||= $c->_get_fake_q($args);
+}
+
+sub _get_fake_q {
     my $c = shift;
+    my $args = shift || {};
+
+    $args->{params} ||= $c->req->parameters;
 
-    # FIXME - implement fully
-    # site
-    return $c->req;
+    return FixMyStreet::FakeQ->new($args);
 }
 
 =head1 SEE ALSO
diff --git a/perllib/FixMyStreet/Cobrand/Default.pm b/perllib/FixMyStreet/Cobrand/Default.pm
index 14f8f6ba3..097ce3ef7 100644
--- a/perllib/FixMyStreet/Cobrand/Default.pm
+++ b/perllib/FixMyStreet/Cobrand/Default.pm
@@ -56,7 +56,8 @@ sub is_default {
 
 =head2 fake_q
 
-    $fake_q = $cobrand->fake_q;
+    $fake_q     = $cobrand->fake_q;
+    $new_fake_q = $cobrand->fake_q($new_fake_q);
 
 Often the cobrand needs access to the request so we add it at the start by
 passing it to ->new. If the request has not been set and you call this (or a
@@ -67,6 +68,8 @@ use a request-related method out of a request-context.
 
 sub fake_q {
     my $self = shift;
+    $self->{fake_q} = shift if @_;
+
     return $self->{fake_q}
       || croak "No fake_q has been set"
       . " - should you be calling this method outside of a web request?";
diff --git a/perllib/FixMyStreet/FakeQ.pm b/perllib/FixMyStreet/FakeQ.pm
new file mode 100644
index 000000000..19f5ab32b
--- /dev/null
+++ b/perllib/FixMyStreet/FakeQ.pm
@@ -0,0 +1,60 @@
+package FixMyStreet::FakeQ;
+
+use strict;
+use warnings;
+use Carp;
+
+=head1 NAME
+
+FixMyStreet::FakeQ - adaptor object to ease code transition
+
+=head1 DESCRIPTION
+
+The old code uses '$q' everywhere - partly to passaround which cobrand is in
+use, partly to give access to the request query parameters and partly as a
+scratch pad.
+
+This object lets us fake this behaviour in a structured way so that the new
+Catalyst based code can call the old CGI code with no need for changes.
+
+Eventually it will be phased out.
+
+=head1 METHODS
+
+=head2 new
+
+    $fake_q = FixMyStreet::FakeQ->new( $args );
+
+Create a new FakeQ object. Checks that 'site' argument is present and corrects
+it if needed.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $args = shift || {};
+
+    croak "required argument 'site' missing" unless $args->{site};
+    $args->{site} = 'fixmystreet' if $args->{site} eq 'default';
+
+    $args->{params} ||= {};
+
+    return bless $args, $class;
+}
+
+=head2 param
+
+    $val = $fake_q->param( 'key' );
+
+Behaves much like CGI's ->param. Returns value if found, or undef if not.
+
+=cut
+
+sub param {
+    my $self = shift;
+    my $key  = shift;
+
+    return $self->{params}->{$key};
+}
+
+1;
diff --git a/t/fakeq.t b/t/fakeq.t
new file mode 100644
index 000000000..ae7c6d98b
--- /dev/null
+++ b/t/fakeq.t
@@ -0,0 +1,24 @@
+use strict;
+use warnings;
+
+use Test::More;
+
+use_ok 'FixMyStreet::FakeQ';
+
+# create a new object and check that it returns what we want.
+my $fake_q = FixMyStreet::FakeQ->new(
+    {
+        params => { foo => 'bar' },    #
+        site => 'boing'
+    }
+);
+
+is $fake_q->{site}, 'boing', 'got site verbatim';
+is $fake_q->param('foo'),     'bar', 'got set param';
+is $fake_q->param('not_set'), undef, 'got undef for not set param';
+
+# check that setting site to 'default' gets translated to fixmystreet
+is FixMyStreet::FakeQ->new( { site => 'default' } )->{site}, 'fixmystreet',
+  "'default' site becomes 'fixmystreet'";
+
+done_testing();