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.103 by root, Sat Dec 30 10:16:11 2006 UTC vs.
Revision 1.113 by root, Mon Jan 1 15:32:40 2007 UTC

… …
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;
18 19
20use Digest::MD5;
21use Fcntl;
19use IO::AIO 2.3; 22use IO::AIO 2.31 ();
20use YAML::Syck (); 23use YAML::Syck ();
21use Time::HiRes; 24use Time::HiRes;
22 25
23use Event; $Event::Eval = 1; # no idea why this is required, but it is 26use Event; $Event::Eval = 1; # no idea why this is required, but it is
24 27
… …
47our $RUNTIME; 50our $RUNTIME;
48 51
49our %MAP; # all maps 52our %MAP; # all maps
50our $LINK_MAP; # the special {link} map 53our $LINK_MAP; # the special {link} map
51our $FREEZE; 54our $FREEZE;
55our $RANDOM_MAPS = cf::localdir . "/random";
56our %EXT_CORO;
52 57
53binmode STDOUT; 58binmode STDOUT;
54binmode STDERR; 59binmode STDERR;
55 60
56# read virtual server time, if available 61# read virtual server time, if available
… …
62 67
63mkdir cf::localdir; 68mkdir cf::localdir;
64mkdir cf::localdir . "/" . cf::playerdir; 69mkdir cf::localdir . "/" . cf::playerdir;
65mkdir cf::localdir . "/" . cf::tmpdir; 70mkdir cf::localdir . "/" . cf::tmpdir;
66mkdir cf::localdir . "/" . cf::uniquedir; 71mkdir cf::localdir . "/" . cf::uniquedir;
72mkdir $RANDOM_MAPS;
67 73
68our %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];
69 78
70############################################################################# 79#############################################################################
71 80
72=head2 GLOBAL VARIABLES 81=head2 GLOBAL VARIABLES
73 82
… …
172sub to_json($) { 181sub to_json($) {
173 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 182 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
174 JSON::Syck::Dump $_[0] 183 JSON::Syck::Dump $_[0]
175} 184}
176 185
186=item cf::sync_job { BLOCK }
187
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
199sub sync_job(&) {
200 my ($job) = @_;
201
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;
217 })->prio (Coro::PRIO_MAX);
218
219 while ($busy) {
220 Coro::cede_notself;
221 Event::one_event unless Coro::nready;
222 }
223
224 wantarray ? @res : $res[0]
225 } else {
226 # we are in another coroutine, how wonderful, everything just works
227
228 $job->()
229 }
230}
231
177=item $coro = cf::coro { BLOCK } 232=item $coro = cf::coro { BLOCK }
178 233
179Creates and returns a new coro. This coro is automcatially being canceled 234Creates and returns a new coro. This coro is automcatially being canceled
180when the extension calling this is being unloaded. 235when the extension calling this is being unloaded.
181 236
… …
197 $EXT_CORO{$coro+0} = $coro; 252 $EXT_CORO{$coro+0} = $coro;
198 253
199 $coro 254 $coro
200} 255}
201 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
202=back 279=back
203 280
204=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;
205 392
206############################################################################# 393#############################################################################
207 394
208=head2 ATTACHABLE OBJECTS 395=head2 ATTACHABLE OBJECTS
209 396
… …
563); 750);
564 751
565sub object_freezer_save { 752sub object_freezer_save {
566 my ($filename, $rdata, $objs) = @_; 753 my ($filename, $rdata, $objs) = @_;
567 754
755 sync_job {
568 if (length $$rdata) { 756 if (length $$rdata) {
569 warn sprintf "saving %s (%d,%d)\n", 757 warn sprintf "saving %s (%d,%d)\n",
570 $filename, length $$rdata, scalar @$objs; 758 $filename, length $$rdata, scalar @$objs;
571 759
572 if (open my $fh, ">:raw", "$filename~") { 760 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
573 chmod SAVE_MODE, $fh;
574 syswrite $fh, $$rdata;
575 close $fh;
576
577 if (@$objs && open my $fh, ">:raw", "$filename.pst~") {
578 chmod SAVE_MODE, $fh; 761 chmod SAVE_MODE, $fh;
579 syswrite $fh, Storable::nfreeze { version => 1, objs => $objs }; 762 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
763 aio_fsync $fh;
580 close $fh; 764 close $fh;
765
766 if (@$objs) {
767 if (my $fh = aio_open "$filename.pst~", O_WRONLY | O_CREAT, 0600) {
768 chmod SAVE_MODE, $fh;
769 my $data = Storable::nfreeze { version => 1, objs => $objs };
770 aio_write $fh, 0, (length $data), $data, 0;
771 aio_fsync $fh;
772 close $fh;
581 rename "$filename.pst~", "$filename.pst"; 773 aio_rename "$filename.pst~", "$filename.pst";
774 }
775 } else {
776 aio_unlink "$filename.pst";
777 }
778
779 aio_rename "$filename~", $filename;
582 } else { 780 } else {
583 unlink "$filename.pst"; 781 warn "FATAL: $filename~: $!\n";
584 } 782 }
585
586 rename "$filename~", $filename;
587 } else { 783 } else {
588 warn "FATAL: $filename~: $!\n";
589 }
590 } else {
591 unlink $filename; 784 aio_unlink $filename;
592 unlink "$filename.pst"; 785 aio_unlink "$filename.pst";
786 }
593 } 787 }
594} 788}
595 789
596sub object_freezer_as_string { 790sub object_freezer_as_string {
597 my ($rdata, $objs) = @_; 791 my ($rdata, $objs) = @_;
… …
602} 796}
603 797
604sub object_thawer_load { 798sub object_thawer_load {
605 my ($filename) = @_; 799 my ($filename) = @_;
606 800
607 local $/; 801 my ($data, $av);
608 802
609 my $av; 803 (aio_load $filename, $data) >= 0
804 or return;
610 805
611 #TODO: use sysread etc. 806 unless (aio_stat "$filename.pst") {
612 if (open my $data, "<:raw:perlio", $filename) { 807 (aio_load "$filename.pst", $av) >= 0
613 $data = <$data>; 808 or return;
614 if (open my $pst, "<:raw:perlio", "$filename.pst") {
615 $av = eval { (Storable::thaw <$pst>)->{objs} }; 809 $av = eval { (Storable::thaw $av)->{objs} };
616 } 810 }
811
617 return ($data, $av); 812 return ($data, $av);
618 }
619
620 ()
621} 813}
622 814
623############################################################################# 815#############################################################################
624# command handling &c 816# command handling &c
625 817
… …
846 $self->send ("ext " . to_json \%msg); 1038 $self->send ("ext " . to_json \%msg);
847} 1039}
848 1040
849=back 1041=back
850 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 rename {
1268 my ($self, $new_path) = @_;
1269
1270 $self->unlink_save;
1271
1272 delete $cf::MAP{$self->path};
1273 $self->{path} = new cf::path $new_path;
1274 $self->path ($self->{path}->path);
1275 $cf::MAP{$self->path} = $self;
1276
1277 $self->save;
1278}
1279
1280sub reset {
1281 my ($self) = @_;
1282
1283 return if $self->players;
1284 return if $self->{path}{user_rel};#d#
1285
1286 warn "resetting map ", $self->path;#d#
1287
1288 delete $cf::MAP{$self->path};
1289
1290 $_->clear_links_to ($self) for values %cf::MAP;
1291
1292 $self->unlink_save;
1293 $self->destroy;
1294}
1295
1296sub customise_for {
1297 my ($map, $ob) = @_;
1298
1299 if ($map->per_player) {
1300 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path};
1301 }
1302
1303 $map
1304}
1305
1306sub emergency_save {
1307 local $cf::FREEZE = 1;
1308
1309 warn "enter emergency map save\n";
1310
1311 cf::sync_job {
1312 warn "begin emergency map save\n";
1313 $_->save for values %cf::MAP;
1314 };
1315
1316 warn "end emergency map save\n";
1317}
1318
1319package cf;
1320
1321=back
1322
1323
851=head3 cf::object::player 1324=head3 cf::object::player
852 1325
853=over 4 1326=over 4
854 1327
855=item $player_object->reply ($npc, $msg[, $flags]) 1328=item $player_object->reply ($npc, $msg[, $flags])
… …
888 1361
889 $self->flag (cf::FLAG_WIZ) || 1362 $self->flag (cf::FLAG_WIZ) ||
890 (ref $cf::CFG{"may_$access"} 1363 (ref $cf::CFG{"may_$access"}
891 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1364 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
892 : $cf::CFG{"may_$access"}) 1365 : $cf::CFG{"may_$access"})
1366}
1367
1368sub cf::object::player::enter_link {
1369 my ($self) = @_;
1370
1371 return if $self->map == $LINK_MAP;
1372
1373 $self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]
1374 if $self->map;
1375
1376 $self->enter_map ($LINK_MAP, 20, 20);
1377 $self->deactivate_recursive;
1378}
1379
1380sub cf::object::player::leave_link {
1381 my ($self, $map, $x, $y) = @_;
1382
1383 my $link_pos = delete $self->{_link_pos};
1384
1385 unless ($map) {
1386 $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1387
1388 # restore original map position
1389 ($map, $x, $y) = @{ $link_pos || [] };
1390 $map = cf::map::find_map $map;
1391
1392 unless ($map) {
1393 ($map, $x, $y) = @$EMERGENCY_POSITION;
1394 $map = cf::map::find_map $map
1395 or die "FATAL: cannot load emergency map\n";
1396 }
1397 }
1398
1399 ($x, $y) = (-1, -1)
1400 unless (defined $x) && (defined $y);
1401
1402 # use -1 or undef as default coordinates, not 0, 0
1403 ($x, $y) = ($map->enter_x, $map->enter_y)
1404 if $x <=0 && $y <= 0;
1405
1406 $map->load;
1407
1408 $self->activate_recursive;
1409 $self->enter_map ($map, $x, $y);
1410}
1411
1412=item $player_object->goto_map ($map, $x, $y)
1413
1414=cut
1415
1416sub cf::object::player::goto_map {
1417 my ($self, $path, $x, $y) = @_;
1418
1419 $self->enter_link;
1420
1421 (Coro::async {
1422 $path = new cf::path $path;
1423
1424 my $map = cf::map::find_map $path->as_string;
1425 $map = $map->customise_for ($self) if $map;
1426
1427 warn "entering ", $map->path, " at ($x, $y)\n"
1428 if $map;
1429
1430 $self->leave_link ($map, $x, $y);
1431 })->prio (1);
1432}
1433
1434=item $player_object->enter_exit ($exit_object)
1435
1436=cut
1437
1438sub parse_random_map_params {
1439 my ($spec) = @_;
1440
1441 my $rmp = { # defaults
1442 xsize => 10,
1443 ysize => 10,
1444 };
1445
1446 for (split /\n/, $spec) {
1447 my ($k, $v) = split /\s+/, $_, 2;
1448
1449 $rmp->{lc $k} = $v if (length $k) && (length $v);
1450 }
1451
1452 $rmp
1453}
1454
1455sub prepare_random_map {
1456 my ($exit) = @_;
1457
1458 # all this does is basically replace the /! path by
1459 # a new random map path (?random/...) with a seed
1460 # that depends on the exit object
1461
1462 my $rmp = parse_random_map_params $exit->msg;
1463
1464 if ($exit->map) {
1465 $rmp->{region} = $exit->map->region_name;
1466 $rmp->{origin_map} = $exit->map->path;
1467 $rmp->{origin_x} = $exit->x;
1468 $rmp->{origin_y} = $exit->y;
1469 }
1470
1471 $rmp->{random_seed} ||= $exit->random_seed;
1472
1473 my $data = cf::to_json $rmp;
1474 my $md5 = Digest::MD5::md5_hex $data;
1475
1476 if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) {
1477 aio_write $fh, 0, (length $data), $data, 0;
1478
1479 $exit->slaying ("?random/$md5");
1480 $exit->msg (undef);
1481 }
1482}
1483
1484sub cf::object::player::enter_exit {
1485 my ($self, $exit) = @_;
1486
1487 return unless $self->type == cf::PLAYER;
1488
1489 $self->enter_link;
1490
1491 (Coro::async {
1492 unless (eval {
1493
1494 prepare_random_map $exit
1495 if $exit->slaying eq "/!";
1496
1497 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1498 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
1499
1500 1;
1501 }) {
1502 $self->message ("Something went wrong deep within the crossfire server. "
1503 . "I'll try to bring you back to the map you were before. "
1504 . "Please report this to the dungeon master",
1505 cf::NDI_UNIQUE | cf::NDI_RED);
1506
1507 warn "ERROR in enter_exit: $@";
1508 $self->leave_link;
1509 }
1510 })->prio (1);
893} 1511}
894 1512
895=head3 cf::client 1513=head3 cf::client
896 1514
897=over 4 1515=over 4
… …
1224 local $/; 1842 local $/;
1225 *CFG = YAML::Syck::Load <$fh>; 1843 *CFG = YAML::Syck::Load <$fh>;
1226} 1844}
1227 1845
1228sub main { 1846sub main {
1847 # we must not ever block the main coroutine
1848 local $Coro::idle = sub {
1849 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
1850 (Coro::unblock_sub {
1851 Event::one_event;
1852 })->();
1853 };
1854
1229 cfg_load; 1855 cfg_load;
1230 db_load; 1856 db_load;
1231 load_extensions; 1857 load_extensions;
1232 Event::loop; 1858 Event::loop;
1233} 1859}
1234 1860
1235############################################################################# 1861#############################################################################
1236# initialisation 1862# initialisation
1237 1863
1238sub _perl_reload() { 1864sub reload() {
1865 # can/must only be called in main
1866 if ($Coro::current != $Coro::main) {
1867 warn "can only reload from main coroutine\n";
1868 return;
1869 }
1870
1239 warn "reloading..."; 1871 warn "reloading...";
1240 1872
1873 local $FREEZE = 1;
1874 cf::emergency_save;
1875
1241 eval { 1876 eval {
1242 local $FREEZE = 1; 1877 # if anything goes wrong in here, we should simply crash as we already saved
1243
1244 cf::emergency_save;
1245 1878
1246 # cancel all watchers 1879 # cancel all watchers
1247 for (Event::all_watchers) { 1880 for (Event::all_watchers) {
1248 $_->cancel if $_->data & WF_AUTOCANCEL; 1881 $_->cancel if $_->data & WF_AUTOCANCEL;
1249 } 1882 }
… …
1308 1941
1309 # reattach attachments to objects 1942 # reattach attachments to objects
1310 warn "reattach"; 1943 warn "reattach";
1311 _global_reattach; 1944 _global_reattach;
1312 }; 1945 };
1313 warn $@ if $@;
1314 1946
1315 warn "reloaded"; 1947 if ($@) {
1948 warn $@;
1949 warn "error while reloading, exiting.";
1950 exit 1;
1951 }
1952
1953 warn "reloaded successfully";
1316}; 1954};
1317 1955
1318sub perl_reload() { 1956#############################################################################
1319 _perl_reload; 1957
1958unless ($LINK_MAP) {
1959 $LINK_MAP = cf::map::new;
1960
1961 $LINK_MAP->width (41);
1962 $LINK_MAP->height (41);
1963 $LINK_MAP->alloc;
1964 $LINK_MAP->path ("{link}");
1965 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1966 $LINK_MAP->in_memory (MAP_IN_MEMORY);
1967
1968 # dirty hack because... archetypes are not yet loaded
1969 Event->timer (
1970 after => 2,
1971 cb => sub {
1972 $_[0]->w->cancel;
1973
1974 # provide some exits "home"
1975 my $exit = cf::object::new "exit";
1976
1977 $exit->slaying ($EMERGENCY_POSITION->[0]);
1978 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
1979 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
1980
1981 $LINK_MAP->insert ($exit->clone, 19, 19);
1982 $LINK_MAP->insert ($exit->clone, 19, 20);
1983 $LINK_MAP->insert ($exit->clone, 19, 21);
1984 $LINK_MAP->insert ($exit->clone, 20, 19);
1985 $LINK_MAP->insert ($exit->clone, 20, 21);
1986 $LINK_MAP->insert ($exit->clone, 21, 19);
1987 $LINK_MAP->insert ($exit->clone, 21, 20);
1988 $LINK_MAP->insert ($exit->clone, 21, 21);
1989
1990 $exit->destroy;
1991 });
1992
1993 $LINK_MAP->{deny_save} = 1;
1994 $LINK_MAP->{deny_reset} = 1;
1995
1996 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1320} 1997}
1321 1998
1322register "<global>", __PACKAGE__; 1999register "<global>", __PACKAGE__;
1323 2000
1324register_command "perl-reload" => sub { 2001register_command "reload" => sub {
1325 my ($who, $arg) = @_; 2002 my ($who, $arg) = @_;
1326 2003
1327 if ($who->flag (FLAG_WIZ)) { 2004 if ($who->flag (FLAG_WIZ)) {
2005 $who->message ("start of reload.");
2006 reload;
1328 $who->message ("reloading..."); 2007 $who->message ("end of reload.");
1329 _perl_reload;
1330 } 2008 }
1331}; 2009};
1332 2010
1333unshift @INC, $LIBDIR; 2011unshift @INC, $LIBDIR;
1334 2012
1335$TICK_WATCHER = Event->timer ( 2013$TICK_WATCHER = Event->timer (
2014 reentrant => 0,
1336 prio => 0, 2015 prio => 0,
1337 at => $NEXT_TICK || $TICK, 2016 at => $NEXT_TICK || $TICK,
1338 data => WF_AUTOCANCEL, 2017 data => WF_AUTOCANCEL,
1339 cb => sub { 2018 cb => sub {
1340 unless ($FREEZE) { 2019 unless ($FREEZE) {
1341 cf::server_tick; # one server iteration 2020 cf::server_tick; # one server iteration
1342 $RUNTIME += $TICK; 2021 $RUNTIME += $TICK;
1343 } 2022 }
1344 2023
… …
1352 }, 2031 },
1353); 2032);
1354 2033
1355IO::AIO::max_poll_time $TICK * 0.2; 2034IO::AIO::max_poll_time $TICK * 0.2;
1356 2035
2036Event->io (
1357Event->io (fd => IO::AIO::poll_fileno, 2037 fd => IO::AIO::poll_fileno,
1358 poll => 'r', 2038 poll => 'r',
1359 prio => 5, 2039 prio => 5,
1360 data => WF_AUTOCANCEL, 2040 data => WF_AUTOCANCEL,
1361 cb => \&IO::AIO::poll_cb); 2041 cb => \&IO::AIO::poll_cb,
2042);
1362 2043
1363# we must not ever block the main coroutine 2044Event->timer (
1364$Coro::idle = sub { 2045 data => WF_AUTOCANCEL,
1365 #Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 2046 after => 0,
1366 warn "FATAL: Coro::idle was called, major BUG\n"; 2047 interval => 10,
2048 cb => sub {
1367 (Coro::unblock_sub { 2049 (Coro::unblock_sub {
1368 Event::one_event; 2050 write_runtime
2051 or warn "ERROR: unable to write runtime file: $!";
1369 })->(); 2052 })->();
1370}; 2053 },
2054);
1371 2055
13721 20561
1373 2057

Diff Legend

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