search spec components factored out of T365

12 files changed, 381 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;
+
diff --git a/lib/Reaction/UI/Controller/Collection/CRUD/Search.pm b/lib/Reaction/UI/Controller/Collection/CRUD/Search.pm
new file mode 100644
index 0000000..e9d467d
--- /dev/null
+++ b/lib/Reaction/UI/Controller/Collection/CRUD/Search.pm
@@ -0,0 +1,29 @@
+package Reaction::UI::Controller::Collection::CRUD::Search;
+use parent 'Reaction::UI::Controller::Collection::CRUD';
+use Reaction::Class;
+
+use aliased 'Reaction::UI::ViewPort::SearchableListViewContainer';
+
+use namespace::clean -except => 'meta';
+
+override _build_action_viewport_map => sub {
+    my ($self) = @_;
+
+    my $map = super;
+
+    $map->{list} = SearchableListViewContainer;
+
+    return $map;
+};
+
+override _build_action_viewport_args => sub {
+    my ($self) = @_;
+
+    my $args = super;
+
+    $args->{list}{layout} = 'searchable_list_view_container';
+
+    return $args;
+};
+
+1;
diff --git a/lib/Reaction/UI/ViewPort/Collection/Role/UseSearchSpec.pm b/lib/Reaction/UI/ViewPort/Collection/Role/UseSearchSpec.pm
new file mode 100644
index 0000000..5949056
--- /dev/null
+++ b/lib/Reaction/UI/ViewPort/Collection/Role/UseSearchSpec.pm
@@ -0,0 +1,35 @@
+package Reaction::UI::ViewPort::Collection::Role::UseSearchSpec;
+
+use Reaction::Role;
+use aliased 'Reaction::InterfaceModel::Search::Spec' => 'SearchSpecRole';
+use Scalar::Util qw(weaken);
+use Method::Signatures::Simple;
+use signatures;
+use namespace::clean -except => 'meta';
+
+has 'search_spec' => (isa => SearchSpecRole, is => 'ro', required => 1);
+
+has '_search_spec_cb' => (is => 'ro', lazy_build => 1);
+
+method _build__search_spec_cb () {
+  my $object = $self;
+  weaken($object);
+  my $cb = sub { $object->clear_current_collection };
+}
+
+method _filter_collection_using_search_spec($coll) {
+  $self->search_spec->filter_collection($coll);
+}
+
+method _register_self_with_search_spec () {
+  my $cb = $self->_search_spec_cb;
+  $self->search_spec->register_dependent($self, $cb);
+}
+
+around _build_current_collection => sub ($orig, $self, @rest) {
+  my $coll = $self->$orig(@rest);
+  return $self->_filter_collection_using_search_spec($coll);
+};
+
+1;
+
diff --git a/lib/Reaction/UI/ViewPort/ListViewWithSearch.pm b/lib/Reaction/UI/ViewPort/ListViewWithSearch.pm
new file mode 100644
index 0000000..ee5f738
--- /dev/null
+++ b/lib/Reaction/UI/ViewPort/ListViewWithSearch.pm
@@ -0,0 +1,14 @@
+package Reaction::UI::ViewPort::ListViewWithSearch;
+
+use Reaction::Class;
+use namespace::clean -except => [ qw(meta) ];
+extends 'Reaction::UI::ViewPort::Collection::Grid';
+
+with 'Reaction::UI::ViewPort::Collection::Role::UseSearchSpec';
+with 'Reaction::UI::ViewPort::Collection::Role::Order';
+with 'Reaction::UI::ViewPort::Collection::Role::Pager';
+with 'Reaction::UI::ViewPort::Role::Actions';
+
+__PACKAGE__->meta->make_immutable;
+
+1;
diff --git a/lib/Reaction/UI/ViewPort/SearchableListViewContainer.pm b/lib/Reaction/UI/ViewPort/SearchableListViewContainer.pm
new file mode 100644
index 0000000..b9f919d
--- /dev/null
+++ b/lib/Reaction/UI/ViewPort/SearchableListViewContainer.pm
@@ -0,0 +1,77 @@
+package Reaction::UI::ViewPort::SearchableListViewContainer;
+use Reaction::Class;
+
+#use aliased 'Reaction::InterfaceModel::Search::Spec', 'SearchSpec';
+use aliased 'Reaction::InterfaceModel::Action::Search::UpdateSpec', 'UpdateSearchSpec';
+use aliased 'Reaction::UI::ViewPort::ListViewWithSearch';
+use aliased 'Reaction::UI::ViewPort::Action' => 'ActionVP';
+use aliased 'Reaction::UI::ViewPort::Collection::Role::Pager', 'PagerRole';
+
+use Method::Signatures::Simple;
+
+use namespace::clean -except => 'meta';
+
+extends 'Reaction::UI::ViewPort';
+
+has 'listview' => (
+    isa => ListViewWithSearch, 
+    is => 'ro', 
+    required => 1, 
+);
+
+has 'search_form' => (isa => ActionVP, is => 'ro', required => 1);
+
+override BUILDARGS => sub {
+  my $args = super;
+  my $spec_event_id = $args->{location}.':search-spec';
+  my $spec_class = $args->{spec_class}
+    or confess "Argument spec_class is required";
+  my $action_class = $args->{action_class}
+    or confess "Argument action_class is required";
+#  TODO: how do we autodiscover spec classes?
+#  $spec_class =~ s/^::/${\SearchSpec}::/;
+  Class::MOP::load_class($spec_class);
+  my $spec = do {
+    if (my $string = $args->{ctx}->req->query_params->{$spec_event_id}) {
+      $spec_class->from_string($string, $args->{spec}||{});
+    } else {
+      $spec_class->new($args->{spec}||{});
+    }
+  };
+  my $listview_location = $args->{location}.'-listview';
+  # should this maybe use the listview class in $args->{listview}?
+  my $listview = $args->{listview} = ListViewWithSearch->new(
+    %$args,
+    layout => 'list_view',
+    search_spec => $spec,
+    location => $listview_location,
+  );
+  # same as with listview wrt. class name
+  $args->{search_form} = ActionVP->new(
+    model => $action_class->new(target_model => $spec),
+    location => $args->{location}.'-search_form',
+    apply_label => 'search',
+    ctx => $args->{ctx},
+    on_apply_callback => sub {
+      my ($vp, $spec) = @_;
+      my $req = $vp->ctx->req;
+      my $new_uri = $req->uri->clone;
+      my %query = %{$req->query_parameters};
+      delete @query{grep /^\Q${listview_location}\E/, keys %query};
+      $query{$spec_event_id} = $spec->to_string;
+      $new_uri->query_form(\%query);
+      $req->uri($new_uri);
+      $listview->clear_page;
+      $listview->clear_order_by;
+    },
+    %{$args->{search}||{}}
+  );
+  $args;
+};
+
+override child_event_sinks => method () {
+  ((map $self->$_, 'listview', 'search_form'), super);
+};
+
+1;
+
diff --git a/lib/Reaction/UI/Widget/Search/NoResults.pm b/lib/Reaction/UI/Widget/Search/NoResults.pm
new file mode 100644
index 0000000..2a35c86
--- /dev/null
+++ b/lib/Reaction/UI/Widget/Search/NoResults.pm
@@ -0,0 +1,10 @@
+package Reaction::UI::Widget::Search::NoResults;
+
+use Reaction::UI::WidgetClass;
+
+use namespace::clean -except => [ qw(meta) ];
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
diff --git a/lib/Reaction/UI/Widget/SearchableListViewContainer.pm b/lib/Reaction/UI/Widget/SearchableListViewContainer.pm
new file mode 100644
index 0000000..31b11c3
--- /dev/null
+++ b/lib/Reaction/UI/Widget/SearchableListViewContainer.pm
@@ -0,0 +1,7 @@
+package Reaction::UI::Widget::SearchableListViewContainer;
+
+use Reaction::UI::WidgetClass;
+extends 'Reaction::UI::Widget::Container';
+use namespace::clean -except => 'meta';
+
+1;
diff --git a/share/skin/base/layout/searchable_list_view_container.tt b/share/skin/base/layout/searchable_list_view_container.tt
new file mode 100644
index 0000000..63c5ad4
--- /dev/null
+++ b/share/skin/base/layout/searchable_list_view_container.tt
@@ -0,0 +1,7 @@
+=for layout widget
+
+[% search_form %]
+
+[% listview %]
+
+=cut
diff --git a/share/skin/base/layout/searchable_list_view_container_with_inner.tt b/share/skin/base/layout/searchable_list_view_container_with_inner.tt
new file mode 100644
index 0000000..fafd516
--- /dev/null
+++ b/share/skin/base/layout/searchable_list_view_container_with_inner.tt
@@ -0,0 +1,14 @@
+=extends searchable_list_view_container
+
+=widget SearchableListViewContainer
+
+=for layout widget
+
+<!-- FOO -->
+
+[% call_next %]
+
+[% inner %]
+
+=cut
+