3 files changed, 141 insertions, 0 deletions
diff --git a/perllib/FixMyStreet/App/Form/I18N.pm b/perllib/FixMyStreet/App/Form/I18N.pm
new file mode 100644
index 000000000..b37f7ac53
--- /dev/null
+++ b/perllib/FixMyStreet/App/Form/I18N.pm
@@ -0,0 +1,13 @@
+package FixMyStreet::App::Form::I18N;
+
+use Moo;
+
+sub maketext {
+    my ($self, $msg, @args) = @_;
+
+    no if ($] >= 5.022), warnings => 'redundant';
+    return sprintf(_($msg), @args);
+}
+
+1;
+
diff --git a/perllib/FixMyStreet/App/Form/Role.pm b/perllib/FixMyStreet/App/Form/Role.pm
new file mode 100644
index 000000000..f0711af15
--- /dev/null
+++ b/perllib/FixMyStreet/App/Form/Role.pm
@@ -0,0 +1,66 @@
+package FixMyStreet::App::Form::Role;
+
+use HTML::FormHandler::Moose;
+use FixMyStreet::App::Form::I18N;
+extends 'HTML::FormHandler::Model::DBIC';
+use namespace::autoclean;
+
+has 'body_id' => ( isa => 'Int', is => 'ro' );
+
+has '+widget_name_space' => ( default => sub { ['FixMyStreet::App::Form::Widget'] } );
+has '+widget_tags' => ( default => sub { { wrapper_tag => 'p' } } );
+has '+item_class' => ( default => 'Role' );
+has_field 'name' => ( required => 1 );
+has_field 'body' => ( type => 'Select', empty_select => 'Select a body', required => 1 );
+has_field 'permissions' => (
+    type => 'Multiple',
+    widget => 'CheckboxGroup',
+    tags => { inline => 1, wrapper_tag => 'fieldset', },
+);
+
+before 'update_model' => sub {
+    my $self = shift;
+    $self->item->body_id($self->body_id) if $self->body_id;
+};
+
+sub _build_language_handle { FixMyStreet::App::Form::I18N->new }
+
+has '+unique_messages' => (
+   default => sub {
+      { roles_body_id_name_key => "Role names must be unique" };
+   }
+);
+
+sub validate {
+    my $self = shift;
+
+    my $rs = $self->resultset;
+    my $value = $self->value;
+
+    return 0 if $self->body_id; # The core validation catches this, because body_id is set on $self->item
+    return 0 if $self->item_id && $self->item->body_id == $value->{body}; # Correctly caught by core validation
+
+    # Okay, due to a bug we need to check this ourselves
+    # https://github.com/gshank/html-formhandler-model-dbic/issues/20
+    my @id_clause = ();
+    @id_clause = HTML::FormHandler::Model::DBIC::_id_clause( $rs, $self->item_id ) if defined $self->item;
+
+    my %form_columns = (body => 'body_id', name => 'name');
+    my %where = map { $form_columns{$_} =>
+        exists( $value->{$_} ) ? $value->{$_} : undef ||
+            ( $self->item ? $self->item->get_column($form_columns{$_}) : undef )
+    } keys %form_columns;
+
+    my $count = $rs->search( \%where )->search( {@id_clause} )->count;
+    return 0 if $count < 1;
+
+    my $field = $self->field('name');
+    my $constraint = 'roles_body_id_name_key';
+    my $field_error = $self->unique_message_for_constraint($constraint);
+    $field->add_error( $field_error, $constraint );
+    return 1;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
diff --git a/perllib/FixMyStreet/App/Form/Widget/Field/CheckboxGroup.pm b/perllib/FixMyStreet/App/Form/Widget/Field/CheckboxGroup.pm
new file mode 100644
index 000000000..1dc55e49b
--- /dev/null
+++ b/perllib/FixMyStreet/App/Form/Widget/Field/CheckboxGroup.pm
@@ -0,0 +1,62 @@
+package FixMyStreet::App::Form::Widget::Field::CheckboxGroup;
+
+use Moose::Role;
+with 'HTML::FormHandler::Widget::Field::CheckboxGroup';
+use namespace::autoclean;
+
+sub render_element {
+    my ( $self, $result ) = @_;
+    $result ||= $self->result;
+
+    my $output = '<ul class="permissions-checkboxes">';
+    foreach my $option ( @{ $self->{options} } ) {
+        if ( my $label = $option->{group} ) {
+            $label = $self->_localize( $label ) if $self->localize_labels;
+            $output .= qq{\n<li>$label\n<ul class="no-margin no-bullets">};
+            $output .= qq{\n<li>(<a href="#" data-select-all>} . _('all') . '</a> / ';
+            $output .= '<a href="#" data-select-none>' . _('none') . '</a>)</li>';
+            foreach my $group_opt ( @{ $option->{options} } ) {
+                $output .= '<li>';
+                $output .= $self->render_option( $group_opt, $result );
+                $output .= "</li>\n";
+            }
+            $output .= qq{</ul>\n</li>};
+        }
+        else {
+            $output .= $self->render_option( $option, $result );
+        }
+    }
+    $output .= '</ul>';
+    $self->reset_options_index;
+    return $output;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+FixMyStreet::App::Form::Widget::Field::CheckboxGroup - checkbox group field role
+
+=head1 SYNOPSIS
+
+Subclass of HTML::FormHandler::Widget::Field::CheckboxGroup, but printed
+as a nested <ul>.
+
+=head1 AUTHOR
+
+FormHandler Contributors - see HTML::FormHandler
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2017 by Gerda Shank.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=cut