rclass stuff ripped out of everything but widget classes

1 files changed, 157 insertions, 173 deletions

diff --git a/lib/Reaction/UI/ViewPort/Action.pm b/lib/Reaction/UI/ViewPort/Action.pm
index fba28cf..b62e68f 100644
--- a/lib/Reaction/UI/ViewPort/Action.pm
+++ b/lib/Reaction/UI/ViewPort/Action.pm
@@ -22,189 +22,173 @@ use aliased 'Reaction::UI::ViewPort::Field::Mutable::File';
 
 use Reaction::Types::Core qw/NonEmptySimpleStr/;
 
-class Action is Object, which {
-  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' } );
+use namespace::clean -except => [ qw(meta) ];
+extends Object;
 
-  has next_action       => (is => 'rw', isa => 'ArrayRef');
-  has on_apply_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 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 changed => (is => 'rw', isa => 'Int', reader => 'is_changed', default => sub{0});
+has next_action       => (is => 'rw', isa => 'ArrayRef');
+has on_apply_callback => (is => 'rw', isa => 'CodeRef');
 
-  implements BUILD => as{
-    my $self = shift;
-    $self->close_label($self->close_label_close);
-  };
-
-  implements _build_ok_label           => as{ 'ok'     };
-  implements _build_apply_label        => as{ 'apply'  };
-  implements _build_close_label_close  => as{ 'close'  };
-  implements _build_close_label_cancel => as{ 'cancel' };
-
-  implements can_apply => as {
-    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;
+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"
+        );
       }
-      # 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;
-  };
-
-  implements do_apply => as {
-    shift->model->do_apply;
-  };
-
-  implements ok => as {
-    my $self = shift;
-    $self->close(@_) if $self->apply(@_);
-  };
-
-  implements apply => as {
-    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;
     }
-  };
-
-  implements close => as {
-    my $self = shift;
-    my ($controller, $name, @args) = @{$self->next_action};
-    $controller->pop_viewport;
-    $controller->$name($self->ctx, @args);
-  };
-
-  implements can_close => as { 1 };
-
-  override accept_events => sub {
-    (($_[0]->has_next_action ? ('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;
-  };
-
-  implements sync_action_from_fields => as {
-    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
-    }
-  };
-
-
-  implements _build_fields_for_type_Num => as {
-    my ($self, $attr, $args) = @_;
-    $self->_build_simple_field(attribute => $attr, class => Number, %$args);
-  };
-
-  implements _build_fields_for_type_Int => as {
-    my ($self, $attr, $args) = @_;
-    $self->_build_simple_field(attribute => $attr, class => Integer, %$args);
-  };
-
-  implements _build_fields_for_type_Bool => as {
-    my ($self,  $attr, $args) = @_;
-    $self->_build_simple_field(attribute => $attr, class => Boolean, %$args);
-  };
-
-  implements _build_fields_for_type_Reaction_Types_Core_SimpleStr => as {
-    my ($self, $attr, $args) = @_;
-    $self->_build_simple_field(attribute => $attr, class => String, %$args);
-  };
-
-  implements _build_fields_for_type_Reaction_Types_File_File => as {
-    my ($self, $attr, $args) = @_;
-    $self->_build_simple_field(attribute => $attr, class => File, %$args);
-  };
-
-  implements _build_fields_for_type_Str => as {
-    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);
-    }
-  };
-
-  implements _build_fields_for_type_Reaction_Types_Core_Password => as {
-    my ($self, $attr, $args) = @_;
-    $self->_build_simple_field(attribute => $attr, class => Password, %$args);
-  };
-
-  implements _build_fields_for_type_Reaction_Types_DateTime_DateTime => as {
-    my ($self, $attr, $args) = @_;
-    $self->_build_simple_field(attribute => $attr, class => DateTime, %$args);
-  };
-
-  implements _build_fields_for_type_Enum => as {
-    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 {
-  implements _build_fields_for_type_DBIx_Class_Row => as {
-    my ($self, $attr, $args) = @_;
-    $self->_build_simple_field(attribute => $attr, class => ChooseOne, %$args);
-  };
-
-  implements _build_fields_for_type_ArrayRef => as {
-    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);
-    }
-  };
+    # 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;
+  my ($controller, $name, @args) = @{$self->next_action};
+  $controller->pop_viewport;
+  $controller->$name($self->ctx, @args);
+};
+sub can_close { 1 };
+
+override accept_events => sub {
+  (($_[0]->has_next_action ? ('ok', 'close') : ()), 'apply', super());
+}; # can't do a close-type operation if there's nowhere to go afterwards
 
-  #implements _build_fields_for_type_DateTime_Spanset => as {
-  #  my ($self, $attr, $args) = @_;
-  #    $self->_build_simple_field(attribute => $attr, class => TimeRange,  %$args);
-  #};
+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;