lib/Reaction/UI/Widget.pm

   1 package Reaction::UI::Widget;
   2
   3 use Reaction::Class;
   4 use aliased 'Reaction::UI::ViewPort';
   5 use aliased 'Reaction::UI::View';
   6 use aliased 'Reaction::UI::LayoutSet';
   7
   8 class Widget which {
   9
  10   has 'view' => (isa => View, is => 'ro', required => 1);
  11   has 'layout_set' => (isa => LayoutSet, is => 'ro', required => 1);
  12   has 'fragment_names' => (is => 'ro', lazy_build => 1);
  13   has 'basic_layout_args' => (is => 'ro', lazy_build => 1);
  14
  15   implements '_build_fragment_names' => as {
  16     my ($self) = shift;
  17     return [
  18       map { /^_fragment_(.*)/; $1; }
  19       grep { /^_fragment_/ }
  20       map { $_->{name} }
  21       $self->meta->compute_all_applicable_methods
  22     ];
  23   };
  24
  25   implements 'render' => as {
  26     my ($self, $fragment_name, $rctx, $passed_args) = @_;
  27     confess "\$passed_args not hashref" unless ref($passed_args) eq 'HASH';
  28 #warn "Render: ${fragment_name} for ${self}";
  29     my $args = { self => $self, %$passed_args };
  30     my $new_args = { %$args };
  31     my $render_tree = $self->_render_dispatch_order(
  32                         $fragment_name, $args, $new_args
  33                       );
  34     $rctx->dispatch($render_tree, $new_args);
  35   };
  36
  37   implements '_render_dispatch_order' => as {
  38     my ($self, $fragment_name, $args, $new_args) = @_;
  39
  40     my @render_stack = (my $render_deep = (my $render_curr = []));
  41     my @layout_order = $self->layout_set->widget_order_for($fragment_name);
  42
  43     if (my $f_meth = $self->can("_fragment_${fragment_name}")) {
  44       my @wclass_stack;
  45       my $do_render = sub {
  46         my $package = shift;
  47         if (@layout_order) {
  48           while ($package eq $layout_order[0][0]
  49                  || $layout_order[0][0]->isa($package)) {
  50             my $new_curr = [];
  51             my @l = @{shift(@layout_order)};
  52             push(@$render_curr, [ -layout, $l[1], $fragment_name, $new_curr ]);
  53             push(@render_stack, $new_curr);
  54             push(@wclass_stack, $l[0]);
  55             $render_deep = $render_curr = $new_curr;
  56             last unless @layout_order;
  57           }
  58         }
  59         if (@wclass_stack) {
  60           while ($package ne $wclass_stack[-1]
  61                  && $package->isa($wclass_stack[-1])) {
  62             pop(@wclass_stack);
  63             $render_curr = pop(@render_stack);
  64           }
  65         }
  66         push(@{$render_curr}, [ -render, @_ ]);
  67       };
  68       $self->$f_meth($do_render, $args, $new_args);
  69     }
  70     # if we had no fragment method or if we still have layouts left
  71     if (@layout_order) {
  72       while (my $l = shift(@layout_order)) {
  73         push(@$render_deep, [
  74           -layout => $l->[1], $fragment_name, ($render_deep = [])
  75         ]);
  76       }
  77     }
  78
  79     return $render_stack[0];
  80   };
  81
  82   implements '_build_basic_layout_args' => as {
  83     my ($self) = @_;
  84     my $args;
  85     foreach my $name (@{$self->fragment_names},
  86                       @{$self->layout_set->layout_names}) {
  87       $args->{$name} ||= sub { $self->render($name, @_); };
  88     }
  89     return $args;
  90   };
  91
  92   implements '_fragment_viewport' => as {
  93     my ($self, $do_render, $args, $new_args) = @_;
  94     my $vp = $args->{'_'};
  95     my ($widget, $merge_args) = $self->view->render_viewport_args($vp);
  96     delete @{$new_args}{keys %$new_args}; # fresh start
  97     @{$new_args}{keys %$merge_args} = values %$merge_args;
  98     $do_render->(Widget, $widget, 'widget');
  99   };
 100
 101   implements '_fragment_widget' => as {
 102     my ($self, $do_render, $args, $new_args) = @_;
 103     my $merge = $self->basic_layout_args;
 104 #warn "Merge: ".join(', ', keys %$merge)." into: ".join(', ', keys %$new_args);
 105     delete @{$merge}{keys %$new_args}; # nuke 'self' and 'viewport'
 106     @{$new_args}{keys %$merge} = values %$merge;
 107   };
 108
 109 };
 110
 111 1;
 112
 113 =head1 NAME
 114
 115 Reaction::UI::Widget
 116
 117 =head1 DESCRIPTION
 118
 119 =head1 AUTHORS
 120
 121 See L<Reaction::Class> for authors.
 122
 123 =head1 LICENSE
 124
 125 See L<Reaction::Class> for the license.
 126
 127 =cut