1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
package Reaction::UI::WidgetClass;
use Reaction::ClassExporter;
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 {
# 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(
$package, 'fragment', DECLARE_NAME,
sub { },
sub {
WidgetClass->handle_fragment(@_);
}
);
};
after 'setup_and_cleanup' => sub {
my ($self, $package) = @_;
{
no strict 'refs';
delete ${"${package}::"}{'fragment'};
}
#Devel::Declare->teardown_for($package);
};
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);
},
);
};
overrides default_base => sub { ('Reaction::UI::Widget') };
implements handle_fragment => as {
my ($self, $name, $proto, $code) = @_;
#warn ($self, $name, $code);
return ("_fragment_${name}" => $self->wrap_as_fragment($code));
};
implements wrap_as_fragment => as {
my ($self, $code) = @_;
return sub {
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 $_ = $_[2]->{_};
local $new_args = $_[3];
$code->(@_);
};
};
};
1;
=head1 NAME
Reaction::UI::WidgetClass
=head1 DESCRIPTION
=head1 AUTHORS
See L<Reaction::Class> for authors.
=head1 LICENSE
See L<Reaction::Class> for the license.
=cut
|
