search spec components factored out of T365
[catagits/Reaction.git] / lib / Reaction / UI / ViewPort.pm
index 4c5ac5a..06ffffa 100644 (file)
 package Reaction::UI::ViewPort;
 
 use Reaction::Class;
-
-class ViewPort which {
-
-  has location => (isa => 'Str', is => 'rw', required => 1);
-  has layout => (isa => 'Str', is => 'rw', lazy_build => 1);
-  has outer => (isa => 'Reaction::UI::ViewPort', is => 'rw', weak_ref => 1);
-  has inner => (isa => 'Reaction::UI::ViewPort', is => 'rw');
-  has focus_stack => (
-    isa => 'Reaction::UI::FocusStack', is => 'rw', weak_ref => 1
-  );
-  has _tangent_stacks => (
-    isa => 'HashRef', is => 'ro', default => sub { {} }
-  );
-  has ctx => (isa => 'Catalyst', is => 'ro', required => 1);
-  has column_order => (is => 'rw');
-  
-  implements build_layout => as {
-    '';
-  };
-  
-  implements create_tangent => as {
-    my ($self, $name) = @_;
-    my $t_map = $self->_tangent_stacks;
-    if (exists $t_map->{$name}) {
-      confess "Can't create tangent with already existing name ${name}";
-    }
-    my $loc = join('.', $self->location, $name);
-    my $tangent = Reaction::UI::FocusStack->new(loc_prefix => $loc);
-    $t_map->{$name} = $tangent;
+use Scalar::Util qw/blessed/;
+
+use namespace::clean -except => [ qw(meta) ];
+
+
+sub DEBUG_EVENTS () { $ENV{REACTION_UI_VIEWPORT_DEBUG_EVENTS} }
+
+has location => (isa => 'Str', is => 'rw', required => 1);
+has layout => (isa => 'Str', is => 'rw', lazy_build => 1);
+has layout_args => (isa => 'HashRef', is => 'ro', default => sub { {} });
+has outer => (isa => 'Reaction::UI::ViewPort', is => 'rw', weak_ref => 1);
+has inner => (isa => 'Reaction::UI::ViewPort', is => 'rw');
+has focus_stack => (
+  isa => 'Reaction::UI::FocusStack', is => 'rw', weak_ref => 1
+);
+has _tangent_stacks => (
+  isa => 'HashRef', is => 'ro', default => sub { {} }
+);
+has ctx => (isa => 'Catalyst', is => 'ro', weak_ref => 1); #, required => 1);
+
+sub _build_layout {
+  '';
+}
+
+sub create_tangent {
+  my ($self, $name) = @_;
+  my $t_map = $self->_tangent_stacks;
+  if (exists $t_map->{$name}) {
+    confess "Can't create tangent with already existing name ${name}";
+  }
+  my $loc = join('.', $self->location, $name);
+  my $tangent = Reaction::UI::FocusStack->new(loc_prefix => $loc);
+  $t_map->{$name} = $tangent;
+  return $tangent;
+}
+
+sub focus_tangent {
+  my ($self, $name) = @_;
+  if (my $tangent = $self->_tangent_stacks->{$name}) {
     return $tangent;
-  };
-  
-  implements focus_tangent => as {
-    my ($self, $name) = @_;
-    if (my $tangent = $self->_tangent_stacks->{$name}) {
-      return $tangent;
-    } else {
-      return;
-    }
-  };
-  
-  implements focus_tangents => as {
-    return keys %{shift->_tangent_stacks};
-  };
-  
-  implements child_event_sinks => as {
-    my $self = shift;
-    return values %{$self->_tangent_stacks};
-  };
-  
-  implements apply_events => as {
-    my ($self, $ctx, $events) = @_;
-    $self->apply_child_events($ctx, $events);
-    $self->apply_our_events($ctx, $events);
-  };
-  
-  implements apply_child_events => as {
-    my ($self, $ctx, $events) = @_;
-    foreach my $child ($self->child_event_sinks) {
-      $child->apply_events($ctx, $events);
+  } else {
+    return;
+  }
+}
+
+sub focus_tangents {
+  return keys %{shift->_tangent_stacks};
+}
+
+sub child_event_sinks {
+  my $self = shift;
+  return values %{$self->_tangent_stacks};
+}
+
+sub apply_events {
+  my ($self, $events) = @_;
+  return unless keys %$events;
+  $self->apply_child_events($events);
+  $self->apply_our_events($events);
+}
+
+sub apply_child_events {
+  my ($self, $events) = @_;
+  return unless keys %$events;
+  foreach my $child ($self->child_event_sinks) {
+    confess blessed($child) ."($child) is not a valid object"
+      unless blessed($child) && $child->can('apply_events');
+    my $loc = $child->location;
+    my %child_events = map { $_ => delete $events->{$_} }
+      grep { /^${loc}[-:]/ } keys %$events;
+    $child->apply_events(\%child_events);
+  }
+}
+
+sub apply_our_events {
+  my ($self, $events) = @_;
+  my $loc = $self->location;
+  my %our_events;
+  foreach my $key (keys %$events) {
+    if ($key =~ m/^${loc}:(.*)$/) {
+      $our_events{$1} = delete $events->{$key};
     }
-  };
-  
-  implements apply_our_events => as {
-    my ($self, $ctx, $events) = @_;
-    my $loc = $self->location;
-    my %our_events;
-    foreach my $key (keys %$events) {
-      if ($key =~ m/^${loc}:(.*)$/) {
-        $our_events{$1} = $events->{$key};
+  }
+  $self->handle_events(\%our_events) if keys %our_events;
+}
+
+sub handle_events {
+  my ($self, $events) = @_;
+  my $exists = exists $events->{exists};
+  if ($exists) {
+    my %force = $self->force_events;
+    my @need = grep { !exists $events->{$_} } keys %force;
+    @{$events}{@need} = @force{@need};
+  }
+  foreach my $event ($self->accept_events) {
+    if (exists $events->{$event}) {
+      if (DEBUG_EVENTS) {
+        my $name = join(' at ', $self, $self->location);
+        print STDERR
+          "Applying Event: $event on $name with value: "
+          .(defined $events->{$event} ? $events->{$event} : '<undef>')."\n";
       }
+      $self->$event($events->{$event});
     }
-    if (keys %our_events) {
-      #warn "$self: events ".join(', ', %our_events)."\n";
-      $self->handle_events(\%our_events);
-    }
-  };
-  
-  implements handle_events => as {
-    my ($self, $events) = @_;
-    foreach my $event ($self->accept_events) {
-      if (exists $events->{$event}) {
-        $self->$event($events->{$event});
-      }
-    }
-  };
-  
-  implements accept_events => as { () };
-  
-  implements event_id_for => as {
-    my ($self, $name) = @_;
-    return join(':', $self->location, $name);
-  };
-  
-  implements sort_by_spec => as {
-    my ($self, $spec, $items) = @_;
-    return $items if not defined $spec;
-  
-    my @order;
-    if (ref $spec eq 'ARRAY') {
-      @order = @$spec;
-    }
-    elsif (not ref $spec) {
-      return $items unless length $spec;
-      @order = split /\s+/, $spec;
-    }
-  
-    my %order_map = map {$_ => 0} @$items;
-    for my $order_num (0..$#order) {
-      $order_map{ $order[$order_num] } = ($#order - $order_num) + 1;
-    }
-  
-    return [sort {$order_map{$b} <=> $order_map{$a}} @$items];
-  };
+  }
+}
+
+sub accept_events { () }
+
+sub force_events { () }
+
+sub event_id_for {
+  my ($self, $name) = @_;
+  return join(':', $self->location, $name);
+}
+
+sub sort_by_spec {
+  my ($self, $spec, $items) = @_;
+  return [sort @$items] unless $spec;
+
+  my @order;
+  if (ref $spec eq 'ARRAY') {
+    @order = @$spec;
+  } elsif (not ref $spec) {
+    @order = split /\s+/, $spec;
+  }
+
+  my %order_map = map {$_ => 0} @$items;
+  for my $order_num (0..$#order) {
+    $order_map{ $order[$order_num] } = ($#order - $order_num) + 1;
+  }
+
+  return [sort {$order_map{$b} <=> $order_map{$a}} @$items];
+}
+
+__PACKAGE__->meta->make_immutable;
 
-};
 
 1;
 
@@ -156,7 +177,7 @@ Reaction::UI::ViewPort - Page layout building block
   # Resolve current events with this ViewPort
   $vp->apply_events($ctx, $param_hash);
 
-  # Apply current events to all tangent stacks 
+  # Apply current events to all tangent stacks
   # This is called by apply_events
   $vp->apply_child_events($ctx, $params_hash);
 
@@ -233,7 +254,7 @@ ViewPorts classname.
 
 This is generally used by more specialised ViewPorts such as the
 L<ListView|Reaction::UI::ViewPort::ListView> or
-L<ActionForm|Reaction::UI::ViewPort::ActionForm>. It can be either a
+L<Action|Reaction::UI::ViewPort::Action>. It can be either a
 space separated list of column names, or an arrayref of column names.
 
 =back
@@ -374,7 +395,7 @@ returns the location and the name, joined with a colon.
 
 Sorts the given list of items such that the ones that also appear in
 the spec are at the beginning. This is called by
-L<Reaction::UI::ViewPort::ActionForm> and
+L<Reaction::UI::ViewPort::Action> and
 L<Reaction::UI::ViewPort::ListView>, and gets passed L<column_order>
 as the spec argument.