ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.11 by root, Sun Mar 26 15:52:03 2006 UTC vs.
Revision 1.15 by root, Sun Jun 11 15:02:16 2006 UTC

… …
65 65
66my %ext_pkg; 66my %ext_pkg;
67my @exts; 67my @exts;
68my @hook; 68my @hook;
69my %command; 69my %command;
70my %extcmd;
70 71
71sub inject_event { 72sub inject_event {
72 my ($data) = @_; 73 my $extension = shift;
74 my $event_code = shift;
73 75
74 my $cb = $hook[$data->{event_code}]{$data->{extension}} 76 my $cb = $hook[$event_code]{$extension}
75 or return; 77 or return;
76 78
77 $cb->($data) 79 &$cb
78} 80}
79 81
80sub inject_global_event { 82sub inject_global_event {
81 my ($data) = @_; 83 my $event = shift;
82 84
83 my $cb = $hook[$data->{event_code}] 85 my $cb = $hook[$event]
84 or return; 86 or return;
85 87
86 List::Util::max map $_->($data), values %$cb 88 List::Util::max map &$_, values %$cb
87} 89}
88 90
89sub inject_command { 91sub inject_command {
90 my ($name, $obj, $params) = @_; 92 my ($name, $obj, $params) = @_;
91 93
… …
171 delete $command{$name}; 173 delete $command{$name};
172 delete $COMMAND{"$name\000"}; 174 delete $COMMAND{"$name\000"};
173 } 175 }
174 } 176 }
175 177
178 # remove extcmds
179 for my $name (keys %command) {
180 my @cb = grep $_->[2] ne $pkg, @{ $command{$name} };
181
182 if (@cb) {
183 $command{$name} = \@cb;
184 $COMMAND{"$name\000"} = List::Util::max map $_->[0], @cb;
185 } else {
186 delete $command{$name};
187 delete $COMMAND{"$name\000"};
188 }
189 }
190
191
176 Symbol::delete_package $pkg; 192 Symbol::delete_package $pkg;
177} 193}
178 194
179sub load_extensions { 195sub load_extensions {
180 my $LIBDIR = maps_directory "perl"; 196 my $LIBDIR = maps_directory "perl";
… …
213 $who->message ("Intruder Alert!"); 229 $who->message ("Intruder Alert!");
214 } 230 }
215}; 231};
216 232
217############################################################################# 233#############################################################################
234# extcmd framework, basically convert ext <id> <pkg> arg1 args
235# into pkg::->on_extcmd_arg1 (...) while shortcutting a few
236
237sub on_extcmd {
238 my ($pl, $buf) = @_;
239
240 my ($id, $pkg, $name, $data) = split / /, $buf, 4;
241
242 if (my $method = "cf::ext::$pkg"->can ("on_extcmd_$name")) {
243 $method->($pl, $id, $buf);
244 }
245}
246
247#############################################################################
218# load/save/clean perl data associated with a map 248# load/save/clean perl data associated with a map
219 249
220*on_mapclean = sub { 250*on_mapclean = sub {
221 my $map = shift->{map}; 251 my ($map) = @_;
222 252
223 my $path = $map->tmpname; 253 my $path = $map->tmpname;
224 defined $path or return; 254 defined $path or return;
225 255
226 unlink "$path.cfperl"; 256 unlink "$path.cfperl";
227}; 257};
228 258
229*on_mapin = 259*on_mapin =
230*on_mapload = sub { 260*on_mapload = sub {
231 my $map = shift->{map}; 261 my ($map) = @_;
232 262
233 my $path = $map->tmpname; 263 my $path = $map->tmpname;
234 $path = $map->path unless defined $path; 264 $path = $map->path unless defined $path;
235 265
236 open my $fh, "<:raw", "$path.cfperl" 266 open my $fh, "<:raw", "$path.cfperl"
… …
243 273
244 $map->_set_obs ($data->{obs}); 274 $map->_set_obs ($data->{obs});
245}; 275};
246 276
247*on_mapout = sub { 277*on_mapout = sub {
248 my $map = shift->{map}; 278 my ($map) = @_;
249 279
250 my $path = $map->tmpname; 280 my $path = $map->tmpname;
251 $path = $map->path unless defined $path; 281 $path = $map->path unless defined $path;
252 282
253 my $obs = $map->_get_obs; 283 my $obs = $map->_get_obs;
… …
273 303
274############################################################################# 304#############################################################################
275# load/save perl data associated with player->ob objects 305# load/save perl data associated with player->ob objects
276 306
277*on_player_load = sub { 307*on_player_load = sub {
278 my ($event) = @_; 308 my ($ob, $path) = @_;
279 my $path = $event->{message};
280 my $ob = $event->{who};
281 309
282 if (open my $fh, "<:raw", "$path.cfperl") { 310 if (open my $fh, "<:raw", "$path.cfperl") {
283 311
284 #d##TODO#remove 312 #d##TODO#remove
285 313
… …
300 } 328 }
301 } 329 }
302}; 330};
303 331
304*on_player_save = sub { 332*on_player_save = sub {
305 my ($event) = @_; 333 my ($ob, $path) = @_;
306 my $path = $event->{message};
307 my $ob = $event->{who};
308 334
309 $_->set_ob_key_value (_perl_data => unpack "H*", Storable::nfreeze $_) 335 $_->set_ob_key_value (_perl_data => unpack "H*", Storable::nfreeze $_)
310 for grep %$_, $ob, $ob->inv; 336 for grep %$_, $ob, $ob->inv;
311 337
312 unlink "$path.cfperl";#d##TODO#remove 338 unlink "$path.cfperl";#d##TODO#remove

Diff Legend

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