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.138 by root, Fri Jan 5 17:07:17 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;
… …
49our $UPTIME; $UPTIME ||= time; 49our $UPTIME; $UPTIME ||= time;
50our $RUNTIME; 50our $RUNTIME;
51 51
52our %MAP; # all maps 52our %MAP; # all maps
53our $LINK_MAP; # the special {link} map 53our $LINK_MAP; # the special {link} map
54our $FREEZE;
55our $RANDOM_MAPS = cf::localdir . "/random"; 54our $RANDOM_MAPS = cf::localdir . "/random";
56our %EXT_CORO; 55our %EXT_CORO;
57 56
58binmode STDOUT; 57binmode STDOUT;
59binmode STDERR; 58binmode STDERR;
… …
71mkdir cf::localdir . "/" . cf::uniquedir; 70mkdir cf::localdir . "/" . cf::uniquedir;
72mkdir $RANDOM_MAPS; 71mkdir $RANDOM_MAPS;
73 72
74# a special map that is always available 73# a special map that is always available
75our $LINK_MAP; 74our $LINK_MAP;
75our $EMERGENCY_POSITION;
76 76
77############################################################################# 77#############################################################################
78 78
79=head2 GLOBAL VARIABLES 79=head2 GLOBAL VARIABLES
80 80
… …
179sub to_json($) { 179sub to_json($) {
180 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 180 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
181 JSON::Syck::Dump $_[0] 181 JSON::Syck::Dump $_[0]
182} 182}
183 183
184=item cf::lock_wait $string
185
186Wait until the given lock is available. See cf::lock_acquire.
187
188=item my $lock = cf::lock_acquire $string
189
190Wait until the given lock is available and then acquires it and returns
191a Coro::guard object. If the guard object gets destroyed (goes out of scope,
192for example when the coroutine gets canceled), the lock is automatically
193returned.
194
195Lock names should begin with a unique identifier (for example, cf::map::find
196uses map_find and cf::map::load uses map_load).
197
198=cut
199
200our %LOCK;
201
202sub lock_wait($) {
203 my ($key) = @_;
204
205 # wait for lock, if any
206 while ($LOCK{$key}) {
207 push @{ $LOCK{$key} }, $Coro::current;
208 Coro::schedule;
209 }
210}
211
212sub lock_acquire($) {
213 my ($key) = @_;
214
215 # wait, to be sure we are not locked
216 lock_wait $key;
217
218 $LOCK{$key} = [];
219
220 Coro::guard {
221 # wake up all waiters, to be on the safe side
222 $_->ready for @{ delete $LOCK{$key} };
223 }
224}
225
226sub freeze_mainloop {
227 return unless $TICK_WATCHER->is_active;
228
229 my $guard = Coro::guard { $TICK_WATCHER->start };
230 $TICK_WATCHER->stop;
231 $guard
232}
233
184=item cf::sync_job { BLOCK } 234=item cf::sync_job { BLOCK }
185 235
186The design of crossfire+ requires that the main coro ($Coro::main) is 236The design of crossfire+ requires that the main coro ($Coro::main) is
187always able to handle events or runnable, as crossfire+ is only partly 237always 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. 238reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
… …
195=cut 245=cut
196 246
197sub sync_job(&) { 247sub sync_job(&) {
198 my ($job) = @_; 248 my ($job) = @_;
199 249
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) { 250 if ($Coro::current == $Coro::main) {
251 # this is the main coro, too bad, we have to block
252 # till the operation succeeds, freezing the server :/
253
254 # TODO: use suspend/resume instead
255 # (but this is cancel-safe)
256 my $freeze_guard = freeze_mainloop;
257
258 my $busy = 1;
259 my @res;
260
261 (Coro::async_pool {
262 @res = eval { $job->() };
263 warn $@ if $@;
264 undef $busy;
213 $coro->prio (Coro::PRIO_MAX); 265 })->prio (Coro::PRIO_MAX);
266
214 while ($busy) { 267 while ($busy) {
215 Coro::cede_notself; 268 Coro::cede_notself;
216 Event::one_event unless Coro::nready; 269 Event::one_event unless Coro::nready;
217 } 270 }
271
272 wantarray ? @res : $res[0]
218 } else { 273 } else {
219 $coro->join; 274 # we are in another coroutine, how wonderful, everything just works
275
276 $job->()
220 } 277 }
221
222 wantarray ? @res : $res[0]
223} 278}
224 279
225=item $coro = cf::coro { BLOCK } 280=item $coro = cf::coro { BLOCK }
226 281
227Creates and returns a new coro. This coro is automcatially being canceled 282Creates (and readies) and returns a new coro. This coro is automcatially
228when the extension calling this is being unloaded. 283being canceled when the extension calling this is being unloaded.
229 284
230=cut 285=cut
231 286
232sub coro(&) { 287sub coro(&) {
233 my $cb = shift; 288 my $cb = shift;
234 289
235 my $coro; $coro = async { 290 my $coro = &Coro::async_pool ($cb);
236 eval {
237 $cb->();
238 };
239 warn $@ if $@;
240 };
241 291
242 $coro->on_destroy (sub { 292 $coro->on_destroy (sub {
243 delete $EXT_CORO{$coro+0}; 293 delete $EXT_CORO{$coro+0};
244 }); 294 });
245 $EXT_CORO{$coro+0} = $coro; 295 $EXT_CORO{$coro+0} = $coro;
… …
251 my $runtime = cf::localdir . "/runtime"; 301 my $runtime = cf::localdir . "/runtime";
252 302
253 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 303 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
254 or return; 304 or return;
255 305
256 my $value = $cf::RUNTIME; 306 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 307 (aio_write $fh, 0, (length $value), $value, 0) <= 0
258 and return; 308 and return;
259 309
260 aio_fsync $fh 310 aio_fsync $fh
261 and return; 311 and return;
… …
278package cf::path; 328package cf::path;
279 329
280sub new { 330sub new {
281 my ($class, $path, $base) = @_; 331 my ($class, $path, $base) = @_;
282 332
333 $path = $path->as_string if ref $path;
334
283 my $self = bless { }, $class; 335 my $self = bless { }, $class;
284 336
337 # {... are special paths that are not touched
338 # ?xxx/... are special absolute paths
339 # ?random/... random maps
340 # /! non-realised random map exit
341 # /... normal maps
342 # ~/... per-player maps without a specific player (DO NOT USE)
343 # ~user/... per-player map of a specific user
344
345 if ($path =~ /^{/) {
346 # fine as it is
285 if ($path =~ s{^\?random/}{}) { 347 } elsif ($path =~ s{^\?random/}{}) {
286 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data; 348 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
287 $self->{random} = cf::from_json $data; 349 $self->{random} = cf::from_json $data;
288 } else { 350 } else {
289 if ($path =~ s{^~([^/]+)?}{}) { 351 if ($path =~ s{^~([^/]+)?}{}) {
290 $self->{user_rel} = 1; 352 $self->{user_rel} = 1;
… …
795 or return; 857 or return;
796 858
797 unless (aio_stat "$filename.pst") { 859 unless (aio_stat "$filename.pst") {
798 (aio_load "$filename.pst", $av) >= 0 860 (aio_load "$filename.pst", $av) >= 0
799 or return; 861 or return;
800 $av = eval { (Storable::thaw <$av>)->{objs} }; 862 $av = eval { (Storable::thaw $av)->{objs} };
801 } 863 }
802 864
865 warn sprintf "loading %s (%d)\n",
866 $filename, length $data, scalar @{$av || []};#d#
803 return ($data, $av); 867 return ($data, $av);
804} 868}
805 869
806############################################################################# 870#############################################################################
807# command handling &c 871# command handling &c
… …
1029 $self->send ("ext " . to_json \%msg); 1093 $self->send ("ext " . to_json \%msg);
1030} 1094}
1031 1095
1032=back 1096=back
1033 1097
1098
1099=head3 cf::map
1100
1101=over 4
1102
1103=cut
1104
1105package cf::map;
1106
1107use Fcntl;
1108use Coro::AIO;
1109
1110our $MAX_RESET = 3600;
1111our $DEFAULT_RESET = 3000;
1112
1113sub generate_random_map {
1114 my ($path, $rmp) = @_;
1115
1116 # mit "rum" bekleckern, nicht
1117 cf::map::_create_random_map
1118 $path,
1119 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1120 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1121 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1122 $rmp->{exit_on_final_map},
1123 $rmp->{xsize}, $rmp->{ysize},
1124 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1125 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1126 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1127 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1128 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1129 (cf::region::find $rmp->{region})
1130}
1131
1132# and all this just because we cannot iterate over
1133# all maps in C++...
1134sub change_all_map_light {
1135 my ($change) = @_;
1136
1137 $_->change_map_light ($change)
1138 for grep $_->outdoor, values %cf::MAP;
1139}
1140
1141sub try_load_header($) {
1142 my ($path) = @_;
1143
1144 utf8::encode $path;
1145 aio_open $path, O_RDONLY, 0
1146 or return;
1147
1148 my $map = cf::map::new
1149 or return;
1150
1151 # for better error messages only, will be overwritten
1152 $map->path ($path);
1153
1154 $map->load_header ($path)
1155 or return;
1156
1157 $map->{load_path} = $path;
1158
1159 $map
1160}
1161
1162sub find;
1163sub find {
1164 my ($path, $origin) = @_;
1165
1166 #warn "find<$path,$origin>\n";#d#
1167
1168 $path = new cf::path $path, $origin && $origin->path;
1169 my $key = $path->as_string;
1170
1171 cf::lock_wait "map_find:$key";
1172
1173 $cf::MAP{$key} || do {
1174 my $guard = cf::lock_acquire "map_find:$key";
1175
1176 # do it the slow way
1177 my $map = try_load_header $path->save_path;
1178
1179 Coro::cede;
1180
1181 if ($map) {
1182 $map->last_access ((delete $map->{last_access})
1183 || $cf::RUNTIME); #d#
1184 # safety
1185 $map->{instantiate_time} = $cf::RUNTIME
1186 if $map->{instantiate_time} > $cf::RUNTIME;
1187 } else {
1188 if (my $rmp = $path->random_map_params) {
1189 $map = generate_random_map $key, $rmp;
1190 } else {
1191 $map = try_load_header $path->load_path;
1192 }
1193
1194 $map or return;
1195
1196 $map->{load_original} = 1;
1197 $map->{instantiate_time} = $cf::RUNTIME;
1198 $map->last_access ($cf::RUNTIME);
1199 $map->instantiate;
1200
1201 # per-player maps become, after loading, normal maps
1202 $map->per_player (0) if $path->{user_rel};
1203 }
1204
1205 $map->path ($key);
1206 $map->{path} = $path;
1207 $map->{last_save} = $cf::RUNTIME;
1208
1209 Coro::cede;
1210
1211 if ($map->should_reset) {
1212 $map->reset;
1213 undef $guard;
1214 $map = find $path
1215 or return;
1216 }
1217
1218 $cf::MAP{$key} = $map
1219 }
1220}
1221
1222sub load {
1223 my ($self) = @_;
1224
1225 my $path = $self->{path};
1226 my $guard = cf::lock_acquire "map_load:" . $path->as_string;
1227
1228 return if $self->in_memory != cf::MAP_SWAPPED;
1229
1230 $self->in_memory (cf::MAP_LOADING);
1231
1232 $self->alloc;
1233 $self->load_objects ($self->{load_path}, 1)
1234 or return;
1235
1236 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1237 if delete $self->{load_original};
1238
1239 if (my $uniq = $path->uniq_path) {
1240 utf8::encode $uniq;
1241 if (aio_open $uniq, O_RDONLY, 0) {
1242 $self->clear_unique_items;
1243 $self->load_objects ($uniq, 0);
1244 }
1245 }
1246
1247 Coro::cede;
1248
1249 # now do the right thing for maps
1250 $self->link_multipart_objects;
1251
1252 if ($self->{path}->is_style_map) {
1253 $self->{deny_save} = 1;
1254 $self->{deny_reset} = 1;
1255 } else {
1256 $self->fix_auto_apply;
1257 $self->decay_objects;
1258 $self->update_buttons;
1259 $self->set_darkness_map;
1260 $self->difficulty ($self->estimate_difficulty)
1261 unless $self->difficulty;
1262 $self->activate;
1263 }
1264
1265 Coro::cede;
1266
1267 $self->in_memory (cf::MAP_IN_MEMORY);
1268}
1269
1270sub find_sync {
1271 my ($path, $origin) = @_;
1272
1273 cf::sync_job { cf::map::find $path, $origin }
1274}
1275
1276sub do_load_sync {
1277 my ($map) = @_;
1278
1279 cf::sync_job { $map->load };
1280}
1281
1282sub save {
1283 my ($self) = @_;
1284
1285 my $lock = cf::lock_acquire "map_data:" . $self->path;
1286
1287 $self->{last_save} = $cf::RUNTIME;
1288
1289 return unless $self->dirty;
1290
1291 my $save = $self->{path}->save_path; utf8::encode $save;
1292 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1293
1294 $self->{load_path} = $save;
1295
1296 return if $self->{deny_save};
1297
1298 local $self->{last_access} = $self->last_access;#d#
1299
1300 if ($uniq) {
1301 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1302 $self->save_objects ($uniq, cf::IO_UNIQUES);
1303 } else {
1304 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1305 }
1306}
1307
1308sub swap_out {
1309 my ($self) = @_;
1310
1311 # save first because save cedes
1312 $self->save;
1313
1314 my $lock = cf::lock_acquire "map_data:" . $self->path;
1315
1316 return if $self->players;
1317 return if $self->in_memory != cf::MAP_IN_MEMORY;
1318 return if $self->{deny_save};
1319
1320 $self->clear;
1321 $self->in_memory (cf::MAP_SWAPPED);
1322}
1323
1324sub reset_at {
1325 my ($self) = @_;
1326
1327 # TODO: safety, remove and allow resettable per-player maps
1328 return 1e99 if $self->{path}{user_rel};
1329 return 1e99 if $self->{deny_reset};
1330
1331 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1332 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
1333
1334 $time + $to
1335}
1336
1337sub should_reset {
1338 my ($self) = @_;
1339
1340 $self->reset_at <= $cf::RUNTIME
1341}
1342
1343sub unlink_save {
1344 my ($self) = @_;
1345
1346 utf8::encode (my $save = $self->{path}->save_path);
1347 aioreq_pri 3; IO::AIO::aio_unlink $save;
1348 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1349}
1350
1351sub rename {
1352 my ($self, $new_path) = @_;
1353
1354 $self->unlink_save;
1355
1356 delete $cf::MAP{$self->path};
1357 $self->{path} = new cf::path $new_path;
1358 $self->path ($self->{path}->as_string);
1359 $cf::MAP{$self->path} = $self;
1360
1361 $self->save;
1362}
1363
1364sub reset {
1365 my ($self) = @_;
1366
1367 my $lock = cf::lock_acquire "map_data:" . $self->path;
1368
1369 return if $self->players;
1370 return if $self->{path}{user_rel};#d#
1371
1372 warn "resetting map ", $self->path;#d#
1373
1374 delete $cf::MAP{$self->path};
1375
1376 $_->clear_links_to ($self) for values %cf::MAP;
1377
1378 $self->unlink_save;
1379 $self->destroy;
1380}
1381
1382my $nuke_counter = "aaaa";
1383
1384sub nuke {
1385 my ($self) = @_;
1386
1387 $self->{deny_save} = 1;
1388 $self->reset_timeout (1);
1389 $self->rename ("{nuke}/" . ($nuke_counter++));
1390 $self->reset; # polite request, might not happen
1391}
1392
1393sub customise_for {
1394 my ($map, $ob) = @_;
1395
1396 if ($map->per_player) {
1397 return cf::map::find "~" . $ob->name . "/" . $map->{path}{path};
1398 }
1399
1400 $map
1401}
1402
1403sub emergency_save {
1404 my $freeze_guard = cf::freeze_mainloop;
1405
1406 warn "enter emergency map save\n";
1407
1408 cf::sync_job {
1409 warn "begin emergency map save\n";
1410 $_->save for values %cf::MAP;
1411 };
1412
1413 warn "end emergency map save\n";
1414}
1415
1416package cf;
1417
1418=back
1419
1420
1034=head3 cf::object::player 1421=head3 cf::object::player
1035 1422
1036=over 4 1423=over 4
1037 1424
1038=item $player_object->reply ($npc, $msg[, $flags]) 1425=item $player_object->reply ($npc, $msg[, $flags])
… …
1073 (ref $cf::CFG{"may_$access"} 1460 (ref $cf::CFG{"may_$access"}
1074 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1461 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
1075 : $cf::CFG{"may_$access"}) 1462 : $cf::CFG{"may_$access"})
1076} 1463}
1077 1464
1465=item $player_object->enter_link
1466
1467Freezes the player and moves him/her to a special map (C<{link}>).
1468
1469The player should be reaosnably safe there for short amounts of time. You
1470I<MUST> call C<leave_link> as soon as possible, though.
1471
1472=item $player_object->leave_link ($map, $x, $y)
1473
1474Moves the player out of the specila link map onto the given map. If the
1475map is not valid (or omitted), the player will be moved back to the
1476location he/she was before the call to C<enter_link>, or, if that fails,
1477to the emergency map position.
1478
1479Might block.
1480
1481=cut
1482
1483sub cf::object::player::enter_link {
1484 my ($self) = @_;
1485
1486 $self->deactivate_recursive;
1487
1488 return if $self->map == $LINK_MAP;
1489
1490 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
1491 if $self->map;
1492
1493 $self->enter_map ($LINK_MAP, 20, 20);
1494}
1495
1496sub cf::object::player::leave_link {
1497 my ($self, $map, $x, $y) = @_;
1498
1499 my $link_pos = delete $self->{_link_pos};
1500
1501 unless ($map) {
1502 # restore original map position
1503 ($map, $x, $y) = @{ $link_pos || [] };
1504 $map = cf::map::find $map;
1505
1506 unless ($map) {
1507 ($map, $x, $y) = @$EMERGENCY_POSITION;
1508 $map = cf::map::find $map
1509 or die "FATAL: cannot load emergency map\n";
1510 }
1511 }
1512
1513 ($x, $y) = (-1, -1)
1514 unless (defined $x) && (defined $y);
1515
1516 # use -1 or undef as default coordinates, not 0, 0
1517 ($x, $y) = ($map->enter_x, $map->enter_y)
1518 if $x <=0 && $y <= 0;
1519
1520 $map->load;
1521
1522 $self->activate_recursive;
1523 $self->enter_map ($map, $x, $y);
1524}
1525
1526cf::player->attach (
1527 on_logout => sub {
1528 my ($pl) = @_;
1529
1530 # abort map switching before logout
1531 if ($pl->ob->{_link_pos}) {
1532 cf::sync_job {
1533 $pl->ob->leave_link
1534 };
1535 }
1536 },
1537 on_login => sub {
1538 my ($pl) = @_;
1539
1540 # try to abort aborted map switching on player login :)
1541 # should happen only on crashes
1542 if ($pl->ob->{_link_pos}) {
1543 $pl->ob->enter_link;
1544 Coro::async_pool {
1545 # we need this sleep as the login has a concurrent enter_exit running
1546 # and this sleep increases chances of the player not ending up in scorn
1547 Coro::Timer::sleep 1;
1548 $pl->ob->leave_link;
1549 };
1550 }
1551 },
1552);
1553
1554=item $player_object->goto ($path, $x, $y)
1555
1556=cut
1557
1558sub cf::object::player::goto {
1559 my ($self, $path, $x, $y) = @_;
1560
1561 $self->enter_link;
1562
1563 (Coro::async_pool {
1564 $path = new cf::path $path;
1565
1566 my $map = cf::map::find $path->as_string;
1567 $map = $map->customise_for ($self) if $map;
1568
1569# warn "entering ", $map->path, " at ($x, $y)\n"
1570# if $map;
1571
1572 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1573
1574 $self->leave_link ($map, $x, $y);
1575 })->prio (1);
1576}
1577
1578=item $player_object->enter_exit ($exit_object)
1579
1580=cut
1581
1582sub parse_random_map_params {
1583 my ($spec) = @_;
1584
1585 my $rmp = { # defaults
1586 xsize => 10,
1587 ysize => 10,
1588 };
1589
1590 for (split /\n/, $spec) {
1591 my ($k, $v) = split /\s+/, $_, 2;
1592
1593 $rmp->{lc $k} = $v if (length $k) && (length $v);
1594 }
1595
1596 $rmp
1597}
1598
1599sub prepare_random_map {
1600 my ($exit) = @_;
1601
1602 # all this does is basically replace the /! path by
1603 # a new random map path (?random/...) with a seed
1604 # that depends on the exit object
1605
1606 my $rmp = parse_random_map_params $exit->msg;
1607
1608 if ($exit->map) {
1609 $rmp->{region} = $exit->map->region_name;
1610 $rmp->{origin_map} = $exit->map->path;
1611 $rmp->{origin_x} = $exit->x;
1612 $rmp->{origin_y} = $exit->y;
1613 }
1614
1615 $rmp->{random_seed} ||= $exit->random_seed;
1616
1617 my $data = cf::to_json $rmp;
1618 my $md5 = Digest::MD5::md5_hex $data;
1619
1620 if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) {
1621 aio_write $fh, 0, (length $data), $data, 0;
1622
1623 $exit->slaying ("?random/$md5");
1624 $exit->msg (undef);
1625 }
1626}
1627
1628sub cf::object::player::enter_exit {
1629 my ($self, $exit) = @_;
1630
1631 return unless $self->type == cf::PLAYER;
1632
1633 $self->enter_link;
1634
1635 (Coro::async_pool {
1636 $self->deactivate_recursive; # just to be sure
1637 unless (eval {
1638 prepare_random_map $exit
1639 if $exit->slaying eq "/!";
1640
1641 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1642 $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
1643
1644 1;
1645 }) {
1646 $self->message ("Something went wrong deep within the crossfire server. "
1647 . "I'll try to bring you back to the map you were before. "
1648 . "Please report this to the dungeon master",
1649 cf::NDI_UNIQUE | cf::NDI_RED);
1650
1651 warn "ERROR in enter_exit: $@";
1652 $self->leave_link;
1653 }
1654 })->prio (1);
1655}
1656
1078=head3 cf::client 1657=head3 cf::client
1079 1658
1080=over 4 1659=over 4
1081 1660
1082=item $client->send_drawinfo ($text, $flags) 1661=item $client->send_drawinfo ($text, $flags)
… …
1125 on_reply => sub { 1704 on_reply => sub {
1126 my ($ns, $msg) = @_; 1705 my ($ns, $msg) = @_;
1127 1706
1128 # this weird shuffling is so that direct followup queries 1707 # this weird shuffling is so that direct followup queries
1129 # get handled first 1708 # get handled first
1130 my $queue = delete $ns->{query_queue}; 1709 my $queue = delete $ns->{query_queue}
1710 or return; # be conservative, not sure how that can happen, but we saw a crash here
1131 1711
1132 (shift @$queue)->[1]->($msg); 1712 (shift @$queue)->[1]->($msg);
1133 1713
1134 push @{ $ns->{query_queue} }, @$queue; 1714 push @{ $ns->{query_queue} }, @$queue;
1135 1715
… …
1152=cut 1732=cut
1153 1733
1154sub cf::client::coro { 1734sub cf::client::coro {
1155 my ($self, $cb) = @_; 1735 my ($self, $cb) = @_;
1156 1736
1157 my $coro; $coro = async { 1737 my $coro = &Coro::async_pool ($cb);
1158 eval {
1159 $cb->();
1160 };
1161 warn $@ if $@;
1162 };
1163 1738
1164 $coro->on_destroy (sub { 1739 $coro->on_destroy (sub {
1165 delete $self->{_coro}{$coro+0}; 1740 delete $self->{_coro}{$coro+0};
1166 }); 1741 });
1167 1742
… …
1339 1914
1340{ 1915{
1341 my $path = cf::localdir . "/database.pst"; 1916 my $path = cf::localdir . "/database.pst";
1342 1917
1343 sub db_load() { 1918 sub db_load() {
1344 warn "loading database $path\n";#d# remove later
1345 $DB = stat $path ? Storable::retrieve $path : { }; 1919 $DB = stat $path ? Storable::retrieve $path : { };
1346 } 1920 }
1347 1921
1348 my $pid; 1922 my $pid;
1349 1923
1350 sub db_save() { 1924 sub db_save() {
1351 warn "saving database $path\n";#d# remove later
1352 waitpid $pid, 0 if $pid; 1925 waitpid $pid, 0 if $pid;
1353 if (0 == ($pid = fork)) { 1926 if (0 == ($pid = fork)) {
1354 $DB->{_meta}{version} = 1; 1927 $DB->{_meta}{version} = 1;
1355 Storable::nstore $DB, "$path~"; 1928 Storable::nstore $DB, "$path~";
1356 rename "$path~", $path; 1929 rename "$path~", $path;
… …
1404 open my $fh, "<:utf8", cf::confdir . "/config" 1977 open my $fh, "<:utf8", cf::confdir . "/config"
1405 or return; 1978 or return;
1406 1979
1407 local $/; 1980 local $/;
1408 *CFG = YAML::Syck::Load <$fh>; 1981 *CFG = YAML::Syck::Load <$fh>;
1982
1983 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
1984
1985 if (exists $CFG{mlockall}) {
1986 eval {
1987 $CFG{mlockall} ? &mlockall : &munlockall
1988 and die "WARNING: m(un)lockall failed: $!\n";
1989 };
1990 warn $@ if $@;
1991 }
1409} 1992}
1410 1993
1411sub main { 1994sub main {
1412 # we must not ever block the main coroutine 1995 # we must not ever block the main coroutine
1413 local $Coro::idle = sub { 1996 local $Coro::idle = sub {
1414 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 1997 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
1415 (Coro::unblock_sub { 1998 (Coro::unblock_sub {
1416 Event::one_event; 1999 Event::one_event;
1417 })->(); 2000 })->();
1418 }; 2001 };
1419 2002
… …
1424} 2007}
1425 2008
1426############################################################################# 2009#############################################################################
1427# initialisation 2010# initialisation
1428 2011
1429sub perl_reload() { 2012sub reload() {
1430 # can/must only be called in main 2013 # can/must only be called in main
1431 if ($Coro::current != $Coro::main) { 2014 if ($Coro::current != $Coro::main) {
1432 warn "can only reload from main coroutine\n"; 2015 warn "can only reload from main coroutine\n";
1433 return; 2016 return;
1434 } 2017 }
1435 2018
1436 warn "reloading..."; 2019 warn "reloading...";
1437 2020
1438 local $FREEZE = 1; 2021 my $guard = freeze_mainloop;
1439 cf::emergency_save; 2022 cf::emergency_save;
1440 2023
1441 eval { 2024 eval {
1442 # if anything goes wrong in here, we should simply crash as we already saved 2025 # if anything goes wrong in here, we should simply crash as we already saved
1443 2026
… …
1527 $LINK_MAP->height (41); 2110 $LINK_MAP->height (41);
1528 $LINK_MAP->alloc; 2111 $LINK_MAP->alloc;
1529 $LINK_MAP->path ("{link}"); 2112 $LINK_MAP->path ("{link}");
1530 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2113 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1531 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2114 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2115
2116 # dirty hack because... archetypes are not yet loaded
2117 Event->timer (
2118 after => 2,
2119 cb => sub {
2120 $_[0]->w->cancel;
2121
2122 # provide some exits "home"
2123 my $exit = cf::object::new "exit";
2124
2125 $exit->slaying ($EMERGENCY_POSITION->[0]);
2126 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
2127 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
2128
2129 $LINK_MAP->insert ($exit->clone, 19, 19);
2130 $LINK_MAP->insert ($exit->clone, 19, 20);
2131 $LINK_MAP->insert ($exit->clone, 19, 21);
2132 $LINK_MAP->insert ($exit->clone, 20, 19);
2133 $LINK_MAP->insert ($exit->clone, 20, 21);
2134 $LINK_MAP->insert ($exit->clone, 21, 19);
2135 $LINK_MAP->insert ($exit->clone, 21, 20);
2136 $LINK_MAP->insert ($exit->clone, 21, 21);
2137
2138 $exit->destroy;
2139 });
2140
2141 $LINK_MAP->{deny_save} = 1;
2142 $LINK_MAP->{deny_reset} = 1;
2143
2144 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1532} 2145}
1533 2146
1534register "<global>", __PACKAGE__; 2147register "<global>", __PACKAGE__;
1535 2148
1536register_command "perl-reload" => sub { 2149register_command "reload" => sub {
1537 my ($who, $arg) = @_; 2150 my ($who, $arg) = @_;
1538 2151
1539 if ($who->flag (FLAG_WIZ)) { 2152 if ($who->flag (FLAG_WIZ)) {
1540 $who->message ("start of reload."); 2153 $who->message ("start of reload.");
1541 perl_reload; 2154 reload;
1542 $who->message ("end of reload."); 2155 $who->message ("end of reload.");
1543 } 2156 }
1544}; 2157};
1545 2158
1546unshift @INC, $LIBDIR; 2159unshift @INC, $LIBDIR;
… …
1549 reentrant => 0, 2162 reentrant => 0,
1550 prio => 0, 2163 prio => 0,
1551 at => $NEXT_TICK || $TICK, 2164 at => $NEXT_TICK || $TICK,
1552 data => WF_AUTOCANCEL, 2165 data => WF_AUTOCANCEL,
1553 cb => sub { 2166 cb => sub {
1554 unless ($FREEZE) {
1555 cf::server_tick; # one server iteration 2167 cf::server_tick; # one server iteration
1556 $RUNTIME += $TICK; 2168 $RUNTIME += $TICK;
1557 }
1558
1559 $NEXT_TICK += $TICK; 2169 $NEXT_TICK += $TICK;
1560 2170
1561 # if we are delayed by four ticks or more, skip them all 2171 # if we are delayed by four ticks or more, skip them all
1562 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2172 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
1563 2173
… …
1586 or warn "ERROR: unable to write runtime file: $!"; 2196 or warn "ERROR: unable to write runtime file: $!";
1587 })->(); 2197 })->();
1588 }, 2198 },
1589); 2199);
1590 2200
2201END { cf::emergency_save }
2202
15911 22031
1592 2204

Diff Legend

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