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.158 by root, Wed Jan 10 19:52:43 2007 UTC vs.
Revision 1.165 by root, Fri Jan 12 22:09:22 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(&) {
… …
373 '""' => \&as_string; 372 '""' => \&as_string;
374 373
375# 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 ∕
376our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 375our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
377 376
377sub register {
378 my ($pkg, $prefix) = @_;
379
380 $EXT_MAP{$prefix} = $pkg;
381}
382
378sub new { 383sub new {
379 my ($class, $path, $base) = @_; 384 my ($class, $path, $base) = @_;
380 385
381 $path = $path->as_string if ref $path; 386 return $path if ref $path;
382 387
383 my $self = bless { }, $class; 388 my $self = {};
384 389
385 # {... are special paths that are not touched 390 # {... are special paths that are not being touched
386 # ?xxx/... are special absolute paths 391 # ?xxx/... are special absolute paths
387 # ?random/... random maps 392 # ?random/... random maps
388 # /! non-realised random map exit 393 # /! non-realised random map exit
389 # /... normal maps 394 # /... normal maps
390 # ~/... per-player maps without a specific player (DO NOT USE) 395 # ~/... per-player maps without a specific player (DO NOT USE)
… …
392 397
393 $path =~ s/$PATH_SEP/\//go; 398 $path =~ s/$PATH_SEP/\//go;
394 399
395 if ($path =~ /^{/) { 400 if ($path =~ /^{/) {
396 # fine as it is 401 # fine as it is
397 } elsif ($path =~ s{^\?random/}{}) {
398 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
399 $self->{random} = cf::from_json $data;
400 } else { 402 } else {
401 if ($path =~ s{^~([^/]+)?}{}) { 403 if ($path =~ s{^~([^/]+)?}{}) {
404 # ~user
402 $self->{user_rel} = 1; 405 $self->{user_rel} = 1;
403 406
404 if (defined $1) { 407 if (defined $1) {
405 $self->{user} = $1; 408 $self->{user} = $1;
406 } elsif ($base =~ m{^~([^/]+)/}) { 409 } elsif ($base =~ m{^~([^/]+)/}) {
407 $self->{user} = $1; 410 $self->{user} = $1;
408 } else { 411 } else {
409 warn "cannot resolve user-relative path without user <$path,$base>\n"; 412 warn "cannot resolve user-relative path without user <$path,$base>\n";
410 } 413 }
414 } elsif ($path =~ s{^\?([^/]+)/}{}) {
415 # ?...
416 $self->{ext} = $1;
417 if (my $ext = $EXT_MAP{$1}) {
418 bless $self, $ext;
419 }
411 } elsif ($path =~ /^\//) { 420 } elsif ($path =~ /^\//) {
421 # /...
412 # already absolute 422 # already absolute
413 } else { 423 } else {
424 # relative
414 $base =~ s{[^/]+/?$}{}; 425 $base =~ s{[^/]+/?$}{};
415 return $class->new ("$base/$path"); 426 return $class->new ("$base/$path");
416 } 427 }
417 428
418 for ($path) { 429 for ($path) {
… …
421 } 432 }
422 } 433 }
423 434
424 $self->{path} = $path; 435 $self->{path} = $path;
425 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
426 $self 449 $self
450}
451
452sub init {
453 # nop
454}
455
456sub substitute {
457 ()
427} 458}
428 459
429# the name / primary key / in-game path 460# the name / primary key / in-game path
430sub as_string { 461sub as_string {
431 my ($self) = @_; 462 my ($self) = @_;
432 463
433 $self->{user_rel} ? "~$self->{user}$self->{path}" 464 $self->{user_rel} ? "~$self->{user}$self->{path}"
434 : $self->{random} ? "?random/$self->{path}" 465 : $self->{ext} ? "?$self->{ext}/$self->{path}"
435 : $self->{path} 466 : $self->{path}
436} 467}
437 468
438# the displayed name, this is a one way mapping 469# the displayed name, this is a one way mapping
439sub visible_name { 470sub visible_name {
440 my ($self) = @_; 471 &as_string
441
442# if (my $rmp = $self->{random}) {
443# # todo: be more intelligent about this
444# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
445# } else {
446 $self->as_string
447# }
448} 472}
449 473
450# escape the /'s in the path 474# escape the /'s in the path
451sub _escaped_path { 475sub _escaped_path {
452 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 476 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
477
453 $path 478 $path
454} 479}
455 480
456# the original (read-only) location 481# the original (read-only) location
457sub load_path { 482sub load_path {
… …
462 487
463# the temporary/swap location 488# the temporary/swap location
464sub save_path { 489sub save_path {
465 my ($self) = @_; 490 my ($self) = @_;
466 491
492 $self->{user_rel}
467 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path 493 ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
468 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
469 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path 494 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
470} 495}
471 496
472# the unique path, might be eq to save_path 497# the unique path, undef == no special unique path
473sub uniq_path { 498sub uniq_path {
474 my ($self) = @_; 499 my ($self) = @_;
475 500
476 $self->{user_rel} || $self->{random} 501 $self->{user_rel} || $self->{ext}
477 ? undef 502 ? undef
478 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path 503 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
479} 504}
480 505
481# return random map parameters, or undef 506sub customise_for {
482sub random_map_params {
483 my ($self) = @_; 507 my ($self, $map, $ob) = @_;
484 508
485 $self->{random} 509 if ($map->per_player) {
510 return cf::map::find ("~" . $ob->name . "/" . $map->{path}{path});
511 }
512
513 $map
486} 514}
487 515
488# this is somewhat ugly, but style maps do need special treatment 516# this is somewhat ugly, but style maps do need special treatment
489sub is_style_map { 517sub is_style_map {
490 $_[0]{path} =~ m{^/styles/} 518 $_[0]{path} =~ m{^/styles/}
519}
520
521sub load_orig {
522 my ($self) = @_;
523
524 &cf::map::load_map_header ($self->load_path)
525}
526
527sub load_temp {
528 my ($self) = @_;
529
530 &cf::map::load_map_header ($self->save_path)
531}
532
533sub unlink_save {
534 my ($self) = @_;
535
536 utf8::encode (my $save = $self->save_path);
537 IO::AIO::aioreq_pri 4; IO::AIO::aio_unlink $save;
538 IO::AIO::aioreq_pri 4; IO::AIO::aio_unlink "$save.pst";
491} 539}
492 540
493package cf; 541package cf;
494 542
495############################################################################# 543#############################################################################
… …
945=cut 993=cut
946 994
947sub register_extcmd { 995sub register_extcmd {
948 my ($name, $cb) = @_; 996 my ($name, $cb) = @_;
949 997
950 my $caller = caller;
951 #warn "registering extcmd '$name' to '$caller'";
952
953 $EXTCMD{$name} = [$cb, $caller]; 998 $EXTCMD{$name} = $cb;
954} 999}
955 1000
956cf::player->attach ( 1001cf::player->attach (
957 on_command => sub { 1002 on_command => sub {
958 my ($pl, $name, $params) = @_; 1003 my ($pl, $name, $params) = @_;
… …
971 1016
972 my $msg = eval { from_json $buf }; 1017 my $msg = eval { from_json $buf };
973 1018
974 if (ref $msg) { 1019 if (ref $msg) {
975 if (my $cb = $EXTCMD{$msg->{msgtype}}) { 1020 if (my $cb = $EXTCMD{$msg->{msgtype}}) {
976 if (my %reply = $cb->[0]->($pl, $msg)) { 1021 if (my %reply = $cb->($pl, $msg)) {
977 $pl->ext_reply ($msg->{msgid}, %reply); 1022 $pl->ext_reply ($msg->{msgid}, %reply);
978 } 1023 }
979 } 1024 }
980 } else { 1025 } else {
981 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 1026 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
… …
983 1028
984 cf::override; 1029 cf::override;
985 }, 1030 },
986); 1031);
987 1032
988sub register {
989 my ($base, $pkg) = @_;
990
991 #TODO
992}
993
994sub load_extension { 1033sub load_extension {
995 my ($path) = @_; 1034 my ($path) = @_;
996 1035
997 $path =~ /([^\/\\]+)\.ext$/ or die "$path"; 1036 $path =~ /([^\/\\]+)\.ext$/ or die "$path";
998 my $base = $1; 1037 my $base = $1;
999 my $pkg = $1; 1038 my $pkg = $1;
1000 $pkg =~ s/[^[:word:]]/_/g; 1039 $pkg =~ s/[^[:word:]]/_/g;
1001 $pkg = "ext::$pkg"; 1040 $pkg = "ext::$pkg";
1002 1041
1003 warn "loading '$path' into '$pkg'\n"; 1042 warn "... loading '$path' into '$pkg'\n";
1004 1043
1005 open my $fh, "<:utf8", $path 1044 open my $fh, "<:utf8", $path
1006 or die "$path: $!"; 1045 or die "$path: $!";
1007 1046
1008 my $source = 1047 my $source =
… …
1013 1052
1014 eval $source 1053 eval $source
1015 or die $@ ? "$path: $@\n" 1054 or die $@ ? "$path: $@\n"
1016 : "extension disabled.\n"; 1055 : "extension disabled.\n";
1017 1056
1018 push @exts, $pkg; 1057 push @EXTS, $pkg;
1019 $ext_pkg{$base} = $pkg;
1020
1021# no strict 'refs';
1022# @{"$pkg\::ISA"} = ext::;
1023
1024 register $base, $pkg;
1025}
1026
1027sub unload_extension {
1028 my ($pkg) = @_;
1029
1030 warn "removing extension $pkg\n";
1031
1032 # remove hooks
1033 #TODO
1034# for my $idx (0 .. $#PLUGIN_EVENT) {
1035# delete $hook[$idx]{$pkg};
1036# }
1037
1038 # remove commands
1039 for my $name (keys %COMMAND) {
1040 my @cb = grep $_->[0] ne $pkg, @{ $COMMAND{$name} };
1041
1042 if (@cb) {
1043 $COMMAND{$name} = \@cb;
1044 } else {
1045 delete $COMMAND{$name};
1046 }
1047 }
1048
1049 # remove extcmds
1050 for my $name (grep $EXTCMD{$_}[1] eq $pkg, keys %EXTCMD) {
1051 delete $EXTCMD{$name};
1052 }
1053
1054 if (my $cb = $pkg->can ("unload")) {
1055 eval {
1056 $cb->($pkg);
1057 1
1058 } or warn "$pkg unloaded, but with errors: $@";
1059 }
1060
1061 Symbol::delete_package $pkg;
1062} 1058}
1063 1059
1064sub load_extensions { 1060sub load_extensions {
1065 for my $ext (<$LIBDIR/*.ext>) { 1061 for my $ext (<$LIBDIR/*.ext>) {
1066 next unless -r $ext; 1062 next unless -r $ext;
… …
1290 1286
1291sub generate_random_map { 1287sub generate_random_map {
1292 my ($path, $rmp) = @_; 1288 my ($path, $rmp) = @_;
1293 1289
1294 # mit "rum" bekleckern, nicht 1290 # mit "rum" bekleckern, nicht
1295 cf::map::_create_random_map 1291 cf::map::_create_random_map (
1296 $path, 1292 $path,
1297 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle}, 1293 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1298 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, 1294 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1299 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map}, 1295 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1300 $rmp->{exit_on_final_map}, 1296 $rmp->{exit_on_final_map},
… …
1302 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3}, 1298 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1303 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase}, 1299 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1304 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation}, 1300 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1305 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp}, 1301 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1306 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used}, 1302 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1307 (cf::region::find $rmp->{region}) 1303 (cf::region::find $rmp->{region}), $rmp->{custom}
1304 )
1308} 1305}
1309 1306
1310# and all this just because we cannot iterate over 1307# and all this just because we cannot iterate over
1311# all maps in C++... 1308# all maps in C++...
1312sub change_all_map_light { 1309sub change_all_map_light {
… …
1314 1311
1315 $_->change_map_light ($change) 1312 $_->change_map_light ($change)
1316 for grep $_->outdoor, values %cf::MAP; 1313 for grep $_->outdoor, values %cf::MAP;
1317} 1314}
1318 1315
1319sub try_load_header($) { 1316sub load_map_header($) {
1320 my ($path) = @_; 1317 my ($path) = @_;
1321 1318
1322 utf8::encode $path; 1319 utf8::encode $path;
1323 aio_open $path, O_RDONLY, 0 1320 aio_open $path, O_RDONLY, 0
1324 or return; 1321 or return;
1325 1322
1326 my $map = cf::map::new 1323 my $map = cf::map::new
1327 or return; 1324 or return;
1328 1325
1329 # for better error messages only, will be overwritten 1326 # for better error messages only, will be overwritten later
1330 $map->path ($path); 1327 $map->path ($path);
1331 1328
1332 $map->load_header ($path) 1329 $map->load_header ($path)
1333 or return; 1330 or return;
1334 1331
… …
1350 1347
1351 $cf::MAP{$key} || do { 1348 $cf::MAP{$key} || do {
1352 my $guard = cf::lock_acquire "map_find:$key"; 1349 my $guard = cf::lock_acquire "map_find:$key";
1353 1350
1354 # do it the slow way 1351 # do it the slow way
1355 my $map = try_load_header $path->save_path; 1352 my $map = $path->load_temp;
1356 1353
1357 Coro::cede; 1354 Coro::cede;
1358 1355
1359 if ($map) { 1356 if ($map) {
1360 $map->last_access ((delete $map->{last_access}) 1357 $map->last_access ((delete $map->{last_access})
1361 || $cf::RUNTIME); #d# 1358 || $cf::RUNTIME); #d#
1362 # safety 1359 # safety
1363 $map->{instantiate_time} = $cf::RUNTIME 1360 $map->{instantiate_time} = $cf::RUNTIME
1364 if $map->{instantiate_time} > $cf::RUNTIME; 1361 if $map->{instantiate_time} > $cf::RUNTIME;
1365 } else { 1362 } else {
1366 if (my $rmp = $path->random_map_params) { 1363 $map = $path->load_orig
1367 $map = generate_random_map $key, $rmp;
1368 } else {
1369 $map = try_load_header $path->load_path;
1370 }
1371
1372 $map or return; 1364 or return;
1373 1365
1374 $map->{load_original} = 1; 1366 $map->{load_original} = 1;
1375 $map->{instantiate_time} = $cf::RUNTIME; 1367 $map->{instantiate_time} = $cf::RUNTIME;
1376 $map->last_access ($cf::RUNTIME); 1368 $map->last_access ($cf::RUNTIME);
1377 $map->instantiate; 1369 $map->instantiate;
… …
1429 1421
1430 if ($self->{path}->is_style_map) { 1422 if ($self->{path}->is_style_map) {
1431 $self->{deny_save} = 1; 1423 $self->{deny_save} = 1;
1432 $self->{deny_reset} = 1; 1424 $self->{deny_reset} = 1;
1433 } else { 1425 } else {
1426 $self->decay_objects;
1434 $self->fix_auto_apply; 1427 $self->fix_auto_apply;
1435 $self->decay_objects;
1436 $self->update_buttons; 1428 $self->update_buttons;
1437 $self->set_darkness_map; 1429 $self->set_darkness_map;
1438 $self->difficulty ($self->estimate_difficulty) 1430 $self->difficulty ($self->estimate_difficulty)
1439 unless $self->difficulty; 1431 unless $self->difficulty;
1440 $self->activate; 1432 $self->activate;
… …
1576 my ($self) = @_; 1568 my ($self) = @_;
1577 1569
1578 $self->reset_at <= $cf::RUNTIME 1570 $self->reset_at <= $cf::RUNTIME
1579} 1571}
1580 1572
1581sub unlink_save {
1582 my ($self) = @_;
1583
1584 utf8::encode (my $save = $self->{path}->save_path);
1585 aioreq_pri 3; IO::AIO::aio_unlink $save;
1586 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1587}
1588
1589sub rename { 1573sub rename {
1590 my ($self, $new_path) = @_; 1574 my ($self, $new_path) = @_;
1591 1575
1592 $self->unlink_save; 1576 $self->{path}->unlink_save;
1593 1577
1594 delete $cf::MAP{$self->path}; 1578 delete $cf::MAP{$self->path};
1595 $self->{path} = new cf::path $new_path; 1579 $self->{path} = new cf::path $new_path;
1596 $self->path ($self->{path}->as_string); 1580 $self->path ($self->{path}->as_string);
1597 $cf::MAP{$self->path} = $self; 1581 $cf::MAP{$self->path} = $self;
… …
1611 1595
1612 delete $cf::MAP{$self->path}; 1596 delete $cf::MAP{$self->path};
1613 1597
1614 $_->clear_links_to ($self) for values %cf::MAP; 1598 $_->clear_links_to ($self) for values %cf::MAP;
1615 1599
1616 $self->unlink_save; 1600 $self->{path}->unlink_save;
1617 $self->destroy; 1601 $self->destroy;
1618} 1602}
1619 1603
1620my $nuke_counter = "aaaa"; 1604my $nuke_counter = "aaaa";
1621 1605
… …
1624 1608
1625 $self->{deny_save} = 1; 1609 $self->{deny_save} = 1;
1626 $self->reset_timeout (1); 1610 $self->reset_timeout (1);
1627 $self->rename ("{nuke}/" . ($nuke_counter++)); 1611 $self->rename ("{nuke}/" . ($nuke_counter++));
1628 $self->reset; # polite request, might not happen 1612 $self->reset; # polite request, might not happen
1629}
1630
1631sub customise_for {
1632 my ($map, $ob) = @_;
1633
1634 if ($map->per_player) {
1635 return cf::map::find "~" . $ob->name . "/" . $map->{path}{path};
1636 }
1637
1638 $map
1639} 1613}
1640 1614
1641=item cf::map::unique_maps 1615=item cf::map::unique_maps
1642 1616
1643Returns an arrayref of cf::path's of all shared maps that have 1617Returns an arrayref of cf::path's of all shared maps that have
… …
1843 1817
1844 $self->enter_link; 1818 $self->enter_link;
1845 1819
1846 (async { 1820 (async {
1847 my $map = cf::map::find $path->as_string; 1821 my $map = cf::map::find $path->as_string;
1848 $map = $map->customise_for ($self) if $map; 1822 $map = $map->{path}->customise_for ($map, $self) if $map;
1849 1823
1850# warn "entering ", $map->path, " at ($x, $y)\n" 1824# warn "entering ", $map->path, " at ($x, $y)\n"
1851# if $map; 1825# if $map;
1852 1826
1853 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1827 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
… …
2340 return; 2314 return;
2341 } 2315 }
2342 2316
2343 warn "reloading..."; 2317 warn "reloading...";
2344 2318
2319 warn "freezing server";
2345 my $guard = freeze_mainloop; 2320 my $guard = freeze_mainloop;
2346 cf::emergency_save; 2321 cf::emergency_save;
2347 2322
2323 warn "sync database to disk";
2324 cf::db_sync;
2325 IO::AIO::flush;
2326
2348 eval { 2327 eval {
2349 # if anything goes wrong in here, we should simply crash as we already saved 2328 # if anything goes wrong in here, we should simply crash as we already saved
2350 2329
2351 # cancel all watchers 2330 warn "cancel all watchers";
2352 for (Event::all_watchers) { 2331 for (Event::all_watchers) {
2353 $_->cancel if $_->data & WF_AUTOCANCEL; 2332 $_->cancel if $_->data & WF_AUTOCANCEL;
2354 } 2333 }
2355 2334
2356 # cancel all extension coros 2335 warn "cancel all extension coros";
2357 $_->cancel for values %EXT_CORO; 2336 $_->cancel for values %EXT_CORO;
2358 %EXT_CORO = (); 2337 %EXT_CORO = ();
2359 2338
2339 warn "remove commands";
2340 %COMMAND = ();
2341
2342 warn "remove ext commands";
2343 %EXTCMD = ();
2344
2360 # unload all extensions 2345 warn "unload/nuke all extensions";
2361 for (@exts) { 2346 for my $pkg (@EXTS) {
2362 warn "unloading <$_>"; 2347 warn "... unloading $pkg";
2363 unload_extension $_; 2348
2349 if (my $cb = $pkg->can ("unload")) {
2350 eval {
2351 $cb->($pkg);
2352 1
2353 } or warn "$pkg unloaded, but with errors: $@";
2364 } 2354 }
2365 2355
2356 warn "... nuking $pkg";
2357 Symbol::delete_package $pkg;
2358 }
2359
2366 # unload all modules loaded from $LIBDIR 2360 warn "unload all perl modules loaded from $LIBDIR";
2367 while (my ($k, $v) = each %INC) { 2361 while (my ($k, $v) = each %INC) {
2368 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 2362 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
2369 2363
2370 warn "removing <$k>"; 2364 warn "removing <$k>";
2371 delete $INC{$k}; 2365 delete $INC{$k};
… …
2378 } 2372 }
2379 2373
2380 Symbol::delete_package $k; 2374 Symbol::delete_package $k;
2381 } 2375 }
2382 2376
2383 # sync database to disk
2384 cf::db_sync;
2385 IO::AIO::flush;
2386
2387 # get rid of safe::, as good as possible 2377 warn "get rid of safe::, as good as possible";
2388 Symbol::delete_package "safe::$_" 2378 Symbol::delete_package "safe::$_"
2389 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 2379 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
2390 2380
2391 # remove register_script_function callbacks
2392 # TODO
2393
2394 # unload cf.pm "a bit" 2381 warn "unload cf.pm \"a bit\"";
2395 delete $INC{"cf.pm"}; 2382 delete $INC{"cf.pm"};
2396 2383
2397 # don't, removes xs symbols, too, 2384 # don't, removes xs symbols, too,
2398 # and global variables created in xs 2385 # and global variables created in xs
2399 #Symbol::delete_package __PACKAGE__; 2386 #Symbol::delete_package __PACKAGE__;
2400 2387
2401 # reload cf.pm
2402 warn "reloading cf.pm"; 2388 warn "reloading cf.pm";
2403 require cf; 2389 require cf;
2404 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 2390 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
2405 2391
2406 # load config and database again 2392 warn "load config and database again";
2407 cf::cfg_load; 2393 cf::cfg_load;
2408 cf::db_load; 2394 cf::db_load;
2409 2395
2410 # load extensions
2411 warn "load extensions"; 2396 warn "load extensions";
2412 cf::load_extensions; 2397 cf::load_extensions;
2413 2398
2414 # reattach attachments to objects 2399 warn "reattach attachments to objects/players";
2415 warn "reattach";
2416 _global_reattach; 2400 _global_reattach;
2401 warn "reattach attachments to maps";
2417 reattach $_ for values %MAP; 2402 reattach $_ for values %MAP;
2418 }; 2403 };
2419 2404
2420 if ($@) { 2405 if ($@) {
2421 warn $@; 2406 warn $@;
2422 warn "error while reloading, exiting."; 2407 warn "error while reloading, exiting.";
2423 exit 1; 2408 exit 1;
2424 } 2409 }
2425 2410
2426 warn "reloaded successfully"; 2411 warn "reloaded";
2427}; 2412};
2428 2413
2429############################################################################# 2414#############################################################################
2430 2415
2431unless ($LINK_MAP) { 2416unless ($LINK_MAP) {
… …
2467 $LINK_MAP->{deny_reset} = 1; 2452 $LINK_MAP->{deny_reset} = 1;
2468 2453
2469 $cf::MAP{$LINK_MAP->path} = $LINK_MAP; 2454 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
2470} 2455}
2471 2456
2472register "<global>", __PACKAGE__;
2473
2474register_command "reload" => sub { 2457register_command "reload" => sub {
2475 my ($who, $arg) = @_; 2458 my ($who, $arg) = @_;
2476 2459
2477 if ($who->flag (FLAG_WIZ)) { 2460 if ($who->flag (FLAG_WIZ)) {
2478 $who->message ("start of reload."); 2461 $who->message ("start of reload.");
… …
2487 reentrant => 0, 2470 reentrant => 0,
2488 prio => 0, 2471 prio => 0,
2489 at => $NEXT_TICK || $TICK, 2472 at => $NEXT_TICK || $TICK,
2490 data => WF_AUTOCANCEL, 2473 data => WF_AUTOCANCEL,
2491 cb => sub { 2474 cb => sub {
2475 $NOW = Event::time;
2476
2492 cf::server_tick; # one server iteration 2477 cf::server_tick; # one server iteration
2493 $RUNTIME += $TICK; 2478 $RUNTIME += $TICK;
2494 $NEXT_TICK += $TICK; 2479 $NEXT_TICK += $TICK;
2495 2480
2496 $WAIT_FOR_TICK->broadcast; 2481 $WAIT_FOR_TICK->broadcast;

Diff Legend

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