search spec components factored out of T365

4 files changed, 188 insertions, 0 deletions

diff --git a/lib/Reaction/InterfaceModel/Action/Search/UpdateSpec.pm b/lib/Reaction/InterfaceModel/Action/Search/UpdateSpec.pm
new file mode 100644
index 0000000..070b9df
--- /dev/null
+++ b/lib/Reaction/InterfaceModel/Action/Search/UpdateSpec.pm
@@ -0,0 +1,27 @@
+package Reaction::InterfaceModel::Action::Search::UpdateSpec;
+
+use Reaction::Class;
+#use aliased 'BrokerInterface::SearchSpec';
+use Method::Signatures::Simple;
+use Reaction::InterfaceModel::Reflector::SearchSpec;
+use Carp qw( confess );
+
+use namespace::clean -except => 'meta';
+
+extends 'Reaction::InterfaceModel::Action';
+
+my %ReflectionCache;
+
+method build_reflected_search_spec () {
+    confess sprintf "Class %s did not override the build_reflected_search_spec method", ref($self) || $self;
+}
+
+method _reflection_info () {
+    $ReflectionCache{ ref($self) || $self }
+        ||= reflect_attributes_from_target $self->build_reflected_search_spec;
+}
+
+with 'Reaction::InterfaceModel::Search::UpdateSpec';
+
+1;
+
diff --git a/lib/Reaction/InterfaceModel/Reflector/SearchSpec.pm b/lib/Reaction/InterfaceModel/Reflector/SearchSpec.pm
new file mode 100644
index 0000000..9d8b905
--- /dev/null
+++ b/lib/Reaction/InterfaceModel/Reflector/SearchSpec.pm
@@ -0,0 +1,53 @@
+package Reaction::InterfaceModel::Reflector::SearchSpec;
+
+use Moose::Exporter;
+use Carp qw(confess);
+use Reaction::Types::Core qw(SimpleStr NonEmptySimpleStr);
+#use aliased 'T365::BrokerInterface::SearchSpec';
+use aliased 'Moose::Meta::TypeConstraint::Enum';
+
+sub reflect_attributes_from_target {
+  my ($caller, $foreign) = @_;
+  confess 'Class name to reflect search specification is required as first argument to reflect_attributes_from_target'
+    unless $foreign;
+#  $foreign ||= SearchSpec;
+  my $meta = Class::MOP::Class->initialize($caller);
+  my %info;
+  foreach my $attr (
+    grep { $_->name !~ /^_/ }
+      $foreign->meta->get_all_attributes
+  ) {
+#warn "Doing ".$attr->name;
+    my %args;
+    { my @copy = qw(required is isa);
+      @args{@copy} = @{$attr}{@copy};
+    }
+    if ($args{isa} eq NonEmptySimpleStr) {
+#warn "here ".$attr->name." ".join(', ', %args);
+      if ($args{required}) {
+        confess "I really have no idea how we got here";
+      } else {
+        $args{isa} = SimpleStr;
+        $args{required} = 1;
+        push(@{$info{empty}||=[]}, $attr->name);
+      }
+    } else {
+      push(@{$info{normal}||=[]}, $attr->name);
+#warn "here instead ".$attr->name;
+    }
+    my $tc;
+    if (($tc = $args{type_constraint}) && ($tc->isa(Enum))) {
+      $args{valid_values} = $tc->values;
+    }
+    $args{predicate} = "has_".$attr->name;
+    $meta->add_attribute($attr->name => \%args);
+  }
+  \%info;
+}
+
+Moose::Exporter->setup_import_methods(
+  with_caller => [ 'reflect_attributes_from_target' ]
+);
+
+1;
+
diff --git a/lib/Reaction/InterfaceModel/Search/Spec.pm b/lib/Reaction/InterfaceModel/Search/Spec.pm
new file mode 100644
index 0000000..25bb916
--- /dev/null
+++ b/lib/Reaction/InterfaceModel/Search/Spec.pm
@@ -0,0 +1,61 @@
+package Reaction::InterfaceModel::Search::Spec;
+
+use Moose::Role;
+use Method::Signatures::Simple;
+use JSON qw(to_json from_json);
+use Scalar::Util qw(weaken);
+use namespace::clean -except => [ qw(meta) ];
+
+has '_search_spec' => (
+  is => 'ro', lazy_build => 1, clearer => '_clear_search_spec',
+);
+
+has '_dependent_clients' => (
+  is => 'ro', default => sub { {} },
+);
+
+method register_dependent ($dep, $callback) {
+  weaken($self->_dependent_clients->{$dep} = $callback);
+}
+
+method unregister_dependent ($dep) {
+  delete $self->_dependent_clients->{$dep};
+}
+
+after '_clear_search_spec' => method () {
+  $_->($self) for grep defined, values %{$self->_dependent_clients};
+};
+
+requires '_build__search_spec';
+
+method filter_collection ($coll) {
+  return $coll->where(@{$self->_search_spec});
+}
+
+method _to_string_fetch ($attr) {
+  return () unless $self->${\($attr->get_predicate_method||sub{ 1 })};
+  my $value = $self->${\$attr->get_read_method};
+  return ($attr->name => $self->_to_string_pack_value($attr->name, $value));
+}
+
+requires '_to_string_pack_value';
+
+method to_string () {
+  my %val = map { $self->_to_string_fetch($_) }
+            grep { $_->name !~ /^_/ } $self->meta->get_all_attributes;
+  return to_json(\%val, { canonical => 1 });
+}
+
+requires '_from_string_unpack_value';
+
+method from_string ($class: $string, $other) {
+  my %raw = %{from_json($string)};
+  my %val;
+  @val{keys %raw} = map {
+    $class->_from_string_unpack_value($_, $raw{$_})
+  } keys %raw;
+  return $class->new({ %val, %{$other||{}} });
+}
+
+1;
+
diff --git a/lib/Reaction/InterfaceModel/Search/UpdateSpec.pm b/lib/Reaction/InterfaceModel/Search/UpdateSpec.pm
new file mode 100644
index 0000000..5299166
--- /dev/null
+++ b/lib/Reaction/InterfaceModel/Search/UpdateSpec.pm
@@ -0,0 +1,47 @@
+package Reaction::InterfaceModel::Search::UpdateSpec;
+
+use Moose::Role;
+use Method::Signatures::Simple;
+use aliased 'Reaction::InterfaceModel::Search::Spec', 'SearchSpec';
+use namespace::clean -except => 'meta';
+
+has '+target_model' => (isa => SearchSpec);
+
+requires '_reflection_info';
+
+override BUILDARGS => method () {
+  my $args = super;
+  my $model = $args->{target_model};
+  my $reflected = $self->_reflection_info;
+  foreach my $attr (@{$reflected->{empty}||[]}) {
+    if ($model->${\"has_${attr}"}) {
+      $args->{$attr} = $model->$attr;
+    } else {
+      $args->{$attr} = '';
+    }
+  }
+  foreach my $attr (@{$reflected->{normal}||[]}) {
+    my $has = $model->can("has_${attr}")||sub {1};
+    $args->{$attr} = $model->$attr if $model->$has;
+  }
+  $args;
+};
+
+method do_apply () {
+  my $data = $self->parameter_hashref;
+  my $spec = $self->target_model;
+  foreach my $name (keys %$data) {
+    # note: this assumes plain is => 'rw' attrs on the backend
+    # which is safe since we control it. Also, we assume '' means
+    # clear - this may not be safe later but is for now
+    if (length(my $value = $data->{$name})) {
+      $spec->$name($value);
+    } else {
+      $spec->${\"clear_${name}"};
+    }
+  }
+  $spec;
+}
+
+1;
+