aboutsummaryrefslogtreecommitdiffstats
path: root/perllib/FixMyStreet
diff options
context:
space:
mode:
Diffstat (limited to 'perllib/FixMyStreet')
-rw-r--r--perllib/FixMyStreet/App/Controller/Admin.pm3
-rw-r--r--perllib/FixMyStreet/App/Controller/Report/New.pm3
-rw-r--r--perllib/FixMyStreet/Cobrand/Zurich.pm98
-rw-r--r--perllib/FixMyStreet/DB/RABXColumn.pm98
-rw-r--r--perllib/FixMyStreet/DB/Result/Body.pm6
-rw-r--r--perllib/FixMyStreet/DB/Result/Comment.pm23
-rw-r--r--perllib/FixMyStreet/DB/Result/Contact.pm22
-rw-r--r--perllib/FixMyStreet/DB/Result/Problem.pm45
-rw-r--r--perllib/FixMyStreet/DB/Result/Token.pm25
-rw-r--r--perllib/FixMyStreet/TestMech.pm20
10 files changed, 216 insertions, 127 deletions
diff --git a/perllib/FixMyStreet/App/Controller/Admin.pm b/perllib/FixMyStreet/App/Controller/Admin.pm
index ba8f22a05..4973b7c4e 100644
--- a/perllib/FixMyStreet/App/Controller/Admin.pm
+++ b/perllib/FixMyStreet/App/Controller/Admin.pm
@@ -413,7 +413,7 @@ sub update_contacts : Private {
sub body_params : Private {
my ( $self, $c ) = @_;
- my @fields = qw/name endpoint jurisdiction api_key send_method send_comments suppress_alerts send_extended_statuses comment_user_id can_be_devolved parent/;
+ my @fields = qw/name endpoint jurisdiction api_key send_method send_comments suppress_alerts send_extended_statuses comment_user_id can_be_devolved parent deleted/;
my %defaults = map { $_ => '' } @fields;
%defaults = ( %defaults,
send_comments => 0,
@@ -422,6 +422,7 @@ sub body_params : Private {
send_extended_statuses => 0,
can_be_devolved => 0,
parent => undef,
+ deleted => 0,
);
my %params = map { $_ => $c->req->param($_) || $defaults{$_} } @fields;
return \%params;
diff --git a/perllib/FixMyStreet/App/Controller/Report/New.pm b/perllib/FixMyStreet/App/Controller/Report/New.pm
index 3d3ddce1e..6018dfa80 100644
--- a/perllib/FixMyStreet/App/Controller/Report/New.pm
+++ b/perllib/FixMyStreet/App/Controller/Report/New.pm
@@ -956,6 +956,9 @@ sub check_for_errors : Private {
delete $field_errors{name};
my $report = $c->stash->{report};
$report->title( Utils::cleanup_text( substr($report->detail, 0, 25) ) );
+ if ( ! $c->req->param('phone') ) {
+ $field_errors{phone} = _("This information is required");
+ }
}
# FIXME: need to check for required bromley fields here
diff --git a/perllib/FixMyStreet/Cobrand/Zurich.pm b/perllib/FixMyStreet/Cobrand/Zurich.pm
index 8e8b79d07..e15170721 100644
--- a/perllib/FixMyStreet/Cobrand/Zurich.pm
+++ b/perllib/FixMyStreet/Cobrand/Zurich.pm
@@ -8,6 +8,47 @@ use RABX;
use strict;
use warnings;
+=head1 NAME
+
+Zurich FixMyStreet cobrand
+
+=head1 DESCRIPTION
+
+This module provides the specific functionality for the Zurich FMS cobrand.
+
+=head1 DEVELOPMENT NOTES
+
+The admin for Zurich is different to the other cobrands. To access it you need
+to be logged in as a user associated with an appropriate body.
+
+You can create the bodies needed to develop by running the 't/cobrand/zurich.t'
+test script with the three C<$mech->delete...> lines at the end commented out.
+This should leave you with the bodies and users correctly set up.
+
+The entries will be something like this (but with different ids).
+
+ Bodies:
+ id | name | parent | endpoint
+ ----+---------------+--------+---------------------------
+ 1 | Zurich | |
+ 2 | Division 1 | 1 | division@example.org
+ 3 | Subdivision A | 2 | subdivision@example.org
+ 4 | External Body | | external_body@example.org
+
+ Users:
+ id | email | from_body
+ ----+------------------+-----------
+ 2 | dm1@example.org | 2
+ 3 | sdm1@example.org | 3
+
+The passwords for the users is 'secret'.
+
+Note: the password hashes are salted with the user's id so cannot be easily
+changed. High ids have been used so that it should not conflict with anything
+you already have, and the countres set so that they shouldn't in future.
+
+=cut
+
sub shorten_recency_if_new_greater_than_fixed {
return 0;
}
@@ -356,29 +397,51 @@ sub admin_report_edit {
}
- # Problem updates upon submission
+ # If super or sdm check that the token is correct before proceeding
if ( ($type eq 'super' || $type eq 'dm') && $c->req->param('submit') ) {
$c->forward('check_token');
+ }
+ # All types of users can add internal notes
+ if ( ($type eq 'super' || $type eq 'dm' || $type eq 'sdm') && $c->req->param('submit') ) {
+ # If there is a new note add it as a comment to the problem (with is_internal_note set true in extra).
+ if ( my $new_internal_note = $c->req->params->{new_internal_note} ) {
+ $problem->add_to_comments( {
+ text => $new_internal_note,
+ user => $c->user->obj,
+ state => 'hidden', # seems best fit, should not be shown publicly
+ mark_fixed => 0,
+ anonymous => 1,
+ extra => { is_internal_note => 1 },
+ } );
+ }
+ }
+
+ # Problem updates upon submission
+ if ( ($type eq 'super' || $type eq 'dm') && $c->req->param('submit') ) {
# Predefine the hash so it's there for lookups
- # XXX Note you need to shallow copy each time you set it, due to a bug? in FilterColumn.
my $extra = $problem->extra || {};
- $extra->{internal_notes} = $c->req->param('internal_notes');
$extra->{publish_photo} = $c->req->params->{publish_photo} || 0;
$extra->{third_personal} = $c->req->params->{third_personal} || 0;
# Make sure we have a copy of the original detail field
$extra->{original_detail} = $problem->detail if !$extra->{original_detail} && $c->req->params->{detail} && $problem->detail ne $c->req->params->{detail};
+ # Some changes will be accompanied by an internal note, which if needed
+ # should be stored in this variable.
+ my $internal_note_text = "";
+
# Workflow things
my $redirect = 0;
my $new_cat = $c->req->params->{category};
if ( $new_cat && $new_cat ne $problem->category ) {
my $cat = $c->model('DB::Contact')->search( { category => $c->req->params->{category} } )->first;
+ my $old_cat = $problem->category;
$problem->category( $new_cat );
$problem->external_body( undef );
$problem->bodies_str( $cat->body_id );
$problem->whensent( undef );
$extra->{changed_category} = 1;
+ $internal_note_text = "Weitergeleitet von $old_cat an $new_cat";
$redirect = 1 if $cat->body_id ne $body->id;
} elsif ( my $subdiv = $c->req->params->{body_subdivision} ) {
$extra->{moderated_overdue} = $self->overdue( $problem );
@@ -401,7 +464,7 @@ sub admin_report_edit {
}
}
- $problem->extra( { %$extra } );
+ $problem->extra( $extra );
$problem->title( $c->req->param('title') );
$problem->detail( $c->req->param('detail') );
$problem->latitude( $c->req->param('latitude') );
@@ -410,7 +473,7 @@ sub admin_report_edit {
# Final, public, Update from DM
if (my $update = $c->req->param('status_update')) {
$extra->{public_response} = $update;
- $problem->extra( { %$extra } );
+ $problem->extra( $extra );
if ($c->req->params->{publish_response}) {
$problem->state( 'fixed - council' );
_admin_send_email( $c, 'problem-closed.txt', $problem );
@@ -424,9 +487,22 @@ sub admin_report_edit {
'<p><em>' . _('Updated!') . '</em></p>';
# do this here otherwise lastupdate and confirmed times
- # do not display correctly
+ # do not display correctly (reloads problem from database, including
+ # fields modified by the database when saving)
$problem->discard_changes;
+ # Create an internal note if required
+ if ($internal_note_text) {
+ $problem->add_to_comments( {
+ text => $internal_note_text,
+ user => $c->user->obj,
+ state => 'hidden', # seems best fit, should not be shown publicly
+ mark_fixed => 0,
+ anonymous => 1,
+ extra => { is_internal_note => 1 },
+ } );
+ }
+
if ( $redirect ) {
$c->detach('index');
}
@@ -462,14 +538,6 @@ sub admin_report_edit {
$db_update = 1;
}
- my $extra = $problem->extra || {};
- $extra->{internal_notes} ||= '';
- if ($c->req->param('internal_notes') && $c->req->param('internal_notes') ne $extra->{internal_notes}) {
- $extra->{internal_notes} = $c->req->param('internal_notes');
- $problem->extra( { %$extra } );
- $db_update = 1;
- }
-
$problem->update if $db_update;
# Add new update from status_update
@@ -491,7 +559,7 @@ sub admin_report_edit {
if ($c->req->param('no_more_updates')) {
my $extra = $problem->extra || {};
$extra->{subdiv_overdue} = $self->overdue( $problem );
- $problem->extra( { %$extra } );
+ $problem->extra( $extra );
$problem->bodies_str( $body->parent->id );
$problem->whensent( undef );
$problem->state( 'planned' );
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/Body.pm b/perllib/FixMyStreet/DB/Result/Body.pm
index b6a044b04..c2b0555fb 100644
--- a/perllib/FixMyStreet/DB/Result/Body.pm
+++ b/perllib/FixMyStreet/DB/Result/Body.pm
@@ -40,6 +40,8 @@ __PACKAGE__->add_columns(
{ data_type => "boolean", default_value => \"false", is_nullable => 0 },
"send_extended_statuses",
{ data_type => "boolean", default_value => \"false", is_nullable => 0 },
+ "deleted",
+ { data_type => "boolean", default_value => \"false", is_nullable => 0 },
);
__PACKAGE__->set_primary_key("id");
__PACKAGE__->has_many(
@@ -90,8 +92,8 @@ __PACKAGE__->has_many(
);
-# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 17:11:54
-# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:JT0w76BWaDpjAV61WVSYHg
+# Created by DBIx::Class::Schema::Loader v0.07035 @ 2013-09-10 18:11:23
+# DO NOT MODIFY THIS OR ANYTHING ABOVE! md5sum:hTOxxiiHmC8nmQK/p8dXhQ
sub url {
my ( $self, $c ) = @_;
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/perllib/FixMyStreet/TestMech.pm b/perllib/FixMyStreet/TestMech.pm
index e91c6a1d6..be8f004a5 100644
--- a/perllib/FixMyStreet/TestMech.pm
+++ b/perllib/FixMyStreet/TestMech.pm
@@ -87,8 +87,8 @@ sub log_in_ok {
my $user = $mech->create_user_ok($email);
- # store the old password and then change it
- my $old_password = $user->password;
+ # remember the old password and then change it to a known one
+ my $old_password = $user->password || '';
$user->update( { password => 'secret' } );
# log in
@@ -99,7 +99,19 @@ sub log_in_ok {
$mech->logged_in_ok;
# restore the password (if there was one)
- $user->update( { password => $old_password } ) if $old_password;
+ if ($old_password) {
+
+ # Use store_column and then make_column_dirty to bypass the filters that
+ # would hash the password, otherwise the password required ito log in
+ # would be the hash of the previous one.
+ $user->store_column("password", $old_password);
+ $user->make_column_dirty("password");
+ $user->update();
+
+ # Belt and braces, check that the password has been correctly saved.
+ die "password not correctly restored after log_in_ok"
+ if $user->password ne $old_password;
+ }
return $user;
}
@@ -296,7 +308,7 @@ sub extract_location {
$meta = $mech->extract_problem_meta;
-Returns the problem meta information ( submitted by, at etc ) from a
+Returns the problem meta information ( submitted by, at etc ) from a
problem report page
=cut
generated by cgit v1.2.3 (git 2.25.1) at 2025-07-23 17:51:12 +0000