lib/Reaction/UI/ViewPort/ActionForm.pm

   1 package Reaction::UI::ViewPort::ActionForm;
   2
   3 use Reaction::Class;
   4
   5 use aliased 'Reaction::UI::ViewPort::Field::Text';
   6 use aliased 'Reaction::UI::ViewPort::Field::Number';
   7 use aliased 'Reaction::UI::ViewPort::Field::Boolean';
   8 use aliased 'Reaction::UI::ViewPort::Field::File';
   9 use aliased 'Reaction::UI::ViewPort::Field::String';
  10 use aliased 'Reaction::UI::ViewPort::Field::Password';
  11 use aliased 'Reaction::UI::ViewPort::Field::DateTime';
  12 use aliased 'Reaction::UI::ViewPort::Field::ChooseOne';
  13 use aliased 'Reaction::UI::ViewPort::Field::ChooseMany';
  14 use aliased 'Reaction::UI::ViewPort::Field::HiddenArray';
  15 use aliased 'Reaction::UI::ViewPort::Field::TimeRange';
  16
  17 class ActionForm is 'Reaction::UI::ViewPort', which {
  18   has action => (
  19     isa => 'Reaction::InterfaceModel::Action', is => 'ro', required => 1
  20   );
  21
  22   has ordered_fields => (is => 'rw', isa => 'ArrayRef', lazy_build => 1);
  23
  24   has _field_map => (
  25     isa => 'HashRef', is => 'rw', init_arg => 'fields', lazy_build => 1,
  26   );
  27
  28   has changed => (
  29     isa => 'Int', is => 'rw', reader => 'is_changed', default => sub { 0 }
  30   );
  31
  32   has next_action => (
  33     isa => 'ArrayRef', is => 'rw', required => 0, predicate => 'has_next_action'
  34   );
  35
  36   has on_apply_callback => (
  37     isa => 'CodeRef', is => 'rw', required => 0,
  38     predicate => 'has_on_apply_callback'
  39   );
  40
  41   has ok_label => (
  42     isa => 'Str', is => 'rw', required => 1, default => sub { 'ok' }
  43   );
  44
  45   has apply_label => (
  46     isa  => 'Str', is => 'rw', required => 1, default => sub { 'apply' }
  47   );
  48
  49   has close_label => (isa => 'Str', is => 'rw', lazy_fail => 1);
  50
  51   has close_label_close => (
  52     isa => 'Str', is => 'rw', required => 1, default => sub { 'close' }
  53   );
  54
  55   has close_label_cancel => (
  56     isa => 'Str', is => 'rw', required => 1, default => sub { 'cancel' }
  57   );
  58
  59   sub fields { shift->_field_map }
  60
  61   implements BUILD => as {
  62     my ($self, $args) = @_;
  63     unless ($self->_has_field_map) {
  64       my @field_map;
  65       my $action = $self->action;
  66       foreach my $attr ($action->parameter_attributes) {
  67         push(@field_map, $self->build_fields_for($attr => $args));
  68       }
  69       $self->_field_map({ @field_map });
  70     }
  71     $self->close_label($self->close_label_close);
  72   };
  73
  74   implements build_fields_for => as {
  75     my ($self, $attr, $args) = @_;
  76     my $attr_name = $attr->name;
  77     #TODO: DOCUMENT ME!!!!!!!!!!!!!!!!!
  78     my $builder = "build_fields_for_name_${attr_name}";
  79     my @fields;
  80     if ($self->can($builder)) {
  81       @fields = $self->$builder($attr, $args); # re-use coderef from can()
  82     } elsif ($attr->has_type_constraint) {
  83       my $constraint = $attr->type_constraint;
  84       my $base_name = $constraint->name;
  85       my $tried_isa = 0;
  86       CONSTRAINT: while (defined($constraint)) {
  87         my $name = $constraint->name;
  88         if (eval { $name->can('meta') } && !$tried_isa++) {
  89           foreach my $class ($name->meta->class_precedence_list) {
  90             my $mangled_name = $class;
  91             $mangled_name =~ s/:+/_/g;
  92             my $builder = "build_fields_for_type_${mangled_name}";
  93             if ($self->can($builder)) {
  94               @fields = $self->$builder($attr, $args);
  95               last CONSTRAINT;
  96             }
  97           }
  98         }
  99         if (defined($name)) {
 100           unless (defined($base_name)) {
 101             $base_name = "(anon subtype of ${name})";
 102           }
 103           my $mangled_name = $name;
 104           $mangled_name =~ s/:+/_/g;
 105           my $builder = "build_fields_for_type_${mangled_name}";
 106           if ($self->can($builder)) {
 107             @fields = $self->$builder($attr, $args);
 108             last CONSTRAINT;
 109           }
 110         }
 111         $constraint = $constraint->parent;
 112       }
 113       if (!defined($constraint)) {
 114         confess "Can't build field ${attr_name} of type ${base_name} without $builder method or build_fields_for_type_<type> method for type or any supertype";
 115       }
 116     } else {
 117       confess "Can't build field ${attr} without $builder method or type constraint";
 118     }
 119     return @fields;
 120   };
 121
 122   implements build_field_map => as {
 123     confess "Lazy field map building not supported by default";
 124   };
 125
 126   implements build_ordered_fields => as {
 127     my $self = shift;
 128     $self->sort_by_spec($self->column_order, [keys %{$self->_field_map_}])};
 129   };
 130
 131   implements can_apply => as {
 132     my ($self) = @_;
 133     foreach my $field (values %{$self->_field_map}) {
 134       return 0 if $field->needs_sync;
 135         # if e.g. a datetime field has an invalid value that can't be re-assembled
 136         # into a datetime object, the action may be in a consistent state but
 137         # not synchronized from the fields; in this case, we must not apply
 138     }
 139     return $self->action->can_apply;
 140   };
 141
 142   implements do_apply => as {
 143     my $self = shift;
 144     return $self->action->do_apply;
 145   };
 146
 147   implements ok => as {
 148     my $self = shift;
 149     if ($self->apply(@_)) {
 150       $self->close(@_);
 151     }
 152   };
 153
 154   implements apply => as {
 155     my $self = shift;
 156     if ($self->can_apply && (my $result = $self->do_apply)) {
 157       $self->changed(0);
 158       $self->close_label($self->close_label_close);
 159       $self->on_apply_callback->($self => $result) if $self->has_on_apply_callback;
 160       return 1;
 161     } else {
 162       $self->changed(1);
 163       $self->close_label($self->close_label_cancel);
 164       return 0;
 165     }
 166   };
 167
 168   implements close => as {
 169     my $self = shift;
 170     my ($controller, $name, @args) = @{$self->next_action};
 171     $controller->pop_viewport;
 172     $controller->$name($self->action->ctx, @args);
 173   };
 174
 175   sub can_close { 1 }
 176
 177   override accept_events => sub {
 178     (($_[0]->has_next_action ? ('ok', 'close') : ()), 'apply', super());
 179   }; # can't do a close-type operation if there's nowhere to go afterwards
 180
 181   override child_event_sinks => sub {
 182     my ($self) = @_;
 183     return ((grep { ref($_) =~ 'Hidden' } values %{$self->_field_map}),
 184             (grep { ref($_) !~ 'Hidden' } values %{$self->_field_map}),
 185             super());
 186   };
 187
 188   after apply_child_events => sub {
 189     # interrupt here because fields will have been updated
 190     my ($self) = @_;
 191     $self->sync_action_from_fields;
 192   };
 193
 194   implements sync_action_from_fields => as {
 195     my ($self) = @_;
 196     my $field_map = $self->_field_map;
 197     my @fields = values %{$field_map};
 198     foreach my $field (@fields) {
 199       $field->sync_to_action; # get the field to populate the $action if possible
 200     }
 201     $self->action->sync_all;
 202     foreach my $field (@fields) {
 203       $field->sync_from_action; # get errors from $action if applicable
 204     }
 205   };
 206
 207   implements build_simple_field => as {
 208     my ($self, $class, $attr, $args) = @_;
 209     my $attr_name = $attr->name;
 210     my %extra;
 211     if (my $config = $args->{Field}{$attr_name}) {
 212       %extra = %$config;
 213     }
 214     my $field = $class->new(
 215                   action => $self->action,
 216                   attribute => $attr,
 217                   name => $attr->name,
 218                   location => join('-', $self->location, 'field', $attr->name),
 219                   ctx => $self->ctx,
 220                   %extra
 221                 );
 222     return ($attr_name => $field);
 223   };
 224
 225   implements build_fields_for_type_Num => as {
 226     my ($self, $attr, $args) = @_;
 227     return $self->build_simple_field(Number, $attr, $args);
 228   };
 229
 230   implements build_fields_for_type_Int => as {
 231     my ($self, $attr, $args) = @_;
 232     return $self->build_simple_field(Number, $attr, $args);
 233   };
 234
 235   implements build_fields_for_type_Bool => as {
 236     my ($self, $attr, $args) = @_;
 237     return $self->build_simple_field(Boolean, $attr, $args);
 238   };
 239
 240   implements build_fields_for_type_File => as {
 241     my ($self, $attr, $args) = @_;
 242     return $self->build_simple_field(File, $attr, $args);
 243   };
 244
 245   implements build_fields_for_type_Str => as {
 246     my ($self, $attr, $args) = @_;
 247     if ($attr->has_valid_values) { # There's probably a better way to do this
 248       return $self->build_simple_field(ChooseOne, $attr, $args);
 249     }
 250     return $self->build_simple_field(Text, $attr, $args);
 251   };
 252
 253   implements build_fields_for_type_SimpleStr => as {
 254     my ($self, $attr, $args) = @_;
 255     return $self->build_simple_field(String, $attr, $args);
 256   };
 257
 258   implements build_fields_for_type_Password => as {
 259     my ($self, $attr, $args) = @_;
 260     return $self->build_simple_field(Password, $attr, $args);
 261   };
 262
 263   implements build_fields_for_type_DateTime => as {
 264     my ($self, $attr, $args) = @_;
 265     return $self->build_simple_field(DateTime, $attr, $args);
 266   };
 267
 268   implements build_fields_for_type_Enum => as {
 269     my ($self, $attr, $args) = @_;
 270     return $self->build_simple_field(ChooseOne, $attr, $args);
 271   };
 272
 273   #implements build_fields_for_type_Reaction_InterfaceModel_Object => as {
 274   implements build_fields_for_type_DBIx_Class_Row => as {
 275     my ($self, $attr, $args) = @_;
 276     return $self->build_simple_field(ChooseOne, $attr, $args);
 277   };
 278
 279   implements build_fields_for_type_ArrayRef => as {
 280     my ($self, $attr, $args) = @_;
 281     if ($attr->has_valid_values) {
 282       return $self->build_simple_field(ChooseMany, $attr, $args)
 283     } else {
 284       return $self->build_simple_field(HiddenArray, $attr, $args)
 285     }
 286   };
 287
 288   implements build_fields_for_type_DateTime_Spanset => as {
 289     my ($self, $attr, $args) = @_;
 290     return $self->build_simple_field(TimeRange, $attr, $args);
 291   };
 292
 293   no Moose;
 294
 295   no strict 'refs';
 296   delete ${__PACKAGE__ . '::'}{inner};
 297
 298 };
 299
 300 1;
 301
 302 =head1 NAME
 303
 304 Reaction::UI::ViewPort::ActionForm
 305
 306 =head1 SYNOPSIS
 307
 308   use aliased 'Reaction::UI::ViewPort::ActionForm';
 309
 310   $self->push_viewport(ActionForm,
 311     layout => 'register',
 312     action => $action,
 313     next_action => [ $self, 'redirect_to', 'accounts', $c->req->captures ],
 314     ctx => $c,
 315     column_order => [
 316       qw / contact_title company_name email address1 address2 address3
 317            city country post_code telephone mobile fax/ ],
 318   );
 319
 320 =head1 DESCRIPTION
 321
 322 This subclass of viewport is used for rendering a collection of
 323 L<Reaction::UI::ViewPort::Field> objects for user editing.
 324
 325 =head1 ATTRIBUTES
 326
 327 =head2 action
 328
 329 L<Reaction::InterfaceModel::Action>
 330
 331 =head2 ok_label
 332
 333 Default: 'ok'
 334
 335 =head2 apply_label
 336
 337 Default: 'apply'
 338
 339 =head2 close_label_close
 340
 341 Default: 'close'
 342
 343 =head2 close_label_cancel
 344
 345 This label is only shown when C<changed> is true.
 346
 347 Default: 'cancel'
 348
 349 =head2 fields
 350
 351 =head2 can_apply
 352
 353 =head2 can_close
 354
 355 =head2 changed
 356
 357 Returns true if a field has been edited.
 358
 359 =head2 next_action
 360
 361 =head2 on_apply_callback
 362
 363 CodeRef.
 364
 365 =head1 METHODS
 366
 367 =head2 ok
 368
 369 Calls C<apply>, and then C<close> if successful.
 370
 371 =head2 close
 372
 373 Pop viewport and proceed to C<next_action>.
 374
 375 =head2 apply
 376
 377 Attempt to save changes and update C<changed> attribute if required.
 378
 379 =head1 SEE ALSO
 380
 381 L<Reaction::UI::ViewPort>
 382
 383 L<Reaction::InterfaceModel::Action>
 384
 385 =head1 AUTHORS
 386
 387 See L<Reaction::Class> for authors.
 388
 389 =head1 LICENSE
 390
 391 See L<Reaction::Class> for the license.
 392
 393 =cut