search spec components factored out of T365
[catagits/Reaction.git] / 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 use namespace::clean -except => [ qw(meta) ];
9
10
11 sub DEBUG_FRAGMENTS () { $ENV{REACTION_UI_WIDGET_DEBUG_FRAGMENTS} }
12 sub DEBUG_LAYOUTS () { $ENV{REACTION_UI_WIDGET_DEBUG_LAYOUTS} }
13
14 has 'view' => (isa => View, is => 'ro', required => 1);
15 has 'layout_set' => (isa => LayoutSet, is => 'ro', required => 1);
16 has 'fragment_names' => (is => 'ro', lazy_build => 1);
17 has 'basic_layout_args' => (is => 'ro', lazy_build => 1);
18 sub _build_fragment_names {
19   my ($self) = shift;
20   return [
21     map { /^_fragment_(.*)/; $1; }
22     grep { /^_fragment_/ }
23     map { $_->{name} }
24     $self->meta->compute_all_applicable_methods
25   ];
26 };
27 sub render {
28   my ($self, $fragment_name, $rctx, $passed_args) = @_;
29   confess "\$passed_args not hashref" unless ref($passed_args) eq 'HASH';
30   if (DEBUG_FRAGMENTS) {
31     my $vp = $passed_args->{viewport};
32     $self->view->app->log->debug(
33       "Rendering fragment ${fragment_name} for ".ref($self)
34       ." for VP ${vp} at ".$vp->location
35     );
36   }
37   my $args = { self => $self, %$passed_args };
38   my $new_args = { %$args };
39   my $render_tree = $self->_render_dispatch_order(
40                       $fragment_name, $args, $new_args
41                     );
42   $rctx->dispatch($render_tree, $new_args);
43 };
44 sub _method_for_fragment_name {
45   my ($self, $fragment_name) = @_;
46   return $self->can("_fragment_${fragment_name}");
47 };
48 sub _render_dispatch_order {
49   my ($self, $fragment_name, $args, $new_args) = @_;
50
51   my @render_stack = (my $render_deep = (my $render_curr = []));
52   my @layout_order = $self->layout_set->widget_order_for($fragment_name);
53
54   if (my $f_meth = $self->_method_for_fragment_name($fragment_name)) {
55     my @wclass_stack;
56     my $do_render = sub {
57       my $package = shift;
58       if (@layout_order) {
59         while ($package eq $layout_order[0][0]
60                || $layout_order[0][0]->isa($package)) {
61           my $new_curr = [];
62           my @l = @{shift(@layout_order)};
63           if (DEBUG_LAYOUTS) {
64             $self->view->app->log->debug(
65               "Layout ${fragment_name} in ${\$l[1]->name} from ${\$l[1]->source_file}"
66             );
67           }
68           push(@$render_curr, [ -layout, $l[1], $fragment_name, $new_curr ]);
69           push(@render_stack, $new_curr);
70           push(@wclass_stack, $l[0]);
71           $render_deep = $render_curr = $new_curr;
72           last unless @layout_order;
73         }
74       }
75       if (@wclass_stack) {
76         while ($package ne $wclass_stack[-1]
77                && $package->isa($wclass_stack[-1])) {
78           pop(@wclass_stack);
79           $render_curr = pop(@render_stack);
80         }
81       }
82       push(@{$render_curr}, [ '-render', @_ ]);
83     };
84     $self->$f_meth($do_render, $args, $new_args);
85   }
86   # if we had no fragment method or if we still have layouts left
87   if (@layout_order) {
88     while (my $l = shift(@layout_order)) {
89       if (DEBUG_LAYOUTS) {
90         $self->view->app->log->debug(
91           "Layout ${fragment_name} in ${\$l->[1]->name} from ${\$l->[1]->source_file}"
92         );
93       }
94       push(@$render_deep, [
95         -layout => $l->[1], $fragment_name, ($render_deep = [])
96       ]);
97     }
98   }
99
100   return $render_stack[0];
101 };
102 sub _build_basic_layout_args {
103   my ($self) = @_;
104   my $args;
105   foreach my $name (@{$self->fragment_names},
106                     @{$self->layout_set->layout_names}) {
107     $args->{$name} ||= sub { $self->render($name, @_); };
108   }
109   return $args;
110 };
111 sub _fragment_viewport {
112   my ($self, $do_render, $args, $new_args) = @_;
113   my $vp = $args->{'_'};
114   my ($widget, $merge_args) = $self->view->render_viewport_args($vp);
115   $merge_args->{outer} = { %$new_args };
116   delete @{$new_args}{keys %$new_args}; # fresh start
117   @{$new_args}{keys %$merge_args} = values %$merge_args;
118   $do_render->(Widget, $widget, 'widget');
119 };
120 sub _fragment_widget {
121   my ($self, $do_render, $args, $new_args) = @_;
122   my $merge = $self->basic_layout_args;
123 #warn "Merge: ".join(', ', keys %$merge)." into: ".join(', ', keys %$new_args);
124   delete @{$merge}{keys %$new_args}; # nuke 'self' and 'viewport'
125   @{$new_args}{keys %$merge} = values %$merge;
126 };
127
128 __PACKAGE__->meta->make_immutable;
129
130
131 1;
132
133 =head1 NAME
134
135 Reaction::UI::Widget - The base widget.
136
137 =head1 DESCRIPTION
138
139 This is the base class for all widgets. It provides common functionality and 
140 fragments. It is also concerned with the rendering of the fragments.
141
142 =head1 FRAGMENTS
143
144 =head2 widget
145
146 This is the root fragment for every widget.
147
148 =head2 viewport
149
150 This fragment is used to render another viewport from inside a fragment. It
151 assumes the viewport is stored in the C<_> argument.
152
153 =head1 ENVIRONMENT FLAGS
154
155 =over
156
157 =item REACTION_UI_WIDGET_DEBUG_FRAGMENTS
158
159 Log additional debugging output for fragment processing.
160
161 =item REACTION_UI_WIDGET_DEBUUG_LAYOUTS
162
163 Log additional debugging output for layout processing.
164
165 =back
166
167 =head1 ATTRIBUTES
168
169 =head2 view
170
171 The widget's view object. Is required, readonly and must be a L<Reaction::UI::View>.
172
173 =head2 layout_set
174
175 The widget's layout set. Is required, readonly and must be a L<Reaction::UI::LayoutSet>.
176
177 =head2 fragment_names
178
179 List of names of known fragments for the current widget. Lazily computed from all 
180 methods that are named in the pattern C<_fragment_$name>.
181
182 =head2 basic_layout_args
183
184 A lazily built hash reference containing the rendered fragments defined in both the widget and
185 the layout set, keyed by the fragments' names.
186
187 =head
188
189 =head1 METHODS
190
191 =head2 render
192
193   $widget->render('fragment_name', $reaction_ctx, \%passed_args);
194
195 This method is concerned with rendering a fragment.
196
197 =head1 SEE ALSO
198
199 =over 4
200
201 =item * L<Reaction::Manual::Widgets>
202
203 =back
204
205 =head1 AUTHORS
206
207 See L<Reaction::Class> for authors.
208
209 =head1 LICENSE
210
211 See L<Reaction::Class> for the license.
212
213 =cut