Commit | Line | Data |
7adfd53f |
1 | package Reaction::UI::WidgetClass; |
2 | |
3 | use Reaction::ClassExporter; |
4 | use Reaction::Class; |
5 | use Reaction::UI::Widget; |
6 | use Data::Dumper; |
ce0ce002 |
7 | use Devel::Declare; |
f2fef590 |
8 | use aliased 'Reaction::UI::WidgetClass::_OVER'; |
7adfd53f |
9 | |
10 | no warnings 'once'; |
11 | |
81393881 |
12 | use namespace::clean -except => [ qw(meta) ]; |
7adfd53f |
13 | |
7adfd53f |
14 | |
81393881 |
15 | # for local() for fragment wrap |
16 | our ($next_call, $fragment_args, $current_widget, $do_render, $new_args); |
7adfd53f |
17 | |
81393881 |
18 | after 'do_import' => sub { |
19 | my ($self, $package) = @_; |
20 | Devel::Declare->install_declarator( |
21 | $package, 'fragment', DECLARE_NAME, |
22 | sub { }, |
23 | sub { |
24 | WidgetClass->handle_fragment(@_); |
25 | } |
26 | ); |
27 | }; |
7adfd53f |
28 | |
81393881 |
29 | after 'setup_and_cleanup' => sub { |
30 | my ($self, $package) = @_; |
31 | { |
32 | no strict 'refs'; |
33 | delete ${"${package}::"}{'fragment'}; |
34 | } |
35 | #Devel::Declare->teardown_for($package); |
36 | }; |
37 | override exports_for_package => sub { |
38 | my ($self, $package) = @_; |
39 | return (super(), |
40 | over => sub { |
41 | my ($collection) = @_; |
42 | confess "too many args, should be: over \$collection" if @_ > 1; |
43 | _OVER->new(collection => $collection); |
44 | }, |
45 | render => sub { |
46 | my ($name, $over) = @_; |
47 | |
48 | my $sig = "should be: render 'name' or render 'name' => over \$coll"; |
49 | if (!defined $name) { confess "name undefined: $sig"; } |
50 | if (ref $name) { confess "name not string: $sig"; } |
51 | if (defined $over && !(blessed($over) && $over->isa(_OVER))) { |
52 | confess "invalid args after name, $sig"; |
53 | } |
54 | $do_render->($package, $current_widget, $name, $over); |
55 | }, |
56 | arg => sub { |
57 | my ($name, $value) = @_; |
58 | |
59 | my $sig = "should be: arg 'name' => \$value"; |
2f6669e1 |
60 | if (@_ < 2) { |
61 | $name ||= 'undef'; |
62 | $value ||= 'undef'; |
63 | confess "Not enough arguments, $sig, got: $name => $value"; |
64 | } |
81393881 |
65 | if (!defined $name) { confess "name undefined, $sig"; } |
66 | if (ref $name) { confess "name is not a string, $sig"; } |
67 | |
68 | $new_args->{$name} = $value; |
69 | }, |
00b55ddd |
70 | localized => sub { |
71 | my($value) = @_; |
72 | return $_{self}->view->localize($value); |
73 | }, |
81393881 |
74 | call_next => sub { |
75 | confess "args passed, should be just call_next; or call_next();" |
76 | if @_; |
77 | $next_call->(@$fragment_args); |
78 | }, |
79 | event_id => sub { |
80 | my ($name) = @_; |
81 | $_{viewport}->event_id_for($name); |
82 | }, |
83 | event_uri => sub { |
84 | my ($events) = @_; |
85 | my $vp = $_{viewport}; |
86 | my %args = map{ $vp->event_id_for($_) => $events->{$_} } keys %$events; |
87 | $vp->ctx->req->uri_with(\%args); |
88 | }, |
a86de581 |
89 | attrs => sub { |
90 | my ($attrs) = @_; |
91 | return join(' ', map { |
92 | my $text = $attrs->{$_}; |
93 | for ($text) { |
94 | s/&/&/g; |
95 | s/</</g; |
96 | s/>/>/g; |
97 | s/"/"/g; |
98 | } |
99 | qq{$_="${text}"}; |
100 | } keys %$attrs); |
101 | }, |
a3c28d59 |
102 | implements => sub { |
103 | my ($name, $sub) = @_; |
104 | $package->meta->add_method($name, $sub); |
105 | }, |
81393881 |
106 | ); |
107 | }; |
108 | override default_base => sub { ('Reaction::UI::Widget') }; |
109 | sub handle_fragment { |
110 | my ($self, $name, $proto, $code) = @_; |
d7b00a50 |
111 | #warn ($self, $name, $code); |
81393881 |
112 | return ("_fragment_${name}" => $self->wrap_as_fragment($code)); |
113 | }; |
114 | sub wrap_as_fragment { |
115 | my ($self, $code) = @_; |
116 | return sub { |
117 | local $next_call; |
118 | if (ref $_[0] eq 'CODE') { # inside 'around' modifier |
119 | $next_call = shift; |
120 | } |
121 | local $fragment_args = \@_; |
122 | |
123 | # $self->$method($do_render, \%_, $new_args) |
124 | local $current_widget = $_[0]; |
125 | local $do_render = $_[1]; |
126 | local *_ = \%{$_[2]}; |
127 | local $_ = $_[2]->{_}; |
128 | local $new_args = $_[3]; |
129 | $code->(@_); |
f2fef590 |
130 | }; |
81393881 |
131 | }; |
7adfd53f |
132 | |
81393881 |
133 | __PACKAGE__->meta->make_immutable; |
87018d74 |
134 | |
7adfd53f |
135 | |
87018d74 |
136 | 1; |
137 | |
7adfd53f |
138 | =head1 NAME |
139 | |
140 | Reaction::UI::WidgetClass |
141 | |
142 | =head1 DESCRIPTION |
143 | |
144 | =head1 AUTHORS |
145 | |
146 | See L<Reaction::Class> for authors. |
147 | |
148 | =head1 LICENSE |
149 | |
150 | See L<Reaction::Class> for the license. |
151 | |
152 | =cut |