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.140 by root, Fri Jan 5 20:04:02 2007 UTC vs.
Revision 1.157 by root, Wed Jan 10 01:16:54 2007 UTC

15use Coro::Timer; 15use Coro::Timer;
16use Coro::Signal; 16use Coro::Signal;
17use Coro::Semaphore; 17use Coro::Semaphore;
18use Coro::AIO; 18use Coro::AIO;
19 19
20use Data::Dumper;
20use Digest::MD5; 21use Digest::MD5;
21use Fcntl; 22use Fcntl;
22use IO::AIO 2.31 (); 23use IO::AIO 2.32 ();
23use YAML::Syck (); 24use YAML::Syck ();
24use Time::HiRes; 25use Time::HiRes;
25 26
26use 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
27 28
29sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
30
28# 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?
29$YAML::Syck::ImplicitUnicode = 1; 32$YAML::Syck::ImplicitUnicode = 1;
30 33
31$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
32
33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
34 35
35our %COMMAND = (); 36our %COMMAND = ();
36our %COMMAND_TIME = (); 37our %COMMAND_TIME = ();
37our %EXTCMD = (); 38our %EXTCMD = ();
38 39
47our %CFG; 48our %CFG;
48 49
49our $UPTIME; $UPTIME ||= time; 50our $UPTIME; $UPTIME ||= time;
50our $RUNTIME; 51our $RUNTIME;
51 52
53our %PLAYER; # all users
52our %MAP; # all maps 54our %MAP; # all maps
53our $LINK_MAP; # the special {link} map 55our $LINK_MAP; # the special {link} map
54our $RANDOM_MAPS = cf::localdir . "/random"; 56our $RANDOM_MAPS = cf::localdir . "/random";
55our %EXT_CORO; 57our %EXT_CORO; # coroutines bound to extensions
58
59our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal;
60our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
56 61
57binmode STDOUT; 62binmode STDOUT;
58binmode STDERR; 63binmode STDERR;
59 64
60# read virtual server time, if available 65# read virtual server time, if available
105=item %cf::CFG 110=item %cf::CFG
106 111
107Configuration for the server, loaded from C</etc/crossfire/config>, or 112Configuration for the server, loaded from C</etc/crossfire/config>, or
108from wherever your confdir points to. 113from wherever your confdir points to.
109 114
115=item $cf::WAIT_FOR_TICK, $cf::WAIT_FOR_TICK_ONE
116
117These are Coro::Signal objects that are C<< ->broadcast >> (WAIT_FOR_TICK)
118or C<< ->send >> (WAIT_FOR_TICK_ONE) on after normal server tick
119processing has been done. Call C<< ->wait >> on them to maximise the
120window of cpu time available, or simply to synchronise to the server tick.
121
110=back 122=back
111 123
112=cut 124=cut
113 125
114BEGIN { 126BEGIN {
117 utf8::encode $msg; 129 utf8::encode $msg;
118 130
119 $msg .= "\n" 131 $msg .= "\n"
120 unless $msg =~ /\n$/; 132 unless $msg =~ /\n$/;
121 133
122 LOG llevError, "cfperl: $msg"; 134 LOG llevError, $msg;
123 }; 135 };
124} 136}
125 137
126@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 138@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
127@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 139@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
153 165
154=head2 UTILITY FUNCTIONS 166=head2 UTILITY FUNCTIONS
155 167
156=over 4 168=over 4
157 169
170=item dumpval $ref
171
158=cut 172=cut
173
174sub dumpval {
175 eval {
176 local $SIG{__DIE__};
177 my $d;
178 if (1) {
179 $d = new Data::Dumper([$_[0]], ["*var"]);
180 $d->Terse(1);
181 $d->Indent(2);
182 $d->Quotekeys(0);
183 $d->Useqq(1);
184 #$d->Bless(...);
185 $d->Seen($_[1]) if @_ > 1;
186 $d = $d->Dump();
187 }
188 $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
189 $d
190 } || "[unable to dump $_[0]: '$@']";
191}
159 192
160use JSON::Syck (); # TODO# replace by JSON::PC once working 193use JSON::Syck (); # TODO# replace by JSON::PC once working
161 194
162=item $ref = cf::from_json $json 195=item $ref = cf::from_json $json
163 196
273 warn $@ if $@; 306 warn $@ if $@;
274 undef $busy; 307 undef $busy;
275 })->prio (Coro::PRIO_MAX); 308 })->prio (Coro::PRIO_MAX);
276 309
277 while ($busy) { 310 while ($busy) {
278 unless (Coro::cede) { 311 Coro::cede or Event::one_event;
279 Coro::nready ? Event::one_event 0 : Event::one_event;
280 Coro::cede_notself unless Coro::cede;
281 }
282 } 312 }
283 313
284 wantarray ? @res : $res[0] 314 wantarray ? @res : $res[0]
285 } else { 315 } else {
286 # we are in another coroutine, how wonderful, everything just works 316 # we are in another coroutine, how wonderful, everything just works
336=cut 366=cut
337 367
338############################################################################# 368#############################################################################
339 369
340package cf::path; 370package cf::path;
371
372# used to convert map paths into valid unix filenames by repalcing / by ∕
373our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
341 374
342sub new { 375sub new {
343 my ($class, $path, $base) = @_; 376 my ($class, $path, $base) = @_;
344 377
345 $path = $path->as_string if ref $path; 378 $path = $path->as_string if ref $path;
409# } 442# }
410} 443}
411 444
412# escape the /'s in the path 445# escape the /'s in the path
413sub _escaped_path { 446sub _escaped_path {
414 # ∕ is U+2215
415 (my $path = $_[0]{path}) =~ s/\///g; 447 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
416 $path 448 $path
417} 449}
418 450
419# the original (read-only) location 451# the original (read-only) location
420sub load_path { 452sub load_path {
1047}; 1079};
1048 1080
1049cf::map->attach (prio => -10000, package => cf::mapsupport::); 1081cf::map->attach (prio => -10000, package => cf::mapsupport::);
1050 1082
1051############################################################################# 1083#############################################################################
1052# load/save perl data associated with player->ob objects
1053
1054sub all_objects(@) {
1055 @_, map all_objects ($_->inv), @_
1056}
1057
1058# TODO: compatibility cruft, remove when no longer needed
1059cf::player->attach (
1060 on_load => sub {
1061 my ($pl, $path) = @_;
1062
1063 for my $o (all_objects $pl->ob) {
1064 if (my $value = $o->get_ob_key_value ("_perl_data")) {
1065 $o->set_ob_key_value ("_perl_data");
1066
1067 %$o = %{ Storable::thaw pack "H*", $value };
1068 }
1069 }
1070 },
1071);
1072
1073#############################################################################
1074 1084
1075=head2 CORE EXTENSIONS 1085=head2 CORE EXTENSIONS
1076 1086
1077Functions and methods that extend core crossfire objects. 1087Functions and methods that extend core crossfire objects.
1078 1088
1089=cut
1090
1091package cf::player;
1092
1093use Coro::AIO;
1094
1079=head3 cf::player 1095=head3 cf::player
1080 1096
1081=over 4 1097=over 4
1082 1098
1083=item cf::player::exists $login 1099=item cf::player::find $login
1084 1100
1085Returns true when the given account exists. 1101Returns the given player object, loading it if necessary (might block).
1086 1102
1087=cut 1103=cut
1088 1104
1089sub cf::player::exists($) { 1105sub playerdir($) {
1090 cf::player::find $_[0] 1106 cf::localdir
1091 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 1107 . "/"
1108 . cf::playerdir
1109 . "/"
1110 . (ref $_[0] ? $_[0]->ob->name : $_[0])
1111}
1112
1113sub path($) {
1114 my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
1115
1116 (playerdir $login) . "/$login.pl"
1117}
1118
1119sub find_active($) {
1120 $cf::PLAYER{$_[0]}
1121 and $cf::PLAYER{$_[0]}->active
1122 and $cf::PLAYER{$_[0]}
1123}
1124
1125sub exists($) {
1126 my ($login) = @_;
1127
1128 $cf::PLAYER{$login}
1129 or cf::sync_job { !aio_stat $login }
1130}
1131
1132sub find($) {
1133 return $cf::PLAYER{$_[0]} || do {
1134 my $login = $_[0];
1135
1136 my $guard = cf::lock_acquire "user_find:$login";
1137
1138 $cf::PLAYER{$_[0]} || do {
1139 my $pl = load_pl path $login
1140 or return;
1141 $cf::PLAYER{$login} = $pl
1142 }
1143 }
1144}
1145
1146sub save($) {
1147 my ($pl) = @_;
1148
1149 return if $pl->{deny_save};
1150
1151 my $path = path $pl;
1152 my $guard = cf::lock_acquire "user_save:$path";
1153
1154 return if $pl->{deny_save};
1155
1156 aio_mkdir playerdir $pl, 0770;
1157 $pl->{last_save} = $cf::RUNTIME;
1158
1159 $pl->save_pl ($path);
1160 Coro::cede;
1161}
1162
1163sub new($) {
1164 my ($login) = @_;
1165
1166 my $self = create;
1167
1168 $self->ob->name ($login);
1169 $self->{deny_save} = 1;
1170
1171 $cf::PLAYER{$login} = $self;
1172
1173 $self
1174}
1175
1176=item $pl->quit_character
1177
1178Nukes the player without looking back. If logged in, the connection will
1179be destroyed. May block for a long time.
1180
1181=cut
1182
1183sub quit_character {
1184 my ($pl) = @_;
1185
1186 $pl->{deny_save} = 1;
1187 $pl->password ("*"); # this should lock out the player until we nuked the dir
1188
1189 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1190 $pl->deactivate;
1191 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1192 $pl->ns->destroy if $pl->ns;
1193
1194 my $path = playerdir $pl;
1195 my $temp = "$path~$cf::RUNTIME~deleting~";
1196 aio_rename $path, $temp;
1197 delete $cf::PLAYER{$pl->ob->name};
1198 $pl->destroy;
1199 IO::AIO::aio_rmtree $temp;
1200}
1201
1202=item cf::player::list_logins
1203
1204Returns am arrayref of all valid playernames in the system, can take a
1205while and may block, so not sync_job-capable, ever.
1206
1207=cut
1208
1209sub list_logins {
1210 my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir
1211 or return [];
1212
1213 my @logins;
1214
1215 for my $login (@$dirs) {
1216 my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next;
1217 aio_read $fh, 0, 512, my $buf, 0 or next;
1218 $buf !~ /^password -------------$/m or next; # official not-valid tag
1219
1220 utf8::decode $login;
1221 push @logins, $login;
1222 }
1223
1224 \@logins
1225}
1226
1227=item $player->maps
1228
1229Returns an arrayref of cf::path's of all maps that are private for this
1230player. May block.
1231
1232=cut
1233
1234sub maps($) {
1235 my ($pl) = @_;
1236
1237 my $files = aio_readdir playerdir $pl
1238 or return;
1239
1240 my @paths;
1241
1242 for (@$files) {
1243 utf8::decode $_;
1244 next if /\.(?:pl|pst)$/;
1245 next unless /^$PATH_SEP/;
1246
1247 s/$PATH_SEP/\//g;
1248 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
1249 }
1250
1251 \@paths
1092} 1252}
1093 1253
1094=item $player->ext_reply ($msgid, $msgtype, %msg) 1254=item $player->ext_reply ($msgid, $msgtype, %msg)
1095 1255
1096Sends an ext reply to the player. 1256Sends an ext reply to the player.
1097 1257
1098=cut 1258=cut
1099 1259
1100sub cf::player::ext_reply($$$%) { 1260sub ext_reply($$$%) {
1101 my ($self, $id, %msg) = @_; 1261 my ($self, $id, %msg) = @_;
1102 1262
1103 $msg{msgid} = $id; 1263 $msg{msgid} = $id;
1104 1264
1105 $self->send ("ext " . to_json \%msg); 1265 $self->send ("ext " . cf::to_json \%msg);
1106} 1266}
1267
1268package cf;
1107 1269
1108=back 1270=back
1109 1271
1110 1272
1111=head3 cf::map 1273=head3 cf::map
1277 Coro::cede; 1439 Coro::cede;
1278 1440
1279 $self->in_memory (cf::MAP_IN_MEMORY); 1441 $self->in_memory (cf::MAP_IN_MEMORY);
1280} 1442}
1281 1443
1444# find and load all maps in the 3x3 area around a map
1445sub load_diag {
1446 my ($map) = @_;
1447
1448 my @diag; # diagonal neighbours
1449
1450 for (0 .. 3) {
1451 my $neigh = $map->tile_path ($_)
1452 or next;
1453 $neigh = find $neigh, $map
1454 or next;
1455 $neigh->load;
1456
1457 push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
1458 [$neigh->tile_path (($_ + 1) % 4), $neigh];
1459 }
1460
1461 for (@diag) {
1462 my $neigh = find @$_
1463 or next;
1464 $neigh->load;
1465 }
1466}
1467
1282sub find_sync { 1468sub find_sync {
1283 my ($path, $origin) = @_; 1469 my ($path, $origin) = @_;
1284 1470
1285 cf::sync_job { cf::map::find $path, $origin } 1471 cf::sync_job { find $path, $origin }
1286} 1472}
1287 1473
1288sub do_load_sync { 1474sub do_load_sync {
1289 my ($map) = @_; 1475 my ($map) = @_;
1290 1476
1291 cf::sync_job { $map->load }; 1477 cf::sync_job { $map->load };
1292} 1478}
1293 1479
1480our %MAP_PREFETCH;
1481our $MAP_PREFETCHER = Coro::async {
1482 while () {
1483 while (%MAP_PREFETCH) {
1484 my $key = each %MAP_PREFETCH
1485 or next;
1486 my $path = delete $MAP_PREFETCH{$key};
1487
1488 my $map = find $path
1489 or next;
1490 $map->load;
1491 }
1492 Coro::schedule;
1493 }
1494};
1495
1496sub find_async {
1497 my ($path, $origin) = @_;
1498
1499 $path = new cf::path $path, $origin && $origin->path;
1500 my $key = $path->as_string;
1501
1502 if (my $map = $cf::MAP{$key}) {
1503 return $map if $map->in_memory == cf::MAP_IN_MEMORY;
1504 }
1505
1506 $MAP_PREFETCH{$key} = $path;
1507 $MAP_PREFETCHER->ready;
1508
1509 ()
1510}
1511
1294sub save { 1512sub save {
1295 my ($self) = @_; 1513 my ($self) = @_;
1296 1514
1297 my $lock = cf::lock_acquire "map_data:" . $self->path; 1515 my $lock = cf::lock_acquire "map_data:" . $self->path;
1298 1516
1306 $self->{load_path} = $save; 1524 $self->{load_path} = $save;
1307 1525
1308 return if $self->{deny_save}; 1526 return if $self->{deny_save};
1309 1527
1310 local $self->{last_access} = $self->last_access;#d# 1528 local $self->{last_access} = $self->last_access;#d#
1529
1530 cf::async {
1531 $_->contr->save for $self->players;
1532 };
1311 1533
1312 if ($uniq) { 1534 if ($uniq) {
1313 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1535 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1314 $self->save_objects ($uniq, cf::IO_UNIQUES); 1536 $self->save_objects ($uniq, cf::IO_UNIQUES);
1315 } else { 1537 } else {
1410 } 1632 }
1411 1633
1412 $map 1634 $map
1413} 1635}
1414 1636
1415sub emergency_save {
1416 my $freeze_guard = cf::freeze_mainloop;
1417
1418 warn "enter emergency map save\n";
1419
1420 cf::sync_job {
1421 warn "begin emergency map save\n";
1422 $_->save for values %cf::MAP;
1423 };
1424
1425 warn "end emergency map save\n";
1426}
1427
1428package cf; 1637package cf;
1429 1638
1430=back 1639=back
1431 1640
1641=head3 cf::object
1642
1643=cut
1644
1645package cf::object;
1646
1647=over 4
1648
1649=item $ob->inv_recursive
1650
1651Returns the inventory of the object _and_ their inventories, recursively.
1652
1653=cut
1654
1655sub inv_recursive_;
1656sub inv_recursive_ {
1657 map { $_, inv_recursive_ $_->inv } @_
1658}
1659
1660sub inv_recursive {
1661 inv_recursive_ inv $_[0]
1662}
1663
1664package cf;
1665
1666=back
1432 1667
1433=head3 cf::object::player 1668=head3 cf::object::player
1434 1669
1435=over 4 1670=over 4
1436 1671
1528 # use -1 or undef as default coordinates, not 0, 0 1763 # use -1 or undef as default coordinates, not 0, 0
1529 ($x, $y) = ($map->enter_x, $map->enter_y) 1764 ($x, $y) = ($map->enter_x, $map->enter_y)
1530 if $x <=0 && $y <= 0; 1765 if $x <=0 && $y <= 0;
1531 1766
1532 $map->load; 1767 $map->load;
1768 $map->load_diag;
1533 1769
1770 return unless $self->contr->active;
1534 $self->activate_recursive; 1771 $self->activate_recursive;
1535 $self->enter_map ($map, $x, $y); 1772 $self->enter_map ($map, $x, $y);
1536} 1773}
1537 1774
1538cf::player->attach ( 1775cf::player->attach (
1550 my ($pl) = @_; 1787 my ($pl) = @_;
1551 1788
1552 # try to abort aborted map switching on player login :) 1789 # try to abort aborted map switching on player login :)
1553 # should happen only on crashes 1790 # should happen only on crashes
1554 if ($pl->ob->{_link_pos}) { 1791 if ($pl->ob->{_link_pos}) {
1555
1556 $pl->ob->enter_link; 1792 $pl->ob->enter_link;
1557 (async { 1793 (async {
1558 # we need this sleep as the login has a concurrent enter_exit running 1794 # we need this sleep as the login has a concurrent enter_exit running
1559 # and this sleep increases chances of the player not ending up in scorn 1795 # and this sleep increases chances of the player not ending up in scorn
1560 $pl->ob->reply (undef, 1796 $pl->ob->reply (undef,
1573=cut 1809=cut
1574 1810
1575sub cf::object::player::goto { 1811sub cf::object::player::goto {
1576 my ($self, $path, $x, $y) = @_; 1812 my ($self, $path, $x, $y) = @_;
1577 1813
1814 $path = new cf::path $path;
1815 $path ne "/" or Carp::cluck ("oy");#d#
1816
1578 $self->enter_link; 1817 $self->enter_link;
1579 1818
1580 (async { 1819 (async {
1581 $path = new cf::path $path;
1582
1583 my $map = cf::map::find $path->as_string; 1820 my $map = cf::map::find $path->as_string;
1584 $map = $map->customise_for ($self) if $map; 1821 $map = $map->customise_for ($self) if $map;
1585 1822
1586# warn "entering ", $map->path, " at ($x, $y)\n" 1823# warn "entering ", $map->path, " at ($x, $y)\n"
1587# if $map; 1824# if $map;
1588 1825
1589 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1826 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1590 1827
1591 $self->leave_link ($map, $x, $y); 1828 $self->leave_link ($map, $x, $y);
1592 })->prio (1); 1829 })->prio (1);
1593} 1830}
1594 1831
2002 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 2239 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2003 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 2240 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2004 2241
2005 if (exists $CFG{mlockall}) { 2242 if (exists $CFG{mlockall}) {
2006 eval { 2243 eval {
2007 $CFG{mlockall} ? &mlockall : &munlockall 2244 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2008 and die "WARNING: m(un)lockall failed: $!\n"; 2245 and die "WARNING: m(un)lockall failed: $!\n";
2009 }; 2246 };
2010 warn $@ if $@; 2247 warn $@ if $@;
2011 } 2248 }
2012} 2249}
2023 load_extensions; 2260 load_extensions;
2024 Event::loop; 2261 Event::loop;
2025} 2262}
2026 2263
2027############################################################################# 2264#############################################################################
2028# initialisation 2265# initialisation and cleanup
2266
2267# install some emergency cleanup handlers
2268BEGIN {
2269 for my $signal (qw(INT HUP TERM)) {
2270 Event->signal (
2271 data => WF_AUTOCANCEL,
2272 signal => $signal,
2273 cb => sub {
2274 cf::cleanup "SIG$signal";
2275 },
2276 );
2277 }
2278}
2279
2280sub emergency_save() {
2281 my $freeze_guard = cf::freeze_mainloop;
2282
2283 warn "enter emergency perl save\n";
2284
2285 cf::sync_job {
2286 # use a peculiar iteration method to avoid tripping on perl
2287 # refcount bugs in for. also avoids problems with players
2288 # and maps saved/Destroyed asynchronously.
2289 warn "begin emergency player save\n";
2290 for my $login (keys %cf::PLAYER) {
2291 my $pl = $cf::PLAYER{$login} or next;
2292 $pl->valid or next;
2293 $pl->save;
2294 }
2295 warn "end emergency player save\n";
2296
2297 warn "begin emergency map save\n";
2298 for my $path (keys %cf::MAP) {
2299 my $map = $cf::MAP{$path} or next;
2300 $map->valid or next;
2301 $map->save;
2302 }
2303 warn "end emergency map save\n";
2304 };
2305
2306 warn "leave emergency perl save\n";
2307}
2029 2308
2030sub reload() { 2309sub reload() {
2031 # can/must only be called in main 2310 # can/must only be called in main
2032 if ($Coro::current != $Coro::main) { 2311 if ($Coro::current != $Coro::main) {
2033 warn "can only reload from main coroutine\n"; 2312 warn "can only reload from main coroutine\n";
2106 cf::load_extensions; 2385 cf::load_extensions;
2107 2386
2108 # reattach attachments to objects 2387 # reattach attachments to objects
2109 warn "reattach"; 2388 warn "reattach";
2110 _global_reattach; 2389 _global_reattach;
2390 reattach $_ for values %MAP;
2111 }; 2391 };
2112 2392
2113 if ($@) { 2393 if ($@) {
2114 warn $@; 2394 warn $@;
2115 warn "error while reloading, exiting."; 2395 warn "error while reloading, exiting.";
2131 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2411 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2132 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2412 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2133 2413
2134 # dirty hack because... archetypes are not yet loaded 2414 # dirty hack because... archetypes are not yet loaded
2135 Event->timer ( 2415 Event->timer (
2136 after => 2, 2416 after => 10,
2137 cb => sub { 2417 cb => sub {
2138 $_[0]->w->cancel; 2418 $_[0]->w->cancel;
2139 2419
2140 # provide some exits "home" 2420 # provide some exits "home"
2141 my $exit = cf::object::new "exit"; 2421 my $exit = cf::object::new "exit";
2183 data => WF_AUTOCANCEL, 2463 data => WF_AUTOCANCEL,
2184 cb => sub { 2464 cb => sub {
2185 cf::server_tick; # one server iteration 2465 cf::server_tick; # one server iteration
2186 $RUNTIME += $TICK; 2466 $RUNTIME += $TICK;
2187 $NEXT_TICK += $TICK; 2467 $NEXT_TICK += $TICK;
2468
2469 $WAIT_FOR_TICK->broadcast;
2470 $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
2188 2471
2189 # if we are delayed by four ticks or more, skip them all 2472 # if we are delayed by four ticks or more, skip them all
2190 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2473 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2191 2474
2192 $TICK_WATCHER->at ($NEXT_TICK); 2475 $TICK_WATCHER->at ($NEXT_TICK);

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines