diff options
author | matthewt <matthewt@03d0b0b2-0e1a-0410-a411-fdb2f4bd65d7> | 2007-12-20 21:39:06 +0000 |
---|---|---|
committer | matthewt <matthewt@03d0b0b2-0e1a-0410-a411-fdb2f4bd65d7> | 2007-12-20 21:39:06 +0000 |
commit | cfadd2f304c56a9510f1e18f02febb8694890b47 (patch) | |
tree | de5e5d7a6c196c815d7de0785dbbc20816462289 /lib | |
parent | 5b6b308142924d9bff7997a4f63b4e1f5e2daa73 (diff) | |
parent | f2fef590a7283ea919bdaa51bac9d433e8785a09 (diff) | |
download | reaction-cfadd2f304c56a9510f1e18f02febb8694890b47.tar.gz reaction-cfadd2f304c56a9510f1e18f02febb8694890b47.zip |
r72431@cain (orig r414): matthewt | 2007-11-26 20:11:29 +0000
root of componentUI renders
Diffstat (limited to 'lib')
-rw-r--r-- | lib/ComponentUI/View/Site/Widget/Index.pm | 2 | ||||
-rw-r--r-- | lib/ComponentUI/View/Site/Widget/Layout.pm | 12 | ||||
-rw-r--r-- | lib/Reaction/UI/LayoutSet.pm | 29 | ||||
-rw-r--r-- | lib/Reaction/UI/LayoutSet/TT.pm | 6 | ||||
-rw-r--r-- | lib/Reaction/UI/RenderingContext/TT.pm | 41 | ||||
-rw-r--r-- | lib/Reaction/UI/View.pm | 24 | ||||
-rw-r--r-- | lib/Reaction/UI/Widget.pm | 92 | ||||
-rw-r--r-- | lib/Reaction/UI/WidgetClass.pm | 352 | ||||
-rw-r--r-- | lib/Reaction/UI/WidgetClass/_OVER.pm | 34 |
9 files changed, 285 insertions, 307 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; |