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.156 by root, Tue Jan 9 22:07:08 2007 UTC vs.
Revision 1.161 by root, Thu Jan 11 00:16:58 2007 UTC

… …
33 33
34$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 34$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
35 35
36our %COMMAND = (); 36our %COMMAND = ();
37our %COMMAND_TIME = (); 37our %COMMAND_TIME = ();
38
39our @EXTS = (); # list of extension package names
38our %EXTCMD = (); 40our %EXTCMD = ();
41our %EXT_CORO = (); # coroutines bound to extensions
42our %EXT_MAP = (); # pluggable maps
39 43
40our @EVENT; 44our @EVENT;
41our $LIBDIR = datadir . "/ext"; 45our $LIBDIR = datadir . "/ext";
42 46
43our $TICK = MAX_TIME * 1e-6; 47our $TICK = MAX_TIME * 1e-6;
… …
52 56
53our %PLAYER; # all users 57our %PLAYER; # all users
54our %MAP; # all maps 58our %MAP; # all maps
55our $LINK_MAP; # the special {link} map 59our $LINK_MAP; # the special {link} map
56our $RANDOM_MAPS = cf::localdir . "/random"; 60our $RANDOM_MAPS = cf::localdir . "/random";
57our %EXT_CORO; # coroutines bound to extensions
58 61
59our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal; 62our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal;
60our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal; 63our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
61 64
62binmode STDOUT; 65binmode STDOUT;
… …
156} 159}
157 160
158$Event::DIED = sub { 161$Event::DIED = sub {
159 warn "error in event callback: @_"; 162 warn "error in event callback: @_";
160}; 163};
161
162my %ext_pkg;
163my @exts;
164my @hook;
165 164
166=head2 UTILITY FUNCTIONS 165=head2 UTILITY FUNCTIONS
167 166
168=over 4 167=over 4
169 168
… …
319 } 318 }
320} 319}
321 320
322=item $coro = cf::async_ext { BLOCK } 321=item $coro = cf::async_ext { BLOCK }
323 322
324Like async, but this coro is automcatially being canceled when the 323Like async, but this coro is automatically being canceled when the
325extension calling this is being unloaded. 324extension calling this is being unloaded.
326 325
327=cut 326=cut
328 327
329sub async_ext(&) { 328sub async_ext(&) {
… …
367 366
368############################################################################# 367#############################################################################
369 368
370package cf::path; 369package cf::path;
371 370
371use overload
372 '""' => \&as_string;
373
372# used to convert map paths into valid unix filenames by repalcing / by ∕ 374# used to convert map paths into valid unix filenames by repalcing / by ∕
373our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 375our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
374 376
377sub register {
378 my ($pkg, $prefix) = @_;
379
380 $EXT_MAP{$prefix} = $pkg;
381}
382
375sub new { 383sub new {
376 my ($class, $path, $base) = @_; 384 my ($class, $path, $base) = @_;
377 385
378 $path = $path->as_string if ref $path; 386 return $path if ref $path;
379 387
380 my $self = bless { }, $class; 388 my $self = {};
381 389
382 # {... are special paths that are not touched 390 # {... are special paths that are not being touched
383 # ?xxx/... are special absolute paths 391 # ?xxx/... are special absolute paths
384 # ?random/... random maps 392 # ?random/... random maps
385 # /! non-realised random map exit 393 # /! non-realised random map exit
386 # /... normal maps 394 # /... normal maps
387 # ~/... per-player maps without a specific player (DO NOT USE) 395 # ~/... per-player maps without a specific player (DO NOT USE)
388 # ~user/... per-player map of a specific user 396 # ~user/... per-player map of a specific user
389 397
398 $path =~ s/$PATH_SEP/\//go;
399
390 if ($path =~ /^{/) { 400 if ($path =~ /^{/) {
391 # fine as it is 401 # fine as it is
392 } elsif ($path =~ s{^\?random/}{}) {
393 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
394 $self->{random} = cf::from_json $data;
395 } else { 402 } else {
396 if ($path =~ s{^~([^/]+)?}{}) { 403 if ($path =~ s{^~([^/]+)?}{}) {
404 # ~user
397 $self->{user_rel} = 1; 405 $self->{user_rel} = 1;
398 406
399 if (defined $1) { 407 if (defined $1) {
400 $self->{user} = $1; 408 $self->{user} = $1;
401 } elsif ($base =~ m{^~([^/]+)/}) { 409 } elsif ($base =~ m{^~([^/]+)/}) {
402 $self->{user} = $1; 410 $self->{user} = $1;
403 } else { 411 } else {
404 warn "cannot resolve user-relative path without user <$path,$base>\n"; 412 warn "cannot resolve user-relative path without user <$path,$base>\n";
405 } 413 }
414 } elsif ($path =~ s{^\?([^/]+)/}{}) {
415 # ?...
416 $self->{ext} = $1;
417 if (my $ext = $EXT_MAP{$1}) {
418 bless $self, $ext;
419 }
406 } elsif ($path =~ /^\//) { 420 } elsif ($path =~ /^\//) {
421 # /...
407 # already absolute 422 # already absolute
408 } else { 423 } else {
424 # relative
409 $base =~ s{[^/]+/?$}{}; 425 $base =~ s{[^/]+/?$}{};
410 return $class->new ("$base/$path"); 426 return $class->new ("$base/$path");
411 } 427 }
412 428
413 for ($path) { 429 for ($path) {
… …
416 } 432 }
417 } 433 }
418 434
419 $self->{path} = $path; 435 $self->{path} = $path;
420 436
437 if ("HASH" eq ref $self) {
438 bless $self, $class;
439 } else {
440 $self->init;
441 }
442
443 for my $ext (values %EXT_MAP) {
444 if (my $subst = $ext->substitute ($self)) {
445 return $subst;
446 }
447 }
448
421 $self 449 $self
450}
451
452sub init {
453 # nop
454}
455
456sub substitute {
457 ()
422} 458}
423 459
424# the name / primary key / in-game path 460# the name / primary key / in-game path
425sub as_string { 461sub as_string {
426 my ($self) = @_; 462 my ($self) = @_;
427 463
428 $self->{user_rel} ? "~$self->{user}$self->{path}" 464 $self->{user_rel} ? "~$self->{user}$self->{path}"
429 : $self->{random} ? "?random/$self->{path}" 465 : $self->{ext} ? "?$self->{ext}/$self->{path}"
430 : $self->{path} 466 : $self->{path}
431} 467}
432 468
433# the displayed name, this is a one way mapping 469# the displayed name, this is a one way mapping
434sub visible_name { 470sub visible_name {
435 my ($self) = @_; 471 &as_string
436
437# if (my $rmp = $self->{random}) {
438# # todo: be more intelligent about this
439# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
440# } else {
441 $self->as_string
442# }
443} 472}
444 473
445# escape the /'s in the path 474# escape the /'s in the path
446sub _escaped_path { 475sub _escaped_path {
447 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 476 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
… …
462 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path 491 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
463 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path} 492 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
464 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path 493 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
465} 494}
466 495
467# the unique path, might be eq to save_path 496# the unique path, undef == no special unique path
468sub uniq_path { 497sub uniq_path {
469 my ($self) = @_; 498 my ($self) = @_;
470 499
471 $self->{user_rel} || $self->{random}
472 ? undef
473 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path 500 sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
474}
475
476# return random map parameters, or undef
477sub random_map_params {
478 my ($self) = @_;
479
480 $self->{random}
481} 501}
482 502
483# this is somewhat ugly, but style maps do need special treatment 503# this is somewhat ugly, but style maps do need special treatment
484sub is_style_map { 504sub is_style_map {
485 $_[0]{path} =~ m{^/styles/} 505 $_[0]{path} =~ m{^/styles/}
506}
507
508sub load_orig {
509 my ($self) = @_;
510
511 &cf::map::load_map_header ($self->load_path)
512}
513
514sub load_temp {
515 my ($self) = @_;
516
517 &cf::map::load_map_header ($self->save_path)
486} 518}
487 519
488package cf; 520package cf;
489 521
490############################################################################# 522#############################################################################
… …
940=cut 972=cut
941 973
942sub register_extcmd { 974sub register_extcmd {
943 my ($name, $cb) = @_; 975 my ($name, $cb) = @_;
944 976
945 my $caller = caller;
946 #warn "registering extcmd '$name' to '$caller'";
947
948 $EXTCMD{$name} = [$cb, $caller]; 977 $EXTCMD{$name} = $cb;
949} 978}
950 979
951cf::player->attach ( 980cf::player->attach (
952 on_command => sub { 981 on_command => sub {
953 my ($pl, $name, $params) = @_; 982 my ($pl, $name, $params) = @_;
… …
966 995
967 my $msg = eval { from_json $buf }; 996 my $msg = eval { from_json $buf };
968 997
969 if (ref $msg) { 998 if (ref $msg) {
970 if (my $cb = $EXTCMD{$msg->{msgtype}}) { 999 if (my $cb = $EXTCMD{$msg->{msgtype}}) {
971 if (my %reply = $cb->[0]->($pl, $msg)) { 1000 if (my %reply = $cb->($pl, $msg)) {
972 $pl->ext_reply ($msg->{msgid}, %reply); 1001 $pl->ext_reply ($msg->{msgid}, %reply);
973 } 1002 }
974 } 1003 }
975 } else { 1004 } else {
976 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 1005 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
… …
978 1007
979 cf::override; 1008 cf::override;
980 }, 1009 },
981); 1010);
982 1011
983sub register {
984 my ($base, $pkg) = @_;
985
986 #TODO
987}
988
989sub load_extension { 1012sub load_extension {
990 my ($path) = @_; 1013 my ($path) = @_;
991 1014
992 $path =~ /([^\/\\]+)\.ext$/ or die "$path"; 1015 $path =~ /([^\/\\]+)\.ext$/ or die "$path";
993 my $base = $1; 1016 my $base = $1;
994 my $pkg = $1; 1017 my $pkg = $1;
995 $pkg =~ s/[^[:word:]]/_/g; 1018 $pkg =~ s/[^[:word:]]/_/g;
996 $pkg = "ext::$pkg"; 1019 $pkg = "ext::$pkg";
997 1020
998 warn "loading '$path' into '$pkg'\n"; 1021 warn "... loading '$path' into '$pkg'\n";
999 1022
1000 open my $fh, "<:utf8", $path 1023 open my $fh, "<:utf8", $path
1001 or die "$path: $!"; 1024 or die "$path: $!";
1002 1025
1003 my $source = 1026 my $source =
… …
1008 1031
1009 eval $source 1032 eval $source
1010 or die $@ ? "$path: $@\n" 1033 or die $@ ? "$path: $@\n"
1011 : "extension disabled.\n"; 1034 : "extension disabled.\n";
1012 1035
1013 push @exts, $pkg; 1036 push @EXTS, $pkg;
1014 $ext_pkg{$base} = $pkg;
1015
1016# no strict 'refs';
1017# @{"$pkg\::ISA"} = ext::;
1018
1019 register $base, $pkg;
1020}
1021
1022sub unload_extension {
1023 my ($pkg) = @_;
1024
1025 warn "removing extension $pkg\n";
1026
1027 # remove hooks
1028 #TODO
1029# for my $idx (0 .. $#PLUGIN_EVENT) {
1030# delete $hook[$idx]{$pkg};
1031# }
1032
1033 # remove commands
1034 for my $name (keys %COMMAND) {
1035 my @cb = grep $_->[0] ne $pkg, @{ $COMMAND{$name} };
1036
1037 if (@cb) {
1038 $COMMAND{$name} = \@cb;
1039 } else {
1040 delete $COMMAND{$name};
1041 }
1042 }
1043
1044 # remove extcmds
1045 for my $name (grep $EXTCMD{$_}[1] eq $pkg, keys %EXTCMD) {
1046 delete $EXTCMD{$name};
1047 }
1048
1049 if (my $cb = $pkg->can ("unload")) {
1050 eval {
1051 $cb->($pkg);
1052 1
1053 } or warn "$pkg unloaded, but with errors: $@";
1054 }
1055
1056 Symbol::delete_package $pkg;
1057} 1037}
1058 1038
1059sub load_extensions { 1039sub load_extensions {
1060 for my $ext (<$LIBDIR/*.ext>) { 1040 for my $ext (<$LIBDIR/*.ext>) {
1061 next unless -r $ext; 1041 next unless -r $ext;
… …
1240 my @paths; 1220 my @paths;
1241 1221
1242 for (@$files) { 1222 for (@$files) {
1243 utf8::decode $_; 1223 utf8::decode $_;
1244 next if /\.(?:pl|pst)$/; 1224 next if /\.(?:pl|pst)$/;
1245 next unless /^$PATH_SEP/; 1225 next unless /^$PATH_SEP/o;
1246 1226
1247 s/$PATH_SEP/\//g;
1248 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_; 1227 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
1249 } 1228 }
1250 1229
1251 \@paths 1230 \@paths
1252} 1231}
… …
1310 1289
1311 $_->change_map_light ($change) 1290 $_->change_map_light ($change)
1312 for grep $_->outdoor, values %cf::MAP; 1291 for grep $_->outdoor, values %cf::MAP;
1313} 1292}
1314 1293
1315sub try_load_header($) { 1294sub load_map_header($) {
1316 my ($path) = @_; 1295 my ($path) = @_;
1317 1296
1318 utf8::encode $path; 1297 utf8::encode $path;
1319 aio_open $path, O_RDONLY, 0 1298 aio_open $path, O_RDONLY, 0
1320 or return; 1299 or return;
1321 1300
1322 my $map = cf::map::new 1301 my $map = cf::map::new
1323 or return; 1302 or return;
1324 1303
1325 # for better error messages only, will be overwritten 1304 # for better error messages only, will be overwritten later
1326 $map->path ($path); 1305 $map->path ($path);
1327 1306
1328 $map->load_header ($path) 1307 $map->load_header ($path)
1329 or return; 1308 or return;
1330 1309
… …
1346 1325
1347 $cf::MAP{$key} || do { 1326 $cf::MAP{$key} || do {
1348 my $guard = cf::lock_acquire "map_find:$key"; 1327 my $guard = cf::lock_acquire "map_find:$key";
1349 1328
1350 # do it the slow way 1329 # do it the slow way
1351 my $map = try_load_header $path->save_path; 1330 my $map = $path->load_temp;
1352 1331
1353 Coro::cede; 1332 Coro::cede;
1354 1333
1355 if ($map) { 1334 if ($map) {
1356 $map->last_access ((delete $map->{last_access}) 1335 $map->last_access ((delete $map->{last_access})
1357 || $cf::RUNTIME); #d# 1336 || $cf::RUNTIME); #d#
1358 # safety 1337 # safety
1359 $map->{instantiate_time} = $cf::RUNTIME 1338 $map->{instantiate_time} = $cf::RUNTIME
1360 if $map->{instantiate_time} > $cf::RUNTIME; 1339 if $map->{instantiate_time} > $cf::RUNTIME;
1361 } else { 1340 } else {
1362 if (my $rmp = $path->random_map_params) { 1341 $map = $path->load_orig
1363 $map = generate_random_map $key, $rmp;
1364 } else {
1365 $map = try_load_header $path->load_path;
1366 }
1367
1368 $map or return; 1342 or return;
1369 1343
1370 $map->{load_original} = 1; 1344 $map->{load_original} = 1;
1371 $map->{instantiate_time} = $cf::RUNTIME; 1345 $map->{instantiate_time} = $cf::RUNTIME;
1372 $map->last_access ($cf::RUNTIME); 1346 $map->last_access ($cf::RUNTIME);
1373 $map->instantiate; 1347 $map->instantiate;
… …
1439 Coro::cede; 1413 Coro::cede;
1440 1414
1441 $self->in_memory (cf::MAP_IN_MEMORY); 1415 $self->in_memory (cf::MAP_IN_MEMORY);
1442} 1416}
1443 1417
1418# find and load all maps in the 3x3 area around a map
1419sub load_diag {
1420 my ($map) = @_;
1421
1422 my @diag; # diagonal neighbours
1423
1424 for (0 .. 3) {
1425 my $neigh = $map->tile_path ($_)
1426 or next;
1427 $neigh = find $neigh, $map
1428 or next;
1429 $neigh->load;
1430
1431 push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
1432 [$neigh->tile_path (($_ + 1) % 4), $neigh];
1433 }
1434
1435 for (@diag) {
1436 my $neigh = find @$_
1437 or next;
1438 $neigh->load;
1439 }
1440}
1441
1444sub find_sync { 1442sub find_sync {
1445 my ($path, $origin) = @_; 1443 my ($path, $origin) = @_;
1446 1444
1447 cf::sync_job { cf::map::find $path, $origin } 1445 cf::sync_job { find $path, $origin }
1448} 1446}
1449 1447
1450sub do_load_sync { 1448sub do_load_sync {
1451 my ($map) = @_; 1449 my ($map) = @_;
1452 1450
1453 cf::sync_job { $map->load }; 1451 cf::sync_job { $map->load };
1452}
1453
1454our %MAP_PREFETCH;
1455our $MAP_PREFETCHER = Coro::async {
1456 while () {
1457 while (%MAP_PREFETCH) {
1458 my $key = each %MAP_PREFETCH
1459 or next;
1460 my $path = delete $MAP_PREFETCH{$key};
1461
1462 my $map = find $path
1463 or next;
1464 $map->load;
1465 }
1466 Coro::schedule;
1467 }
1468};
1469
1470sub find_async {
1471 my ($path, $origin) = @_;
1472
1473 $path = new cf::path $path, $origin && $origin->path;
1474 my $key = $path->as_string;
1475
1476 if (my $map = $cf::MAP{$key}) {
1477 return $map if $map->in_memory == cf::MAP_IN_MEMORY;
1478 }
1479
1480 $MAP_PREFETCH{$key} = $path;
1481 $MAP_PREFETCHER->ready;
1482
1483 ()
1454} 1484}
1455 1485
1456sub save { 1486sub save {
1457 my ($self) = @_; 1487 my ($self) = @_;
1458 1488
… …
1576 } 1606 }
1577 1607
1578 $map 1608 $map
1579} 1609}
1580 1610
1611=item cf::map::unique_maps
1612
1613Returns an arrayref of cf::path's of all shared maps that have
1614instantiated unique items. May block.
1615
1616=cut
1617
1618sub unique_maps() {
1619 my $files = aio_readdir cf::localdir . "/" . cf::uniquedir
1620 or return;
1621
1622 my @paths;
1623
1624 for (@$files) {
1625 utf8::decode $_;
1626 next if /\.pst$/;
1627 next unless /^$PATH_SEP/o;
1628
1629 push @paths, new cf::path $_;
1630 }
1631
1632 \@paths
1633}
1634
1581package cf; 1635package cf;
1582 1636
1583=back 1637=back
1584 1638
1585=head3 cf::object 1639=head3 cf::object
… …
1707 # use -1 or undef as default coordinates, not 0, 0 1761 # use -1 or undef as default coordinates, not 0, 0
1708 ($x, $y) = ($map->enter_x, $map->enter_y) 1762 ($x, $y) = ($map->enter_x, $map->enter_y)
1709 if $x <=0 && $y <= 0; 1763 if $x <=0 && $y <= 0;
1710 1764
1711 $map->load; 1765 $map->load;
1766 $map->load_diag;
1712 1767
1713 return unless $self->contr->active; 1768 return unless $self->contr->active;
1714 $self->activate_recursive; 1769 $self->activate_recursive;
1715 $self->enter_map ($map, $x, $y); 1770 $self->enter_map ($map, $x, $y);
1716} 1771}
… …
1753 1808
1754sub cf::object::player::goto { 1809sub cf::object::player::goto {
1755 my ($self, $path, $x, $y) = @_; 1810 my ($self, $path, $x, $y) = @_;
1756 1811
1757 $path = new cf::path $path; 1812 $path = new cf::path $path;
1758 $path ne "/" or Carp::cluck ("oy");#d#
1759 1813
1760 $self->enter_link; 1814 $self->enter_link;
1761 1815
1762 (async { 1816 (async {
1763 my $map = cf::map::find $path->as_string; 1817 my $map = cf::map::find $path->as_string;
… …
1840 1894
1841 1; 1895 1;
1842 }) { 1896 }) {
1843 $self->message ("Something went wrong deep within the crossfire server. " 1897 $self->message ("Something went wrong deep within the crossfire server. "
1844 . "I'll try to bring you back to the map you were before. " 1898 . "I'll try to bring you back to the map you were before. "
1845 . "Please report this to the dungeon master", 1899 . "Please report this to the dungeon master!",
1846 cf::NDI_UNIQUE | cf::NDI_RED); 1900 cf::NDI_UNIQUE | cf::NDI_RED);
1847 1901
1848 warn "ERROR in enter_exit: $@"; 1902 warn "ERROR in enter_exit: $@";
1849 $self->leave_link; 1903 $self->leave_link;
1850 } 1904 }
… …
2256 return; 2310 return;
2257 } 2311 }
2258 2312
2259 warn "reloading..."; 2313 warn "reloading...";
2260 2314
2315 warn "freezing server";
2261 my $guard = freeze_mainloop; 2316 my $guard = freeze_mainloop;
2262 cf::emergency_save; 2317 cf::emergency_save;
2263 2318
2319 warn "sync database to disk";
2320 cf::db_sync;
2321 IO::AIO::flush;
2322
2264 eval { 2323 eval {
2265 # if anything goes wrong in here, we should simply crash as we already saved 2324 # if anything goes wrong in here, we should simply crash as we already saved
2266 2325
2267 # cancel all watchers 2326 warn "cancel all watchers";
2268 for (Event::all_watchers) { 2327 for (Event::all_watchers) {
2269 $_->cancel if $_->data & WF_AUTOCANCEL; 2328 $_->cancel if $_->data & WF_AUTOCANCEL;
2270 } 2329 }
2271 2330
2272 # cancel all extension coros 2331 warn "cancel all extension coros";
2273 $_->cancel for values %EXT_CORO; 2332 $_->cancel for values %EXT_CORO;
2274 %EXT_CORO = (); 2333 %EXT_CORO = ();
2275 2334
2335 warn "remove commands";
2336 %COMMAND = ();
2337
2338 warn "remove ext commands";
2339 %EXTCMD = ();
2340
2276 # unload all extensions 2341 warn "unload/nuke all extensions";
2277 for (@exts) { 2342 for my $pkg (@EXTS) {
2278 warn "unloading <$_>"; 2343 warn "... unloading $pkg";
2279 unload_extension $_; 2344
2345 if (my $cb = $pkg->can ("unload")) {
2346 eval {
2347 $cb->($pkg);
2348 1
2349 } or warn "$pkg unloaded, but with errors: $@";
2280 } 2350 }
2281 2351
2352 warn "... nuking $pkg";
2353 Symbol::delete_package $pkg;
2354 }
2355
2282 # unload all modules loaded from $LIBDIR 2356 warn "unload all perl modules loaded from $LIBDIR";
2283 while (my ($k, $v) = each %INC) { 2357 while (my ($k, $v) = each %INC) {
2284 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 2358 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
2285 2359
2286 warn "removing <$k>"; 2360 warn "removing <$k>";
2287 delete $INC{$k}; 2361 delete $INC{$k};
… …
2294 } 2368 }
2295 2369
2296 Symbol::delete_package $k; 2370 Symbol::delete_package $k;
2297 } 2371 }
2298 2372
2299 # sync database to disk
2300 cf::db_sync;
2301 IO::AIO::flush;
2302
2303 # get rid of safe::, as good as possible 2373 warn "get rid of safe::, as good as possible";
2304 Symbol::delete_package "safe::$_" 2374 Symbol::delete_package "safe::$_"
2305 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 2375 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
2306 2376
2307 # remove register_script_function callbacks
2308 # TODO
2309
2310 # unload cf.pm "a bit" 2377 warn "unload cf.pm \"a bit\"";
2311 delete $INC{"cf.pm"}; 2378 delete $INC{"cf.pm"};
2312 2379
2313 # don't, removes xs symbols, too, 2380 # don't, removes xs symbols, too,
2314 # and global variables created in xs 2381 # and global variables created in xs
2315 #Symbol::delete_package __PACKAGE__; 2382 #Symbol::delete_package __PACKAGE__;
2316 2383
2317 # reload cf.pm
2318 warn "reloading cf.pm"; 2384 warn "reloading cf.pm";
2319 require cf; 2385 require cf;
2320 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 2386 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
2321 2387
2322 # load config and database again 2388 warn "load config and database again";
2323 cf::cfg_load; 2389 cf::cfg_load;
2324 cf::db_load; 2390 cf::db_load;
2325 2391
2326 # load extensions
2327 warn "load extensions"; 2392 warn "load extensions";
2328 cf::load_extensions; 2393 cf::load_extensions;
2329 2394
2330 # reattach attachments to objects 2395 warn "reattach attachments to objects/players";
2331 warn "reattach";
2332 _global_reattach; 2396 _global_reattach;
2397 warn "reattach attachments to maps";
2333 reattach $_ for values %MAP; 2398 reattach $_ for values %MAP;
2334 }; 2399 };
2335 2400
2336 if ($@) { 2401 if ($@) {
2337 warn $@; 2402 warn $@;
2338 warn "error while reloading, exiting."; 2403 warn "error while reloading, exiting.";
2339 exit 1; 2404 exit 1;
2340 } 2405 }
2341 2406
2342 warn "reloaded successfully"; 2407 warn "reloaded";
2343}; 2408};
2344 2409
2345############################################################################# 2410#############################################################################
2346 2411
2347unless ($LINK_MAP) { 2412unless ($LINK_MAP) {
… …
2382 $LINK_MAP->{deny_save} = 1; 2447 $LINK_MAP->{deny_save} = 1;
2383 $LINK_MAP->{deny_reset} = 1; 2448 $LINK_MAP->{deny_reset} = 1;
2384 2449
2385 $cf::MAP{$LINK_MAP->path} = $LINK_MAP; 2450 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
2386} 2451}
2387
2388register "<global>", __PACKAGE__;
2389 2452
2390register_command "reload" => sub { 2453register_command "reload" => sub {
2391 my ($who, $arg) = @_; 2454 my ($who, $arg) = @_;
2392 2455
2393 if ($who->flag (FLAG_WIZ)) { 2456 if ($who->flag (FLAG_WIZ)) {

Diff Legend

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