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.118 by root, Mon Jan 1 21:19:52 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
822 warn sprintf "loading %s (%d)\n",
823 $filename, length $data, scalar @{$av || []};#d#
668 return ($data, $av); 824 return ($data, $av);
669} 825}
670 826
671############################################################################# 827#############################################################################
672# command handling &c 828# command handling &c
… …
894 $self->send ("ext " . to_json \%msg); 1050 $self->send ("ext " . to_json \%msg);
895} 1051}
896 1052
897=back 1053=back
898 1054
1055
1056=head3 cf::map
1057
1058=over 4
1059
1060=cut
1061
1062package cf::map;
1063
1064use Fcntl;
1065use Coro::AIO;
1066
1067our $MAX_RESET = 7200;
1068our $DEFAULT_RESET = 3600;
1069
1070sub generate_random_map {
1071 my ($path, $rmp) = @_;
1072
1073 # mit "rum" bekleckern, nicht
1074 cf::map::_create_random_map
1075 $path,
1076 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1077 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1078 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1079 $rmp->{exit_on_final_map},
1080 $rmp->{xsize}, $rmp->{ysize},
1081 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1082 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1083 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1084 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1085 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1086 (cf::region::find $rmp->{region})
1087}
1088
1089# and all this just because we cannot iterate over
1090# all maps in C++...
1091sub change_all_map_light {
1092 my ($change) = @_;
1093
1094 $_->change_map_light ($change) for values %cf::MAP;
1095}
1096
1097sub try_load_header($) {
1098 my ($path) = @_;
1099
1100 utf8::encode $path;
1101 aio_open $path, O_RDONLY, 0
1102 or return;
1103
1104 my $map = cf::map::new
1105 or return;
1106
1107 $map->load_header ($path)
1108 or return;
1109
1110 $map->{load_path} = $path;
1111
1112 $map
1113}
1114
1115sub find_map {
1116 my ($path, $origin) = @_;
1117
1118 #warn "find_map<$path,$origin>\n";#d#
1119
1120 $path = new cf::path $path, $origin && $origin->path;
1121 my $key = $path->as_string;
1122
1123 $cf::MAP{$key} || do {
1124 # do it the slow way
1125 my $map = try_load_header $path->save_path;
1126
1127 if ($map) {
1128 # safety
1129 $map->{instantiate_time} = $cf::RUNTIME
1130 if $map->{instantiate_time} > $cf::RUNTIME;
1131 } else {
1132 if (my $rmp = $path->random_map_params) {
1133 $map = generate_random_map $key, $rmp;
1134 } else {
1135 $map = try_load_header $path->load_path;
1136 }
1137
1138 $map or return;
1139
1140 $map->{load_original} = 1;
1141 $map->{instantiate_time} = $cf::RUNTIME;
1142 $map->instantiate;
1143
1144 # per-player maps become, after loading, normal maps
1145 $map->per_player (0) if $path->{user_rel};
1146 }
1147 #Coro::Timer::sleep 1;#d#
1148
1149 $map->path ($key);
1150 $map->{path} = $path;
1151 $map->{last_save} = $cf::RUNTIME;
1152 $map->last_access ($cf::RUNTIME);
1153
1154 if ($map->should_reset) {
1155 $map->reset;
1156 $map = find_map $path;
1157 }
1158
1159 $cf::MAP{$key} = $map
1160 }
1161}
1162
1163sub load {
1164 my ($self) = @_;
1165
1166 return if $self->in_memory != cf::MAP_SWAPPED;
1167
1168 $self->in_memory (cf::MAP_LOADING);
1169
1170 my $path = $self->{path};
1171
1172 $self->alloc;
1173 $self->load_objects ($self->{load_path}, 1)
1174 or return;
1175
1176 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1177 if delete $self->{load_original};
1178
1179 if (my $uniq = $path->uniq_path) {
1180 utf8::encode $uniq;
1181 if (aio_open $uniq, O_RDONLY, 0) {
1182 $self->clear_unique_items;
1183 $self->load_objects ($uniq, 0);
1184 }
1185 }
1186
1187 # now do the right thing for maps
1188 $self->link_multipart_objects;
1189
1190 if ($self->{path}->is_style_map) {
1191 $self->{deny_save} = 1;
1192 $self->{deny_reset} = 1;
1193 } else {
1194 $self->fix_auto_apply;
1195 $self->decay_objects;
1196 $self->update_buttons;
1197 $self->set_darkness_map;
1198 $self->difficulty ($self->estimate_difficulty)
1199 unless $self->difficulty;
1200 $self->activate;
1201 }
1202
1203 $self->in_memory (cf::MAP_IN_MEMORY);
1204}
1205
1206sub load_map_sync {
1207 my ($path, $origin) = @_;
1208
1209 #warn "load_map_sync<$path, $origin>\n";#d#
1210
1211 cf::sync_job {
1212 my $map = cf::map::find_map $path, $origin
1213 or return;
1214 $map->load;
1215 $map
1216 }
1217}
1218
1219sub save {
1220 my ($self) = @_;
1221
1222 $self->{last_save} = $cf::RUNTIME;
1223
1224 return unless $self->dirty;
1225
1226 my $save = $self->{path}->save_path; utf8::encode $save;
1227 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1228
1229 $self->{load_path} = $save;
1230
1231 return if $self->{deny_save};
1232
1233 if ($uniq) {
1234 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1235 $self->save_objects ($uniq, cf::IO_UNIQUES);
1236 } else {
1237 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1238 }
1239}
1240
1241sub swap_out {
1242 my ($self) = @_;
1243
1244 return if $self->players;
1245 return if $self->in_memory != cf::MAP_IN_MEMORY;
1246 return if $self->{deny_save};
1247
1248 $self->save;
1249 $self->clear;
1250 $self->in_memory (cf::MAP_SWAPPED);
1251}
1252
1253sub reset_at {
1254 my ($self) = @_;
1255
1256 # TODO: safety, remove and allow resettable per-player maps
1257 return 1e99 if $self->{path}{user_rel};
1258 return 1e99 if $self->{deny_reset};
1259
1260 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1261 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
1262
1263 $time + $to
1264}
1265
1266sub should_reset {
1267 my ($self) = @_;
1268
1269 $self->reset_at <= $cf::RUNTIME
1270}
1271
1272sub unlink_save {
1273 my ($self) = @_;
1274
1275 utf8::encode (my $save = $self->{path}->save_path);
1276 aioreq_pri 3; IO::AIO::aio_unlink $save;
1277 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1278}
1279
1280sub rename {
1281 my ($self, $new_path) = @_;
1282
1283 $self->unlink_save;
1284
1285 delete $cf::MAP{$self->path};
1286 $self->{path} = new cf::path $new_path;
1287 $self->path ($self->{path}->as_string);
1288 $cf::MAP{$self->path} = $self;
1289
1290 $self->save;
1291}
1292
1293sub reset {
1294 my ($self) = @_;
1295
1296 return if $self->players;
1297 return if $self->{path}{user_rel};#d#
1298
1299 warn "resetting map ", $self->path;#d#
1300
1301 delete $cf::MAP{$self->path};
1302
1303 $_->clear_links_to ($self) for values %cf::MAP;
1304
1305 $self->unlink_save;
1306 $self->destroy;
1307}
1308
1309my $nuke_counter = "aaaa";
1310
1311sub nuke {
1312 my ($self) = @_;
1313
1314 $self->{deny_save} = 1;
1315 $self->reset_timeout (1);
1316 $self->rename ("{nuke}/" . ($nuke_counter++));
1317 $self->reset; # polite request, might not happen
1318}
1319
1320sub customise_for {
1321 my ($map, $ob) = @_;
1322
1323 if ($map->per_player) {
1324 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path};
1325 }
1326
1327 $map
1328}
1329
1330sub emergency_save {
1331 local $cf::FREEZE = 1;
1332
1333 warn "enter emergency map save\n";
1334
1335 cf::sync_job {
1336 warn "begin emergency map save\n";
1337 $_->save for values %cf::MAP;
1338 };
1339
1340 warn "end emergency map save\n";
1341}
1342
1343package cf;
1344
1345=back
1346
1347
899=head3 cf::object::player 1348=head3 cf::object::player
900 1349
901=over 4 1350=over 4
902 1351
903=item $player_object->reply ($npc, $msg[, $flags]) 1352=item $player_object->reply ($npc, $msg[, $flags])
… …
936 1385
937 $self->flag (cf::FLAG_WIZ) || 1386 $self->flag (cf::FLAG_WIZ) ||
938 (ref $cf::CFG{"may_$access"} 1387 (ref $cf::CFG{"may_$access"}
939 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1388 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
940 : $cf::CFG{"may_$access"}) 1389 : $cf::CFG{"may_$access"})
1390}
1391
1392=item $player_object->enter_link
1393
1394Freezes the player and moves him/her to a special map (C<{link}>).
1395
1396The player should be reaosnably safe there for short amounts of time. You
1397I<MUST> call C<leave_link> as soon as possible, though.
1398
1399=item $player_object->leave_link ($map, $x, $y)
1400
1401Moves the player out of the specila link map onto the given map. If the
1402map is not valid (or omitted), the player will be moved back to the
1403location he/she was before the call to C<enter_link>, or, if that fails,
1404to the emergency map position.
1405
1406Might block.
1407
1408=cut
1409
1410sub cf::object::player::enter_link {
1411 my ($self) = @_;
1412
1413 return if $self->map == $LINK_MAP;
1414
1415 $self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]
1416 if $self->map;
1417
1418 $self->enter_map ($LINK_MAP, 20, 20);
1419 $self->deactivate_recursive;
1420}
1421
1422sub cf::object::player::leave_link {
1423 my ($self, $map, $x, $y) = @_;
1424
1425 my $link_pos = delete $self->{_link_pos};
1426
1427 unless ($map) {
1428 # restore original map position
1429 ($map, $x, $y) = @{ $link_pos || [] };
1430 $map = cf::map::find_map $map;
1431
1432 unless ($map) {
1433 ($map, $x, $y) = @$EMERGENCY_POSITION;
1434 $map = cf::map::find_map $map
1435 or die "FATAL: cannot load emergency map\n";
1436 }
1437 }
1438
1439 ($x, $y) = (-1, -1)
1440 unless (defined $x) && (defined $y);
1441
1442 # use -1 or undef as default coordinates, not 0, 0
1443 ($x, $y) = ($map->enter_x, $map->enter_y)
1444 if $x <=0 && $y <= 0;
1445
1446 $map->load;
1447
1448 $self->activate_recursive;
1449 $self->enter_map ($map, $x, $y);
1450}
1451
1452=item $player_object->goto_map ($path, $x, $y)
1453
1454=cut
1455
1456sub cf::object::player::goto_map {
1457 my ($self, $path, $x, $y) = @_;
1458
1459 $self->enter_link;
1460
1461 (Coro::async {
1462 $path = new cf::path $path;
1463
1464 my $map = cf::map::find_map $path->as_string;
1465 $map = $map->customise_for ($self) if $map;
1466
1467 warn "entering ", $map->path, " at ($x, $y)\n"
1468 if $map;
1469
1470 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1471
1472 $self->leave_link ($map, $x, $y);
1473 })->prio (1);
1474}
1475
1476=item $player_object->enter_exit ($exit_object)
1477
1478=cut
1479
1480sub parse_random_map_params {
1481 my ($spec) = @_;
1482
1483 my $rmp = { # defaults
1484 xsize => 10,
1485 ysize => 10,
1486 };
1487
1488 for (split /\n/, $spec) {
1489 my ($k, $v) = split /\s+/, $_, 2;
1490
1491 $rmp->{lc $k} = $v if (length $k) && (length $v);
1492 }
1493
1494 $rmp
1495}
1496
1497sub prepare_random_map {
1498 my ($exit) = @_;
1499
1500 # all this does is basically replace the /! path by
1501 # a new random map path (?random/...) with a seed
1502 # that depends on the exit object
1503
1504 my $rmp = parse_random_map_params $exit->msg;
1505
1506 if ($exit->map) {
1507 $rmp->{region} = $exit->map->region_name;
1508 $rmp->{origin_map} = $exit->map->path;
1509 $rmp->{origin_x} = $exit->x;
1510 $rmp->{origin_y} = $exit->y;
1511 }
1512
1513 $rmp->{random_seed} ||= $exit->random_seed;
1514
1515 my $data = cf::to_json $rmp;
1516 my $md5 = Digest::MD5::md5_hex $data;
1517
1518 if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) {
1519 aio_write $fh, 0, (length $data), $data, 0;
1520
1521 $exit->slaying ("?random/$md5");
1522 $exit->msg (undef);
1523 }
1524}
1525
1526sub cf::object::player::enter_exit {
1527 my ($self, $exit) = @_;
1528
1529 return unless $self->type == cf::PLAYER;
1530
1531 $self->enter_link;
1532
1533 (Coro::async {
1534 unless (eval {
1535
1536 prepare_random_map $exit
1537 if $exit->slaying eq "/!";
1538
1539 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1540 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
1541
1542 1;
1543 }) {
1544 $self->message ("Something went wrong deep within the crossfire server. "
1545 . "I'll try to bring you back to the map you were before. "
1546 . "Please report this to the dungeon master",
1547 cf::NDI_UNIQUE | cf::NDI_RED);
1548
1549 warn "ERROR in enter_exit: $@";
1550 $self->leave_link;
1551 }
1552 })->prio (1);
941} 1553}
942 1554
943=head3 cf::client 1555=head3 cf::client
944 1556
945=over 4 1557=over 4
… …
1272 local $/; 1884 local $/;
1273 *CFG = YAML::Syck::Load <$fh>; 1885 *CFG = YAML::Syck::Load <$fh>;
1274} 1886}
1275 1887
1276sub main { 1888sub main {
1889 # we must not ever block the main coroutine
1890 local $Coro::idle = sub {
1891 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
1892 (Coro::unblock_sub {
1893 Event::one_event;
1894 })->();
1895 };
1896
1277 cfg_load; 1897 cfg_load;
1278 db_load; 1898 db_load;
1279 load_extensions; 1899 load_extensions;
1280 Event::loop; 1900 Event::loop;
1281} 1901}
1282 1902
1283############################################################################# 1903#############################################################################
1284# initialisation 1904# initialisation
1285 1905
1286sub _perl_reload() { 1906sub reload() {
1287 # can/must only be called in main 1907 # can/must only be called in main
1288 if ($Coro::current != $Coro::main) { 1908 if ($Coro::current != $Coro::main) {
1289 warn "can only reload from main coroutine\n"; 1909 warn "can only reload from main coroutine\n";
1290 return; 1910 return;
1291 } 1911 }
… …
1373 } 1993 }
1374 1994
1375 warn "reloaded successfully"; 1995 warn "reloaded successfully";
1376}; 1996};
1377 1997
1378sub perl_reload() { 1998#############################################################################
1379 _perl_reload; 1999
2000unless ($LINK_MAP) {
2001 $LINK_MAP = cf::map::new;
2002
2003 $LINK_MAP->width (41);
2004 $LINK_MAP->height (41);
2005 $LINK_MAP->alloc;
2006 $LINK_MAP->path ("{link}");
2007 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2008 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2009
2010 # dirty hack because... archetypes are not yet loaded
2011 Event->timer (
2012 after => 2,
2013 cb => sub {
2014 $_[0]->w->cancel;
2015
2016 # provide some exits "home"
2017 my $exit = cf::object::new "exit";
2018
2019 $exit->slaying ($EMERGENCY_POSITION->[0]);
2020 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
2021 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
2022
2023 $LINK_MAP->insert ($exit->clone, 19, 19);
2024 $LINK_MAP->insert ($exit->clone, 19, 20);
2025 $LINK_MAP->insert ($exit->clone, 19, 21);
2026 $LINK_MAP->insert ($exit->clone, 20, 19);
2027 $LINK_MAP->insert ($exit->clone, 20, 21);
2028 $LINK_MAP->insert ($exit->clone, 21, 19);
2029 $LINK_MAP->insert ($exit->clone, 21, 20);
2030 $LINK_MAP->insert ($exit->clone, 21, 21);
2031
2032 $exit->destroy;
2033 });
2034
2035 $LINK_MAP->{deny_save} = 1;
2036 $LINK_MAP->{deny_reset} = 1;
2037
2038 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1380} 2039}
1381 2040
1382register "<global>", __PACKAGE__; 2041register "<global>", __PACKAGE__;
1383 2042
1384register_command "perl-reload" => sub { 2043register_command "reload" => sub {
1385 my ($who, $arg) = @_; 2044 my ($who, $arg) = @_;
1386 2045
1387 if ($who->flag (FLAG_WIZ)) { 2046 if ($who->flag (FLAG_WIZ)) {
2047 $who->message ("start of reload.");
2048 reload;
1388 $who->message ("reloading..."); 2049 $who->message ("end of reload.");
1389 _perl_reload;
1390 } 2050 }
1391}; 2051};
1392 2052
1393unshift @INC, $LIBDIR; 2053unshift @INC, $LIBDIR;
1394 2054
… …
1413 }, 2073 },
1414); 2074);
1415 2075
1416IO::AIO::max_poll_time $TICK * 0.2; 2076IO::AIO::max_poll_time $TICK * 0.2;
1417 2077
2078Event->io (
1418Event->io (fd => IO::AIO::poll_fileno, 2079 fd => IO::AIO::poll_fileno,
1419 poll => 'r', 2080 poll => 'r',
1420 prio => 5, 2081 prio => 5,
1421 data => WF_AUTOCANCEL, 2082 data => WF_AUTOCANCEL,
1422 cb => \&IO::AIO::poll_cb); 2083 cb => \&IO::AIO::poll_cb,
2084);
1423 2085
1424# we must not ever block the main coroutine 2086Event->timer (
1425$Coro::idle = sub { 2087 data => WF_AUTOCANCEL,
1426 #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 2088 after => 0,
1427 warn "FATAL: Coro::idle was called, major BUG\n"; 2089 interval => 10,
2090 cb => sub {
1428 (Coro::unblock_sub { 2091 (Coro::unblock_sub {
1429 Event::one_event; 2092 write_runtime
2093 or warn "ERROR: unable to write runtime file: $!";
1430 })->(); 2094 })->();
1431}; 2095 },
2096);
1432 2097
14331 20981
1434 2099

Diff Legend

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