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.106 by root, Sun Dec 31 17:29:22 2006 UTC vs.
Revision 1.116 by root, Mon Jan 1 17:30:34 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 Digest::MD5;
20use Fcntl; 21use Fcntl;
21use IO::AIO 2.31 (); 22use IO::AIO 2.31 ();
22use YAML::Syck (); 23use YAML::Syck ();
23use Time::HiRes; 24use Time::HiRes;
24 25
… …
49our $RUNTIME; 50our $RUNTIME;
50 51
51our %MAP; # all maps 52our %MAP; # all maps
52our $LINK_MAP; # the special {link} map 53our $LINK_MAP; # the special {link} map
53our $FREEZE; 54our $FREEZE;
55our $RANDOM_MAPS = cf::localdir . "/random";
56our %EXT_CORO;
54 57
55binmode STDOUT; 58binmode STDOUT;
56binmode STDERR; 59binmode STDERR;
57 60
58# read virtual server time, if available 61# read virtual server time, if available
… …
64 67
65mkdir cf::localdir; 68mkdir cf::localdir;
66mkdir cf::localdir . "/" . cf::playerdir; 69mkdir cf::localdir . "/" . cf::playerdir;
67mkdir cf::localdir . "/" . cf::tmpdir; 70mkdir cf::localdir . "/" . cf::tmpdir;
68mkdir cf::localdir . "/" . cf::uniquedir; 71mkdir cf::localdir . "/" . cf::uniquedir;
72mkdir $RANDOM_MAPS;
69 73
70our %EXT_CORO; 74# a special map that is always available
75our $LINK_MAP;
76
77our $EMERGENCY_POSITION = $cf::CFG{emergency_position} || ["/world/world_105_115", 5, 37];
71 78
72############################################################################# 79#############################################################################
73 80
74=head2 GLOBAL VARIABLES 81=head2 GLOBAL VARIABLES
75 82
… …
190=cut 197=cut
191 198
192sub sync_job(&) { 199sub sync_job(&) {
193 my ($job) = @_; 200 my ($job) = @_;
194 201
195 my $busy = 1;
196 my @res;
197
198 # TODO: use suspend/resume instead
199 local $FREEZE = 1;
200
201 my $coro = Coro::async {
202 @res = eval { $job->() };
203 warn $@ if $@;
204 undef $busy;
205 };
206
207 if ($Coro::current == $Coro::main) { 202 if ($Coro::current == $Coro::main) {
203 # this is the main coro, too bad, we have to block
204 # till the operation succeeds, freezing the server :/
205
206 # TODO: use suspend/resume instead
207 # (but this is cancel-safe)
208 local $FREEZE = 1;
209
210 my $busy = 1;
211 my @res;
212
213 (Coro::async {
214 @res = eval { $job->() };
215 warn $@ if $@;
216 undef $busy;
208 $coro->prio (Coro::PRIO_MAX); 217 })->prio (Coro::PRIO_MAX);
218
209 while ($busy) { 219 while ($busy) {
210 Coro::cede_notself; 220 Coro::cede_notself;
211 Event::one_event unless Coro::nready; 221 Event::one_event unless Coro::nready;
212 } 222 }
223
224 wantarray ? @res : $res[0]
213 } else { 225 } else {
214 $coro->join; 226 # we are in another coroutine, how wonderful, everything just works
227
228 $job->()
215 } 229 }
216
217 wantarray ? @res : $res[0]
218} 230}
219 231
220=item $coro = cf::coro { BLOCK } 232=item $coro = cf::coro { BLOCK }
221 233
222Creates and returns a new coro. This coro is automcatially being canceled 234Creates and returns a new coro. This coro is automcatially being canceled
… …
240 $EXT_CORO{$coro+0} = $coro; 252 $EXT_CORO{$coro+0} = $coro;
241 253
242 $coro 254 $coro
243} 255}
244 256
257sub write_runtime {
258 my $runtime = cf::localdir . "/runtime";
259
260 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
261 or return;
262
263 my $value = $cf::RUNTIME + 1 + 10; # 10 is the runtime save interval, for a monotonic clock
264 (aio_write $fh, 0, (length $value), $value, 0) <= 0
265 and return;
266
267 aio_fsync $fh
268 and return;
269
270 close $fh
271 or return;
272
273 aio_rename "$runtime~", $runtime
274 and return;
275
276 1
277}
278
245=back 279=back
246 280
247=cut 281=cut
282
283#############################################################################
284
285package cf::path;
286
287sub new {
288 my ($class, $path, $base) = @_;
289
290 $path = $path->as_string if ref $path;
291
292 my $self = bless { }, $class;
293
294 # {... are special paths that are not touched
295 # ?xxx/... are special absolute paths
296 # ?random/... random maps
297 # /! non-realised random map exit
298 # /... normal maps
299 # ~/... per-player maps without a specific player (DO NOT USE)
300 # ~user/... per-player map of a specific user
301
302 if ($path =~ /^{/) {
303 # fine as it is
304 } elsif ($path =~ s{^\?random/}{}) {
305 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
306 $self->{random} = cf::from_json $data;
307 } else {
308 if ($path =~ s{^~([^/]+)?}{}) {
309 $self->{user_rel} = 1;
310
311 if (defined $1) {
312 $self->{user} = $1;
313 } elsif ($base =~ m{^~([^/]+)/}) {
314 $self->{user} = $1;
315 } else {
316 warn "cannot resolve user-relative path without user <$path,$base>\n";
317 }
318 } elsif ($path =~ /^\//) {
319 # already absolute
320 } else {
321 $base =~ s{[^/]+/?$}{};
322 return $class->new ("$base/$path");
323 }
324
325 for ($path) {
326 redo if s{/\.?/}{/};
327 redo if s{/[^/]+/\.\./}{/};
328 }
329 }
330
331 $self->{path} = $path;
332
333 $self
334}
335
336# the name / primary key / in-game path
337sub as_string {
338 my ($self) = @_;
339
340 $self->{user_rel} ? "~$self->{user}$self->{path}"
341 : $self->{random} ? "?random/$self->{path}"
342 : $self->{path}
343}
344
345# the displayed name, this is a one way mapping
346sub visible_name {
347 my ($self) = @_;
348
349# if (my $rmp = $self->{random}) {
350# # todo: be more intelligent about this
351# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
352# } else {
353 $self->as_string
354# }
355}
356
357# escape the /'s in the path
358sub _escaped_path {
359 # ∕ is U+2215
360 (my $path = $_[0]{path}) =~ s/\//∕/g;
361 $path
362}
363
364# the original (read-only) location
365sub load_path {
366 my ($self) = @_;
367
368 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
369}
370
371# the temporary/swap location
372sub save_path {
373 my ($self) = @_;
374
375 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
376 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
377 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
378}
379
380# the unique path, might be eq to save_path
381sub uniq_path {
382 my ($self) = @_;
383
384 $self->{user_rel} || $self->{random}
385 ? undef
386 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
387}
388
389# return random map parameters, or undef
390sub random_map_params {
391 my ($self) = @_;
392
393 $self->{random}
394}
395
396# this is somewhat ugly, but style maps do need special treatment
397sub is_style_map {
398 $_[0]{path} =~ m{^/styles/}
399}
400
401package cf;
248 402
249############################################################################# 403#############################################################################
250 404
251=head2 ATTACHABLE OBJECTS 405=head2 ATTACHABLE OBJECTS
252 406
… …
660 or return; 814 or return;
661 815
662 unless (aio_stat "$filename.pst") { 816 unless (aio_stat "$filename.pst") {
663 (aio_load "$filename.pst", $av) >= 0 817 (aio_load "$filename.pst", $av) >= 0
664 or return; 818 or return;
665 $av = eval { (Storable::thaw <$av>)->{objs} }; 819 $av = eval { (Storable::thaw $av)->{objs} };
666 } 820 }
667 821
668 return ($data, $av); 822 return ($data, $av);
669} 823}
670 824
… …
894 $self->send ("ext " . to_json \%msg); 1048 $self->send ("ext " . to_json \%msg);
895} 1049}
896 1050
897=back 1051=back
898 1052
1053
1054=head3 cf::map
1055
1056=over 4
1057
1058=cut
1059
1060package cf::map;
1061
1062use Fcntl;
1063use Coro::AIO;
1064
1065our $MAX_RESET = 7200;
1066our $DEFAULT_RESET = 3600;
1067
1068sub generate_random_map {
1069 my ($path, $rmp) = @_;
1070
1071 # mit "rum" bekleckern, nicht
1072 cf::map::_create_random_map
1073 $path,
1074 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1075 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1076 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1077 $rmp->{exit_on_final_map},
1078 $rmp->{xsize}, $rmp->{ysize},
1079 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1080 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1081 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1082 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1083 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1084 (cf::region::find $rmp->{region})
1085}
1086
1087# and all this just because we cannot iterate over
1088# all maps in C++...
1089sub change_all_map_light {
1090 my ($change) = @_;
1091
1092 $_->change_map_light ($change) for values %cf::MAP;
1093}
1094
1095sub try_load_header($) {
1096 my ($path) = @_;
1097
1098 utf8::encode $path;
1099 aio_open $path, O_RDONLY, 0
1100 or return;
1101
1102 my $map = cf::map::new
1103 or return;
1104
1105 $map->load_header ($path)
1106 or return;
1107
1108 $map->{load_path} = $path;
1109
1110 $map
1111}
1112
1113sub find_map {
1114 my ($path, $origin) = @_;
1115
1116 #warn "find_map<$path,$origin>\n";#d#
1117
1118 $path = new cf::path $path, $origin && $origin->path;
1119 my $key = $path->as_string;
1120
1121 $cf::MAP{$key} || do {
1122 # do it the slow way
1123 my $map = try_load_header $path->save_path;
1124
1125 if ($map) {
1126 # safety
1127 $map->{instantiate_time} = $cf::RUNTIME
1128 if $map->{instantiate_time} > $cf::RUNTIME;
1129 } else {
1130 if (my $rmp = $path->random_map_params) {
1131 $map = generate_random_map $key, $rmp;
1132 } else {
1133 $map = try_load_header $path->load_path;
1134 }
1135
1136 $map or return;
1137
1138 $map->{load_original} = 1;
1139 $map->{instantiate_time} = $cf::RUNTIME;
1140 $map->instantiate;
1141
1142 # per-player maps become, after loading, normal maps
1143 $map->per_player (0) if $path->{user_rel};
1144 }
1145
1146 $map->path ($key);
1147 $map->{path} = $path;
1148 $map->{last_save} = $cf::RUNTIME;
1149 $map->last_access ($cf::RUNTIME);
1150
1151 if ($map->should_reset) {
1152 $map->reset;
1153 $map = find_map $path;
1154 }
1155
1156 $cf::MAP{$key} = $map
1157 }
1158}
1159
1160sub load {
1161 my ($self) = @_;
1162
1163 return if $self->in_memory != cf::MAP_SWAPPED;
1164
1165 $self->in_memory (cf::MAP_LOADING);
1166
1167 my $path = $self->{path};
1168
1169 $self->alloc;
1170 $self->load_objects ($self->{load_path}, 1)
1171 or return;
1172
1173 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1174 if delete $self->{load_original};
1175
1176 if (my $uniq = $path->uniq_path) {
1177 utf8::encode $uniq;
1178 if (aio_open $uniq, O_RDONLY, 0) {
1179 $self->clear_unique_items;
1180 $self->load_objects ($uniq, 0);
1181 }
1182 }
1183
1184 # now do the right thing for maps
1185 $self->link_multipart_objects;
1186
1187 if ($self->{path}->is_style_map) {
1188 $self->{deny_save} = 1;
1189 $self->{deny_reset} = 1;
1190 } else {
1191 $self->fix_auto_apply;
1192 $self->decay_objects;
1193 $self->update_buttons;
1194 $self->set_darkness_map;
1195 $self->difficulty ($self->estimate_difficulty)
1196 unless $self->difficulty;
1197 $self->activate;
1198 }
1199
1200 $self->in_memory (cf::MAP_IN_MEMORY);
1201}
1202
1203sub load_map_sync {
1204 my ($path, $origin) = @_;
1205
1206 #warn "load_map_sync<$path, $origin>\n";#d#
1207
1208 cf::sync_job {
1209 my $map = cf::map::find_map $path, $origin
1210 or return;
1211 $map->load;
1212 $map
1213 }
1214}
1215
1216sub save {
1217 my ($self) = @_;
1218
1219 my $save = $self->{path}->save_path; utf8::encode $save;
1220 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1221
1222 $self->{last_save} = $cf::RUNTIME;
1223
1224 return unless $self->dirty;
1225
1226 $self->{load_path} = $save;
1227
1228 return if $self->{deny_save};
1229
1230 if ($uniq) {
1231 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1232 $self->save_objects ($uniq, cf::IO_UNIQUES);
1233 } else {
1234 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1235 }
1236}
1237
1238sub swap_out {
1239 my ($self) = @_;
1240
1241 return if $self->players;
1242 return if $self->in_memory != cf::MAP_IN_MEMORY;
1243 return if $self->{deny_save};
1244
1245 $self->save;
1246 $self->clear;
1247 $self->in_memory (cf::MAP_SWAPPED);
1248}
1249
1250sub reset_at {
1251 my ($self) = @_;
1252
1253 # TODO: safety, remove and allow resettable per-player maps
1254 return 1e99 if $self->{path}{user_rel};
1255 return 1e99 if $self->{deny_reset};
1256
1257 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1258 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
1259
1260 $time + $to
1261}
1262
1263sub should_reset {
1264 my ($self) = @_;
1265
1266 $self->reset_at <= $cf::RUNTIME
1267}
1268
1269sub unlink_save {
1270 my ($self) = @_;
1271
1272 utf8::encode (my $save = $self->{path}->save_path);
1273 aioreq_pri 3; IO::AIO::aio_unlink $save;
1274 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1275}
1276
1277sub rename {
1278 my ($self, $new_path) = @_;
1279
1280 $self->unlink_save;
1281
1282 delete $cf::MAP{$self->path};
1283 $self->{path} = new cf::path $new_path;
1284 $self->path ($self->{path}->as_string);
1285 $cf::MAP{$self->path} = $self;
1286
1287 $self->save;
1288}
1289
1290sub reset {
1291 my ($self) = @_;
1292
1293 return if $self->players;
1294 return if $self->{path}{user_rel};#d#
1295
1296 warn "resetting map ", $self->path;#d#
1297
1298 delete $cf::MAP{$self->path};
1299
1300 $_->clear_links_to ($self) for values %cf::MAP;
1301
1302 $self->unlink_save;
1303 $self->destroy;
1304}
1305
1306my $nuke_counter = "aaaa";
1307
1308sub nuke {
1309 my ($self) = @_;
1310
1311 $self->{deny_save} = 1;
1312 $self->reset_timeout (1);
1313 $self->rename ("{nuke}/" . ($nuke_counter++));
1314 $self->reset; # polite request, might not happen
1315}
1316
1317sub customise_for {
1318 my ($map, $ob) = @_;
1319
1320 if ($map->per_player) {
1321 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path};
1322 }
1323
1324 $map
1325}
1326
1327sub emergency_save {
1328 local $cf::FREEZE = 1;
1329
1330 warn "enter emergency map save\n";
1331
1332 cf::sync_job {
1333 warn "begin emergency map save\n";
1334 $_->save for values %cf::MAP;
1335 };
1336
1337 warn "end emergency map save\n";
1338}
1339
1340package cf;
1341
1342=back
1343
1344
899=head3 cf::object::player 1345=head3 cf::object::player
900 1346
901=over 4 1347=over 4
902 1348
903=item $player_object->reply ($npc, $msg[, $flags]) 1349=item $player_object->reply ($npc, $msg[, $flags])
… …
936 1382
937 $self->flag (cf::FLAG_WIZ) || 1383 $self->flag (cf::FLAG_WIZ) ||
938 (ref $cf::CFG{"may_$access"} 1384 (ref $cf::CFG{"may_$access"}
939 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1385 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
940 : $cf::CFG{"may_$access"}) 1386 : $cf::CFG{"may_$access"})
1387}
1388
1389=item $player_object->enter_link
1390
1391Freezes the player and moves him/her to a special map (C<{link}>).
1392
1393The player should be reaosnably safe there for short amounts of time. You
1394I<MUST> call C<leave_link> as soon as possible, though.
1395
1396=item $player_object->leave_link ($map, $x, $y)
1397
1398Moves the player out of the specila link map onto the given map. If the
1399map is not valid (or omitted), the player will be moved back to the
1400location he/she was before the call to C<enter_link>, or, if that fails,
1401to the emergency map position.
1402
1403Might block.
1404
1405=cut
1406
1407sub cf::object::player::enter_link {
1408 my ($self) = @_;
1409
1410 return if $self->map == $LINK_MAP;
1411
1412 $self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]
1413 if $self->map;
1414
1415 $self->enter_map ($LINK_MAP, 20, 20);
1416 $self->deactivate_recursive;
1417}
1418
1419sub cf::object::player::leave_link {
1420 my ($self, $map, $x, $y) = @_;
1421
1422 my $link_pos = delete $self->{_link_pos};
1423
1424 unless ($map) {
1425 # restore original map position
1426 ($map, $x, $y) = @{ $link_pos || [] };
1427 $map = cf::map::find_map $map;
1428
1429 unless ($map) {
1430 ($map, $x, $y) = @$EMERGENCY_POSITION;
1431 $map = cf::map::find_map $map
1432 or die "FATAL: cannot load emergency map\n";
1433 }
1434 }
1435
1436 ($x, $y) = (-1, -1)
1437 unless (defined $x) && (defined $y);
1438
1439 # use -1 or undef as default coordinates, not 0, 0
1440 ($x, $y) = ($map->enter_x, $map->enter_y)
1441 if $x <=0 && $y <= 0;
1442
1443 $map->load;
1444
1445 $self->activate_recursive;
1446 $self->enter_map ($map, $x, $y);
1447}
1448
1449=item $player_object->goto_map ($map, $x, $y)
1450
1451=cut
1452
1453sub cf::object::player::goto_map {
1454 my ($self, $path, $x, $y) = @_;
1455
1456 $self->enter_link;
1457
1458 (Coro::async {
1459 $path = new cf::path $path;
1460
1461 my $map = cf::map::find_map $path->as_string;
1462 $map = $map->customise_for ($self) if $map;
1463
1464 warn "entering ", $map->path, " at ($x, $y)\n"
1465 if $map;
1466
1467 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1468
1469 $self->leave_link ($map, $x, $y);
1470 })->prio (1);
1471}
1472
1473=item $player_object->enter_exit ($exit_object)
1474
1475=cut
1476
1477sub parse_random_map_params {
1478 my ($spec) = @_;
1479
1480 my $rmp = { # defaults
1481 xsize => 10,
1482 ysize => 10,
1483 };
1484
1485 for (split /\n/, $spec) {
1486 my ($k, $v) = split /\s+/, $_, 2;
1487
1488 $rmp->{lc $k} = $v if (length $k) && (length $v);
1489 }
1490
1491 $rmp
1492}
1493
1494sub prepare_random_map {
1495 my ($exit) = @_;
1496
1497 # all this does is basically replace the /! path by
1498 # a new random map path (?random/...) with a seed
1499 # that depends on the exit object
1500
1501 my $rmp = parse_random_map_params $exit->msg;
1502
1503 if ($exit->map) {
1504 $rmp->{region} = $exit->map->region_name;
1505 $rmp->{origin_map} = $exit->map->path;
1506 $rmp->{origin_x} = $exit->x;
1507 $rmp->{origin_y} = $exit->y;
1508 }
1509
1510 $rmp->{random_seed} ||= $exit->random_seed;
1511
1512 my $data = cf::to_json $rmp;
1513 my $md5 = Digest::MD5::md5_hex $data;
1514
1515 if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) {
1516 aio_write $fh, 0, (length $data), $data, 0;
1517
1518 $exit->slaying ("?random/$md5");
1519 $exit->msg (undef);
1520 }
1521}
1522
1523sub cf::object::player::enter_exit {
1524 my ($self, $exit) = @_;
1525
1526 return unless $self->type == cf::PLAYER;
1527
1528 $self->enter_link;
1529
1530 (Coro::async {
1531 unless (eval {
1532
1533 prepare_random_map $exit
1534 if $exit->slaying eq "/!";
1535
1536 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1537 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
1538
1539 1;
1540 }) {
1541 $self->message ("Something went wrong deep within the crossfire server. "
1542 . "I'll try to bring you back to the map you were before. "
1543 . "Please report this to the dungeon master",
1544 cf::NDI_UNIQUE | cf::NDI_RED);
1545
1546 warn "ERROR in enter_exit: $@";
1547 $self->leave_link;
1548 }
1549 })->prio (1);
941} 1550}
942 1551
943=head3 cf::client 1552=head3 cf::client
944 1553
945=over 4 1554=over 4
… …
1272 local $/; 1881 local $/;
1273 *CFG = YAML::Syck::Load <$fh>; 1882 *CFG = YAML::Syck::Load <$fh>;
1274} 1883}
1275 1884
1276sub main { 1885sub main {
1886 # we must not ever block the main coroutine
1887 local $Coro::idle = sub {
1888 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
1889 (Coro::unblock_sub {
1890 Event::one_event;
1891 })->();
1892 };
1893
1277 cfg_load; 1894 cfg_load;
1278 db_load; 1895 db_load;
1279 load_extensions; 1896 load_extensions;
1280 Event::loop; 1897 Event::loop;
1281} 1898}
1282 1899
1283############################################################################# 1900#############################################################################
1284# initialisation 1901# initialisation
1285 1902
1286sub _perl_reload() { 1903sub reload() {
1287 # can/must only be called in main 1904 # can/must only be called in main
1288 if ($Coro::current != $Coro::main) { 1905 if ($Coro::current != $Coro::main) {
1289 warn "can only reload from main coroutine\n"; 1906 warn "can only reload from main coroutine\n";
1290 return; 1907 return;
1291 } 1908 }
… …
1373 } 1990 }
1374 1991
1375 warn "reloaded successfully"; 1992 warn "reloaded successfully";
1376}; 1993};
1377 1994
1378sub perl_reload() { 1995#############################################################################
1379 _perl_reload; 1996
1997unless ($LINK_MAP) {
1998 $LINK_MAP = cf::map::new;
1999
2000 $LINK_MAP->width (41);
2001 $LINK_MAP->height (41);
2002 $LINK_MAP->alloc;
2003 $LINK_MAP->path ("{link}");
2004 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2005 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2006
2007 # dirty hack because... archetypes are not yet loaded
2008 Event->timer (
2009 after => 2,
2010 cb => sub {
2011 $_[0]->w->cancel;
2012
2013 # provide some exits "home"
2014 my $exit = cf::object::new "exit";
2015
2016 $exit->slaying ($EMERGENCY_POSITION->[0]);
2017 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
2018 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
2019
2020 $LINK_MAP->insert ($exit->clone, 19, 19);
2021 $LINK_MAP->insert ($exit->clone, 19, 20);
2022 $LINK_MAP->insert ($exit->clone, 19, 21);
2023 $LINK_MAP->insert ($exit->clone, 20, 19);
2024 $LINK_MAP->insert ($exit->clone, 20, 21);
2025 $LINK_MAP->insert ($exit->clone, 21, 19);
2026 $LINK_MAP->insert ($exit->clone, 21, 20);
2027 $LINK_MAP->insert ($exit->clone, 21, 21);
2028
2029 $exit->destroy;
2030 });
2031
2032 $LINK_MAP->{deny_save} = 1;
2033 $LINK_MAP->{deny_reset} = 1;
2034
2035 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1380} 2036}
1381 2037
1382register "<global>", __PACKAGE__; 2038register "<global>", __PACKAGE__;
1383 2039
1384register_command "perl-reload" => sub { 2040register_command "reload" => sub {
1385 my ($who, $arg) = @_; 2041 my ($who, $arg) = @_;
1386 2042
1387 if ($who->flag (FLAG_WIZ)) { 2043 if ($who->flag (FLAG_WIZ)) {
2044 $who->message ("start of reload.");
2045 reload;
1388 $who->message ("reloading..."); 2046 $who->message ("end of reload.");
1389 _perl_reload;
1390 } 2047 }
1391}; 2048};
1392 2049
1393unshift @INC, $LIBDIR; 2050unshift @INC, $LIBDIR;
1394 2051
… …
1413 }, 2070 },
1414); 2071);
1415 2072
1416IO::AIO::max_poll_time $TICK * 0.2; 2073IO::AIO::max_poll_time $TICK * 0.2;
1417 2074
2075Event->io (
1418Event->io (fd => IO::AIO::poll_fileno, 2076 fd => IO::AIO::poll_fileno,
1419 poll => 'r', 2077 poll => 'r',
1420 prio => 5, 2078 prio => 5,
1421 data => WF_AUTOCANCEL, 2079 data => WF_AUTOCANCEL,
1422 cb => \&IO::AIO::poll_cb); 2080 cb => \&IO::AIO::poll_cb,
2081);
1423 2082
1424# we must not ever block the main coroutine 2083Event->timer (
1425$Coro::idle = sub { 2084 data => WF_AUTOCANCEL,
1426 #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 2085 after => 0,
1427 warn "FATAL: Coro::idle was called, major BUG\n"; 2086 interval => 10,
2087 cb => sub {
1428 (Coro::unblock_sub { 2088 (Coro::unblock_sub {
1429 Event::one_event; 2089 write_runtime
2090 or warn "ERROR: unable to write runtime file: $!";
1430 })->(); 2091 })->();
1431}; 2092 },
2093);
1432 2094
14331 20951
1434 2096

Diff Legend

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