aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/ComponentUI/View/Site/Widget/Index.pm2
-rw-r--r--lib/ComponentUI/View/Site/Widget/Layout.pm12
-rw-r--r--lib/Reaction/UI/LayoutSet.pm29
-rw-r--r--lib/Reaction/UI/LayoutSet/TT.pm6
-rw-r--r--lib/Reaction/UI/RenderingContext/TT.pm41
-rw-r--r--lib/Reaction/UI/View.pm24
-rw-r--r--lib/Reaction/UI/Widget.pm92
-rw-r--r--lib/Reaction/UI/WidgetClass.pm352
-rw-r--r--lib/Reaction/UI/WidgetClass/_OVER.pm34
-rw-r--r--share/skin/default/layout/layout.tt10
10 files changed, 290 insertions, 312 deletions
diff --git a/lib/ComponentUI/View/Site/Widget/Index.pm b/lib/ComponentUI/View/Site/Widget/Index.pm
index 0d3df27..b7f0372 100644
--- a/lib/ComponentUI/View/Site/Widget/Index.pm
+++ b/lib/ComponentUI/View/Site/Widget/Index.pm
@@ -4,8 +4,6 @@ use Reaction::UI::WidgetClass;
class Index which {
- fragment widget [ string {"DUMMY"} ];
-
};
1;
diff --git a/lib/ComponentUI/View/Site/Widget/Layout.pm b/lib/ComponentUI/View/Site/Widget/Layout.pm
index ad1953b..d33fa31 100644
--- a/lib/ComponentUI/View/Site/Widget/Layout.pm
+++ b/lib/ComponentUI/View/Site/Widget/Layout.pm
@@ -4,12 +4,12 @@ use Reaction::UI::WidgetClass;
class Layout which {
- fragment widget [ qw(menu sidebar header main_content) ];
-
- fragment menu [ string { "DUMMY" } ];
- fragment sidebar [ string { "Sidebar Shit" } ];
- fragment header [ string { "DUMMY" } ];
- fragment main_content [ viewport => over func('viewport', 'inner')];
+ implements fragment main_content {
+ if (my $inner = $_{viewport}->inner) {
+ arg '_' => $inner;
+ render 'viewport';
+ }
+ };
};
diff --git a/lib/Reaction/UI/LayoutSet.pm b/lib/Reaction/UI/LayoutSet.pm
index 639af3b..68d23d1 100644
--- a/lib/Reaction/UI/LayoutSet.pm
+++ b/lib/Reaction/UI/LayoutSet.pm
@@ -5,13 +5,15 @@ use File::Spec;
class LayoutSet which {
- has 'fragments' => (is => 'ro', default => sub { {} });
+ has 'layouts' => (is => 'ro', default => sub { {} });
has 'name' => (is => 'ro', required => 1);
has 'source_file' => (is => 'rw', lazy_fail => 1);
has 'file_extension'=> (isa => 'Str', is => 'rw', lazy_build => 1);
+ has 'widget_class' => (is => 'rw', lazy_fail => 1);
+
implements _build_file_extension => as { 'html' };
implements 'BUILD' => as {
@@ -30,19 +32,34 @@ class LayoutSet which {
}
}
confess "Unable to load file for LayoutSet ".$self->name unless $found;
+ confess "No view object provided" unless $args->{view};
+ $self->widget_class($args->{view}->widget_class_for($self));
+ };
+
+ implements 'widget_order_for' => as {
+ my ($self, $name) = @_;
+ if ($self->has_layout($name)) {
+ return ([ $self->widget_class, $self ]);
+ } else {
+ return ();
+ }
};
+ implements 'layout_names' => as { [ keys %{shift->layouts} ] };
+
+ implements 'has_layout' => as { exists $_[0]->layouts->{$_[1]} };
+
implements '_load_file' => as {
my ($self, $file) = @_;
my $data = $file->slurp;
- my $fragments = $self->fragments;
- # cheesy match for "=for layout fragmentname ... =something"
+ my $layouts = $self->layouts;
+ # cheesy match for "=for layout name ... =something"
# final split group also handles last in file, (?==) is lookahead
- # assertion for '=' so "=for layout fragment1 ... =for layout fragment2"
- # doesn't have the match pos go past the latter = and lose fragment2
+ # assertion for '=' so "=for layout name1 ... =for layout name2"
+ # doesn't have the match pos go past the latter = and lose name2
while ($data =~ m/=for layout (.*?)\n(.+?)(?:\n(?==)|$)/sg) {
my ($fname, $text) = ($1, $2);
- $fragments->{$fname} = $text;
+ $layouts->{$fname} = $text;
}
$self->source_file($file);
};
diff --git a/lib/Reaction/UI/LayoutSet/TT.pm b/lib/Reaction/UI/LayoutSet/TT.pm
index e5430f0..2046c41 100644
--- a/lib/Reaction/UI/LayoutSet/TT.pm
+++ b/lib/Reaction/UI/LayoutSet/TT.pm
@@ -26,12 +26,12 @@ class TT is LayoutSet, which {
my $tt_args = { data => {} };
my $name = $self->name;
$name =~ s/\//__/g; #slashes are not happy here...
- my $fragments = $self->fragments;
+ my $layouts = $self->layouts;
my $tt_source = qq{[% VIEW ${name};\n\n}.
join("\n\n",
map {
- qq{BLOCK $_; -%]\n}.$fragments->{$_}.qq{\n[% END;};
- } keys %$fragments
+ qq{BLOCK $_; -%]\n}.$layouts->{$_}.qq{\n[% END;};
+ } keys %$layouts
).qq{\nEND; # End view\ndata.view = ${name};\n %]};
$tt_object->process(\$tt_source, $tt_args)
|| confess "Template processing error: ".$tt_object->error
diff --git a/lib/Reaction/UI/RenderingContext/TT.pm b/lib/Reaction/UI/RenderingContext/TT.pm
index a4e3ff8..e925ff6 100644
--- a/lib/Reaction/UI/RenderingContext/TT.pm
+++ b/lib/Reaction/UI/RenderingContext/TT.pm
@@ -11,8 +11,44 @@ class TT is RenderingContext, which {
default => sub { 'Reaction::UI::Renderer::TT::Iter'; },
);
+ our $body;
+
+ implements 'dispatch' => as {
+ my ($self, $render_tree, $args) = @_;
+#warn "-- dispatch start\n";
+ local $body = '';
+ my %args_copy = %$args;
+ foreach my $to_render (@$render_tree) {
+ my ($type, @to) = @$to_render;
+ if ($type eq '-layout') {
+ my ($lset, $fname, $next) = @to;
+ local $args_copy{call_next} =
+ (@$next
+ ? sub { $self->dispatch($next, $args); }
+ : '' # no point running internal dispatch if nothing -to- dispatch
+ );
+ $self->render($lset, $fname, \%args_copy);
+ } elsif ($type eq '-render') {
+ my ($widget, $fname, $over) = @to;
+ #warn "@to";
+ if (defined $over) {
+ $over->each(sub {
+ local $args_copy{_} = $_[0];
+ $body .= $widget->render($fname, $self, \%args_copy);
+ });
+ } else {
+ $body .= $widget->render($fname, $self, \%args_copy);
+ }
+ }
+ }
+#warn "-- dispatch end, body: ${body}\n-- end body\nbacktrace: ".Carp::longmess()."\n-- end trace\n";
+ return $body;
+ };
+
implements 'render' => as {
my ($self, $lset, $fname, $args) = @_;
+
+ confess "\$body not in scope" unless defined($body);
# foreach non-_ prefixed key in the args
# build a subref for this key that passes self so the generator has a
@@ -22,7 +58,7 @@ class TT is RenderingContext, which {
my $tt_args = {
map {
my $arg = $args->{$_};
- ($_ => (ref $arg eq 'CODE' ? sub { $arg->($self) } : $arg))
+ ($_ => (ref $arg eq 'CODE' ? sub { $arg->($self, $args) } : $arg))
} grep { !/^_/ } keys %$args
};
@@ -41,7 +77,8 @@ class TT is RenderingContext, which {
$tt_args->{content} = $iter;
$tt_args->{pos} = sub { $iter->pos };
}
- $lset->tt_view->include($fname, $tt_args);
+ $body .= $lset->tt_view->include($fname, $tt_args);
+#warn "rendered ${fname}, body length now ".length($body)."\n";
};
};
diff --git a/lib/Reaction/UI/View.pm b/lib/Reaction/UI/View.pm
index 8f0c265..daf1bbc 100644
--- a/lib/Reaction/UI/View.pm
+++ b/lib/Reaction/UI/View.pm
@@ -48,24 +48,25 @@ class View which {
my ($self, $window) = @_;
my $root_vp = $window->focus_stack->vp_head;
my $rctx = $self->create_rendering_context;
- $self->render_viewport($rctx, $root_vp);
+ my ($widget, $args) = $self->render_viewport_args($root_vp);
+ $widget->render(widget => $rctx, $args);
};
- implements 'render_viewport' => as {
- my ($self, $rctx, $vp) = @_;
+ implements 'render_viewport_args' => as {
+ my ($self, $vp) = @_;
my $layout_set = $self->layout_set_for($vp);
my $widget = $self->widget_for($vp, $layout_set);
- $widget->render($rctx, { viewport => $vp });
+ return ($widget, { viewport => $vp });
};
implements 'widget_for' => as {
my ($self, $vp, $layout_set) = @_;
return
$self->_widget_cache->{$layout_set->name}
- ||= $self->widget_class_for($layout_set)
- ->new(
- view => $self, layout_set => $layout_set
- );
+ ||= $layout_set->widget_class
+ ->new(
+ view => $self, layout_set => $layout_set
+ );
};
implements 'widget_class_for' => as {
@@ -85,6 +86,7 @@ class View which {
#only next when !exists
eval { Class::MOP::load_class($class) };
#$@ ? next : return $class;
+ #warn "Loaded ${class}" unless $@;
$@ ? next : return $cache->{ $lset_name } = $class;
}
confess "Couldn't load widget '$tail': tried: @haystack";
@@ -132,7 +134,11 @@ class View which {
implements 'layout_set_args_for' => as {
my ($self, $name) = @_;
- return (name => $name, search_path => $self->layout_search_path);
+ return (
+ name => $name,
+ search_path => $self->layout_search_path,
+ view => $self,
+ );
};
implements 'layout_search_path' => as {
diff --git a/lib/Reaction/UI/Widget.pm b/lib/Reaction/UI/Widget.pm
index 9c3c69e..a5171d1 100644
--- a/lib/Reaction/UI/Widget.pm
+++ b/lib/Reaction/UI/Widget.pm
@@ -9,17 +9,99 @@ class Widget which {
has 'view' => (isa => View, is => 'ro', required => 1);
has 'layout_set' => (isa => LayoutSet, is => 'ro', required => 1);
+ has 'fragment_names' => (is => 'ro', lazy_build => 1);
+ has 'basic_layout_args' => (is => 'ro', lazy_build => 1);
+
+ implements '_build_fragment_names' => as {
+ my ($self) = shift;
+ return [
+ map { /^_fragment_(.*)/; $1; }
+ grep { /^_fragment_/ }
+ map { $_->{name} }
+ $self->meta->compute_all_applicable_methods
+ ];
+ };
implements 'render' => as {
- my ($self, $rctx, $passed_args) = @_;
+ my ($self, $fragment_name, $rctx, $passed_args) = @_;
+ confess "\$passed_args not hashref" unless ref($passed_args) eq 'HASH';
+#warn "Render: ${fragment_name} for ${self}";
my $args = { self => $self, %$passed_args };
- $self->render_widget($rctx, $args);
+ my $new_args = { %$args };
+ my $render_tree = $self->_render_dispatch_order(
+ $fragment_name, $args, $new_args
+ );
+ $rctx->dispatch($render_tree, $new_args);
+ };
+
+ implements '_render_dispatch_order' => as {
+ my ($self, $fragment_name, $args, $new_args) = @_;
+
+ my @render_stack = (my $render_deep = (my $render_curr = []));
+ my @layout_order = $self->layout_set->widget_order_for($fragment_name);
+
+ if (my $f_meth = $self->can("_fragment_${fragment_name}")) {
+ my @wclass_stack;
+ my $do_render = sub {
+ my $package = shift;
+ if (@layout_order) {
+ while ($package eq $layout_order[0][0]
+ || $layout_order[0][0]->isa($package)) {
+ my $new_curr = [];
+ my @l = @{shift(@layout_order)};
+ push(@$render_curr, [ -layout, $l[1], $fragment_name, $new_curr ]);
+ push(@render_stack, $new_curr);
+ push(@wclass_stack, $l[0]);
+ $render_deep = $render_curr = $new_curr;
+ last unless @layout_order;
+ }
+ }
+ if (@wclass_stack) {
+ while ($package ne $wclass_stack[-1]
+ && $package->isa($wclass_stack[-1])) {
+ pop(@wclass_stack);
+ $render_curr = pop(@render_stack);
+ }
+ }
+ push(@{$render_curr}, [ -render, @_ ]);
+ };
+ $self->$f_meth($do_render, $args, $new_args);
+ }
+ # if we had no fragment method or if we still have layouts left
+ if (@layout_order) {
+ while (my $l = shift(@layout_order)) {
+ push(@$render_deep, [
+ -layout => $l->[1], $fragment_name, ($render_deep = [])
+ ]);
+ }
+ }
+
+ return $render_stack[0];
+ };
+
+ implements '_build_basic_layout_args' => as {
+ my ($self) = @_;
+ my $args;
+ foreach my $name (@{$self->fragment_names},
+ @{$self->layout_set->layout_names}) {
+ $args->{$name} ||= sub { $self->render($name, @_); };
+ }
+ return $args;
};
- implements 'render_viewport' => as {
- my ($self, $rctx, $args) = @_;
+ implements '_fragment_viewport' => as {
+ my ($self, $do_render, $args, $new_args) = @_;
my $vp = $args->{'_'};
- $self->view->render_viewport($rctx, $vp);
+ my ($widget, $merge_args) = $self->view->render_viewport_args($vp);
+ @{$new_args}{keys %$merge_args} = values %$merge_args;
+ $do_render->(Widget, $widget, 'widget');
+ };
+
+ implements '_fragment_widget' => as {
+ my ($self, $do_render, $args, $new_args) = @_;
+ my $merge = $self->basic_layout_args;
+ delete @{$merge}{keys %$new_args}; # nuke 'self' and 'viewport'
+ @{$new_args}{keys %$merge} = values %$merge;
};
};
diff --git a/lib/Reaction/UI/WidgetClass.pm b/lib/Reaction/UI/WidgetClass.pm
index ba8f70a..beebe41 100644
--- a/lib/Reaction/UI/WidgetClass.pm
+++ b/lib/Reaction/UI/WidgetClass.pm
@@ -5,287 +5,105 @@ use Reaction::Class;
use Reaction::UI::Widget;
use Data::Dumper;
use Devel::Declare;
+use aliased 'Reaction::UI::WidgetClass::_OVER';
no warnings 'once';
class WidgetClass, which {
- overrides exports_for_package => sub {
- my ($self, $package) = @_;
- return (super(),
- func => sub {
- my ($k, $m) = @_;
- my $sig = "should be: func(data_key => 'method_name')";
- confess "Data key not present, ${sig}" unless defined($k);
- confess "Data key must be string, ${sig}" unless !ref($k);
- confess "Method name not present, ${sig}" unless defined($m);
- confess "Method name must be string, ${sig}" unless !ref($m);
- [ $k, $m ];
- }, # XXX zis is not ze grand design. OBSERVABLE.
- string => sub (&) { -string => [ @_ ] }, # meh (maybe &;@ later?)
- wrap => sub { $self->do_wrap_sub($package, @_); }, # should have class.
- fragment => sub (@) { }, # placeholder rewritten by do_import
- over => sub { -over => @_ },
- );
- };
-
- after do_import => sub {
- my ($self, $pkg, $args) = @_;
+ # for local() for fragment wrap
+ our ($next_call, $fragment_args, $current_widget, $do_render, $new_args);
+ after 'do_import' => sub {
+ my ($self, $package) = @_;
Devel::Declare->install_declarator(
- $pkg, 'fragment', DECLARE_NAME,
+ $package, 'fragment', DECLARE_NAME,
sub { },
sub {
- our $FRAGMENT_CLOSURE;
- splice(@_, 1, 1); # remove undef proto arg
- $FRAGMENT_CLOSURE->(@_);
+ WidgetClass->handle_fragment(@_);
}
);
};
- overrides default_base => sub { ('Reaction::UI::Widget') };
-
- overrides do_class_sub => sub {
- my ($self, $package, $class) = @_;
- # intercepts 'foo renders ...'
- our $FRAGMENT_CLOSURE;
- local $FRAGMENT_CLOSURE = sub {
- $self->do_renders_meth($package, $class, @_);
- };
- # $_ returns '-topic:_', $_{foo} returns '-topic:foo'
- local $_ = '-topic:_';
- my %topichash;
- tie %topichash, 'Reaction::UI::WidgetClass::TopicHash';
- local *_ = \%topichash;
- super;
- };
-
- implements do_wrap_sub => as { confess "Unimplemented" };
-
- implements do_renders_meth => as {
- my ($self, $package, $class, $fname, $content, $args, $extra) = @_;
-
- my $sig = 'should be: renders [ <content spec> ], \%args?';
-
- confess "Too many args to renders, ${sig}" if defined($extra);
- confess "First arg not an arrayref, ${sig}" unless ref($content) eq 'ARRAY';
- confess "Args must be hashref, ${sig}"
- if (defined($args) && (ref($args) ne 'HASH'));
-
- $sig .= '
-where content spec is [ fragment_name => over (func(...)|$_|$_{keyname}), \%args? ]
- or [ qw(list of fragment names), \%args ]'; # explain the mistake, yea
-
- my $inner_args = ((ref($content->[-1]) eq 'HASH') ? pop(@$content) : {});
- # [ blah over (func(...)|$_|$_{keyname}), { ... } ] or [ qw(foo bar), { ... } ]
-
- # predeclare since content_gen gets populated somewhere in an if
- # and inner_args_gen wants to be closed over by content_gen
-
- my ($content_gen, $inner_args_gen);
-
- my %args_extra; # again populated (possibly) within the if
-
- confess "Content spec invalid, ${sig}"
- unless defined($content->[0]) && !ref($content->[0]);
-
- # new-style over gives 'frag, -over, $func'. massage.
-
- if (defined($content->[1]) && !ref($content->[1])
- && ($content->[1] eq '-over')) {
- @$content[0,1] = @$content[1,0];
- }
-
- if (my ($key) = ($content->[0] =~ /^-(.*)?/)) {
-
- # if first content value is -foo, pull it off the front and then
- # figure out is it's a type we know how to handle
-
- shift(@$content);
- if ($key eq 'over') { # fragment_name over func
- my ($fragment, $func) = @$content;
- confess "Fragment name invalid, ${sig}" if ref($fragment);
- my $content_meth = "render_${fragment}";
- # grab result of func
- # - if arrayref, render fragment per entry
- # - if obj and can('next') call that until undef
- # - else scream loudly
- unless ((ref($func) eq 'ARRAY') || ($func =~ /^-topic:(.*)$/)) {
- confess "over value wrong, should be ${sig}";
- }
- $content_gen = sub {
- my ($widget, $args) = @_;
- my $topic;
- if (ref($func) eq 'ARRAY') {
- my ($func_key, $func_meth) = @$func;
- $topic = eval { $args->{$func_key}->$func_meth };
- confess "Error calling ${func_meth} on ${func_key} argument "
- .($args->{$func_key}||'').": $@"
- if $@;
- } elsif ($func =~ /^-topic:(.*)$/) {
- $topic = $args->{$1};
- } else {
- confess "Shouldn't get here";
- }
- my $iter_sub;
- if (ref $topic eq 'ARRAY') {
- my @copy = @$topic; # non-destructive on original data
- $iter_sub = sub { shift(@copy); };
- } elsif (Scalar::Util::blessed($topic) && $topic->can('next')) {
- $iter_sub = sub { $topic->next };
- } else {
- #confess "func(${func_key} => ${func_meth}) for topic within fragment ${fname} did not return arrayref or iterator object";
- # Coercing to a single-arg list instead for the mo. Mistake?
- my @copy = ($topic);
- $iter_sub = sub { shift(@copy); };
- }
- my $inner_args = $inner_args_gen->($args);
- return sub {
- my $next = $iter_sub->();
- return undef unless $next;
- return sub {
- my ($rctx) = @_;
- local $inner_args->{'_'} = $next; # ala local $_, why copy?
- $widget->$content_meth($rctx, $inner_args);
- };
- };
- };
- } elsif ($key eq 'string') {
-
- # string { ... }
-
- my $sub = $content->[0]->[0]; # string {} returns (-string => [ $cr ])
- $content_gen = sub {
- my ($widget, $args) = @_;
- my $done = 0;
- my $inner_args = $inner_args_gen->($args);
- return sub {
- return if $done++; # a string content only happens once
- return sub { # setup $_{foo} etc. and alias $_ to $_{_}
- my ($rctx) = @_;
- local *_ = \%{$inner_args};
- local $_ = $inner_args->{'_'};
- $sub->($rctx);
- };
- };
- };
-
- # must also handle just $_ later for wrap
- } else {
- # unrecognised -foo
- confess "Unrecognised content spec type ${key}, ${sig}";
- }
- } else {
-
- # handling the renders [ qw(list of frag names), \%args ] case
-
-#warn @$content;
- confess "Invalid content spec, ${sig}"
- if grep { ref($_) } @$content;
- $content_gen = sub {
- my ($widget, $args) = @_;
- my @fragment_methods = map { "render_${_}" } @$content;
- my $inner_args = $inner_args_gen->($args);
- return sub {
- my $next = shift(@fragment_methods);
- return undef unless $next;
- return sub {
- my ($rctx) = @_;
- $widget->$next($rctx, $inner_args);
- };
- };
- };
-
- foreach my $key (@$content) {
- my $frag_meth = "render_${key}";
- $args_extra{$key} = sub {
- my ($widget, $args) = @_;
- my $inner_args = $inner_args_gen->($args);
- return sub {
- my ($rctx) = @_;
- $widget->$frag_meth($rctx, $inner_args);
- };
- };
- }
+ after 'setup_and_cleanup' => sub {
+ my ($self, $package) = @_;
+ {
+ no strict 'refs';
+ delete ${"${package}::"}{'fragment'};
}
-
- # populate both args generators here primarily for clarity
-
- my $args_gen = $self->mk_args_generator($args);
- $inner_args_gen = $self->mk_args_generator($inner_args);
-
- my $methname = "render_${fname}";
-
- $args_extra{'_'} = $content_gen;
-
- my @extra_keys = keys %args_extra;
- my @extra_gen = values %args_extra;
-
- my $meth = sub {
- my ($self, $rctx, $args) = @_;
- confess "No rendering context passed" unless $rctx;
- my $r_args = $args_gen->($args);
-#warn Dumper($r_args).' ';
- @{$r_args}{@extra_keys} = map { $_->($self, $args); } @extra_gen;
- $r_args->{'_'} = $content_gen->($self, $args);
-#warn Dumper($r_args).' ';
- $rctx->render($self->layout_set, $fname, $r_args);
- };
-
- $class->meta->add_method($methname => $meth);
+ #Devel::Declare->teardown_for($package);
};
- implements do_over_meth => as {
- my ($self, $package, $class, @args) = @_;
- #warn Dumper(\@args);
- return (-over => @args);
+ overrides exports_for_package => sub {
+ my ($self, $package) = @_;
+ return (super(),
+ over => sub {
+ my ($collection) = @_;
+ confess "too many args, should be: over \$collection" if @_ > 1;
+ _OVER->new(collection => $collection);
+ },
+ render => sub {
+ my ($name, $over) = @_;
+
+ my $sig = "should be: render 'name' or render 'name' => over \$coll";
+ if (!defined $name) { confess "name undefined: $sig"; }
+ if (ref $name) { confess "name not string: $sig"; }
+ if (defined $over && !(blessed($over) && $over->isa(_OVER))) {
+ confess "invalid args after name, $sig";
+ }
+ $do_render->($package, $current_widget, $name, $over);
+ },
+ arg => sub {
+ my ($name, $value) = @_;
+
+ my $sig = "should be: arg 'name' => \$value";
+ if (@_ < 2) { confess "Not enough arguments, $sig"; }
+ if (!defined $name) { confess "name undefined, $sig"; }
+ if (ref $name) { confess "name is not a string, $sig"; }
+
+ $new_args->{$name} = $value;
+ },
+ call_next => sub {
+ confess "args passed, should be just call_next; or call_next();"
+ if @_;
+ $next_call->(@$fragment_args);
+ },
+ event_id => sub {
+ my ($name) = @_;
+ $_{viewport}->event_id_for($name);
+ },
+ event_uri => sub {
+ my ($events) = @_;
+ my $vp = $_{viewport};
+ my %args = map{ $vp->event_id_for($_) => $events->{$_} } keys %$events;
+ $vp->ctx->req->uri_with(\%args);
+ },
+ );
};
- implements mk_args_generator => as {
- my ($self, $argspec) = @_;
-#warn Dumper($argspec);
- # only handling [ $k, $v ] (func()) and -topic:$x ($_{$x}) for the moment
+ overrides default_base => sub { ('Reaction::UI::Widget') };
- my $sig = 'should be: key => $_ or key => $_{name} or key => func("name", "method")';
+ implements handle_fragment => as {
+ my ($self, $name, $proto, $code) = @_;
+warn ($self, $name, $code);
+ return ("_fragment_${name}" => $self->wrap_as_fragment($code));
+ };
- my (@func_to, @func_spec, @copy_from, @copy_to, @sub_spec, @sub_to);
- foreach my $key (keys %$argspec) {
- my $val = $argspec->{$key};
- if (ref($val) eq 'ARRAY') {
- push(@func_spec, $val);
- push(@func_to, $key);
- } elsif (!ref($val) && ($val =~ /^-topic:(.*)$/)) {
- my $topic_key = $1;
- push(@copy_from, $topic_key);
- push(@copy_to, $key);
- } elsif (ref($val) eq 'CODE') {
- #LOOK AT ME
- my $sub = sub{
- my $inner_args = shift;
- local *_ = \%{$inner_args};
- local $_ = $inner_args->{'_'};
- return $val->();
- };
- push(@sub_spec, $sub);
- push(@sub_to, $key);
- } else {
- confess "Invalid args member for ${key}, ${sig}";
- }
- }
-#warn Dumper(\@func_to, \@func_spec, \@copy_from, \@copy_to);
+ implements wrap_as_fragment => as {
+ my ($self, $code) = @_;
return sub {
- my ($outer_args) = @_;
- my $args = { %$outer_args };
-#warn Dumper(\@func_to, \@func_spec, \@copy_from, \@copy_to).' ';
- @{$args}{@copy_to} = @{$outer_args}{@copy_from};
- @{$args}{@func_to} = (map {
- my ($key, $meth) = @{$_};
- $outer_args->{$key}->$meth; # [ 'a, 'b' ] ~~ ->{'a'}->b
- } @func_spec);
- #LOOK AT ME
- @{$args}{@sub_to} = (map { $_->($outer_args) } @sub_spec);
-#warn Dumper($args).' ';
- return $args;
+ local $next_call;
+ if (ref $_[0] eq 'CODE') { # inside 'around' modifier
+ $next_call = shift;
+ }
+ local $fragment_args = \@_;
+
+ # $self->$method($do_render, \%_, $new_args)
+ local $current_widget = $_[0];
+ local $do_render = $_[1];
+ local *_ = \%{$_[2]};
+ local $new_args = $_[3];
+ $code->(@_);
};
};
@@ -293,20 +111,6 @@ where content spec is [ fragment_name => over (func(...)|$_|$_{keyname}), \%args
1;
-package Reaction::UI::WidgetClass::TopicHash;
-
-use Tie::Hash;
-use base qw(Tie::StdHash);
-
-sub FETCH {
- my ($self, $key) = @_;
- return "-topic:${key}";
-}
-
-1;
-
-__END__;
-
=head1 NAME
Reaction::UI::WidgetClass
diff --git a/lib/Reaction/UI/WidgetClass/_OVER.pm b/lib/Reaction/UI/WidgetClass/_OVER.pm
new file mode 100644
index 0000000..d368f23
--- /dev/null
+++ b/lib/Reaction/UI/WidgetClass/_OVER.pm
@@ -0,0 +1,34 @@
+package Reaction::UI::WidgetClass::_OVER;
+
+use Reaction::Class;
+
+class _OVER, which {
+
+ has 'collection' => (is => 'ro', required => 1);
+
+ implements BUILD => as {
+ my ($self, $args) = @_;
+ my $coll = $args->{collection};
+ unless (ref $coll eq 'ARRAY' || (blessed($coll) && $coll->can('next'))) {
+ confess _OVER."->new collection arg ${coll} is neither"
+ ." arrayref nor implements next()";
+ }
+ };
+
+ implements 'each' => as {
+ my ($self, $do) = @_;
+ my $coll = $self->collection;
+ if (ref $coll eq 'ARRAY') {
+ foreach my $el (@$coll) {
+ $do->($el);
+ }
+ } else {
+ $coll->reset if $coll->can('reset');
+ while (my $el = $coll->next) {
+ $do->($el);
+ }
+ }
+ };
+};
+
+1;
diff --git a/share/skin/default/layout/layout.tt b/share/skin/default/layout/layout.tt
index af59032..95cc025 100644
--- a/share/skin/default/layout/layout.tt
+++ b/share/skin/default/layout/layout.tt
@@ -35,16 +35,16 @@
</html>
=for layout main_content
-
- [% content %]
-
+<!-- main content start -->
+[% call_next %]
+<!-- main content end -->
=for layout header
<h1>Component UI Header</h1>
=for layout sidebar
<div class="sidebar">
- [% content %]
+ Nothing to see here. Move along.
</div>
=for layout menu
@@ -53,4 +53,4 @@
<li> <a href="/testmodel/bar">Bar</a> </li>
<li> <a href="/testmodel/baz">Baz</a> </li>
</ul>
-=cut \ No newline at end of file
+=cut
generated by cgit v1.2.3-54-g00ecf (git 2.45.1) at 2024-06-10 18:36:36 +0000