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.105 by root, Sun Dec 31 17:17:23 2006 UTC vs.
Revision 1.112 by root, Mon Jan 1 13:31:47 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
174sub to_json($) { 181sub to_json($) {
175 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 182 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
176 JSON::Syck::Dump $_[0] 183 JSON::Syck::Dump $_[0]
177} 184}
178 185
179# main coro must never ever "block" except in Event 186=item cf::sync_job { BLOCK }
180# sync_job ensures this by running the job in a coroutine 187
181# and waiting in Event while the server is otherwise frozen 188The design of crossfire+ requires that the main coro ($Coro::main) is
189always able to handle events or runnable, as crossfire+ is only partly
190reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
191
192If it must be done, put the blocking parts into C<sync_job>. This will run
193the given BLOCK in another coroutine while waiting for the result. The
194server will be frozen during this time, so the block should either finish
195fast or be very important.
196
197=cut
198
182sub sync_job(&) { 199sub sync_job(&) {
183 my ($job) = @_; 200 my ($job) = @_;
184 201
185 my $busy = 1;
186 my @res;
187
188 local $FREEZE = 1;
189
190 my $coro = Coro::async {
191 @res = eval { $job->() };
192 warn $@ if $@;
193 undef $busy;
194 };
195
196 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;
197 $coro->prio (Coro::PRIO_MAX); 217 })->prio (Coro::PRIO_MAX);
218
198 while ($busy) { 219 while ($busy) {
199 Coro::cede_notself; 220 Coro::cede_notself;
200 Event::one_event unless Coro::nready; 221 Event::one_event unless Coro::nready;
201 } 222 }
223
224 wantarray ? @res : $res[0]
202 } else { 225 } else {
203 $coro->join; 226 # we are in another coroutine, how wonderful, everything just works
227
228 $job->()
204 } 229 }
205
206 wantarray ? @res : $res[0]
207} 230}
208 231
209=item $coro = cf::coro { BLOCK } 232=item $coro = cf::coro { BLOCK }
210 233
211Creates and returns a new coro. This coro is automcatially being canceled 234Creates and returns a new coro. This coro is automcatially being canceled
229 $EXT_CORO{$coro+0} = $coro; 252 $EXT_CORO{$coro+0} = $coro;
230 253
231 $coro 254 $coro
232} 255}
233 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
234=back 279=back
235 280
236=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 if ($path =~ s{^\?random/}{}) {
295 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
296 $self->{random} = cf::from_json $data;
297 } else {
298 if ($path =~ s{^~([^/]+)?}{}) {
299 $self->{user_rel} = 1;
300
301 if (defined $1) {
302 $self->{user} = $1;
303 } elsif ($base =~ m{^~([^/]+)/}) {
304 $self->{user} = $1;
305 } else {
306 warn "cannot resolve user-relative path without user <$path,$base>\n";
307 }
308 } elsif ($path =~ /^\//) {
309 # already absolute
310 } else {
311 $base =~ s{[^/]+/?$}{};
312 return $class->new ("$base/$path");
313 }
314
315 for ($path) {
316 redo if s{/\.?/}{/};
317 redo if s{/[^/]+/\.\./}{/};
318 }
319 }
320
321 $self->{path} = $path;
322
323 $self
324}
325
326# the name / primary key / in-game path
327sub as_string {
328 my ($self) = @_;
329
330 $self->{user_rel} ? "~$self->{user}$self->{path}"
331 : $self->{random} ? "?random/$self->{path}"
332 : $self->{path}
333}
334
335# the displayed name, this is a one way mapping
336sub visible_name {
337 my ($self) = @_;
338
339# if (my $rmp = $self->{random}) {
340# # todo: be more intelligent about this
341# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
342# } else {
343 $self->as_string
344# }
345}
346
347# escape the /'s in the path
348sub _escaped_path {
349 # ∕ is U+2215
350 (my $path = $_[0]{path}) =~ s/\//∕/g;
351 $path
352}
353
354# the original (read-only) location
355sub load_path {
356 my ($self) = @_;
357
358 sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
359}
360
361# the temporary/swap location
362sub save_path {
363 my ($self) = @_;
364
365 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
366 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
367 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
368}
369
370# the unique path, might be eq to save_path
371sub uniq_path {
372 my ($self) = @_;
373
374 $self->{user_rel} || $self->{random}
375 ? undef
376 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
377}
378
379# return random map parameters, or undef
380sub random_map_params {
381 my ($self) = @_;
382
383 $self->{random}
384}
385
386# this is somewhat ugly, but style maps do need special treatment
387sub is_style_map {
388 $_[0]{path} =~ m{^/styles/}
389}
390
391package cf;
237 392
238############################################################################# 393#############################################################################
239 394
240=head2 ATTACHABLE OBJECTS 395=head2 ATTACHABLE OBJECTS
241 396
883 $self->send ("ext " . to_json \%msg); 1038 $self->send ("ext " . to_json \%msg);
884} 1039}
885 1040
886=back 1041=back
887 1042
1043
1044=head3 cf::map
1045
1046=over 4
1047
1048=cut
1049
1050package cf::map;
1051
1052use Fcntl;
1053use Coro::AIO;
1054
1055our $MAX_RESET = 7200;
1056our $DEFAULT_RESET = 3600;
1057
1058sub generate_random_map {
1059 my ($path, $rmp) = @_;
1060
1061 # mit "rum" bekleckern, nicht
1062 cf::map::_create_random_map
1063 $path,
1064 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1065 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1066 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1067 $rmp->{exit_on_final_map},
1068 $rmp->{xsize}, $rmp->{ysize},
1069 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1070 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1071 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1072 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1073 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1074 (cf::region::find $rmp->{region})
1075}
1076
1077# and all this just because we cannot iterate over
1078# all maps in C++...
1079sub change_all_map_light {
1080 my ($change) = @_;
1081
1082 $_->change_map_light ($change) for values %cf::MAP;
1083}
1084
1085sub try_load_header($) {
1086 my ($path) = @_;
1087
1088 utf8::encode $path;
1089 aio_open $path, O_RDONLY, 0
1090 or return;
1091
1092 my $map = cf::map::new
1093 or return;
1094
1095 $map->load_header ($path)
1096 or return;
1097
1098 $map->{load_path} = $path;
1099
1100 $map
1101}
1102
1103sub find_map {
1104 my ($path, $origin) = @_;
1105
1106 #warn "find_map<$path,$origin>\n";#d#
1107
1108 $path = new cf::path $path, $origin && $origin->path;
1109 my $key = $path->as_string;
1110
1111 $cf::MAP{$key} || do {
1112 # do it the slow way
1113 my $map = try_load_header $path->save_path;
1114
1115 if ($map) {
1116 # safety
1117 $map->{instantiate_time} = $cf::RUNTIME
1118 if $map->{instantiate_time} > $cf::RUNTIME;
1119 } else {
1120 if (my $rmp = $path->random_map_params) {
1121 $map = generate_random_map $key, $rmp;
1122 } else {
1123 $map = try_load_header $path->load_path;
1124 }
1125
1126 $map or return;
1127
1128 $map->{load_original} = 1;
1129 $map->{instantiate_time} = $cf::RUNTIME;
1130 $map->instantiate;
1131
1132 # per-player maps become, after loading, normal maps
1133 $map->per_player (0) if $path->{user_rel};
1134 }
1135
1136 $map->path ($key);
1137 $map->{path} = $path;
1138 $map->last_access ($cf::RUNTIME);
1139
1140 if ($map->should_reset) {
1141 $map->reset;
1142 $map = find_map $path;
1143 }
1144
1145 $cf::MAP{$key} = $map
1146 }
1147}
1148
1149sub load {
1150 my ($self) = @_;
1151
1152 return if $self->in_memory != cf::MAP_SWAPPED;
1153
1154 $self->in_memory (cf::MAP_LOADING);
1155
1156 my $path = $self->{path};
1157
1158 $self->alloc;
1159 $self->load_objects ($self->{load_path}, 1)
1160 or return;
1161
1162 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1163 if delete $self->{load_original};
1164
1165 if (my $uniq = $path->uniq_path) {
1166 utf8::encode $uniq;
1167 if (aio_open $uniq, O_RDONLY, 0) {
1168 $self->clear_unique_items;
1169 $self->load_objects ($uniq, 0);
1170 }
1171 }
1172
1173 # now do the right thing for maps
1174 $self->link_multipart_objects;
1175
1176 if ($self->{path}->is_style_map) {
1177 $self->{deny_save} = 1;
1178 $self->{deny_reset} = 1;
1179 } else {
1180 $self->fix_auto_apply;
1181 $self->decay_objects;
1182 $self->update_buttons;
1183 $self->set_darkness_map;
1184 $self->difficulty ($self->estimate_difficulty)
1185 unless $self->difficulty;
1186 $self->activate;
1187 }
1188
1189 $self->in_memory (cf::MAP_IN_MEMORY);
1190}
1191
1192sub load_map_sync {
1193 my ($path, $origin) = @_;
1194
1195 #warn "load_map_sync<$path, $origin>\n";#d#
1196
1197 cf::sync_job {
1198 my $map = cf::map::find_map $path, $origin
1199 or return;
1200 $map->load;
1201 $map
1202 }
1203}
1204
1205sub save {
1206 my ($self) = @_;
1207
1208 my $save = $self->{path}->save_path; utf8::encode $save;
1209 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1210
1211 $self->{last_save} = $cf::RUNTIME;
1212
1213 return unless $self->dirty;
1214
1215 $self->{load_path} = $save;
1216
1217 return if $self->{deny_save};
1218
1219 if ($uniq) {
1220 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1221 $self->save_objects ($uniq, cf::IO_UNIQUES);
1222 } else {
1223 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1224 }
1225}
1226
1227sub swap_out {
1228 my ($self) = @_;
1229
1230 return if $self->players;
1231 return if $self->in_memory != cf::MAP_IN_MEMORY;
1232 return if $self->{deny_save};
1233
1234 $self->save;
1235 $self->clear;
1236 $self->in_memory (cf::MAP_SWAPPED);
1237}
1238
1239sub reset_at {
1240 my ($self) = @_;
1241
1242 # TODO: safety, remove and allow resettable per-player maps
1243 return 1e100 if $self->{path}{user_rel};
1244 return 1e100 if $self->{deny_reset};
1245
1246 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1247 my $to = $self->reset_timeout || $DEFAULT_RESET;
1248 $to = $MAX_RESET if $to > $MAX_RESET;
1249
1250 $time + $to
1251}
1252
1253sub should_reset {
1254 my ($self) = @_;
1255
1256 $self->reset_at <= $cf::RUNTIME
1257}
1258
1259sub unlink_save {
1260 my ($self) = @_;
1261
1262 utf8::encode (my $save = $self->{path}->save_path);
1263 aioreq_pri 3; IO::AIO::aio_unlink $save;
1264 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1265}
1266
1267sub reset {
1268 my ($self) = @_;
1269
1270 return if $self->players;
1271 return if $self->{path}{user_rel};#d#
1272
1273 warn "resetting map ", $self->path;#d#
1274
1275 delete $cf::MAP{$self->path};
1276
1277 $_->clear_links_to ($self) for values %cf::MAP;
1278
1279 $self->unlink_save;
1280 $self->destroy;
1281}
1282
1283sub customise_for {
1284 my ($map, $ob) = @_;
1285
1286 if ($map->per_player) {
1287 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path};
1288 }
1289
1290 $map
1291}
1292
1293sub emergency_save {
1294 local $cf::FREEZE = 1;
1295
1296 warn "enter emergency map save\n";
1297
1298 cf::sync_job {
1299 warn "begin emergency map save\n";
1300 $_->save for values %cf::MAP;
1301 };
1302
1303 warn "end emergency map save\n";
1304}
1305
1306package cf;
1307
1308=back
1309
1310
888=head3 cf::object::player 1311=head3 cf::object::player
889 1312
890=over 4 1313=over 4
891 1314
892=item $player_object->reply ($npc, $msg[, $flags]) 1315=item $player_object->reply ($npc, $msg[, $flags])
925 1348
926 $self->flag (cf::FLAG_WIZ) || 1349 $self->flag (cf::FLAG_WIZ) ||
927 (ref $cf::CFG{"may_$access"} 1350 (ref $cf::CFG{"may_$access"}
928 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1351 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
929 : $cf::CFG{"may_$access"}) 1352 : $cf::CFG{"may_$access"})
1353}
1354
1355sub cf::object::player::enter_link {
1356 my ($self) = @_;
1357
1358 return if $self->map == $LINK_MAP;
1359
1360 $self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]
1361 if $self->map;
1362
1363 $self->enter_map ($LINK_MAP, 20, 20);
1364 $self->deactivate_recursive;
1365}
1366
1367sub cf::object::player::leave_link {
1368 my ($self, $map, $x, $y) = @_;
1369
1370 my $link_pos = delete $self->{_link_pos};
1371
1372 unless ($map) {
1373 $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1374
1375 # restore original map position
1376 ($map, $x, $y) = @{ $link_pos || [] };
1377 $map = cf::map::find_map $map;
1378
1379 unless ($map) {
1380 ($map, $x, $y) = @$EMERGENCY_POSITION;
1381 $map = cf::map::find_map $map
1382 or die "FATAL: cannot load emergency map\n";
1383 }
1384 }
1385
1386 ($x, $y) = (-1, -1)
1387 unless (defined $x) && (defined $y);
1388
1389 # use -1 or undef as default coordinates, not 0, 0
1390 ($x, $y) = ($map->enter_x, $map->enter_y)
1391 if $x <=0 && $y <= 0;
1392
1393 $map->load;
1394
1395 $self->activate_recursive;
1396 $self->enter_map ($map, $x, $y);
1397}
1398
1399=item $player_object->goto_map ($map, $x, $y)
1400
1401=cut
1402
1403sub cf::object::player::goto_map {
1404 my ($self, $path, $x, $y) = @_;
1405
1406 $self->enter_link;
1407
1408 (Coro::async {
1409 $path = new cf::path $path;
1410
1411 my $map = cf::map::find_map $path->as_string;
1412 $map = $map->customise_for ($self) if $map;
1413
1414 warn "entering ", $map->path, " at ($x, $y)\n"
1415 if $map;
1416
1417 $self->leave_link ($map, $x, $y);
1418 })->prio (1);
1419}
1420
1421=item $player_object->enter_exit ($exit_object)
1422
1423=cut
1424
1425sub parse_random_map_params {
1426 my ($spec) = @_;
1427
1428 my $rmp = { # defaults
1429 xsize => 10,
1430 ysize => 10,
1431 };
1432
1433 for (split /\n/, $spec) {
1434 my ($k, $v) = split /\s+/, $_, 2;
1435
1436 $rmp->{lc $k} = $v if (length $k) && (length $v);
1437 }
1438
1439 $rmp
1440}
1441
1442sub prepare_random_map {
1443 my ($exit) = @_;
1444
1445 # all this does is basically replace the /! path by
1446 # a new random map path (?random/...) with a seed
1447 # that depends on the exit object
1448
1449 my $rmp = parse_random_map_params $exit->msg;
1450
1451 if ($exit->map) {
1452 $rmp->{region} = $exit->map->region_name;
1453 $rmp->{origin_map} = $exit->map->path;
1454 $rmp->{origin_x} = $exit->x;
1455 $rmp->{origin_y} = $exit->y;
1456 }
1457
1458 $rmp->{random_seed} ||= $exit->random_seed;
1459
1460 my $data = cf::to_json $rmp;
1461 my $md5 = Digest::MD5::md5_hex $data;
1462
1463 if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) {
1464 aio_write $fh, 0, (length $data), $data, 0;
1465
1466 $exit->slaying ("?random/$md5");
1467 $exit->msg (undef);
1468 }
1469}
1470
1471sub cf::object::player::enter_exit {
1472 my ($self, $exit) = @_;
1473
1474 return unless $self->type == cf::PLAYER;
1475
1476 $self->enter_link;
1477
1478 (Coro::async {
1479 unless (eval {
1480
1481 prepare_random_map $exit
1482 if $exit->slaying eq "/!";
1483
1484 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1485 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
1486
1487 1;
1488 }) {
1489 $self->message ("Something went wrong deep within the crossfire server. "
1490 . "I'll try to bring you back to the map you were before. "
1491 . "Please report this to the dungeon master",
1492 cf::NDI_UNIQUE | cf::NDI_RED);
1493
1494 warn "ERROR in enter_exit: $@";
1495 $self->leave_link;
1496 }
1497 })->prio (1);
930} 1498}
931 1499
932=head3 cf::client 1500=head3 cf::client
933 1501
934=over 4 1502=over 4
1261 local $/; 1829 local $/;
1262 *CFG = YAML::Syck::Load <$fh>; 1830 *CFG = YAML::Syck::Load <$fh>;
1263} 1831}
1264 1832
1265sub main { 1833sub main {
1834 # we must not ever block the main coroutine
1835 local $Coro::idle = sub {
1836 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
1837 (Coro::unblock_sub {
1838 Event::one_event;
1839 })->();
1840 };
1841
1266 cfg_load; 1842 cfg_load;
1267 db_load; 1843 db_load;
1268 load_extensions; 1844 load_extensions;
1269 Event::loop; 1845 Event::loop;
1270} 1846}
1271 1847
1272############################################################################# 1848#############################################################################
1273# initialisation 1849# initialisation
1274 1850
1275sub _perl_reload() { 1851sub reload() {
1852 # can/must only be called in main
1853 if ($Coro::current != $Coro::main) {
1854 warn "can only reload from main coroutine\n";
1855 return;
1856 }
1857
1276 warn "reloading..."; 1858 warn "reloading...";
1277 1859
1860 local $FREEZE = 1;
1861 cf::emergency_save;
1862
1278 eval { 1863 eval {
1279 local $FREEZE = 1; 1864 # if anything goes wrong in here, we should simply crash as we already saved
1280
1281 cf::emergency_save;
1282 1865
1283 # cancel all watchers 1866 # cancel all watchers
1284 for (Event::all_watchers) { 1867 for (Event::all_watchers) {
1285 $_->cancel if $_->data & WF_AUTOCANCEL; 1868 $_->cancel if $_->data & WF_AUTOCANCEL;
1286 } 1869 }
1345 1928
1346 # reattach attachments to objects 1929 # reattach attachments to objects
1347 warn "reattach"; 1930 warn "reattach";
1348 _global_reattach; 1931 _global_reattach;
1349 }; 1932 };
1350 warn $@ if $@;
1351 1933
1352 warn "reloaded"; 1934 if ($@) {
1935 warn $@;
1936 warn "error while reloading, exiting.";
1937 exit 1;
1938 }
1939
1940 warn "reloaded successfully";
1353}; 1941};
1354 1942
1355sub perl_reload() { 1943#############################################################################
1356 _perl_reload; 1944
1945unless ($LINK_MAP) {
1946 $LINK_MAP = cf::map::new;
1947
1948 $LINK_MAP->width (41);
1949 $LINK_MAP->height (41);
1950 $LINK_MAP->alloc;
1951 $LINK_MAP->path ("{link}");
1952 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1953 $LINK_MAP->in_memory (MAP_IN_MEMORY);
1954
1955 # dirty hack because... archetypes are not yet loaded
1956 Event->timer (
1957 after => 2,
1958 cb => sub {
1959 $_[0]->w->cancel;
1960
1961 # provide some exits "home"
1962 my $exit = cf::object::new "exit";
1963
1964 $exit->slaying ($EMERGENCY_POSITION->[0]);
1965 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
1966 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
1967
1968 $LINK_MAP->insert ($exit->clone, 19, 19);
1969 $LINK_MAP->insert ($exit->clone, 19, 20);
1970 $LINK_MAP->insert ($exit->clone, 19, 21);
1971 $LINK_MAP->insert ($exit->clone, 20, 19);
1972 $LINK_MAP->insert ($exit->clone, 20, 21);
1973 $LINK_MAP->insert ($exit->clone, 21, 19);
1974 $LINK_MAP->insert ($exit->clone, 21, 20);
1975 $LINK_MAP->insert ($exit->clone, 21, 21);
1976
1977 $exit->destroy;
1978 });
1979
1980 $LINK_MAP->{deny_save} = 1;
1981 $LINK_MAP->{deny_reset} = 1;
1982
1983 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1357} 1984}
1358 1985
1359register "<global>", __PACKAGE__; 1986register "<global>", __PACKAGE__;
1360 1987
1361register_command "perl-reload" => sub { 1988register_command "reload" => sub {
1362 my ($who, $arg) = @_; 1989 my ($who, $arg) = @_;
1363 1990
1364 if ($who->flag (FLAG_WIZ)) { 1991 if ($who->flag (FLAG_WIZ)) {
1992 $who->message ("start of reload.");
1993 reload;
1365 $who->message ("reloading..."); 1994 $who->message ("end of reload.");
1366 _perl_reload;
1367 } 1995 }
1368}; 1996};
1369 1997
1370unshift @INC, $LIBDIR; 1998unshift @INC, $LIBDIR;
1371 1999
1390 }, 2018 },
1391); 2019);
1392 2020
1393IO::AIO::max_poll_time $TICK * 0.2; 2021IO::AIO::max_poll_time $TICK * 0.2;
1394 2022
2023Event->io (
1395Event->io (fd => IO::AIO::poll_fileno, 2024 fd => IO::AIO::poll_fileno,
1396 poll => 'r', 2025 poll => 'r',
1397 prio => 5, 2026 prio => 5,
1398 data => WF_AUTOCANCEL, 2027 data => WF_AUTOCANCEL,
1399 cb => \&IO::AIO::poll_cb); 2028 cb => \&IO::AIO::poll_cb,
2029);
1400 2030
1401# we must not ever block the main coroutine 2031Event->timer (
1402$Coro::idle = sub { 2032 data => WF_AUTOCANCEL,
1403 #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 2033 after => 0,
1404 warn "FATAL: Coro::idle was called, major BUG\n"; 2034 interval => 10,
2035 cb => sub {
1405 (Coro::unblock_sub { 2036 (Coro::unblock_sub {
1406 Event::one_event; 2037 write_runtime
2038 or warn "ERROR: unable to write runtime file: $!";
1407 })->(); 2039 })->();
1408}; 2040 },
2041);
1409 2042
14101 20431
1411 2044

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines