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.109 by root, Sun Dec 31 22:23:12 2006 UTC vs.
Revision 1.132 by root, Thu Jan 4 01:35:56 2007 UTC

… …
8use Storable; 8use Storable;
9use Opcode; 9use Opcode;
10use Safe; 10use Safe;
11use Safe::Hole; 11use Safe::Hole;
12 12
13use Coro 3.3; 13use Coro 3.3 ();
14use Coro::Event; 14use Coro::Event;
15use Coro::Timer; 15use Coro::Timer;
16use Coro::Signal; 16use Coro::Signal;
17use Coro::Semaphore; 17use Coro::Semaphore;
18use Coro::AIO; 18use Coro::AIO;
… …
71mkdir cf::localdir . "/" . cf::uniquedir; 71mkdir cf::localdir . "/" . cf::uniquedir;
72mkdir $RANDOM_MAPS; 72mkdir $RANDOM_MAPS;
73 73
74# a special map that is always available 74# a special map that is always available
75our $LINK_MAP; 75our $LINK_MAP;
76our $EMERGENCY_POSITION;
76 77
77############################################################################# 78#############################################################################
78 79
79=head2 GLOBAL VARIABLES 80=head2 GLOBAL VARIABLES
80 81
… …
179sub to_json($) { 180sub to_json($) {
180 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 181 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
181 JSON::Syck::Dump $_[0] 182 JSON::Syck::Dump $_[0]
182} 183}
183 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
208
209Wait until the given lock is available. See cf::lock_acquire.
210
211=item my $lock = cf::lock_acquire $string
212
213Wait 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,
215for example when the coroutine gets canceled), the lock is automatically
216returned.
217
218Lock names should begin with a unique identifier (for example, find_map
219uses map_find and load_map uses map_load).
220
221=cut
222
223our %LOCK;
224
225sub lock_wait($) {
226 my ($key) = @_;
227
228 # wait for lock, if any
229 while ($LOCK{$key}) {
230 push @{ $LOCK{$key} }, $Coro::current;
231 Coro::schedule;
232 }
233}
234
235sub lock_acquire($) {
236 my ($key) = @_;
237
238 # wait, to be sure we are not locked
239 lock_wait $key;
240
241 $LOCK{$key} = [];
242
243 cf::guard {
244 # wake up all waiters, to be on the safe side
245 $_->ready for @{ delete $LOCK{$key} };
246 }
247}
248
249=item cf::async { BLOCK }
250
251Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the
252error instead of exiting the server in case of a problem.
253
254=cut
255
256sub async(&) {
257 my ($cb) = @_;
258
259 Coro::async {
260 eval { $cb->() };
261 warn $@ if $@;
262 }
263}
264
184=item cf::sync_job { BLOCK } 265=item cf::sync_job { BLOCK }
185 266
186The design of crossfire+ requires that the main coro ($Coro::main) is 267The design of crossfire+ requires that the main coro ($Coro::main) is
187always able to handle events or runnable, as crossfire+ is only partly 268always able to handle events or runnable, as crossfire+ is only partly
188reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable. 269reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
… …
195=cut 276=cut
196 277
197sub sync_job(&) { 278sub sync_job(&) {
198 my ($job) = @_; 279 my ($job) = @_;
199 280
200 my $busy = 1;
201 my @res;
202
203 # TODO: use suspend/resume instead
204 local $FREEZE = 1;
205
206 my $coro = Coro::async {
207 @res = eval { $job->() };
208 warn $@ if $@;
209 undef $busy;
210 };
211
212 if ($Coro::current == $Coro::main) { 281 if ($Coro::current == $Coro::main) {
282 # this is the main coro, too bad, we have to block
283 # till the operation succeeds, freezing the server :/
284
285 # TODO: use suspend/resume instead
286 # (but this is cancel-safe)
287 local $FREEZE = 1;
288
289 my $busy = 1;
290 my @res;
291
292 (Coro::async {
293 @res = eval { $job->() };
294 warn $@ if $@;
295 undef $busy;
213 $coro->prio (Coro::PRIO_MAX); 296 })->prio (Coro::PRIO_MAX);
297
214 while ($busy) { 298 while ($busy) {
215 Coro::cede_notself; 299 Coro::cede_notself;
216 Event::one_event unless Coro::nready; 300 Event::one_event unless Coro::nready;
217 } 301 }
302
303 wantarray ? @res : $res[0]
218 } else { 304 } else {
219 $coro->join; 305 # we are in another coroutine, how wonderful, everything just works
306
307 $job->()
220 } 308 }
221
222 wantarray ? @res : $res[0]
223} 309}
224 310
225=item $coro = cf::coro { BLOCK } 311=item $coro = cf::coro { BLOCK }
226 312
227Creates and returns a new coro. This coro is automcatially being canceled 313Creates and returns a new coro. This coro is automcatially being canceled
… …
230=cut 316=cut
231 317
232sub coro(&) { 318sub coro(&) {
233 my $cb = shift; 319 my $cb = shift;
234 320
235 my $coro; $coro = async { 321 my $coro = &cf::async ($cb);
236 eval {
237 $cb->();
238 };
239 warn $@ if $@;
240 };
241 322
242 $coro->on_destroy (sub { 323 $coro->on_destroy (sub {
243 delete $EXT_CORO{$coro+0}; 324 delete $EXT_CORO{$coro+0};
244 }); 325 });
245 $EXT_CORO{$coro+0} = $coro; 326 $EXT_CORO{$coro+0} = $coro;
… …
251 my $runtime = cf::localdir . "/runtime"; 332 my $runtime = cf::localdir . "/runtime";
252 333
253 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 334 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
254 or return; 335 or return;
255 336
256 my $value = $cf::RUNTIME; 337 my $value = $cf::RUNTIME + 1 + 10; # 10 is the runtime save interval, for a monotonic clock
257 (aio_write $fh, 0, (length $value), $value, 0) <= 0 338 (aio_write $fh, 0, (length $value), $value, 0) <= 0
258 and return; 339 and return;
259 340
260 aio_fsync $fh 341 aio_fsync $fh
261 and return; 342 and return;
… …
278package cf::path; 359package cf::path;
279 360
280sub new { 361sub new {
281 my ($class, $path, $base) = @_; 362 my ($class, $path, $base) = @_;
282 363
364 $path = $path->as_string if ref $path;
365
283 my $self = bless { }, $class; 366 my $self = bless { }, $class;
284 367
368 # {... are special paths that are not touched
369 # ?xxx/... are special absolute paths
370 # ?random/... random maps
371 # /! non-realised random map exit
372 # /... normal maps
373 # ~/... per-player maps without a specific player (DO NOT USE)
374 # ~user/... per-player map of a specific user
375
376 if ($path =~ /^{/) {
377 # fine as it is
285 if ($path =~ s{^\?random/}{}) { 378 } elsif ($path =~ s{^\?random/}{}) {
286 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data; 379 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
287 $self->{random} = cf::from_json $data; 380 $self->{random} = cf::from_json $data;
288 } else { 381 } else {
289 if ($path =~ s{^~([^/]+)?}{}) { 382 if ($path =~ s{^~([^/]+)?}{}) {
290 $self->{user_rel} = 1; 383 $self->{user_rel} = 1;
… …
795 or return; 888 or return;
796 889
797 unless (aio_stat "$filename.pst") { 890 unless (aio_stat "$filename.pst") {
798 (aio_load "$filename.pst", $av) >= 0 891 (aio_load "$filename.pst", $av) >= 0
799 or return; 892 or return;
800 $av = eval { (Storable::thaw <$av>)->{objs} }; 893 $av = eval { (Storable::thaw $av)->{objs} };
801 } 894 }
802 895
896 warn sprintf "loading %s (%d)\n",
897 $filename, length $data, scalar @{$av || []};#d#
803 return ($data, $av); 898 return ($data, $av);
804} 899}
805 900
806############################################################################# 901#############################################################################
807# command handling &c 902# command handling &c
… …
1029 $self->send ("ext " . to_json \%msg); 1124 $self->send ("ext " . to_json \%msg);
1030} 1125}
1031 1126
1032=back 1127=back
1033 1128
1129
1130=head3 cf::map
1131
1132=over 4
1133
1134=cut
1135
1136package cf::map;
1137
1138use Fcntl;
1139use Coro::AIO;
1140
1141our $MAX_RESET = 7200;
1142our $DEFAULT_RESET = 3600;
1143
1144sub generate_random_map {
1145 my ($path, $rmp) = @_;
1146
1147 # mit "rum" bekleckern, nicht
1148 cf::map::_create_random_map
1149 $path,
1150 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1151 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1152 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1153 $rmp->{exit_on_final_map},
1154 $rmp->{xsize}, $rmp->{ysize},
1155 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1156 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1157 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1158 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1159 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1160 (cf::region::find $rmp->{region})
1161}
1162
1163# and all this just because we cannot iterate over
1164# all maps in C++...
1165sub change_all_map_light {
1166 my ($change) = @_;
1167
1168 $_->change_map_light ($change)
1169 for grep $_->outdoor, values %cf::MAP;
1170}
1171
1172sub try_load_header($) {
1173 my ($path) = @_;
1174
1175 utf8::encode $path;
1176 aio_open $path, O_RDONLY, 0
1177 or return;
1178
1179 my $map = cf::map::new
1180 or return;
1181
1182 $map->load_header ($path)
1183 or return;
1184
1185 $map->{load_path} = $path;
1186
1187 $map
1188}
1189
1190sub find_map;
1191sub find_map {
1192 my ($path, $origin) = @_;
1193
1194 #warn "find_map<$path,$origin>\n";#d#
1195
1196 $path = new cf::path $path, $origin && $origin->path;
1197 my $key = $path->as_string;
1198
1199 cf::lock_wait "map_find:$key";
1200
1201 $cf::MAP{$key} || do {
1202 my $guard = cf::lock_acquire "map_find:$key";
1203
1204 # do it the slow way
1205 my $map = try_load_header $path->save_path;
1206
1207 if ($map) {
1208 $map->last_access ((delete $map->{last_access})
1209 || $cf::RUNTIME); #d#
1210 # safety
1211 $map->{instantiate_time} = $cf::RUNTIME
1212 if $map->{instantiate_time} > $cf::RUNTIME;
1213 } else {
1214 if (my $rmp = $path->random_map_params) {
1215 $map = generate_random_map $key, $rmp;
1216 } else {
1217 $map = try_load_header $path->load_path;
1218 }
1219
1220 $map or return;
1221
1222 $map->{load_original} = 1;
1223 $map->{instantiate_time} = $cf::RUNTIME;
1224 $map->last_access ($cf::RUNTIME);
1225 $map->instantiate;
1226
1227 # per-player maps become, after loading, normal maps
1228 $map->per_player (0) if $path->{user_rel};
1229 }
1230
1231 $map->path ($key);
1232 $map->{path} = $path;
1233 $map->{last_save} = $cf::RUNTIME;
1234
1235 if ($map->should_reset) {
1236 $map->reset;
1237 undef $guard;
1238 $map = find_map $path
1239 or return;
1240 }
1241
1242 $cf::MAP{$key} = $map
1243 }
1244}
1245
1246sub load {
1247 my ($self) = @_;
1248
1249 my $path = $self->{path};
1250 my $guard = cf::lock_acquire "map_load:" . $path->as_string;
1251
1252 return if $self->in_memory != cf::MAP_SWAPPED;
1253
1254 $self->in_memory (cf::MAP_LOADING);
1255
1256 $self->alloc;
1257 $self->load_objects ($self->{load_path}, 1)
1258 or return;
1259
1260 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1261 if delete $self->{load_original};
1262
1263 if (my $uniq = $path->uniq_path) {
1264 utf8::encode $uniq;
1265 if (aio_open $uniq, O_RDONLY, 0) {
1266 $self->clear_unique_items;
1267 $self->load_objects ($uniq, 0);
1268 }
1269 }
1270
1271 # now do the right thing for maps
1272 $self->link_multipart_objects;
1273
1274 if ($self->{path}->is_style_map) {
1275 $self->{deny_save} = 1;
1276 $self->{deny_reset} = 1;
1277 } else {
1278 $self->fix_auto_apply;
1279 $self->decay_objects;
1280 $self->update_buttons;
1281 $self->set_darkness_map;
1282 $self->difficulty ($self->estimate_difficulty)
1283 unless $self->difficulty;
1284 $self->activate;
1285 }
1286
1287 $self->in_memory (cf::MAP_IN_MEMORY);
1288}
1289
1290sub load_map_sync {
1291 my ($path, $origin) = @_;
1292
1293 #warn "load_map_sync<$path, $origin>\n";#d#
1294
1295 cf::sync_job {
1296 my $map = cf::map::find_map $path, $origin
1297 or return;
1298 $map->load;
1299 $map
1300 }
1301}
1302
1303sub save {
1304 my ($self) = @_;
1305
1306 $self->{last_save} = $cf::RUNTIME;
1307
1308 return unless $self->dirty;
1309
1310 my $save = $self->{path}->save_path; utf8::encode $save;
1311 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1312
1313 $self->{load_path} = $save;
1314
1315 return if $self->{deny_save};
1316
1317 local $self->{last_access} = $self->last_access;#d#
1318
1319 if ($uniq) {
1320 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1321 $self->save_objects ($uniq, cf::IO_UNIQUES);
1322 } else {
1323 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1324 }
1325}
1326
1327sub swap_out {
1328 my ($self) = @_;
1329
1330 # save first because save cedes
1331 $self->save;
1332
1333 return if $self->players;
1334 return if $self->in_memory != cf::MAP_IN_MEMORY;
1335 return if $self->{deny_save};
1336
1337 $self->clear;
1338 $self->in_memory (cf::MAP_SWAPPED);
1339}
1340
1341sub reset_at {
1342 my ($self) = @_;
1343
1344 # TODO: safety, remove and allow resettable per-player maps
1345 return 1e99 if $self->{path}{user_rel};
1346 return 1e99 if $self->{deny_reset};
1347
1348 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1349 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
1350
1351 $time + $to
1352}
1353
1354sub should_reset {
1355 my ($self) = @_;
1356
1357 $self->reset_at <= $cf::RUNTIME
1358}
1359
1360sub unlink_save {
1361 my ($self) = @_;
1362
1363 utf8::encode (my $save = $self->{path}->save_path);
1364 aioreq_pri 3; IO::AIO::aio_unlink $save;
1365 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1366}
1367
1368sub rename {
1369 my ($self, $new_path) = @_;
1370
1371 $self->unlink_save;
1372
1373 delete $cf::MAP{$self->path};
1374 $self->{path} = new cf::path $new_path;
1375 $self->path ($self->{path}->as_string);
1376 $cf::MAP{$self->path} = $self;
1377
1378 $self->save;
1379}
1380
1381sub reset {
1382 my ($self) = @_;
1383
1384 return if $self->players;
1385 return if $self->{path}{user_rel};#d#
1386
1387 warn "resetting map ", $self->path;#d#
1388
1389 delete $cf::MAP{$self->path};
1390
1391 $_->clear_links_to ($self) for values %cf::MAP;
1392
1393 $self->unlink_save;
1394 $self->destroy;
1395}
1396
1397my $nuke_counter = "aaaa";
1398
1399sub nuke {
1400 my ($self) = @_;
1401
1402 $self->{deny_save} = 1;
1403 $self->reset_timeout (1);
1404 $self->rename ("{nuke}/" . ($nuke_counter++));
1405 $self->reset; # polite request, might not happen
1406}
1407
1408sub customise_for {
1409 my ($map, $ob) = @_;
1410
1411 if ($map->per_player) {
1412 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path};
1413 }
1414
1415 $map
1416}
1417
1418sub emergency_save {
1419 local $cf::FREEZE = 1;
1420
1421 warn "enter emergency map save\n";
1422
1423 cf::sync_job {
1424 warn "begin emergency map save\n";
1425 $_->save for values %cf::MAP;
1426 };
1427
1428 warn "end emergency map save\n";
1429}
1430
1431package cf;
1432
1433=back
1434
1435
1034=head3 cf::object::player 1436=head3 cf::object::player
1035 1437
1036=over 4 1438=over 4
1037 1439
1038=item $player_object->reply ($npc, $msg[, $flags]) 1440=item $player_object->reply ($npc, $msg[, $flags])
… …
1073 (ref $cf::CFG{"may_$access"} 1475 (ref $cf::CFG{"may_$access"}
1074 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1476 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
1075 : $cf::CFG{"may_$access"}) 1477 : $cf::CFG{"may_$access"})
1076} 1478}
1077 1479
1480=item $player_object->enter_link
1481
1482Freezes the player and moves him/her to a special map (C<{link}>).
1483
1484The player should be reaosnably safe there for short amounts of time. You
1485I<MUST> call C<leave_link> as soon as possible, though.
1486
1487=item $player_object->leave_link ($map, $x, $y)
1488
1489Moves the player out of the specila link map onto the given map. If the
1490map is not valid (or omitted), the player will be moved back to the
1491location he/she was before the call to C<enter_link>, or, if that fails,
1492to the emergency map position.
1493
1494Might block.
1495
1496=cut
1497
1498sub cf::object::player::enter_link {
1499 my ($self) = @_;
1500
1501 $self->deactivate_recursive;
1502
1503 return if $self->map == $LINK_MAP;
1504
1505 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
1506 if $self->map;
1507
1508 $self->enter_map ($LINK_MAP, 20, 20);
1509}
1510
1511sub cf::object::player::leave_link {
1512 my ($self, $map, $x, $y) = @_;
1513
1514 my $link_pos = delete $self->{_link_pos};
1515
1516 unless ($map) {
1517 # restore original map position
1518 ($map, $x, $y) = @{ $link_pos || [] };
1519 $map = cf::map::find_map $map;
1520
1521 unless ($map) {
1522 ($map, $x, $y) = @$EMERGENCY_POSITION;
1523 $map = cf::map::find_map $map
1524 or die "FATAL: cannot load emergency map\n";
1525 }
1526 }
1527
1528 ($x, $y) = (-1, -1)
1529 unless (defined $x) && (defined $y);
1530
1531 # use -1 or undef as default coordinates, not 0, 0
1532 ($x, $y) = ($map->enter_x, $map->enter_y)
1533 if $x <=0 && $y <= 0;
1534
1535 $map->load;
1536
1537 $self->activate_recursive;
1538 $self->enter_map ($map, $x, $y);
1539}
1540
1541cf::player->attach (
1542 on_logout => sub {
1543 my ($pl) = @_;
1544
1545 # abort map switching before logout
1546 if ($pl->ob->{_link_pos}) {
1547 cf::sync_job {
1548 $pl->ob->leave_link
1549 };
1550 }
1551 },
1552 on_login => sub {
1553 my ($pl) = @_;
1554
1555 # try to abort aborted map switching on player login :)
1556 # should happen only on crashes
1557 if ($pl->ob->{_link_pos}) {
1558 $pl->ob->enter_link;
1559 cf::async {
1560 # 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
1562 Coro::Timer::sleep 1;
1563 $pl->ob->leave_link;
1564 };
1565 }
1566 },
1567);
1568
1569=item $player_object->goto_map ($path, $x, $y)
1570
1571=cut
1572
1573sub cf::object::player::goto_map {
1574 my ($self, $path, $x, $y) = @_;
1575
1576 $self->enter_link;
1577
1578 (cf::async {
1579 $path = new cf::path $path;
1580
1581 my $map = cf::map::find_map $path->as_string;
1582 $map = $map->customise_for ($self) if $map;
1583
1584# warn "entering ", $map->path, " at ($x, $y)\n"
1585# if $map;
1586
1587 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1588
1589 $self->leave_link ($map, $x, $y);
1590 })->prio (1);
1591}
1592
1593=item $player_object->enter_exit ($exit_object)
1594
1595=cut
1596
1597sub parse_random_map_params {
1598 my ($spec) = @_;
1599
1600 my $rmp = { # defaults
1601 xsize => 10,
1602 ysize => 10,
1603 };
1604
1605 for (split /\n/, $spec) {
1606 my ($k, $v) = split /\s+/, $_, 2;
1607
1608 $rmp->{lc $k} = $v if (length $k) && (length $v);
1609 }
1610
1611 $rmp
1612}
1613
1614sub prepare_random_map {
1615 my ($exit) = @_;
1616
1617 # all this does is basically replace the /! path by
1618 # a new random map path (?random/...) with a seed
1619 # that depends on the exit object
1620
1621 my $rmp = parse_random_map_params $exit->msg;
1622
1623 if ($exit->map) {
1624 $rmp->{region} = $exit->map->region_name;
1625 $rmp->{origin_map} = $exit->map->path;
1626 $rmp->{origin_x} = $exit->x;
1627 $rmp->{origin_y} = $exit->y;
1628 }
1629
1630 $rmp->{random_seed} ||= $exit->random_seed;
1631
1632 my $data = cf::to_json $rmp;
1633 my $md5 = Digest::MD5::md5_hex $data;
1634
1635 if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) {
1636 aio_write $fh, 0, (length $data), $data, 0;
1637
1638 $exit->slaying ("?random/$md5");
1639 $exit->msg (undef);
1640 }
1641}
1642
1643sub cf::object::player::enter_exit {
1644 my ($self, $exit) = @_;
1645
1646 return unless $self->type == cf::PLAYER;
1647
1648 $self->enter_link;
1649
1650 (cf::async {
1651 unless (eval {
1652 prepare_random_map $exit
1653 if $exit->slaying eq "/!";
1654
1655 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1656 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
1657
1658 1;
1659 }) {
1660 $self->message ("Something went wrong deep within the crossfire server. "
1661 . "I'll try to bring you back to the map you were before. "
1662 . "Please report this to the dungeon master",
1663 cf::NDI_UNIQUE | cf::NDI_RED);
1664
1665 warn "ERROR in enter_exit: $@";
1666 $self->leave_link;
1667 }
1668 })->prio (1);
1669}
1670
1078=head3 cf::client 1671=head3 cf::client
1079 1672
1080=over 4 1673=over 4
1081 1674
1082=item $client->send_drawinfo ($text, $flags) 1675=item $client->send_drawinfo ($text, $flags)
… …
1125 on_reply => sub { 1718 on_reply => sub {
1126 my ($ns, $msg) = @_; 1719 my ($ns, $msg) = @_;
1127 1720
1128 # this weird shuffling is so that direct followup queries 1721 # this weird shuffling is so that direct followup queries
1129 # get handled first 1722 # get handled first
1130 my $queue = delete $ns->{query_queue}; 1723 my $queue = delete $ns->{query_queue}
1724 or return; # be conservative, not sure how that can happen, but we saw a crash here
1131 1725
1132 (shift @$queue)->[1]->($msg); 1726 (shift @$queue)->[1]->($msg);
1133 1727
1134 push @{ $ns->{query_queue} }, @$queue; 1728 push @{ $ns->{query_queue} }, @$queue;
1135 1729
… …
1152=cut 1746=cut
1153 1747
1154sub cf::client::coro { 1748sub cf::client::coro {
1155 my ($self, $cb) = @_; 1749 my ($self, $cb) = @_;
1156 1750
1157 my $coro; $coro = async { 1751 my $coro = &cf::async ($cb);
1158 eval {
1159 $cb->();
1160 };
1161 warn $@ if $@;
1162 };
1163 1752
1164 $coro->on_destroy (sub { 1753 $coro->on_destroy (sub {
1165 delete $self->{_coro}{$coro+0}; 1754 delete $self->{_coro}{$coro+0};
1166 }); 1755 });
1167 1756
… …
1339 1928
1340{ 1929{
1341 my $path = cf::localdir . "/database.pst"; 1930 my $path = cf::localdir . "/database.pst";
1342 1931
1343 sub db_load() { 1932 sub db_load() {
1344 warn "loading database $path\n";#d# remove later
1345 $DB = stat $path ? Storable::retrieve $path : { }; 1933 $DB = stat $path ? Storable::retrieve $path : { };
1346 } 1934 }
1347 1935
1348 my $pid; 1936 my $pid;
1349 1937
1350 sub db_save() { 1938 sub db_save() {
1351 warn "saving database $path\n";#d# remove later
1352 waitpid $pid, 0 if $pid; 1939 waitpid $pid, 0 if $pid;
1353 if (0 == ($pid = fork)) { 1940 if (0 == ($pid = fork)) {
1354 $DB->{_meta}{version} = 1; 1941 $DB->{_meta}{version} = 1;
1355 Storable::nstore $DB, "$path~"; 1942 Storable::nstore $DB, "$path~";
1356 rename "$path~", $path; 1943 rename "$path~", $path;
… …
1404 open my $fh, "<:utf8", cf::confdir . "/config" 1991 open my $fh, "<:utf8", cf::confdir . "/config"
1405 or return; 1992 or return;
1406 1993
1407 local $/; 1994 local $/;
1408 *CFG = YAML::Syck::Load <$fh>; 1995 *CFG = YAML::Syck::Load <$fh>;
1996
1997 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
1998
1999 if (exists $CFG{mlockall}) {
2000 eval {
2001 $CFG{mlockall} ? &mlockall : &munlockall
2002 and die "WARNING: m(un)lockall failed: $!\n";
2003 };
2004 warn $@ if $@;
2005 }
1409} 2006}
1410 2007
1411sub main { 2008sub main {
1412 # we must not ever block the main coroutine 2009 # we must not ever block the main coroutine
1413 local $Coro::idle = sub { 2010 local $Coro::idle = sub {
1414 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 2011 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
1415 (Coro::unblock_sub { 2012 (Coro::unblock_sub {
1416 Event::one_event; 2013 Event::one_event;
1417 })->(); 2014 })->();
1418 }; 2015 };
1419 2016
… …
1424} 2021}
1425 2022
1426############################################################################# 2023#############################################################################
1427# initialisation 2024# initialisation
1428 2025
1429sub perl_reload() { 2026sub reload() {
1430 # can/must only be called in main 2027 # can/must only be called in main
1431 if ($Coro::current != $Coro::main) { 2028 if ($Coro::current != $Coro::main) {
1432 warn "can only reload from main coroutine\n"; 2029 warn "can only reload from main coroutine\n";
1433 return; 2030 return;
1434 } 2031 }
… …
1527 $LINK_MAP->height (41); 2124 $LINK_MAP->height (41);
1528 $LINK_MAP->alloc; 2125 $LINK_MAP->alloc;
1529 $LINK_MAP->path ("{link}"); 2126 $LINK_MAP->path ("{link}");
1530 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2127 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1531 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2128 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2129
2130 # dirty hack because... archetypes are not yet loaded
2131 Event->timer (
2132 after => 2,
2133 cb => sub {
2134 $_[0]->w->cancel;
2135
2136 # provide some exits "home"
2137 my $exit = cf::object::new "exit";
2138
2139 $exit->slaying ($EMERGENCY_POSITION->[0]);
2140 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
2141 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
2142
2143 $LINK_MAP->insert ($exit->clone, 19, 19);
2144 $LINK_MAP->insert ($exit->clone, 19, 20);
2145 $LINK_MAP->insert ($exit->clone, 19, 21);
2146 $LINK_MAP->insert ($exit->clone, 20, 19);
2147 $LINK_MAP->insert ($exit->clone, 20, 21);
2148 $LINK_MAP->insert ($exit->clone, 21, 19);
2149 $LINK_MAP->insert ($exit->clone, 21, 20);
2150 $LINK_MAP->insert ($exit->clone, 21, 21);
2151
2152 $exit->destroy;
2153 });
2154
2155 $LINK_MAP->{deny_save} = 1;
2156 $LINK_MAP->{deny_reset} = 1;
2157
2158 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1532} 2159}
1533 2160
1534register "<global>", __PACKAGE__; 2161register "<global>", __PACKAGE__;
1535 2162
1536register_command "perl-reload" => sub { 2163register_command "reload" => sub {
1537 my ($who, $arg) = @_; 2164 my ($who, $arg) = @_;
1538 2165
1539 if ($who->flag (FLAG_WIZ)) { 2166 if ($who->flag (FLAG_WIZ)) {
1540 $who->message ("start of reload."); 2167 $who->message ("start of reload.");
1541 perl_reload; 2168 reload;
1542 $who->message ("end of reload."); 2169 $who->message ("end of reload.");
1543 } 2170 }
1544}; 2171};
1545 2172
1546unshift @INC, $LIBDIR; 2173unshift @INC, $LIBDIR;
… …
1586 or warn "ERROR: unable to write runtime file: $!"; 2213 or warn "ERROR: unable to write runtime file: $!";
1587 })->(); 2214 })->();
1588 }, 2215 },
1589); 2216);
1590 2217
2218END { cf::emergency_save }
2219
15911 22201
1592 2221

Diff Legend

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