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.154 by root, Tue Jan 9 15:36:19 2007 UTC vs.
Revision 1.160 by root, Wed Jan 10 22:54:06 2007 UTC

… …
24use YAML::Syck (); 24use YAML::Syck ();
25use Time::HiRes; 25use Time::HiRes;
26 26
27use Event; $Event::Eval = 1; # no idea why this is required, but it is 27use Event; $Event::Eval = 1; # no idea why this is required, but it is
28 28
29sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
30
29# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? 31# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
30$YAML::Syck::ImplicitUnicode = 1; 32$YAML::Syck::ImplicitUnicode = 1;
31 33
32$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
33 35
34sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
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
39 42
40our @EVENT; 43our @EVENT;
41our $LIBDIR = datadir . "/ext"; 44our $LIBDIR = datadir . "/ext";
42 45
43our $TICK = MAX_TIME * 1e-6; 46our $TICK = MAX_TIME * 1e-6;
… …
52 55
53our %PLAYER; # all users 56our %PLAYER; # all users
54our %MAP; # all maps 57our %MAP; # all maps
55our $LINK_MAP; # the special {link} map 58our $LINK_MAP; # the special {link} map
56our $RANDOM_MAPS = cf::localdir . "/random"; 59our $RANDOM_MAPS = cf::localdir . "/random";
57our %EXT_CORO; # coroutines bound to extensions 60
61our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal;
62our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
58 63
59binmode STDOUT; 64binmode STDOUT;
60binmode STDERR; 65binmode STDERR;
61 66
62# read virtual server time, if available 67# read virtual server time, if available
… …
106 111
107=item %cf::CFG 112=item %cf::CFG
108 113
109Configuration for the server, loaded from C</etc/crossfire/config>, or 114Configuration for the server, loaded from C</etc/crossfire/config>, or
110from wherever your confdir points to. 115from wherever your confdir points to.
116
117=item $cf::WAIT_FOR_TICK, $cf::WAIT_FOR_TICK_ONE
118
119These are Coro::Signal objects that are C<< ->broadcast >> (WAIT_FOR_TICK)
120or C<< ->send >> (WAIT_FOR_TICK_ONE) on after normal server tick
121processing has been done. Call C<< ->wait >> on them to maximise the
122window of cpu time available, or simply to synchronise to the server tick.
111 123
112=back 124=back
113 125
114=cut 126=cut
115 127
… …
146} 158}
147 159
148$Event::DIED = sub { 160$Event::DIED = sub {
149 warn "error in event callback: @_"; 161 warn "error in event callback: @_";
150}; 162};
151
152my %ext_pkg;
153my @exts;
154my @hook;
155 163
156=head2 UTILITY FUNCTIONS 164=head2 UTILITY FUNCTIONS
157 165
158=over 4 166=over 4
159 167
… …
309 } 317 }
310} 318}
311 319
312=item $coro = cf::async_ext { BLOCK } 320=item $coro = cf::async_ext { BLOCK }
313 321
314Like async, but this coro is automcatially being canceled when the 322Like async, but this coro is automatically being canceled when the
315extension calling this is being unloaded. 323extension calling this is being unloaded.
316 324
317=cut 325=cut
318 326
319sub async_ext(&) { 327sub async_ext(&) {
… …
356=cut 364=cut
357 365
358############################################################################# 366#############################################################################
359 367
360package cf::path; 368package cf::path;
369
370use overload
371 '""' => \&as_string;
361 372
362# used to convert map paths into valid unix filenames by repalcing / by ∕ 373# used to convert map paths into valid unix filenames by repalcing / by ∕
363our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 374our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
364 375
365sub new { 376sub new {
… …
374 # ?random/... random maps 385 # ?random/... random maps
375 # /! non-realised random map exit 386 # /! non-realised random map exit
376 # /... normal maps 387 # /... normal maps
377 # ~/... per-player maps without a specific player (DO NOT USE) 388 # ~/... per-player maps without a specific player (DO NOT USE)
378 # ~user/... per-player map of a specific user 389 # ~user/... per-player map of a specific user
390
391 $path =~ s/$PATH_SEP/\//go;
379 392
380 if ($path =~ /^{/) { 393 if ($path =~ /^{/) {
381 # fine as it is 394 # fine as it is
382 } elsif ($path =~ s{^\?random/}{}) { 395 } elsif ($path =~ s{^\?random/}{}) {
383 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data; 396 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
… …
930=cut 943=cut
931 944
932sub register_extcmd { 945sub register_extcmd {
933 my ($name, $cb) = @_; 946 my ($name, $cb) = @_;
934 947
935 my $caller = caller;
936 #warn "registering extcmd '$name' to '$caller'";
937
938 $EXTCMD{$name} = [$cb, $caller]; 948 $EXTCMD{$name} = $cb;
939} 949}
940 950
941cf::player->attach ( 951cf::player->attach (
942 on_command => sub { 952 on_command => sub {
943 my ($pl, $name, $params) = @_; 953 my ($pl, $name, $params) = @_;
… …
956 966
957 my $msg = eval { from_json $buf }; 967 my $msg = eval { from_json $buf };
958 968
959 if (ref $msg) { 969 if (ref $msg) {
960 if (my $cb = $EXTCMD{$msg->{msgtype}}) { 970 if (my $cb = $EXTCMD{$msg->{msgtype}}) {
961 if (my %reply = $cb->[0]->($pl, $msg)) { 971 if (my %reply = $cb->($pl, $msg)) {
962 $pl->ext_reply ($msg->{msgid}, %reply); 972 $pl->ext_reply ($msg->{msgid}, %reply);
963 } 973 }
964 } 974 }
965 } else { 975 } else {
966 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 976 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
… …
968 978
969 cf::override; 979 cf::override;
970 }, 980 },
971); 981);
972 982
973sub register {
974 my ($base, $pkg) = @_;
975
976 #TODO
977}
978
979sub load_extension { 983sub load_extension {
980 my ($path) = @_; 984 my ($path) = @_;
981 985
982 $path =~ /([^\/\\]+)\.ext$/ or die "$path"; 986 $path =~ /([^\/\\]+)\.ext$/ or die "$path";
983 my $base = $1; 987 my $base = $1;
984 my $pkg = $1; 988 my $pkg = $1;
985 $pkg =~ s/[^[:word:]]/_/g; 989 $pkg =~ s/[^[:word:]]/_/g;
986 $pkg = "ext::$pkg"; 990 $pkg = "ext::$pkg";
987 991
988 warn "loading '$path' into '$pkg'\n"; 992 warn "... loading '$path' into '$pkg'\n";
989 993
990 open my $fh, "<:utf8", $path 994 open my $fh, "<:utf8", $path
991 or die "$path: $!"; 995 or die "$path: $!";
992 996
993 my $source = 997 my $source =
… …
998 1002
999 eval $source 1003 eval $source
1000 or die $@ ? "$path: $@\n" 1004 or die $@ ? "$path: $@\n"
1001 : "extension disabled.\n"; 1005 : "extension disabled.\n";
1002 1006
1003 push @exts, $pkg; 1007 push @EXTS, $pkg;
1004 $ext_pkg{$base} = $pkg;
1005
1006# no strict 'refs';
1007# @{"$pkg\::ISA"} = ext::;
1008
1009 register $base, $pkg;
1010}
1011
1012sub unload_extension {
1013 my ($pkg) = @_;
1014
1015 warn "removing extension $pkg\n";
1016
1017 # remove hooks
1018 #TODO
1019# for my $idx (0 .. $#PLUGIN_EVENT) {
1020# delete $hook[$idx]{$pkg};
1021# }
1022
1023 # remove commands
1024 for my $name (keys %COMMAND) {
1025 my @cb = grep $_->[0] ne $pkg, @{ $COMMAND{$name} };
1026
1027 if (@cb) {
1028 $COMMAND{$name} = \@cb;
1029 } else {
1030 delete $COMMAND{$name};
1031 }
1032 }
1033
1034 # remove extcmds
1035 for my $name (grep $EXTCMD{$_}[1] eq $pkg, keys %EXTCMD) {
1036 delete $EXTCMD{$name};
1037 }
1038
1039 if (my $cb = $pkg->can ("unload")) {
1040 eval {
1041 $cb->($pkg);
1042 1
1043 } or warn "$pkg unloaded, but with errors: $@";
1044 }
1045
1046 Symbol::delete_package $pkg;
1047} 1008}
1048 1009
1049sub load_extensions { 1010sub load_extensions {
1050 for my $ext (<$LIBDIR/*.ext>) { 1011 for my $ext (<$LIBDIR/*.ext>) {
1051 next unless -r $ext; 1012 next unless -r $ext;
… …
1069}; 1030};
1070 1031
1071cf::map->attach (prio => -10000, package => cf::mapsupport::); 1032cf::map->attach (prio => -10000, package => cf::mapsupport::);
1072 1033
1073############################################################################# 1034#############################################################################
1074# load/save perl data associated with player->ob objects
1075
1076sub all_objects(@) {
1077 @_, map all_objects ($_->inv), @_
1078}
1079
1080# TODO: compatibility cruft, remove when no longer needed
1081cf::player->attach (
1082 on_load => sub {
1083 my ($pl, $path) = @_;
1084
1085 for my $o (all_objects $pl->ob) {
1086 if (my $value = $o->get_ob_key_value ("_perl_data")) {
1087 $o->set_ob_key_value ("_perl_data");
1088
1089 %$o = %{ Storable::thaw pack "H*", $value };
1090 }
1091 }
1092 },
1093);
1094
1095#############################################################################
1096 1035
1097=head2 CORE EXTENSIONS 1036=head2 CORE EXTENSIONS
1098 1037
1099Functions and methods that extend core crossfire objects. 1038Functions and methods that extend core crossfire objects.
1100 1039
… …
1225 my @logins; 1164 my @logins;
1226 1165
1227 for my $login (@$dirs) { 1166 for my $login (@$dirs) {
1228 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next; 1167 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next;
1229 aio_read $fh, 0, 512, my $buf, 0 or next; 1168 aio_read $fh, 0, 512, my $buf, 0 or next;
1230 $buf !~ /^password -------------$/ or next; # official not-valid tag 1169 $buf !~ /^password -------------$/m or next; # official not-valid tag
1231 1170
1232 utf8::decode $login; 1171 utf8::decode $login;
1233 push @logins, $login; 1172 push @logins, $login;
1234 } 1173 }
1235 1174
… …
1252 my @paths; 1191 my @paths;
1253 1192
1254 for (@$files) { 1193 for (@$files) {
1255 utf8::decode $_; 1194 utf8::decode $_;
1256 next if /\.(?:pl|pst)$/; 1195 next if /\.(?:pl|pst)$/;
1257 next unless /^$PATH_SEP/; 1196 next unless /^$PATH_SEP/o;
1258 1197
1259 s/$PATH_SEP/\//g;
1260 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_; 1198 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
1261 } 1199 }
1262 1200
1263 \@paths 1201 \@paths
1264} 1202}
… …
1451 Coro::cede; 1389 Coro::cede;
1452 1390
1453 $self->in_memory (cf::MAP_IN_MEMORY); 1391 $self->in_memory (cf::MAP_IN_MEMORY);
1454} 1392}
1455 1393
1394# find and load all maps in the 3x3 area around a map
1395sub load_diag {
1396 my ($map) = @_;
1397
1398 my @diag; # diagonal neighbours
1399
1400 for (0 .. 3) {
1401 my $neigh = $map->tile_path ($_)
1402 or next;
1403 $neigh = find $neigh, $map
1404 or next;
1405 $neigh->load;
1406
1407 push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
1408 [$neigh->tile_path (($_ + 1) % 4), $neigh];
1409 }
1410
1411 for (@diag) {
1412 my $neigh = find @$_
1413 or next;
1414 $neigh->load;
1415 }
1416}
1417
1456sub find_sync { 1418sub find_sync {
1457 my ($path, $origin) = @_; 1419 my ($path, $origin) = @_;
1458 1420
1459 cf::sync_job { cf::map::find $path, $origin } 1421 cf::sync_job { find $path, $origin }
1460} 1422}
1461 1423
1462sub do_load_sync { 1424sub do_load_sync {
1463 my ($map) = @_; 1425 my ($map) = @_;
1464 1426
1465 cf::sync_job { $map->load }; 1427 cf::sync_job { $map->load };
1428}
1429
1430our %MAP_PREFETCH;
1431our $MAP_PREFETCHER = Coro::async {
1432 while () {
1433 while (%MAP_PREFETCH) {
1434 my $key = each %MAP_PREFETCH
1435 or next;
1436 my $path = delete $MAP_PREFETCH{$key};
1437
1438 my $map = find $path
1439 or next;
1440 $map->load;
1441 }
1442 Coro::schedule;
1443 }
1444};
1445
1446sub find_async {
1447 my ($path, $origin) = @_;
1448
1449 $path = new cf::path $path, $origin && $origin->path;
1450 my $key = $path->as_string;
1451
1452 if (my $map = $cf::MAP{$key}) {
1453 return $map if $map->in_memory == cf::MAP_IN_MEMORY;
1454 }
1455
1456 $MAP_PREFETCH{$key} = $path;
1457 $MAP_PREFETCHER->ready;
1458
1459 ()
1466} 1460}
1467 1461
1468sub save { 1462sub save {
1469 my ($self) = @_; 1463 my ($self) = @_;
1470 1464
… …
1588 } 1582 }
1589 1583
1590 $map 1584 $map
1591} 1585}
1592 1586
1593sub emergency_save { 1587=item cf::map::unique_maps
1594 my $freeze_guard = cf::freeze_mainloop;
1595 1588
1596 warn "enter emergency perl save\n"; 1589Returns an arrayref of cf::path's of all shared maps that have
1590instantiated unique items. May block.
1597 1591
1598 cf::sync_job { 1592=cut
1599 warn "begin emergency player save\n";
1600 $_->save for values %cf::PLAYER;
1601 warn "end emergency player save\n";
1602 1593
1603 warn "begin emergency map save\n"; 1594sub unique_maps() {
1604 $_->save for values %cf::MAP; 1595 my $files = aio_readdir cf::localdir . "/" . cf::uniquedir
1605 warn "end emergency map save\n"; 1596 or return;
1597
1598 my @paths;
1599
1600 for (@$files) {
1601 utf8::decode $_;
1602 next if /\.pst$/;
1603 next unless /^$PATH_SEP/o;
1604
1605 push @paths, new cf::path $_;
1606 }; 1606 }
1607 1607
1608 warn "leave emergency perl save\n"; 1608 \@paths
1609} 1609}
1610 1610
1611package cf; 1611package cf;
1612 1612
1613=back 1613=back
1614 1614
1615=head3 cf::object
1616
1617=cut
1618
1619package cf::object;
1620
1621=over 4
1622
1623=item $ob->inv_recursive
1624
1625Returns the inventory of the object _and_ their inventories, recursively.
1626
1627=cut
1628
1629sub inv_recursive_;
1630sub inv_recursive_ {
1631 map { $_, inv_recursive_ $_->inv } @_
1632}
1633
1634sub inv_recursive {
1635 inv_recursive_ inv $_[0]
1636}
1637
1638package cf;
1639
1640=back
1615 1641
1616=head3 cf::object::player 1642=head3 cf::object::player
1617 1643
1618=over 4 1644=over 4
1619 1645
… …
1711 # use -1 or undef as default coordinates, not 0, 0 1737 # use -1 or undef as default coordinates, not 0, 0
1712 ($x, $y) = ($map->enter_x, $map->enter_y) 1738 ($x, $y) = ($map->enter_x, $map->enter_y)
1713 if $x <=0 && $y <= 0; 1739 if $x <=0 && $y <= 0;
1714 1740
1715 $map->load; 1741 $map->load;
1742 $map->load_diag;
1716 1743
1717 return unless $self->contr->active; 1744 return unless $self->contr->active;
1718 $self->activate_recursive; 1745 $self->activate_recursive;
1719 $self->enter_map ($map, $x, $y); 1746 $self->enter_map ($map, $x, $y);
1720} 1747}
… …
1757 1784
1758sub cf::object::player::goto { 1785sub cf::object::player::goto {
1759 my ($self, $path, $x, $y) = @_; 1786 my ($self, $path, $x, $y) = @_;
1760 1787
1761 $path = new cf::path $path; 1788 $path = new cf::path $path;
1762 $path ne "/" or Carp::cluck ("oy");#d#
1763 1789
1764 $self->enter_link; 1790 $self->enter_link;
1765 1791
1766 (async { 1792 (async {
1767 my $map = cf::map::find $path->as_string; 1793 my $map = cf::map::find $path->as_string;
… …
1844 1870
1845 1; 1871 1;
1846 }) { 1872 }) {
1847 $self->message ("Something went wrong deep within the crossfire server. " 1873 $self->message ("Something went wrong deep within the crossfire server. "
1848 . "I'll try to bring you back to the map you were before. " 1874 . "I'll try to bring you back to the map you were before. "
1849 . "Please report this to the dungeon master", 1875 . "Please report this to the dungeon master!",
1850 cf::NDI_UNIQUE | cf::NDI_RED); 1876 cf::NDI_UNIQUE | cf::NDI_RED);
1851 1877
1852 warn "ERROR in enter_exit: $@"; 1878 warn "ERROR in enter_exit: $@";
1853 $self->leave_link; 1879 $self->leave_link;
1854 } 1880 }
… …
2207 load_extensions; 2233 load_extensions;
2208 Event::loop; 2234 Event::loop;
2209} 2235}
2210 2236
2211############################################################################# 2237#############################################################################
2212# initialisation 2238# initialisation and cleanup
2239
2240# install some emergency cleanup handlers
2241BEGIN {
2242 for my $signal (qw(INT HUP TERM)) {
2243 Event->signal (
2244 data => WF_AUTOCANCEL,
2245 signal => $signal,
2246 cb => sub {
2247 cf::cleanup "SIG$signal";
2248 },
2249 );
2250 }
2251}
2252
2253sub emergency_save() {
2254 my $freeze_guard = cf::freeze_mainloop;
2255
2256 warn "enter emergency perl save\n";
2257
2258 cf::sync_job {
2259 # use a peculiar iteration method to avoid tripping on perl
2260 # refcount bugs in for. also avoids problems with players
2261 # and maps saved/Destroyed asynchronously.
2262 warn "begin emergency player save\n";
2263 for my $login (keys %cf::PLAYER) {
2264 my $pl = $cf::PLAYER{$login} or next;
2265 $pl->valid or next;
2266 $pl->save;
2267 }
2268 warn "end emergency player save\n";
2269
2270 warn "begin emergency map save\n";
2271 for my $path (keys %cf::MAP) {
2272 my $map = $cf::MAP{$path} or next;
2273 $map->valid or next;
2274 $map->save;
2275 }
2276 warn "end emergency map save\n";
2277 };
2278
2279 warn "leave emergency perl save\n";
2280}
2213 2281
2214sub reload() { 2282sub reload() {
2215 # can/must only be called in main 2283 # can/must only be called in main
2216 if ($Coro::current != $Coro::main) { 2284 if ($Coro::current != $Coro::main) {
2217 warn "can only reload from main coroutine\n"; 2285 warn "can only reload from main coroutine\n";
2218 return; 2286 return;
2219 } 2287 }
2220 2288
2221 warn "reloading..."; 2289 warn "reloading...";
2222 2290
2291 warn "freezing server";
2223 my $guard = freeze_mainloop; 2292 my $guard = freeze_mainloop;
2224 cf::emergency_save; 2293 cf::emergency_save;
2225 2294
2295 warn "sync database to disk";
2296 cf::db_sync;
2297 IO::AIO::flush;
2298
2226 eval { 2299 eval {
2227 # if anything goes wrong in here, we should simply crash as we already saved 2300 # if anything goes wrong in here, we should simply crash as we already saved
2228 2301
2229 # cancel all watchers 2302 warn "cancel all watchers";
2230 for (Event::all_watchers) { 2303 for (Event::all_watchers) {
2231 $_->cancel if $_->data & WF_AUTOCANCEL; 2304 $_->cancel if $_->data & WF_AUTOCANCEL;
2232 } 2305 }
2233 2306
2234 # cancel all extension coros 2307 warn "cancel all extension coros";
2235 $_->cancel for values %EXT_CORO; 2308 $_->cancel for values %EXT_CORO;
2236 %EXT_CORO = (); 2309 %EXT_CORO = ();
2237 2310
2311 warn "remove commands";
2312 %COMMAND = ();
2313
2314 warn "remove ext commands";
2315 %EXTCMD = ();
2316
2238 # unload all extensions 2317 warn "unload/nuke all extensions";
2239 for (@exts) { 2318 for my $pkg (@EXTS) {
2240 warn "unloading <$_>"; 2319 warn "... unloading $pkg";
2241 unload_extension $_; 2320
2321 if (my $cb = $pkg->can ("unload")) {
2322 eval {
2323 $cb->($pkg);
2324 1
2325 } or warn "$pkg unloaded, but with errors: $@";
2242 } 2326 }
2243 2327
2328 warn "... nuking $pkg";
2329 Symbol::delete_package $pkg;
2330 }
2331
2244 # unload all modules loaded from $LIBDIR 2332 warn "unload all perl modules loaded from $LIBDIR";
2245 while (my ($k, $v) = each %INC) { 2333 while (my ($k, $v) = each %INC) {
2246 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 2334 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
2247 2335
2248 warn "removing <$k>"; 2336 warn "removing <$k>";
2249 delete $INC{$k}; 2337 delete $INC{$k};
… …
2256 } 2344 }
2257 2345
2258 Symbol::delete_package $k; 2346 Symbol::delete_package $k;
2259 } 2347 }
2260 2348
2261 # sync database to disk
2262 cf::db_sync;
2263 IO::AIO::flush;
2264
2265 # get rid of safe::, as good as possible 2349 warn "get rid of safe::, as good as possible";
2266 Symbol::delete_package "safe::$_" 2350 Symbol::delete_package "safe::$_"
2267 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 2351 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
2268 2352
2269 # remove register_script_function callbacks
2270 # TODO
2271
2272 # unload cf.pm "a bit" 2353 warn "unload cf.pm \"a bit\"";
2273 delete $INC{"cf.pm"}; 2354 delete $INC{"cf.pm"};
2274 2355
2275 # don't, removes xs symbols, too, 2356 # don't, removes xs symbols, too,
2276 # and global variables created in xs 2357 # and global variables created in xs
2277 #Symbol::delete_package __PACKAGE__; 2358 #Symbol::delete_package __PACKAGE__;
2278 2359
2279 # reload cf.pm
2280 warn "reloading cf.pm"; 2360 warn "reloading cf.pm";
2281 require cf; 2361 require cf;
2282 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 2362 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
2283 2363
2284 # load config and database again 2364 warn "load config and database again";
2285 cf::cfg_load; 2365 cf::cfg_load;
2286 cf::db_load; 2366 cf::db_load;
2287 2367
2288 # load extensions
2289 warn "load extensions"; 2368 warn "load extensions";
2290 cf::load_extensions; 2369 cf::load_extensions;
2291 2370
2292 # reattach attachments to objects 2371 warn "reattach attachments to objects/players";
2293 warn "reattach";
2294 _global_reattach; 2372 _global_reattach;
2373 warn "reattach attachments to maps";
2295 reattach $_ for values %MAP; 2374 reattach $_ for values %MAP;
2296 }; 2375 };
2297 2376
2298 if ($@) { 2377 if ($@) {
2299 warn $@; 2378 warn $@;
2300 warn "error while reloading, exiting."; 2379 warn "error while reloading, exiting.";
2301 exit 1; 2380 exit 1;
2302 } 2381 }
2303 2382
2304 warn "reloaded successfully"; 2383 warn "reloaded";
2305}; 2384};
2306 2385
2307############################################################################# 2386#############################################################################
2308 2387
2309unless ($LINK_MAP) { 2388unless ($LINK_MAP) {
… …
2344 $LINK_MAP->{deny_save} = 1; 2423 $LINK_MAP->{deny_save} = 1;
2345 $LINK_MAP->{deny_reset} = 1; 2424 $LINK_MAP->{deny_reset} = 1;
2346 2425
2347 $cf::MAP{$LINK_MAP->path} = $LINK_MAP; 2426 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
2348} 2427}
2349
2350register "<global>", __PACKAGE__;
2351 2428
2352register_command "reload" => sub { 2429register_command "reload" => sub {
2353 my ($who, $arg) = @_; 2430 my ($who, $arg) = @_;
2354 2431
2355 if ($who->flag (FLAG_WIZ)) { 2432 if ($who->flag (FLAG_WIZ)) {
… …
2368 data => WF_AUTOCANCEL, 2445 data => WF_AUTOCANCEL,
2369 cb => sub { 2446 cb => sub {
2370 cf::server_tick; # one server iteration 2447 cf::server_tick; # one server iteration
2371 $RUNTIME += $TICK; 2448 $RUNTIME += $TICK;
2372 $NEXT_TICK += $TICK; 2449 $NEXT_TICK += $TICK;
2450
2451 $WAIT_FOR_TICK->broadcast;
2452 $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
2373 2453
2374 # if we are delayed by four ticks or more, skip them all 2454 # if we are delayed by four ticks or more, skip them all
2375 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2455 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2376 2456
2377 $TICK_WATCHER->at ($NEXT_TICK); 2457 $TICK_WATCHER->at ($NEXT_TICK);

Diff Legend

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