--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
+
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+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;
--- /dev/null
+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;
+
--- /dev/null
+package Reaction::UI::Widget::Search::NoResults;
+
+use Reaction::UI::WidgetClass;
+
+use namespace::clean -except => [ qw(meta) ];
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
--- /dev/null
+package Reaction::UI::Widget::SearchableListViewContainer;
+
+use Reaction::UI::WidgetClass;
+extends 'Reaction::UI::Widget::Container';
+use namespace::clean -except => 'meta';
+
+1;
--- /dev/null
+=for layout widget
+
+[% search_form %]
+
+[% listview %]
+
+=cut
--- /dev/null
+=extends searchable_list_view_container
+
+=widget SearchableListViewContainer
+
+=for layout widget
+
+<!-- FOO -->
+
+[% call_next %]
+
+[% inner %]
+
+=cut
+
projects / catagits/Reaction.git / commitdiff