… | |
… | |
14 | |
14 | |
15 | our %COMMAND; |
15 | our %COMMAND; |
16 | our @EVENT; |
16 | our @EVENT; |
17 | our %PROP_TYPE; |
17 | our %PROP_TYPE; |
18 | our %PROP_IDX; |
18 | our %PROP_IDX; |
|
|
19 | our $LIBDIR = maps_directory "perl"; |
19 | |
20 | |
20 | BEGIN { |
21 | BEGIN { |
21 | @EVENT = map lc, @EVENT; |
22 | @EVENT = map lc, @EVENT; |
22 | |
23 | |
23 | *CORE::GLOBAL::warn = sub { |
24 | *CORE::GLOBAL::warn = sub { |
… | |
… | |
230 | if ($who->flag (FLAG_WIZ)) { |
231 | if ($who->flag (FLAG_WIZ)) { |
231 | $who->message ("reloading..."); |
232 | $who->message ("reloading..."); |
232 | |
233 | |
233 | warn "reloading...\n"; |
234 | warn "reloading...\n"; |
234 | eval { |
235 | eval { |
|
|
236 | # 1. cancel all watchers |
235 | $_->cancel for Event::all_watchers; |
237 | $_->cancel for Event::all_watchers; |
236 | |
238 | |
|
|
239 | # 2. unload all extensions |
|
|
240 | for (@exts) { |
|
|
241 | $who->message ("unloading <$_>"); |
237 | unload_extension $_ for @exts; |
242 | unload_extension $_; |
|
|
243 | } |
|
|
244 | |
|
|
245 | # 3. unload all modules loaded from $LIBDIR |
|
|
246 | while (my ($k, $v) = each %INC) { |
|
|
247 | next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; |
|
|
248 | |
|
|
249 | $who->message ("removing <$k>"); |
|
|
250 | delete $INC{$k}; |
|
|
251 | |
|
|
252 | $k =~ s/\.pm$//; |
|
|
253 | $k =~ s/\//::/g; |
|
|
254 | |
|
|
255 | if (my $cb = $k->can ("unload_module")) { |
|
|
256 | $cb->(); |
|
|
257 | } |
|
|
258 | |
|
|
259 | Symbol::delete_package $k; |
|
|
260 | } |
|
|
261 | |
|
|
262 | # 4. get rid of ext::, as good as possible |
|
|
263 | Symbol::delete_package "ext::$_" |
|
|
264 | for qw(cf::object cf::object::map cf::object::player cf::player cf::map cf::party cf::region); |
|
|
265 | |
|
|
266 | # 5. remove register_script_function callbacks |
|
|
267 | # TODO |
|
|
268 | |
|
|
269 | # 6. unload cf.pm "a bit" |
238 | delete $INC{"cf.pm"}; |
270 | delete $INC{"cf.pm"}; |
239 | |
271 | |
240 | # don't, removes xs symbols, too |
272 | # don't, removes xs symbols, too |
241 | #Symbol::delete_package __PACKAGE__; |
273 | #Symbol::delete_package __PACKAGE__; |
242 | |
274 | |
|
|
275 | # 7. reload cf.pm |
|
|
276 | $who->message ("reloading cf.pm"); |
243 | require cf; |
277 | require cf; |
244 | }; |
278 | }; |
245 | warn $@ if $@; |
279 | warn $@ if $@; |
246 | $who->message ($@) if $@; |
280 | $who->message ($@) if $@; |
247 | warn "reloaded\n"; |
281 | warn "reloaded\n"; |
… | |
… | |
384 | $safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time)); |
418 | $safe->permit_only (Opcode::opset qw(:base_core :base_mem :base_orig :base_math sort time)); |
385 | |
419 | |
386 | # here we export the classes and methods available to script code |
420 | # here we export the classes and methods available to script code |
387 | |
421 | |
388 | for ( |
422 | for ( |
389 | ["cf::object" => qw(contr)], |
423 | ["cf::object" => qw(contr pay_amount pay_player)], |
390 | ["cf::object::player" => qw(player)], |
424 | ["cf::object::player" => qw(player)], |
391 | ["cf::player" => qw(peaceful)], |
425 | ["cf::player" => qw(peaceful)], |
392 | ) { |
426 | ) { |
393 | no strict 'refs'; |
427 | no strict 'refs'; |
394 | my ($pkg, @funs) = @$_; |
428 | my ($pkg, @funs) = @$_; |
… | |
… | |
431 | ############################################################################# |
465 | ############################################################################# |
432 | # initialisation |
466 | # initialisation |
433 | |
467 | |
434 | register "<global>", __PACKAGE__; |
468 | register "<global>", __PACKAGE__; |
435 | |
469 | |
436 | unshift @INC, maps_directory "perl"; |
470 | unshift @INC, $LIBDIR; |
437 | |
471 | |
438 | load_extensions; |
472 | load_extensions; |
439 | |
473 | |
440 | 1 |
474 | 1 |
441 | |
475 | |