[catagits/Reaction.git] / lib / Reaction / UI / ViewPort / Action.pm

package Reaction::UI::ViewPort::Action;

use Reaction::Class;

use aliased 'Reaction::UI::ViewPort::Object';

BEGIN { *DEBUG_EVENTS = \&Reaction::UI::ViewPort::DEBUG_EVENTS; }

use aliased 'Reaction::UI::ViewPort::Field::Mutable::Text';
use aliased 'Reaction::UI::ViewPort::Field::Mutable::Array';
use aliased 'Reaction::UI::ViewPort::Field::Mutable::String';
use aliased 'Reaction::UI::ViewPort::Field::Mutable::Number';
use aliased 'Reaction::UI::ViewPort::Field::Mutable::Integer';
use aliased 'Reaction::UI::ViewPort::Field::Mutable::Boolean';
use aliased 'Reaction::UI::ViewPort::Field::Mutable::Password';
use aliased 'Reaction::UI::ViewPort::Field::Mutable::DateTime';
use aliased 'Reaction::UI::ViewPort::Field::Mutable::ChooseOne';
use aliased 'Reaction::UI::ViewPort::Field::Mutable::ChooseMany';

use aliased 'Reaction::UI::ViewPort::Field::Mutable::File';
#use aliased 'Reaction::UI::ViewPort::Field::Mutable::TimeRange';

use Reaction::Types::Core qw/NonEmptySimpleStr/;

use namespace::clean -except => [ qw(meta) ];
extends Object;


has model  => (is => 'ro', isa => 'Reaction::InterfaceModel::Action', required => 1);
#has '+model' => (isa => 'Reaction::InterfaceModel::Action');
has method => ( isa => NonEmptySimpleStr, is => 'rw', default => sub { 'post' } );

has on_apply_callback => (is => 'rw', isa => 'CodeRef');
has on_close_callback => (is => 'rw', isa => 'CodeRef');

has ok_label           => (is => 'rw', isa => 'Str', lazy_build => 1);
has apply_label        => (is => 'rw', isa => 'Str', lazy_build => 1);
has close_label        => (is => 'rw', isa => 'Str', lazy_fail  => 1);
has close_label_close  => (is => 'rw', isa => 'Str', lazy_build => 1);
has close_label_cancel => (is => 'rw', isa => 'Str', lazy_build => 1);

has changed => (is => 'rw', isa => 'Int', reader => 'is_changed', default => sub{0});
sub BUILD {
  my $self = shift;
  $self->close_label($self->close_label_close);
};
sub _build_ok_label { 'ok'     };
sub _build_apply_label { 'apply'  };
sub _build_close_label_close { 'close'  };
sub _build_close_label_cancel { 'cancel' };
sub can_apply {
  my ($self) = @_;
  foreach my $field ( @{ $self->fields } ) {
    if ($field->needs_sync) {
      if (DEBUG_EVENTS) {
        $self->ctx->log->debug(
          "Failing out of can_apply on ${\ref($self)} at ${\$self->location}"
          ." because field for ${\$field->attribute->name} needs sync"
        );
      }
      return 0;
    }
    # if e.g. a datetime field has an invalid value that can't be re-assembled
    # into a datetime object, the action may be in a consistent state but
    # not synchronized from the fields; in this case, we must not apply
  }
  if (DEBUG_EVENTS) {
    my $ret = $self->model->can_apply;
    $self->ctx->log->debug(
      "model can_apply returned ${ret}"
      ." on ${\ref($self)} at ${\$self->location}"
    );
    return $ret;
  }
  return $self->model->can_apply;
};
sub do_apply {
  shift->model->do_apply;
};
sub ok {
  my $self = shift;
  $self->close(@_) if $self->apply(@_);
};
sub apply {
  my $self = shift;
  if ($self->can_apply && (my $result = $self->do_apply)) {
    $self->changed(0);
    $self->close_label($self->close_label_close);
    $self->on_apply_callback->($self => $result) if $self->has_on_apply_callback;
    return 1;
  } else {
    $self->changed(1);
    $self->close_label($self->close_label_cancel);
    return 0;
  }
};
sub close {
  my $self = shift;
  return unless $self->has_on_close_callback;
  $self->on_close_callback->($self);
};
sub can_close { 1 };

override accept_events => sub {
  (($_[0]->has_on_close_callback ? ('ok', 'close') : ()), 'apply', super());
}; # can't do a close-type operation if there's nowhere to go afterwards

after apply_child_events => sub {
  # interrupt here because fields will have been updated
  my ($self) = @_;
  $self->sync_action_from_fields;
};
sub sync_action_from_fields {
  my ($self) = @_;
  foreach my $field (@{$self->fields}) {
    $field->sync_to_action; # get the field to populate the $action if possible
  }
  $self->model->sync_all;
  foreach my $field (@{$self->fields}) {
    $field->sync_from_action; # get errors from $action if applicable
  }
};
sub _build_fields_for_type_Num {
  my ($self, $attr, $args) = @_;
  $self->_build_simple_field(attribute => $attr, class => Number, %$args);
};
sub _build_fields_for_type_Int {
  my ($self, $attr, $args) = @_;
  $self->_build_simple_field(attribute => $attr, class => Integer, %$args);
};
sub _build_fields_for_type_Bool {
  my ($self,  $attr, $args) = @_;
  $self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
};
sub _build_fields_for_type_Reaction_Types_Core_SimpleStr {
  my ($self, $attr, $args) = @_;
  $self->_build_simple_field(attribute => $attr, class => String, %$args);
};
sub _build_fields_for_type_Reaction_Types_File_File {
  my ($self, $attr, $args) = @_;
  $self->_build_simple_field(attribute => $attr, class => File, %$args);
};
sub _build_fields_for_type_Str {
  my ($self, $attr, $args) = @_;
  if ($attr->has_valid_values) { # There's probably a better way to do this
    $self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
  } else {
    $self->_build_simple_field(attribute => $attr, class => Text, %$args);
  }
};
sub _build_fields_for_type_Reaction_Types_Core_Password {
  my ($self, $attr, $args) = @_;
  $self->_build_simple_field(attribute => $attr, class => Password, %$args);
};
sub _build_fields_for_type_Reaction_Types_DateTime_DateTime {
  my ($self, $attr, $args) = @_;
  $self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
};
sub _build_fields_for_type_Enum {
  my ($self, $attr, $args) = @_;
    $self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
};

#this needs to be fixed. somehow. beats the shit our of me. really.
#implements build_fields_for_type_Reaction_InterfaceModel_Object => as {
sub _build_fields_for_type_DBIx_Class_Row {
  my ($self, $attr, $args) = @_;
  $self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
};
sub _build_fields_for_type_ArrayRef {
  my ($self, $attr, $args) = @_;
  if ($attr->has_valid_values) {
    $self->_build_simple_field(attribute => $attr, class => ChooseMany,  %$args);
  } else {
    $self->_build_simple_field
      (
       attribute => $attr,
       class     => Array,
       layout    => 'field/mutable/hidden_array',
       %$args);
  }
};

#implements _build_fields_for_type_DateTime_Spanset => as {
#  my ($self, $attr, $args) = @_;
#    $self->_build_simple_field(attribute => $attr, class => TimeRange,  %$args);
#};

__PACKAGE__->meta->make_immutable;


  1;

=head1 NAME

Reaction::UI::ViewPort::Action

=head1 SYNOPSIS

  use aliased 'Reaction::UI::ViewPort::Action';

  $self->push_viewport(Action,
    layout => 'register',
    model => $action,
    next_action => [ $self, 'redirect_to', 'accounts', $c->req->captures ],
    ctx => $c,
    field_order => [
      qw / contact_title company_name email address1 address2 address3
           city country post_code telephone mobile fax/ ],
  );

=head1 DESCRIPTION

This subclass of L<Reaction::UI::ViewPort::Object> is used for rendering a
collection of C<Reaction::UI::ViewPort::Field::Mutable::*> objects for user editing.

=head1 ATTRIBUTES

=head2 model

L<Reaction::InterfaceModel::Action>

=head2 ok_label

Default: 'ok'

=head2 apply_label

Default: 'apply'

=head2 close_label_close

Default: 'close'

=head2 close_label_cancel

This label is only shown when C<changed> is true.

Default: 'cancel'

=head2 fields

=head2 can_apply

=head2 can_close

=head2 changed

Returns true if a field has been edited.

=head2 next_action

=head2 on_apply_callback

CodeRef.

=head1 METHODS

=head2 ok

Calls C<apply>, and then C<close> if successful.

=head2 close

Pop viewport and proceed to C<next_action>.

=head2 apply

Attempt to save changes and update C<changed> attribute if required.

=head1 SEE ALSO

L<Reaction::UI::ViewPort::Object>

L<Reaction::UI::ViewPort>

L<Reaction::InterfaceModel::Action>

=head1 AUTHORS

See L<Reaction::Class> for authors.

=head1 LICENSE

See L<Reaction::Class> for the license.

=cut
Commit	Line	Data
ddccc6a2	1	package Reaction::UI::ViewPort::Action;
	2
	3	use Reaction::Class;
	4
d9a3266f	5	use aliased 'Reaction::UI::ViewPort::Object';
	6
	7	BEGIN { *DEBUG_EVENTS = \&Reaction::UI::ViewPort::DEBUG_EVENTS; }
	8
ddccc6a2	9	use aliased 'Reaction::UI::ViewPort::Field::Mutable::Text';
	10	use aliased 'Reaction::UI::ViewPort::Field::Mutable::Array';
	11	use aliased 'Reaction::UI::ViewPort::Field::Mutable::String';
	12	use aliased 'Reaction::UI::ViewPort::Field::Mutable::Number';
	13	use aliased 'Reaction::UI::ViewPort::Field::Mutable::Integer';
	14	use aliased 'Reaction::UI::ViewPort::Field::Mutable::Boolean';
	15	use aliased 'Reaction::UI::ViewPort::Field::Mutable::Password';
	16	use aliased 'Reaction::UI::ViewPort::Field::Mutable::DateTime';
	17	use aliased 'Reaction::UI::ViewPort::Field::Mutable::ChooseOne';
	18	use aliased 'Reaction::UI::ViewPort::Field::Mutable::ChooseMany';
	19
ddd1dc65	20	use aliased 'Reaction::UI::ViewPort::Field::Mutable::File';
bd1283bd	21	#use aliased 'Reaction::UI::ViewPort::Field::Mutable::TimeRange';
ddccc6a2	22
2e07908b	23	use Reaction::Types::Core qw/NonEmptySimpleStr/;
2e07908b	24
81393881	25	use namespace::clean -except => [ qw(meta) ];
81393881	26	extends Object;
ddccc6a2	27
ddccc6a2	28
81393881	29	has model => (is => 'ro', isa => 'Reaction::InterfaceModel::Action', required => 1);
	30	#has '+model' => (isa => 'Reaction::InterfaceModel::Action');
	31	has method => ( isa => NonEmptySimpleStr, is => 'rw', default => sub { 'post' } );
ddccc6a2	32
81393881	33	has on_apply_callback => (is => 'rw', isa => 'CodeRef');
52f292b2	34	has on_close_callback => (is => 'rw', isa => 'CodeRef');
ddccc6a2	35
81393881	36	has ok_label => (is => 'rw', isa => 'Str', lazy_build => 1);
	37	has apply_label => (is => 'rw', isa => 'Str', lazy_build => 1);
	38	has close_label => (is => 'rw', isa => 'Str', lazy_fail => 1);
	39	has close_label_close => (is => 'rw', isa => 'Str', lazy_build => 1);
	40	has close_label_cancel => (is => 'rw', isa => 'Str', lazy_build => 1);
	41
	42	has changed => (is => 'rw', isa => 'Int', reader => 'is_changed', default => sub{0});
	43	sub BUILD {
	44	my $self = shift;
	45	$self->close_label($self->close_label_close);
	46	};
	47	sub _build_ok_label { 'ok' };
	48	sub _build_apply_label { 'apply' };
	49	sub _build_close_label_close { 'close' };
	50	sub _build_close_label_cancel { 'cancel' };
	51	sub can_apply {
	52	my ($self) = @_;
	53	foreach my $field ( @{ $self->fields } ) {
	54	if ($field->needs_sync) {
	55	if (DEBUG_EVENTS) {
	56	$self->ctx->log->debug(
	57	"Failing out of can_apply on ${\ref($self)} at ${\$self->location}"
	58	." because field for ${\$field->attribute->name} needs sync"
	59	);
d9a3266f	60	}
ddccc6a2	61	return 0;
ddccc6a2	62	}
81393881	63	# if e.g. a datetime field has an invalid value that can't be re-assembled
	64	# into a datetime object, the action may be in a consistent state but
	65	# not synchronized from the fields; in this case, we must not apply
	66	}
	67	if (DEBUG_EVENTS) {
	68	my $ret = $self->model->can_apply;
	69	$self->ctx->log->debug(
	70	"model can_apply returned ${ret}"
	71	." on ${\ref($self)} at ${\$self->location}"
	72	);
	73	return $ret;
	74	}
	75	return $self->model->can_apply;
	76	};
	77	sub do_apply {
	78	shift->model->do_apply;
	79	};
	80	sub ok {
	81	my $self = shift;
	82	$self->close(@_) if $self->apply(@_);
	83	};
	84	sub apply {
	85	my $self = shift;
	86	if ($self->can_apply && (my $result = $self->do_apply)) {
	87	$self->changed(0);
	88	$self->close_label($self->close_label_close);
	89	$self->on_apply_callback->($self => $result) if $self->has_on_apply_callback;
	90	return 1;
	91	} else {
	92	$self->changed(1);
	93	$self->close_label($self->close_label_cancel);
	94	return 0;
	95	}
	96	};
	97	sub close {
	98	my $self = shift;
52f292b2	99	return unless $self->has_on_close_callback;
52f292b2	100	$self->on_close_callback->($self);
81393881	101	};
	102	sub can_close { 1 };
	103
	104	override accept_events => sub {
52f292b2	105	(($_[0]->has_on_close_callback ? ('ok', 'close') : ()), 'apply', super());
81393881	106	}; # can't do a close-type operation if there's nowhere to go afterwards
ddccc6a2	107
81393881	108	after apply_child_events => sub {
	109	# interrupt here because fields will have been updated
	110	my ($self) = @_;
	111	$self->sync_action_from_fields;
	112	};
	113	sub sync_action_from_fields {
	114	my ($self) = @_;
	115	foreach my $field (@{$self->fields}) {
	116	$field->sync_to_action; # get the field to populate the $action if possible
	117	}
	118	$self->model->sync_all;
	119	foreach my $field (@{$self->fields}) {
	120	$field->sync_from_action; # get errors from $action if applicable
	121	}
	122	};
	123	sub _build_fields_for_type_Num {
	124	my ($self, $attr, $args) = @_;
	125	$self->_build_simple_field(attribute => $attr, class => Number, %$args);
	126	};
	127	sub _build_fields_for_type_Int {
	128	my ($self, $attr, $args) = @_;
	129	$self->_build_simple_field(attribute => $attr, class => Integer, %$args);
	130	};
	131	sub _build_fields_for_type_Bool {
	132	my ($self, $attr, $args) = @_;
	133	$self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
	134	};
	135	sub _build_fields_for_type_Reaction_Types_Core_SimpleStr {
	136	my ($self, $attr, $args) = @_;
	137	$self->_build_simple_field(attribute => $attr, class => String, %$args);
	138	};
	139	sub _build_fields_for_type_Reaction_Types_File_File {
	140	my ($self, $attr, $args) = @_;
	141	$self->_build_simple_field(attribute => $attr, class => File, %$args);
	142	};
	143	sub _build_fields_for_type_Str {
	144	my ($self, $attr, $args) = @_;
	145	if ($attr->has_valid_values) { # There's probably a better way to do this
	146	$self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
	147	} else {
	148	$self->_build_simple_field(attribute => $attr, class => Text, %$args);
	149	}
	150	};
	151	sub _build_fields_for_type_Reaction_Types_Core_Password {
	152	my ($self, $attr, $args) = @_;
	153	$self->_build_simple_field(attribute => $attr, class => Password, %$args);
	154	};
	155	sub _build_fields_for_type_Reaction_Types_DateTime_DateTime {
	156	my ($self, $attr, $args) = @_;
	157	$self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
	158	};
	159	sub _build_fields_for_type_Enum {
	160	my ($self, $attr, $args) = @_;
	161	$self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
	162	};
ddccc6a2	163
81393881	164	#this needs to be fixed. somehow. beats the shit our of me. really.
	165	#implements build_fields_for_type_Reaction_InterfaceModel_Object => as {
	166	sub _build_fields_for_type_DBIx_Class_Row {
	167	my ($self, $attr, $args) = @_;
	168	$self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
ddccc6a2	169	};
81393881	170	sub _build_fields_for_type_ArrayRef {
	171	my ($self, $attr, $args) = @_;
	172	if ($attr->has_valid_values) {
	173	$self->_build_simple_field(attribute => $attr, class => ChooseMany, %$args);
	174	} else {
	175	$self->_build_simple_field
	176	(
	177	attribute => $attr,
	178	class => Array,
	179	layout => 'field/mutable/hidden_array',
	180	%$args);
	181	}
	182	};
	183
	184	#implements _build_fields_for_type_DateTime_Spanset => as {
	185	# my ($self, $attr, $args) = @_;
	186	# $self->_build_simple_field(attribute => $attr, class => TimeRange, %$args);
	187	#};
	188
	189	__PACKAGE__->meta->make_immutable;
	190
ddccc6a2	191
	192	1;
	193
	194	=head1 NAME
	195
bd1283bd	196	Reaction::UI::ViewPort::Action
ddccc6a2	197
	198	=head1 SYNOPSIS
	199
2f670e13	200	use aliased 'Reaction::UI::ViewPort::Action';
ddccc6a2	201
	202	$self->push_viewport(Action,
	203	layout => 'register',
	204	model => $action,
	205	next_action => [ $self, 'redirect_to', 'accounts', $c->req->captures ],
	206	ctx => $c,
	207	field_order => [
	208	qw / contact_title company_name email address1 address2 address3
	209	city country post_code telephone mobile fax/ ],
	210	);
	211
	212	=head1 DESCRIPTION
	213
2dba7201	214	This subclass of L<Reaction::UI::ViewPort::Object> is used for rendering a
2dba7201	215	collection of C<Reaction::UI::ViewPort::Field::Mutable::*> objects for user editing.
ddccc6a2	216
	217	=head1 ATTRIBUTES
	218
	219	=head2 model
	220
	221	L<Reaction::InterfaceModel::Action>
	222
	223	=head2 ok_label
	224
	225	Default: 'ok'
	226
	227	=head2 apply_label
	228
	229	Default: 'apply'
	230
	231	=head2 close_label_close
	232
	233	Default: 'close'
	234
	235	=head2 close_label_cancel
	236
	237	This label is only shown when C<changed> is true.
	238
	239	Default: 'cancel'
	240
	241	=head2 fields
	242
	243	=head2 can_apply
	244
	245	=head2 can_close
	246
	247	=head2 changed
	248
	249	Returns true if a field has been edited.
	250
	251	=head2 next_action
	252
	253	=head2 on_apply_callback
	254
	255	CodeRef.
	256
	257	=head1 METHODS
	258
	259	=head2 ok
	260
	261	Calls C<apply>, and then C<close> if successful.
	262
	263	=head2 close
	264
	265	Pop viewport and proceed to C<next_action>.
	266
	267	=head2 apply
	268
	269	Attempt to save changes and update C<changed> attribute if required.
	270
	271	=head1 SEE ALSO
	272
2dba7201	273	L<Reaction::UI::ViewPort::Object>
2dba7201	274
ddccc6a2	275	L<Reaction::UI::ViewPort>
	276
	277	L<Reaction::InterfaceModel::Action>
	278
	279	=head1 AUTHORS
	280
	281	See L<Reaction::Class> for authors.
	282
	283	=head1 LICENSE
	284
	285	See L<Reaction::Class> for the license.
	286
	287	=cut