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         $name = $attr->_isa_metadata if($name eq '__ANON__');
  89         if (eval { $name->can('meta') } && !$tried_isa++) {
  90           foreach my $class ($name->meta->class_precedence_list) {
  91             my $mangled_name = $class;
  92             $mangled_name =~ s/:+/_/g;
  93             my $builder = "_build_fields_for_type_${mangled_name}";
  94             if ($self->can($builder)) {
  95               @fields = $self->$builder($attr, $args);
  96               last CONSTRAINT;
  97             }
  98           }
  99         }
 100         if (defined($name)) {
 101           unless (defined($base_name)) {
 102             $base_name = "(anon subtype of ${name})";
 103           }
 104           my $mangled_name = $name;
 105           $mangled_name =~ s/:+/_/g;
 106           my $builder = "_build_fields_for_type_${mangled_name}";
 107           if ($self->can($builder)) {
 108             @fields = $self->$builder($attr, $args);
 109             last CONSTRAINT;
 110           }
 111         }
 112         $constraint = $constraint->parent;
 113       }
 114       if (!defined($constraint)) {
 115         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";
 116       }
 117     } else {
 118       confess "Can't build field ${attr} without $builder method or type constraint";
 119     }
 120     return @fields;
 121   };
 122
 123   implements _build_field_map => as {
 124     confess "Lazy field map building not supported by default";
 125   };
 126
 127   implements _build_ordered_fields => as {
 128     my $self = shift;
 129     my $ordered = $self->sort_by_spec($self->column_order, [keys %{$self->_field_map}]);
 130     return [@{$self->_field_map}{@$ordered}];
 131   };
 132
 133   implements can_apply => as {
 134     my ($self) = @_;
 135     foreach my $field ( @{ $self->ordered_fields } ) {
 136       return 0 if $field->needs_sync;
 137       # if e.g. a datetime field has an invalid value that can't be re-assembled
 138       # into a datetime object, the action may be in a consistent state but
 139       # not synchronized from the fields; in this case, we must not apply
 140     }
 141     return $self->action->can_apply;
 142   };
 143
 144   implements do_apply => as {
 145     my $self = shift;
 146     return $self->action->do_apply;
 147   };
 148
 149   implements ok => as {
 150     my $self = shift;
 151     if ($self->apply(@_)) {
 152       $self->close(@_);
 153     }
 154   };
 155
 156   implements apply => as {
 157     my $self = shift;
 158     if ($self->can_apply && (my $result = $self->do_apply)) {
 159       $self->changed(0);
 160       $self->close_label($self->close_label_close);
 161       $self->on_apply_callback->($self => $result) if $self->has_on_apply_callback;
 162       return 1;
 163     } else {
 164       $self->changed(1);
 165       $self->close_label($self->close_label_cancel);
 166       return 0;
 167     }
 168   };
 169
 170   implements close => as {
 171     my $self = shift;
 172     my ($controller, $name, @args) = @{$self->next_action};
 173     $controller->pop_viewport;
 174     $controller->$name($self->action->ctx, @args);
 175   };
 176
 177   sub can_close { 1 }
 178
 179   override accept_events => sub {
 180     (($_[0]->has_next_action ? ('ok', 'close') : ()), 'apply', super());
 181   }; # can't do a close-type operation if there's nowhere to go afterwards
 182
 183   override child_event_sinks => sub {
 184     my ($self) = @_;
 185     return ((grep { ref($_) =~ 'Hidden' } values %{$self->_field_map}),
 186             (grep { ref($_) !~ 'Hidden' } values %{$self->_field_map}),
 187             super());
 188   };
 189
 190   after apply_child_events => sub {
 191     # interrupt here because fields will have been updated
 192     my ($self) = @_;
 193     $self->sync_action_from_fields;
 194   };
 195
 196   implements sync_action_from_fields => as {
 197     my ($self) = @_;
 198     my $field_map = $self->_field_map;
 199     my @fields = values %{$field_map};
 200     foreach my $field (@fields) {
 201       $field->sync_to_action; # get the field to populate the $action if possible
 202     }
 203     $self->action->sync_all;
 204     foreach my $field (@fields) {
 205       $field->sync_from_action; # get errors from $action if applicable
 206     }
 207   };
 208
 209   implements _build_simple_field => as {
 210     my ($self, $class, $attr, $args) = @_;
 211     my $attr_name = $attr->name;
 212     my %extra;
 213     if (my $config = $args->{Field}{$attr_name}) {
 214       %extra = %$config;
 215     }
 216     my $field = $class->new(
 217                             action => $self->action,
 218                             attribute => $attr,
 219                             name => $attr->name,
 220                             location => join('-', $self->location, 'field', $attr->name),
 221                             ctx => $self->ctx,
 222                             %extra
 223                            );
 224     return ($attr_name => $field);
 225   };
 226
 227   implements _build_fields_for_type_Num => as {
 228     my ($self, $attr, $args) = @_;
 229     return $self->_build_simple_field(Number, $attr, $args);
 230   };
 231
 232   implements _build_fields_for_type_Int => as {
 233     my ($self, $attr, $args) = @_;
 234     return $self->_build_simple_field(Number, $attr, $args);
 235   };
 236
 237   implements _build_fields_for_type_Bool => as {
 238     my ($self, $attr, $args) = @_;
 239     return $self->_build_simple_field(Boolean, $attr, $args);
 240   };
 241
 242   implements _build_fields_for_type_File => as {
 243     my ($self, $attr, $args) = @_;
 244     return $self->_build_simple_field(File, $attr, $args);
 245   };
 246
 247   implements _build_fields_for_type_Str => as {
 248     my ($self, $attr, $args) = @_;
 249     if ($attr->has_valid_values) { # There's probably a better way to do this
 250       return $self->_build_simple_field(ChooseOne, $attr, $args);
 251     }
 252     return $self->_build_simple_field(Text, $attr, $args);
 253   };
 254
 255   implements _build_fields_for_type_SimpleStr => as {
 256     my ($self, $attr, $args) = @_;
 257     return $self->_build_simple_field(String, $attr, $args);
 258   };
 259
 260   implements _build_fields_for_type_Password => as {
 261     my ($self, $attr, $args) = @_;
 262     return $self->_build_simple_field(Password, $attr, $args);
 263   };
 264
 265   implements _build_fields_for_type_DateTime => as {
 266     my ($self, $attr, $args) = @_;
 267     return $self->_build_simple_field(DateTime, $attr, $args);
 268   };
 269
 270   implements _build_fields_for_type_Enum => as {
 271     my ($self, $attr, $args) = @_;
 272     return $self->_build_simple_field(ChooseOne, $attr, $args);
 273   };
 274
 275   #implements build_fields_for_type_Reaction_InterfaceModel_Object => as {
 276   implements _build_fields_for_type_Row => as {
 277     my ($self, $attr, $args) = @_;
 278     return $self->_build_simple_field(ChooseOne, $attr, $args);
 279   };
 280
 281   implements _build_fields_for_type_ArrayRef => as {
 282     my ($self, $attr, $args) = @_;
 283     if ($attr->has_valid_values) {
 284       return $self->_build_simple_field(ChooseMany, $attr, $args)
 285     } else {
 286       return $self->_build_simple_field(HiddenArray, $attr, $args)
 287     }
 288   };
 289
 290   implements _build_fields_for_type_Spanset => as {
 291     my ($self, $attr, $args) = @_;
 292     return $self->_build_simple_field(TimeRange, $attr, $args);
 293   };
 294
 295   no Moose;
 296
 297   no strict 'refs';
 298   delete ${__PACKAGE__ . '::'}{inner};
 299
 300 };
 301
 302   1;
 303
 304 =head1 NAME
 305
 306 Reaction::UI::ViewPort::ActionForm
 307
 308 =head1 SYNOPSIS
 309
 310   use aliased 'Reaction::UI::ViewPort::ActionForm';
 311
 312   $self->push_viewport(ActionForm,
 313     layout => 'register',
 314     action => $action,
 315     next_action => [ $self, 'redirect_to', 'accounts', $c->req->captures ],
 316     ctx => $c,
 317     column_order => [
 318       qw / contact_title company_name email address1 address2 address3
 319            city country post_code telephone mobile fax/ ],
 320   );
 321
 322 =head1 DESCRIPTION
 323
 324 This subclass of viewport is used for rendering a collection of
 325 L<Reaction::UI::ViewPort::Field> objects for user editing.
 326
 327 =head1 ATTRIBUTES
 328
 329 =head2 action
 330
 331 L<Reaction::InterfaceModel::Action>
 332
 333 =head2 ok_label
 334
 335 Default: 'ok'
 336
 337 =head2 apply_label
 338
 339 Default: 'apply'
 340
 341 =head2 close_label_close
 342
 343 Default: 'close'
 344
 345 =head2 close_label_cancel
 346
 347 This label is only shown when C<changed> is true.
 348
 349 Default: 'cancel'
 350
 351 =head2 fields
 352
 353 =head2 can_apply
 354
 355 =head2 can_close
 356
 357 =head2 changed
 358
 359 Returns true if a field has been edited.
 360
 361 =head2 next_action
 362
 363 =head2 on_apply_callback
 364
 365 CodeRef.
 366
 367 =head1 METHODS
 368
 369 =head2 ok
 370
 371 Calls C<apply>, and then C<close> if successful.
 372
 373 =head2 close
 374
 375 Pop viewport and proceed to C<next_action>.
 376
 377 =head2 apply
 378
 379 Attempt to save changes and update C<changed> attribute if required.
 380
 381 =head1 SEE ALSO
 382
 383 L<Reaction::UI::ViewPort>
 384
 385 L<Reaction::InterfaceModel::Action>
 386
 387 =head1 AUTHORS
 388
 389 See L<Reaction::Class> for authors.
 390
 391 =head1 LICENSE
 392
 393 See L<Reaction::Class> for the license.
 394
 395 =cut