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.132 by root, Thu Jan 4 01:35:56 2007 UTC vs.
Revision 1.151 by root, Mon Jan 8 20:59:15 2007 UTC

… …
17use Coro::Semaphore; 17use Coro::Semaphore;
18use Coro::AIO; 18use Coro::AIO;
19 19
20use Digest::MD5; 20use Digest::MD5;
21use Fcntl; 21use Fcntl;
22use IO::AIO 2.31 (); 22use IO::AIO 2.32 ();
23use YAML::Syck (); 23use YAML::Syck ();
24use Time::HiRes; 24use Time::HiRes;
25 25
26use Event; $Event::Eval = 1; # no idea why this is required, but it is 26use Event; $Event::Eval = 1; # no idea why this is required, but it is
27 27
28# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? 28# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
29$YAML::Syck::ImplicitUnicode = 1; 29$YAML::Syck::ImplicitUnicode = 1;
30 30
31$Coro::main->prio (2); # run main coroutine ("the server") with very high priority 31$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
32 32
33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
34 34
35our %COMMAND = (); 35our %COMMAND = ();
36our %COMMAND_TIME = (); 36our %COMMAND_TIME = ();
… …
47our %CFG; 47our %CFG;
48 48
49our $UPTIME; $UPTIME ||= time; 49our $UPTIME; $UPTIME ||= time;
50our $RUNTIME; 50our $RUNTIME;
51 51
52our %PLAYER; # all users
52our %MAP; # all maps 53our %MAP; # all maps
53our $LINK_MAP; # the special {link} map 54our $LINK_MAP; # the special {link} map
54our $FREEZE;
55our $RANDOM_MAPS = cf::localdir . "/random"; 55our $RANDOM_MAPS = cf::localdir . "/random";
56our %EXT_CORO; 56our %EXT_CORO; # coroutines bound to extensions
57 57
58binmode STDOUT; 58binmode STDOUT;
59binmode STDERR; 59binmode STDERR;
60 60
61# read virtual server time, if available 61# read virtual server time, if available
… …
118 utf8::encode $msg; 118 utf8::encode $msg;
119 119
120 $msg .= "\n" 120 $msg .= "\n"
121 unless $msg =~ /\n$/; 121 unless $msg =~ /\n$/;
122 122
123 LOG llevError, "cfperl: $msg"; 123 LOG llevError, $msg;
124 }; 124 };
125} 125}
126 126
127@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 127@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
128@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 128@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
… …
180sub to_json($) { 180sub to_json($) {
181 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 181 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
182 JSON::Syck::Dump $_[0] 182 JSON::Syck::Dump $_[0]
183} 183}
184 184
185=item my $guard = cf::guard { BLOCK }
186
187Run the given callback when the guard object gets destroyed (useful for
188coroutine cancellations).
189
190You can call C<< ->cancel >> on the guard object to stop the block from
191being executed.
192
193=cut
194
195sub guard(&) {
196 bless \(my $cb = $_[0]), cf::guard::;
197}
198
199sub cf::guard::cancel {
200 ${$_[0]} = sub { };
201}
202
203sub cf::guard::DESTROY {
204 ${$_[0]}->();
205}
206
207=item cf::lock_wait $string 185=item cf::lock_wait $string
208 186
209Wait until the given lock is available. See cf::lock_acquire. 187Wait until the given lock is available. See cf::lock_acquire.
210 188
211=item my $lock = cf::lock_acquire $string 189=item my $lock = cf::lock_acquire $string
212 190
213Wait until the given lock is available and then acquires it and returns 191Wait until the given lock is available and then acquires it and returns
214a guard object. If the guard object gets destroyed (goes out of scope, 192a Coro::guard object. If the guard object gets destroyed (goes out of scope,
215for example when the coroutine gets canceled), the lock is automatically 193for example when the coroutine gets canceled), the lock is automatically
216returned. 194returned.
217 195
218Lock names should begin with a unique identifier (for example, find_map 196Lock names should begin with a unique identifier (for example, cf::map::find
219uses map_find and load_map uses map_load). 197uses map_find and cf::map::load uses map_load).
220 198
221=cut 199=cut
222 200
223our %LOCK; 201our %LOCK;
224 202
… …
238 # wait, to be sure we are not locked 216 # wait, to be sure we are not locked
239 lock_wait $key; 217 lock_wait $key;
240 218
241 $LOCK{$key} = []; 219 $LOCK{$key} = [];
242 220
243 cf::guard { 221 Coro::guard {
244 # wake up all waiters, to be on the safe side 222 # wake up all waiters, to be on the safe side
245 $_->ready for @{ delete $LOCK{$key} }; 223 $_->ready for @{ delete $LOCK{$key} };
246 } 224 }
247} 225}
248 226
227sub freeze_mainloop {
228 return unless $TICK_WATCHER->is_active;
229
230 my $guard = Coro::guard { $TICK_WATCHER->start };
231 $TICK_WATCHER->stop;
232 $guard
233}
234
249=item cf::async { BLOCK } 235=item cf::async { BLOCK }
250 236
251Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the 237Currently the same as Coro::async_pool, meaning you cannot use
252error instead of exiting the server in case of a problem. 238C<on_destroy>, C<join> or other gimmicks on these coroutines. The only
239thing you are allowed to do is call C<prio> on it.
253 240
254=cut 241=cut
255 242
256sub async(&) { 243BEGIN { *async = \&Coro::async_pool }
257 my ($cb) = @_;
258
259 Coro::async {
260 eval { $cb->() };
261 warn $@ if $@;
262 }
263}
264 244
265=item cf::sync_job { BLOCK } 245=item cf::sync_job { BLOCK }
266 246
267The design of crossfire+ requires that the main coro ($Coro::main) is 247The design of crossfire+ requires that the main coro ($Coro::main) is
268always able to handle events or runnable, as crossfire+ is only partly 248always able to handle events or runnable, as crossfire+ is only partly
… …
282 # this is the main coro, too bad, we have to block 262 # this is the main coro, too bad, we have to block
283 # till the operation succeeds, freezing the server :/ 263 # till the operation succeeds, freezing the server :/
284 264
285 # TODO: use suspend/resume instead 265 # TODO: use suspend/resume instead
286 # (but this is cancel-safe) 266 # (but this is cancel-safe)
287 local $FREEZE = 1; 267 my $freeze_guard = freeze_mainloop;
288 268
289 my $busy = 1; 269 my $busy = 1;
290 my @res; 270 my @res;
291 271
292 (Coro::async { 272 (async {
293 @res = eval { $job->() }; 273 @res = eval { $job->() };
294 warn $@ if $@; 274 warn $@ if $@;
295 undef $busy; 275 undef $busy;
296 })->prio (Coro::PRIO_MAX); 276 })->prio (Coro::PRIO_MAX);
297 277
298 while ($busy) { 278 while ($busy) {
299 Coro::cede_notself; 279 Coro::cede or Event::one_event;
300 Event::one_event unless Coro::nready;
301 } 280 }
302 281
303 wantarray ? @res : $res[0] 282 wantarray ? @res : $res[0]
304 } else { 283 } else {
305 # we are in another coroutine, how wonderful, everything just works 284 # we are in another coroutine, how wonderful, everything just works
306 285
307 $job->() 286 $job->()
308 } 287 }
309} 288}
310 289
311=item $coro = cf::coro { BLOCK } 290=item $coro = cf::async_ext { BLOCK }
312 291
313Creates and returns a new coro. This coro is automcatially being canceled 292Like async, but this coro is automcatially being canceled when the
314when the extension calling this is being unloaded. 293extension calling this is being unloaded.
315 294
316=cut 295=cut
317 296
318sub coro(&) { 297sub async_ext(&) {
319 my $cb = shift; 298 my $cb = shift;
320 299
321 my $coro = &cf::async ($cb); 300 my $coro = &Coro::async ($cb);
322 301
323 $coro->on_destroy (sub { 302 $coro->on_destroy (sub {
324 delete $EXT_CORO{$coro+0}; 303 delete $EXT_CORO{$coro+0};
325 }); 304 });
326 $EXT_CORO{$coro+0} = $coro; 305 $EXT_CORO{$coro+0} = $coro;
… …
1093 1072
1094=head2 CORE EXTENSIONS 1073=head2 CORE EXTENSIONS
1095 1074
1096Functions and methods that extend core crossfire objects. 1075Functions and methods that extend core crossfire objects.
1097 1076
1077=cut
1078
1079package cf::player;
1080
1098=head3 cf::player 1081=head3 cf::player
1099 1082
1100=over 4 1083=over 4
1101 1084
1102=item cf::player::exists $login 1085=item cf::player::find $login
1103 1086
1104Returns true when the given account exists. 1087Returns the given player object, loading it if necessary (might block).
1105 1088
1106=cut 1089=cut
1107 1090
1108sub cf::player::exists($) { 1091sub playerdir($) {
1109 cf::player::find $_[0] 1092 cf::localdir
1110 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 1093 . "/"
1094 . cf::playerdir
1095 . "/"
1096 . (ref $_[0] ? $_[0]->ob->name : $_[0])
1097}
1098
1099sub path($) {
1100 my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
1101
1102 (playerdir $login) . "/$login.pl"
1103}
1104
1105sub find_active($) {
1106 $cf::PLAYER{$_[0]}
1107 and $cf::PLAYER{$_[0]}->active
1108 and $cf::PLAYER{$_[0]}
1109}
1110
1111sub exists($) {
1112 my ($login) = @_;
1113
1114 $cf::PLAYER{$login}
1115 or cf::sync_job { !aio_stat $login }
1116}
1117
1118sub find($) {
1119 return $cf::PLAYER{$_[0]} || do {
1120 my $login = $_[0];
1121
1122 my $guard = cf::lock_acquire "user_find:$login";
1123
1124 $cf::PLAYER{$_[0]} || do {
1125 my $pl = load_pl path $login
1126 or return;
1127 $cf::PLAYER{$login} = $pl
1128 }
1129 }
1130}
1131
1132sub save($) {
1133 my ($pl) = @_;
1134
1135 return if $pl->{deny_save};
1136
1137 my $path = path $pl;
1138 my $guard = cf::lock_acquire "user_save:$path";
1139
1140 return if $pl->{deny_save};
1141
1142 Coro::AIO::aio_mkdir playerdir $pl, 0770;
1143 $pl->{last_save} = $cf::RUNTIME;
1144
1145 $pl->save_pl ($path);
1146 Coro::cede;
1147}
1148
1149sub new($) {
1150 my ($login) = @_;
1151
1152 my $self = create;
1153
1154 $self->ob->name ($login);
1155 $self->{deny_save} = 1;
1156
1157 $cf::PLAYER{$login} = $self;
1158
1159 $self
1160}
1161
1162sub quit_character {
1163 my ($pl) = @_;
1164
1165 $pl->{deny_save} = 1;
1166 $pl->password ("*"); # this should lock out the player until we nuked the dir
1167
1168 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1169 $pl->deactivate;
1170 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1171 $pl->ns->destroy if $pl->ns;
1172
1173 my $path = playerdir $pl;
1174 my $temp = "$path~$cf::RUNTIME~deleting~";
1175 Coro::AIO::aio_rename $path, $temp;
1176 delete $cf::PLAYER{$pl->ob->name};
1177 $pl->destroy;
1178 IO::AIO::aio_rmtree $temp;
1111} 1179}
1112 1180
1113=item $player->ext_reply ($msgid, $msgtype, %msg) 1181=item $player->ext_reply ($msgid, $msgtype, %msg)
1114 1182
1115Sends an ext reply to the player. 1183Sends an ext reply to the player.
1116 1184
1117=cut 1185=cut
1118 1186
1119sub cf::player::ext_reply($$$%) { 1187sub ext_reply($$$%) {
1120 my ($self, $id, %msg) = @_; 1188 my ($self, $id, %msg) = @_;
1121 1189
1122 $msg{msgid} = $id; 1190 $msg{msgid} = $id;
1123 1191
1124 $self->send ("ext " . to_json \%msg); 1192 $self->send ("ext " . cf::to_json \%msg);
1125} 1193}
1194
1195package cf;
1126 1196
1127=back 1197=back
1128 1198
1129 1199
1130=head3 cf::map 1200=head3 cf::map
… …
1136package cf::map; 1206package cf::map;
1137 1207
1138use Fcntl; 1208use Fcntl;
1139use Coro::AIO; 1209use Coro::AIO;
1140 1210
1141our $MAX_RESET = 7200; 1211our $MAX_RESET = 3600;
1142our $DEFAULT_RESET = 3600; 1212our $DEFAULT_RESET = 3000;
1143 1213
1144sub generate_random_map { 1214sub generate_random_map {
1145 my ($path, $rmp) = @_; 1215 my ($path, $rmp) = @_;
1146 1216
1147 # mit "rum" bekleckern, nicht 1217 # mit "rum" bekleckern, nicht
… …
1177 or return; 1247 or return;
1178 1248
1179 my $map = cf::map::new 1249 my $map = cf::map::new
1180 or return; 1250 or return;
1181 1251
1252 # for better error messages only, will be overwritten
1253 $map->path ($path);
1254
1182 $map->load_header ($path) 1255 $map->load_header ($path)
1183 or return; 1256 or return;
1184 1257
1185 $map->{load_path} = $path; 1258 $map->{load_path} = $path;
1186 1259
1187 $map 1260 $map
1188} 1261}
1189 1262
1190sub find_map; 1263sub find;
1191sub find_map { 1264sub find {
1192 my ($path, $origin) = @_; 1265 my ($path, $origin) = @_;
1193 1266
1194 #warn "find_map<$path,$origin>\n";#d# 1267 #warn "find<$path,$origin>\n";#d#
1195 1268
1196 $path = new cf::path $path, $origin && $origin->path; 1269 $path = new cf::path $path, $origin && $origin->path;
1197 my $key = $path->as_string; 1270 my $key = $path->as_string;
1198 1271
1199 cf::lock_wait "map_find:$key"; 1272 cf::lock_wait "map_find:$key";
… …
1201 $cf::MAP{$key} || do { 1274 $cf::MAP{$key} || do {
1202 my $guard = cf::lock_acquire "map_find:$key"; 1275 my $guard = cf::lock_acquire "map_find:$key";
1203 1276
1204 # do it the slow way 1277 # do it the slow way
1205 my $map = try_load_header $path->save_path; 1278 my $map = try_load_header $path->save_path;
1279
1280 Coro::cede;
1206 1281
1207 if ($map) { 1282 if ($map) {
1208 $map->last_access ((delete $map->{last_access}) 1283 $map->last_access ((delete $map->{last_access})
1209 || $cf::RUNTIME); #d# 1284 || $cf::RUNTIME); #d#
1210 # safety 1285 # safety
… …
1230 1305
1231 $map->path ($key); 1306 $map->path ($key);
1232 $map->{path} = $path; 1307 $map->{path} = $path;
1233 $map->{last_save} = $cf::RUNTIME; 1308 $map->{last_save} = $cf::RUNTIME;
1234 1309
1310 Coro::cede;
1311
1235 if ($map->should_reset) { 1312 if ($map->should_reset) {
1236 $map->reset; 1313 $map->reset;
1237 undef $guard; 1314 undef $guard;
1238 $map = find_map $path 1315 $map = find $path
1239 or return; 1316 or return;
1240 } 1317 }
1241 1318
1242 $cf::MAP{$key} = $map 1319 $cf::MAP{$key} = $map
1243 } 1320 }
… …
1265 if (aio_open $uniq, O_RDONLY, 0) { 1342 if (aio_open $uniq, O_RDONLY, 0) {
1266 $self->clear_unique_items; 1343 $self->clear_unique_items;
1267 $self->load_objects ($uniq, 0); 1344 $self->load_objects ($uniq, 0);
1268 } 1345 }
1269 } 1346 }
1347
1348 Coro::cede;
1270 1349
1271 # now do the right thing for maps 1350 # now do the right thing for maps
1272 $self->link_multipart_objects; 1351 $self->link_multipart_objects;
1273 1352
1274 if ($self->{path}->is_style_map) { 1353 if ($self->{path}->is_style_map) {
… …
1282 $self->difficulty ($self->estimate_difficulty) 1361 $self->difficulty ($self->estimate_difficulty)
1283 unless $self->difficulty; 1362 unless $self->difficulty;
1284 $self->activate; 1363 $self->activate;
1285 } 1364 }
1286 1365
1366 Coro::cede;
1367
1287 $self->in_memory (cf::MAP_IN_MEMORY); 1368 $self->in_memory (cf::MAP_IN_MEMORY);
1288} 1369}
1289 1370
1290sub load_map_sync { 1371sub find_sync {
1291 my ($path, $origin) = @_; 1372 my ($path, $origin) = @_;
1292 1373
1293 #warn "load_map_sync<$path, $origin>\n";#d# 1374 cf::sync_job { cf::map::find $path, $origin }
1375}
1294 1376
1295 cf::sync_job { 1377sub do_load_sync {
1296 my $map = cf::map::find_map $path, $origin 1378 my ($map) = @_;
1297 or return; 1379
1298 $map->load; 1380 cf::sync_job { $map->load };
1299 $map
1300 }
1301} 1381}
1302 1382
1303sub save { 1383sub save {
1304 my ($self) = @_; 1384 my ($self) = @_;
1305 1385
1386 my $lock = cf::lock_acquire "map_data:" . $self->path;
1387
1306 $self->{last_save} = $cf::RUNTIME; 1388 $self->{last_save} = $cf::RUNTIME;
1307 1389
1308 return unless $self->dirty; 1390 return unless $self->dirty;
1309 1391
1310 my $save = $self->{path}->save_path; utf8::encode $save; 1392 my $save = $self->{path}->save_path; utf8::encode $save;
… …
1313 $self->{load_path} = $save; 1395 $self->{load_path} = $save;
1314 1396
1315 return if $self->{deny_save}; 1397 return if $self->{deny_save};
1316 1398
1317 local $self->{last_access} = $self->last_access;#d# 1399 local $self->{last_access} = $self->last_access;#d#
1400
1401 cf::async {
1402 $_->contr->save for $self->players;
1403 };
1318 1404
1319 if ($uniq) { 1405 if ($uniq) {
1320 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1406 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1321 $self->save_objects ($uniq, cf::IO_UNIQUES); 1407 $self->save_objects ($uniq, cf::IO_UNIQUES);
1322 } else { 1408 } else {
… …
1328 my ($self) = @_; 1414 my ($self) = @_;
1329 1415
1330 # save first because save cedes 1416 # save first because save cedes
1331 $self->save; 1417 $self->save;
1332 1418
1419 my $lock = cf::lock_acquire "map_data:" . $self->path;
1420
1333 return if $self->players; 1421 return if $self->players;
1334 return if $self->in_memory != cf::MAP_IN_MEMORY; 1422 return if $self->in_memory != cf::MAP_IN_MEMORY;
1335 return if $self->{deny_save}; 1423 return if $self->{deny_save};
1336 1424
1337 $self->clear; 1425 $self->clear;
… …
1379} 1467}
1380 1468
1381sub reset { 1469sub reset {
1382 my ($self) = @_; 1470 my ($self) = @_;
1383 1471
1472 my $lock = cf::lock_acquire "map_data:" . $self->path;
1473
1384 return if $self->players; 1474 return if $self->players;
1385 return if $self->{path}{user_rel};#d# 1475 return if $self->{path}{user_rel};#d#
1386 1476
1387 warn "resetting map ", $self->path;#d# 1477 warn "resetting map ", $self->path;#d#
1388 1478
… …
1407 1497
1408sub customise_for { 1498sub customise_for {
1409 my ($map, $ob) = @_; 1499 my ($map, $ob) = @_;
1410 1500
1411 if ($map->per_player) { 1501 if ($map->per_player) {
1412 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path}; 1502 return cf::map::find "~" . $ob->name . "/" . $map->{path}{path};
1413 } 1503 }
1414 1504
1415 $map 1505 $map
1416} 1506}
1417 1507
1418sub emergency_save { 1508sub emergency_save {
1419 local $cf::FREEZE = 1; 1509 my $freeze_guard = cf::freeze_mainloop;
1420 1510
1421 warn "enter emergency map save\n"; 1511 warn "enter emergency perl save\n";
1422 1512
1423 cf::sync_job { 1513 cf::sync_job {
1514 warn "begin emergency player save\n";
1515 $_->save for values %cf::PLAYER;
1516 warn "end emergency player save\n";
1517
1424 warn "begin emergency map save\n"; 1518 warn "begin emergency map save\n";
1425 $_->save for values %cf::MAP; 1519 $_->save for values %cf::MAP;
1520 warn "end emergency map save\n";
1426 }; 1521 };
1427 1522
1428 warn "end emergency map save\n"; 1523 warn "leave emergency perl save\n";
1429} 1524}
1430 1525
1431package cf; 1526package cf;
1432 1527
1433=back 1528=back
… …
1514 my $link_pos = delete $self->{_link_pos}; 1609 my $link_pos = delete $self->{_link_pos};
1515 1610
1516 unless ($map) { 1611 unless ($map) {
1517 # restore original map position 1612 # restore original map position
1518 ($map, $x, $y) = @{ $link_pos || [] }; 1613 ($map, $x, $y) = @{ $link_pos || [] };
1519 $map = cf::map::find_map $map; 1614 $map = cf::map::find $map;
1520 1615
1521 unless ($map) { 1616 unless ($map) {
1522 ($map, $x, $y) = @$EMERGENCY_POSITION; 1617 ($map, $x, $y) = @$EMERGENCY_POSITION;
1523 $map = cf::map::find_map $map 1618 $map = cf::map::find $map
1524 or die "FATAL: cannot load emergency map\n"; 1619 or die "FATAL: cannot load emergency map\n";
1525 } 1620 }
1526 } 1621 }
1527 1622
1528 ($x, $y) = (-1, -1) 1623 ($x, $y) = (-1, -1)
… …
1532 ($x, $y) = ($map->enter_x, $map->enter_y) 1627 ($x, $y) = ($map->enter_x, $map->enter_y)
1533 if $x <=0 && $y <= 0; 1628 if $x <=0 && $y <= 0;
1534 1629
1535 $map->load; 1630 $map->load;
1536 1631
1632 return unless $self->contr->active;
1537 $self->activate_recursive; 1633 $self->activate_recursive;
1538 $self->enter_map ($map, $x, $y); 1634 $self->enter_map ($map, $x, $y);
1539} 1635}
1540 1636
1541cf::player->attach ( 1637cf::player->attach (
… …
1554 1650
1555 # try to abort aborted map switching on player login :) 1651 # try to abort aborted map switching on player login :)
1556 # should happen only on crashes 1652 # should happen only on crashes
1557 if ($pl->ob->{_link_pos}) { 1653 if ($pl->ob->{_link_pos}) {
1558 $pl->ob->enter_link; 1654 $pl->ob->enter_link;
1559 cf::async { 1655 (async {
1560 # we need this sleep as the login has a concurrent enter_exit running 1656 # we need this sleep as the login has a concurrent enter_exit running
1561 # and this sleep increases chances of the player not ending up in scorn 1657 # and this sleep increases chances of the player not ending up in scorn
1658 $pl->ob->reply (undef,
1659 "There was an internal problem at your last logout, "
1660 . "the server will try to bring you to your intended destination in a second.",
1661 cf::NDI_RED);
1562 Coro::Timer::sleep 1; 1662 Coro::Timer::sleep 1;
1563 $pl->ob->leave_link; 1663 $pl->ob->leave_link;
1564 }; 1664 })->prio (2);
1565 } 1665 }
1566 }, 1666 },
1567); 1667);
1568 1668
1569=item $player_object->goto_map ($path, $x, $y) 1669=item $player_object->goto ($path, $x, $y)
1570 1670
1571=cut 1671=cut
1572 1672
1573sub cf::object::player::goto_map { 1673sub cf::object::player::goto {
1574 my ($self, $path, $x, $y) = @_; 1674 my ($self, $path, $x, $y) = @_;
1575 1675
1576 $self->enter_link; 1676 $self->enter_link;
1577 1677
1578 (cf::async { 1678 (async {
1579 $path = new cf::path $path; 1679 $path = new cf::path $path;
1580 1680
1581 my $map = cf::map::find_map $path->as_string; 1681 my $map = cf::map::find $path->as_string;
1582 $map = $map->customise_for ($self) if $map; 1682 $map = $map->customise_for ($self) if $map;
1583 1683
1584# warn "entering ", $map->path, " at ($x, $y)\n" 1684# warn "entering ", $map->path, " at ($x, $y)\n"
1585# if $map; 1685# if $map;
1586 1686
1687 $map or $map->cluck ("oy");#d#
1587 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1688 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1588 1689
1589 $self->leave_link ($map, $x, $y); 1690 $self->leave_link ($map, $x, $y);
1590 })->prio (1); 1691 })->prio (1);
1591} 1692}
1592 1693
… …
1645 1746
1646 return unless $self->type == cf::PLAYER; 1747 return unless $self->type == cf::PLAYER;
1647 1748
1648 $self->enter_link; 1749 $self->enter_link;
1649 1750
1650 (cf::async { 1751 (async {
1752 $self->deactivate_recursive; # just to be sure
1651 unless (eval { 1753 unless (eval {
1652 prepare_random_map $exit 1754 prepare_random_map $exit
1653 if $exit->slaying eq "/!"; 1755 if $exit->slaying eq "/!";
1654 1756
1655 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path; 1757 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1656 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp); 1758 $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
1657 1759
1658 1; 1760 1;
1659 }) { 1761 }) {
1660 $self->message ("Something went wrong deep within the crossfire server. " 1762 $self->message ("Something went wrong deep within the crossfire server. "
1661 . "I'll try to bring you back to the map you were before. " 1763 . "I'll try to bring you back to the map you were before. "
… …
1735 } 1837 }
1736 } 1838 }
1737 }, 1839 },
1738); 1840);
1739 1841
1740=item $client->coro (\&cb) 1842=item $client->async (\&cb)
1741 1843
1742Create a new coroutine, running the specified callback. The coroutine will 1844Create a new coroutine, running the specified callback. The coroutine will
1743be automatically cancelled when the client gets destroyed (e.g. on logout, 1845be automatically cancelled when the client gets destroyed (e.g. on logout,
1744or loss of connection). 1846or loss of connection).
1745 1847
1746=cut 1848=cut
1747 1849
1748sub cf::client::coro { 1850sub cf::client::async {
1749 my ($self, $cb) = @_; 1851 my ($self, $cb) = @_;
1750 1852
1751 my $coro = &cf::async ($cb); 1853 my $coro = &Coro::async ($cb);
1752 1854
1753 $coro->on_destroy (sub { 1855 $coro->on_destroy (sub {
1754 delete $self->{_coro}{$coro+0}; 1856 delete $self->{_coro}{$coro+0};
1755 }); 1857 });
1756 1858
… …
1994 local $/; 2096 local $/;
1995 *CFG = YAML::Syck::Load <$fh>; 2097 *CFG = YAML::Syck::Load <$fh>;
1996 2098
1997 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 2099 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
1998 2100
2101 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2102 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2103
1999 if (exists $CFG{mlockall}) { 2104 if (exists $CFG{mlockall}) {
2000 eval { 2105 eval {
2001 $CFG{mlockall} ? &mlockall : &munlockall 2106 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2002 and die "WARNING: m(un)lockall failed: $!\n"; 2107 and die "WARNING: m(un)lockall failed: $!\n";
2003 }; 2108 };
2004 warn $@ if $@; 2109 warn $@ if $@;
2005 } 2110 }
2006} 2111}
2007 2112
2008sub main { 2113sub main {
2009 # we must not ever block the main coroutine 2114 # we must not ever block the main coroutine
2010 local $Coro::idle = sub { 2115 local $Coro::idle = sub {
2011 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 2116 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
2012 (Coro::unblock_sub {
2013 Event::one_event; 2117 async { Event::one_event };
2014 })->();
2015 }; 2118 };
2016 2119
2017 cfg_load; 2120 cfg_load;
2018 db_load; 2121 db_load;
2019 load_extensions; 2122 load_extensions;
… …
2030 return; 2133 return;
2031 } 2134 }
2032 2135
2033 warn "reloading..."; 2136 warn "reloading...";
2034 2137
2035 local $FREEZE = 1; 2138 my $guard = freeze_mainloop;
2036 cf::emergency_save; 2139 cf::emergency_save;
2037 2140
2038 eval { 2141 eval {
2039 # if anything goes wrong in here, we should simply crash as we already saved 2142 # if anything goes wrong in here, we should simply crash as we already saved
2040 2143
… …
2102 cf::load_extensions; 2205 cf::load_extensions;
2103 2206
2104 # reattach attachments to objects 2207 # reattach attachments to objects
2105 warn "reattach"; 2208 warn "reattach";
2106 _global_reattach; 2209 _global_reattach;
2210 reattach $_ for values %MAP;
2107 }; 2211 };
2108 2212
2109 if ($@) { 2213 if ($@) {
2110 warn $@; 2214 warn $@;
2111 warn "error while reloading, exiting."; 2215 warn "error while reloading, exiting.";
… …
2127 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2231 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2128 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2232 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2129 2233
2130 # dirty hack because... archetypes are not yet loaded 2234 # dirty hack because... archetypes are not yet loaded
2131 Event->timer ( 2235 Event->timer (
2132 after => 2, 2236 after => 10,
2133 cb => sub { 2237 cb => sub {
2134 $_[0]->w->cancel; 2238 $_[0]->w->cancel;
2135 2239
2136 # provide some exits "home" 2240 # provide some exits "home"
2137 my $exit = cf::object::new "exit"; 2241 my $exit = cf::object::new "exit";
… …
2176 reentrant => 0, 2280 reentrant => 0,
2177 prio => 0, 2281 prio => 0,
2178 at => $NEXT_TICK || $TICK, 2282 at => $NEXT_TICK || $TICK,
2179 data => WF_AUTOCANCEL, 2283 data => WF_AUTOCANCEL,
2180 cb => sub { 2284 cb => sub {
2181 unless ($FREEZE) {
2182 cf::server_tick; # one server iteration 2285 cf::server_tick; # one server iteration
2183 $RUNTIME += $TICK; 2286 $RUNTIME += $TICK;
2184 }
2185
2186 $NEXT_TICK += $TICK; 2287 $NEXT_TICK += $TICK;
2187 2288
2188 # if we are delayed by four ticks or more, skip them all 2289 # if we are delayed by four ticks or more, skip them all
2189 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2290 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2190 2291

Diff Legend

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