ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/ext/widget.ext
(Generate patch)

Comparing deliantra/server/ext/widget.ext (file contents):
Revision 1.13 by root, Mon Jul 23 21:02:50 2007 UTC vs.
Revision 1.14 by root, Mon Jul 23 23:38:17 2007 UTC

1#! perl # mandatory depends=login 1#! perl # mandatory depends=login
2 2
3# sends the following ext message types 3# sends the following ext message types
4# ws_n id # widgetset new 4# ws_n ws # widgetset new
5# ws_d id # widgetset destroy 5# ws_d ws # widgetset destroy
6# ws_c ws id class args # widgetset create 6# ws_c ws id class args # widgetset create
7# w_c id [rid] name args # widget method call 7# w_c id rid name args # widget method call
8# w_s id @attr # widget member set 8# w_s id @attr # widget member set
9# w_g id rid @attr # widget member get 9# w_g id rid @attr # widget member get
10# 10#
11# and expects the following exti message types 11# and expects the following exti message types
12# w_r rid res # widget call return 12# w_r rid res # widget call return
… …
97 #csc_start $ns; 97 #csc_start $ns;
98 }, 98 },
99); 99);
100 100
101cf::register_exticmd w_e => sub { 101cf::register_exticmd w_e => sub {
102 my ($ns, $pkt) = @_; 102 my ($ns, $id, $name, $args) = @_;
103 103
104 if (my $w = $ns->{widget}{$pkt->{id}}) { 104 if (my $w = $ns->{widget}{$id}) {
105 if (my $cb = $w->{ev}{$pkt->{name}}) { 105 if (my $cb = $w->{ev}{$name}) {
106 $_->($w, @{ $pkt->{args} || [] }) 106 $_->($w, @$args)
107 for @$cb; 107 for @$cb;
108 } 108 }
109 } 109 }
110 110
111 () 111 ()
112}; 112};
113 113
114cf::register_exticmd w_r => sub { 114cf::register_exticmd w_r => sub {
115 my ($ns, $pkt) = @_; 115 my ($ns, $rid, $res) = @_;
116 116
117 if (my $cb = delete $ns->{widget_return}{$pkt->{rid}}) { 117 if (my $cb = delete $ns->{widget_return}{$rid}) {
118 $cb->(@{$pkt->{res} || [] }); 118 $cb->(@$res);
119 } 119 }
120 120
121 () 121 ()
122}; 122};
123 123
… …
130 id => $id, 130 id => $id,
131 ns => $self, 131 ns => $self,
132 _w => {}, 132 _w => {},
133 }, "ext::widget::set"; 133 }, "ext::widget::set";
134 134
135 $ws->msg (ws_n => id => $id); 135 $ws->msg (ws_n => $id);
136 136
137 $ws 137 $ws
138} 138}
139 139
140############################################################################# 140#############################################################################
… …
146} 146}
147 147
148sub destroy { 148sub destroy {
149 my ($self) = @_; 149 my ($self) = @_;
150 150
151 $self->msg (ws_d => id => $self->{id}); 151 $self->msg (ws_d => $self->{id});
152 delete $self->{ns}; 152 delete $self->{ns};
153 $_->destroy 153 $_->destroy
154 for values %{ $self->{w} }; 154 for values %{ $self->{w} };
155} 155}
156 156
157sub msg { 157sub msg {
158 my ($self, $type, %msg) = @_; 158 my ($self, @msg) = @_;
159 159
160 if (my $ns = shift->{ns}) { 160 if (my $ns = shift->{ns}) {
161 $msg{msgtype} = $type;
162 warn "msg " . $ns->{json_coder}->encode (\%msg) if $DEBUG;#d# 161 warn "msg " . $ns->{json_coder}->encode (\@msg) if $DEBUG;#d#
163 $ns->send_packet ("ext " . $ns->{json_coder}->encode (\%msg)); 162 $ns->send_packet ("ext " . $ns->{json_coder}->encode (\@msg));
164 } 163 }
165} 164}
166 165
167sub new { 166sub new {
168 my ($self, $class, %args) = @_; 167 my ($self, $class, %args) = @_;
… …
182 push @{$proxy->{ev}{$ev}}, $args{$ev}; 181 push @{$proxy->{ev}{$ev}}, $args{$ev};
183 $args{$ev} = 0; 182 $args{$ev} = 0;
184 } 183 }
185 184
186 $self->msg (ws_c => 185 $self->msg (ws_c =>
187 ws => $proxy->{id}, 186 $proxy->{id},
188 id => $id, 187 $id,
189 class => $class, 188 $class,
190 args => \%args, 189 \%args,
191 ); 190 );
192 191
193 $proxy 192 $proxy
194} 193}
195 194
… …
201 my ($self) = @_; 200 my ($self) = @_;
202 201
203 delete $self->{ns}{widget}{$self->{id}}; 202 delete $self->{ns}{widget}{$self->{id}};
204 203
205 if (my $ws = $self->{ws}) { 204 if (my $ws = $self->{ws}) {
206 $self->msg (w_c => name => "destroy"); 205 $self->msg (w_c => 0, "destroy");
207 delete $ws->{_w}{$self->{id}}; 206 delete $ws->{_w}{$self->{id}};
208 } 207 }
209} 208}
210 209
211sub msg { 210sub msg {
212 my ($self, $type, %msg) = @_; 211 my ($self, $type, @arg) = @_;
213 212
214 if (my $ws = $self->{ws}) { 213 if (my $ws = $self->{ws}) {
215 $ws->msg ($type, 214 $ws->msg ($type, $self->{id}, @arg);
216 %msg,
217 id => $self->{id},
218 );
219 } 215 }
220} 216}
221 217
222sub msg_cb { 218sub msg_cb {
223 my ($self, $cb, $type, %msg) = @_; 219 my ($self, $cb, $type, @arg) = @_;
224 220
225 if (my $ws = $self->{ws}) { 221 if (my $ws = $self->{ws}) {
226
227 my $rid = ++$ws->{ns}{id}; 222 my $rid = ++$ws->{ns}{id};
228 223
229 $self->msg ($type, %msg, rid => $rid); 224 $self->msg ($type, $rid, @arg);
230 225
231 if ($cb) { 226 if ($cb) {
232 $ws->{ns}{widget_return}{$rid} = $cb; 227 $ws->{ns}{widget_return}{$rid} = $cb;
233 } else { 228 } else {
234 # synchronous case 229 # synchronous case
… …
249} 244}
250 245
251sub set { 246sub set {
252 my ($self, @kv) = @_; 247 my ($self, @kv) = @_;
253 248
254 $self->msg (w_s => attr => \@kv); 249 $self->msg (w_s => \@kv);
255} 250}
256 251
257sub get { 252sub get {
258 my ($self, $member, $cb) = @_; 253 my ($self, $member, $cb) = @_;
259 254
260 $self->msg_cb ($cb, w_g => attr => [$member]); 255 $self->msg_cb ($cb, w_g => [$member]);
261} 256}
262 257
263sub TO_JSON { 258sub TO_JSON {
264 { __widget_ref__ => $_[0]{id} } 259 { __widget_ref__ => $_[0]{id} }
265} 260}
… …
270 $AUTOLOAD =~ s/^.*:// 265 $AUTOLOAD =~ s/^.*://
271 or return; 266 or return;
272 267
273 my $self = shift; 268 my $self = shift;
274 269
275 $self->msg (w_c => name => $AUTOLOAD, args => \@_); 270 $self->msg (w_c => 0, $AUTOLOAD, \@_);
276 271
277 () 272 ()
278} 273}
279 274

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines