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.131 by root, Thu Jan 4 00:53:54 2007 UTC vs.
Revision 1.150 by root, Mon Jan 8 19:25:53 2007 UTC

… …
17use Coro::Semaphore; 17use Coro::Semaphore;
18use Coro::AIO; 18use Coro::AIO;
19 19
20use Digest::MD5; 20use Digest::MD5;
21use Fcntl; 21use Fcntl;
22use IO::AIO 2.31 (); 22use IO::AIO 2.32 ();
23use YAML::Syck (); 23use YAML::Syck ();
24use Time::HiRes; 24use Time::HiRes;
25 25
26use 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
27 27
28# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? 28# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
29$YAML::Syck::ImplicitUnicode = 1; 29$YAML::Syck::ImplicitUnicode = 1;
30 30
31$Coro::main->prio (2); # run main coroutine ("the server") with very high priority 31$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
32 32
33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload 33sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
34 34
35our %COMMAND = (); 35our %COMMAND = ();
36our %COMMAND_TIME = (); 36our %COMMAND_TIME = ();
… …
47our %CFG; 47our %CFG;
48 48
49our $UPTIME; $UPTIME ||= time; 49our $UPTIME; $UPTIME ||= time;
50our $RUNTIME; 50our $RUNTIME;
51 51
52our %PLAYER; # all users
52our %MAP; # all maps 53our %MAP; # all maps
53our $LINK_MAP; # the special {link} map 54our $LINK_MAP; # the special {link} map
54our $FREEZE;
55our $RANDOM_MAPS = cf::localdir . "/random"; 55our $RANDOM_MAPS = cf::localdir . "/random";
56our %EXT_CORO; 56our %EXT_CORO; # coroutines bound to extensions
57 57
58binmode STDOUT; 58binmode STDOUT;
59binmode STDERR; 59binmode STDERR;
60 60
61# read virtual server time, if available 61# read virtual server time, if available
… …
118 utf8::encode $msg; 118 utf8::encode $msg;
119 119
120 $msg .= "\n" 120 $msg .= "\n"
121 unless $msg =~ /\n$/; 121 unless $msg =~ /\n$/;
122 122
123 LOG llevError, "cfperl: $msg"; 123 LOG llevError, $msg;
124 }; 124 };
125} 125}
126 126
127@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable'; 127@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
128@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable'; 128@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
… …
180sub to_json($) { 180sub to_json($) {
181 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 181 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
182 JSON::Syck::Dump $_[0] 182 JSON::Syck::Dump $_[0]
183} 183}
184 184
185=item my $guard = cf::guard { BLOCK }
186
187Run the given callback when the guard object gets destroyed (useful for
188coroutine cancellations).
189
190You can call C<< ->cancel >> on the guard object to stop the block from
191being executed.
192
193=cut
194
195sub guard(&) {
196 bless \(my $cb = $_[0]), cf::guard::;
197}
198
199sub cf::guard::cancel {
200 ${$_[0]} = sub { };
201}
202
203sub cf::guard::DESTROY {
204 ${$_[0]}->();
205}
206
207=item cf::lock_wait $string 185=item cf::lock_wait $string
208 186
209Wait until the given lock is available. See cf::lock_acquire. 187Wait until the given lock is available. See cf::lock_acquire.
210 188
211=item my $lock = cf::lock_acquire $string 189=item my $lock = cf::lock_acquire $string
212 190
213Wait until the given lock is available and then acquires it and returns 191Wait until the given lock is available and then acquires it and returns
214a guard object. If the guard object gets destroyed (goes out of scope, 192a Coro::guard object. If the guard object gets destroyed (goes out of scope,
215for example when the coroutine gets canceled), the lock is automatically 193for example when the coroutine gets canceled), the lock is automatically
216returned. 194returned.
217 195
218Lock names should begin with a unique identifier (for example, find_map 196Lock names should begin with a unique identifier (for example, cf::map::find
219uses map_find and load_map uses map_load). 197uses map_find and cf::map::load uses map_load).
220 198
221=cut 199=cut
222 200
223our %LOCK; 201our %LOCK;
224 202
… …
238 # wait, to be sure we are not locked 216 # wait, to be sure we are not locked
239 lock_wait $key; 217 lock_wait $key;
240 218
241 $LOCK{$key} = []; 219 $LOCK{$key} = [];
242 220
243 cf::guard { 221 Coro::guard {
244 # wake up all waiters, to be on the safe side 222 # wake up all waiters, to be on the safe side
245 $_->ready for @{ delete $LOCK{$key} }; 223 $_->ready for @{ delete $LOCK{$key} };
246 } 224 }
247} 225}
248 226
227sub freeze_mainloop {
228 return unless $TICK_WATCHER->is_active;
229
230 my $guard = Coro::guard { $TICK_WATCHER->start };
231 $TICK_WATCHER->stop;
232 $guard
233}
234
249=item cf::async { BLOCK } 235=item cf::async { BLOCK }
250 236
251Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the 237Currently the same as Coro::async_pool, meaning you cannot use
252error instead of exiting the server in case of a problem. 238C<on_destroy>, C<join> or other gimmicks on these coroutines. The only
239thing you are allowed to do is call C<prio> on it.
253 240
254=cut 241=cut
255 242
256sub async(&) { 243BEGIN { *async = \&Coro::async_pool }
257 my ($cb) = @_;
258
259 Coro::async {
260 eval { $cb->() };
261 warn $@ if $@;
262 }
263}
264 244
265=item cf::sync_job { BLOCK } 245=item cf::sync_job { BLOCK }
266 246
267The design of crossfire+ requires that the main coro ($Coro::main) is 247The design of crossfire+ requires that the main coro ($Coro::main) is
268always able to handle events or runnable, as crossfire+ is only partly 248always able to handle events or runnable, as crossfire+ is only partly
… …
282 # this is the main coro, too bad, we have to block 262 # this is the main coro, too bad, we have to block
283 # till the operation succeeds, freezing the server :/ 263 # till the operation succeeds, freezing the server :/
284 264
285 # TODO: use suspend/resume instead 265 # TODO: use suspend/resume instead
286 # (but this is cancel-safe) 266 # (but this is cancel-safe)
287 local $FREEZE = 1; 267 my $freeze_guard = freeze_mainloop;
288 268
289 my $busy = 1; 269 my $busy = 1;
290 my @res; 270 my @res;
291 271
292 (Coro::async { 272 (async {
293 @res = eval { $job->() }; 273 @res = eval { $job->() };
294 warn $@ if $@; 274 warn $@ if $@;
295 undef $busy; 275 undef $busy;
296 })->prio (Coro::PRIO_MAX); 276 })->prio (Coro::PRIO_MAX);
297 277
298 while ($busy) { 278 while ($busy) {
299 Coro::cede_notself; 279 Coro::cede or Event::one_event;
300 Event::one_event unless Coro::nready;
301 } 280 }
302 281
303 wantarray ? @res : $res[0] 282 wantarray ? @res : $res[0]
304 } else { 283 } else {
305 # we are in another coroutine, how wonderful, everything just works 284 # we are in another coroutine, how wonderful, everything just works
306 285
307 $job->() 286 $job->()
308 } 287 }
309} 288}
310 289
311=item $coro = cf::coro { BLOCK } 290=item $coro = cf::async_ext { BLOCK }
312 291
313Creates and returns a new coro. This coro is automcatially being canceled 292Like async, but this coro is automcatially being canceled when the
314when the extension calling this is being unloaded. 293extension calling this is being unloaded.
315 294
316=cut 295=cut
317 296
318sub coro(&) { 297sub async_ext(&) {
319 my $cb = shift; 298 my $cb = shift;
320 299
321 my $coro = &cf::async ($cb); 300 my $coro = &Coro::async ($cb);
322 301
323 $coro->on_destroy (sub { 302 $coro->on_destroy (sub {
324 delete $EXT_CORO{$coro+0}; 303 delete $EXT_CORO{$coro+0};
325 }); 304 });
326 $EXT_CORO{$coro+0} = $coro; 305 $EXT_CORO{$coro+0} = $coro;
… …
1093 1072
1094=head2 CORE EXTENSIONS 1073=head2 CORE EXTENSIONS
1095 1074
1096Functions and methods that extend core crossfire objects. 1075Functions and methods that extend core crossfire objects.
1097 1076
1077=cut
1078
1079package cf::player;
1080
1098=head3 cf::player 1081=head3 cf::player
1099 1082
1100=over 4 1083=over 4
1101 1084
1102=item cf::player::exists $login 1085=item cf::player::find $login
1103 1086
1104Returns true when the given account exists. 1087Returns the given player object, loading it if necessary (might block).
1105 1088
1106=cut 1089=cut
1107 1090
1108sub cf::player::exists($) { 1091sub playerdir($) {
1109 cf::player::find $_[0] 1092 cf::localdir
1110 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 1093 . "/"
1094 . cf::playerdir
1095 . "/"
1096 . (ref $_[0] ? $_[0]->ob->name : $_[0])
1097}
1098
1099sub path($) {
1100 my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
1101
1102 (playerdir $login) . "/$login.pl"
1103}
1104
1105sub find_active($) {
1106 $cf::PLAYER{$_[0]}
1107 and $cf::PLAYER{$_[0]}->active
1108 and $cf::PLAYER{$_[0]}
1109}
1110
1111sub exists($) {
1112 my ($login) = @_;
1113
1114 $cf::PLAYER{$login}
1115 or cf::sync_job { !aio_stat $login }
1116}
1117
1118sub find($) {
1119 return $cf::PLAYER{$_[0]} || do {
1120 my $login = $_[0];
1121
1122 my $guard = cf::lock_acquire "user_find:$login";
1123
1124 $cf::PLAYER{$login} ||= (load_pl path $login or return);
1125 };
1126}
1127
1128sub save($) {
1129 my ($pl) = @_;
1130
1131 return if $pl->{deny_save};
1132
1133 my $path = path $pl;
1134 my $guard = cf::lock_acquire "user_save:$path";
1135
1136 return if $pl->{deny_save};
1137
1138 Coro::AIO::aio_mkdir playerdir $pl, 0770;
1139 $pl->{last_save} = $cf::RUNTIME;
1140
1141 $pl->save_pl ($path);
1142 Coro::cede;
1143}
1144
1145sub new($) {
1146 my ($login) = @_;
1147
1148 my $self = create;
1149
1150 $self->ob->name ($login);
1151 $self->{deny_save} = 1;
1152
1153 $cf::PLAYER{$login} = $self;
1154
1155 $self
1156}
1157
1158sub quit_character {
1159 my ($pl) = @_;
1160
1161 $pl->{deny_save} = 1;
1162 $pl->password ("*"); # this should lock out the player until we nuked the dir
1163
1164 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1165 $pl->deactivate;
1166 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1167 $pl->ns->destroy if $pl->ns;
1168
1169 my $path = playerdir $pl;
1170 my $temp = "$path~$cf::RUNTIME~deleting~";
1171 Coro::AIO::aio_rename $path, $temp;
1172 delete $cf::PLAYER{$pl->ob->name};
1173 $pl->destroy;
1174 IO::AIO::aio_rmtree $temp;
1111} 1175}
1112 1176
1113=item $player->ext_reply ($msgid, $msgtype, %msg) 1177=item $player->ext_reply ($msgid, $msgtype, %msg)
1114 1178
1115Sends an ext reply to the player. 1179Sends an ext reply to the player.
1116 1180
1117=cut 1181=cut
1118 1182
1119sub cf::player::ext_reply($$$%) { 1183sub ext_reply($$$%) {
1120 my ($self, $id, %msg) = @_; 1184 my ($self, $id, %msg) = @_;
1121 1185
1122 $msg{msgid} = $id; 1186 $msg{msgid} = $id;
1123 1187
1124 $self->send ("ext " . to_json \%msg); 1188 $self->send ("ext " . cf::to_json \%msg);
1125} 1189}
1190
1191package cf;
1126 1192
1127=back 1193=back
1128 1194
1129 1195
1130=head3 cf::map 1196=head3 cf::map
… …
1136package cf::map; 1202package cf::map;
1137 1203
1138use Fcntl; 1204use Fcntl;
1139use Coro::AIO; 1205use Coro::AIO;
1140 1206
1141our $MAX_RESET = 7200; 1207our $MAX_RESET = 3600;
1142our $DEFAULT_RESET = 3600; 1208our $DEFAULT_RESET = 3000;
1143 1209
1144sub generate_random_map { 1210sub generate_random_map {
1145 my ($path, $rmp) = @_; 1211 my ($path, $rmp) = @_;
1146 1212
1147 # mit "rum" bekleckern, nicht 1213 # mit "rum" bekleckern, nicht
… …
1177 or return; 1243 or return;
1178 1244
1179 my $map = cf::map::new 1245 my $map = cf::map::new
1180 or return; 1246 or return;
1181 1247
1248 # for better error messages only, will be overwritten
1249 $map->path ($path);
1250
1182 $map->load_header ($path) 1251 $map->load_header ($path)
1183 or return; 1252 or return;
1184 1253
1185 $map->{load_path} = $path; 1254 $map->{load_path} = $path;
1186 1255
1187 $map 1256 $map
1188} 1257}
1189 1258
1190sub find_map; 1259sub find;
1191sub find_map { 1260sub find {
1192 my ($path, $origin) = @_; 1261 my ($path, $origin) = @_;
1193 1262
1194 #warn "find_map<$path,$origin>\n";#d# 1263 #warn "find<$path,$origin>\n";#d#
1195 1264
1196 $path = new cf::path $path, $origin && $origin->path; 1265 $path = new cf::path $path, $origin && $origin->path;
1197 my $key = $path->as_string; 1266 my $key = $path->as_string;
1198 1267
1199 cf::lock_wait "map_find:$key"; 1268 cf::lock_wait "map_find:$key";
… …
1202 my $guard = cf::lock_acquire "map_find:$key"; 1271 my $guard = cf::lock_acquire "map_find:$key";
1203 1272
1204 # do it the slow way 1273 # do it the slow way
1205 my $map = try_load_header $path->save_path; 1274 my $map = try_load_header $path->save_path;
1206 1275
1276 Coro::cede;
1277
1207 if ($map) { 1278 if ($map) {
1279 $map->last_access ((delete $map->{last_access})
1280 || $cf::RUNTIME); #d#
1208 # safety 1281 # safety
1209 $map->{instantiate_time} = $cf::RUNTIME 1282 $map->{instantiate_time} = $cf::RUNTIME
1210 if $map->{instantiate_time} > $cf::RUNTIME; 1283 if $map->{instantiate_time} > $cf::RUNTIME;
1211 } else { 1284 } else {
1212 if (my $rmp = $path->random_map_params) { 1285 if (my $rmp = $path->random_map_params) {
… …
1217 1290
1218 $map or return; 1291 $map or return;
1219 1292
1220 $map->{load_original} = 1; 1293 $map->{load_original} = 1;
1221 $map->{instantiate_time} = $cf::RUNTIME; 1294 $map->{instantiate_time} = $cf::RUNTIME;
1295 $map->last_access ($cf::RUNTIME);
1222 $map->instantiate; 1296 $map->instantiate;
1223 1297
1224 # per-player maps become, after loading, normal maps 1298 # per-player maps become, after loading, normal maps
1225 $map->per_player (0) if $path->{user_rel}; 1299 $map->per_player (0) if $path->{user_rel};
1226 } 1300 }
1227 1301
1228 $map->path ($key); 1302 $map->path ($key);
1229 $map->{path} = $path; 1303 $map->{path} = $path;
1230 $map->{last_save} = $cf::RUNTIME; 1304 $map->{last_save} = $cf::RUNTIME;
1231 $map->last_access ($cf::RUNTIME); 1305
1306 Coro::cede;
1232 1307
1233 if ($map->should_reset) { 1308 if ($map->should_reset) {
1234 $map->reset; 1309 $map->reset;
1235 undef $guard; 1310 undef $guard;
1236 $map = find_map $path 1311 $map = find $path
1237 or return; 1312 or return;
1238 } 1313 }
1239 1314
1240 $cf::MAP{$key} = $map 1315 $cf::MAP{$key} = $map
1241 } 1316 }
… …
1263 if (aio_open $uniq, O_RDONLY, 0) { 1338 if (aio_open $uniq, O_RDONLY, 0) {
1264 $self->clear_unique_items; 1339 $self->clear_unique_items;
1265 $self->load_objects ($uniq, 0); 1340 $self->load_objects ($uniq, 0);
1266 } 1341 }
1267 } 1342 }
1343
1344 Coro::cede;
1268 1345
1269 # now do the right thing for maps 1346 # now do the right thing for maps
1270 $self->link_multipart_objects; 1347 $self->link_multipart_objects;
1271 1348
1272 if ($self->{path}->is_style_map) { 1349 if ($self->{path}->is_style_map) {
… …
1280 $self->difficulty ($self->estimate_difficulty) 1357 $self->difficulty ($self->estimate_difficulty)
1281 unless $self->difficulty; 1358 unless $self->difficulty;
1282 $self->activate; 1359 $self->activate;
1283 } 1360 }
1284 1361
1362 Coro::cede;
1363
1285 $self->in_memory (cf::MAP_IN_MEMORY); 1364 $self->in_memory (cf::MAP_IN_MEMORY);
1286} 1365}
1287 1366
1288sub load_map_sync { 1367sub find_sync {
1289 my ($path, $origin) = @_; 1368 my ($path, $origin) = @_;
1290 1369
1291 #warn "load_map_sync<$path, $origin>\n";#d# 1370 cf::sync_job { cf::map::find $path, $origin }
1371}
1292 1372
1293 cf::sync_job { 1373sub do_load_sync {
1294 my $map = cf::map::find_map $path, $origin 1374 my ($map) = @_;
1295 or return; 1375
1296 $map->load; 1376 cf::sync_job { $map->load };
1297 $map
1298 }
1299} 1377}
1300 1378
1301sub save { 1379sub save {
1302 my ($self) = @_; 1380 my ($self) = @_;
1303 1381
1382 my $lock = cf::lock_acquire "map_data:" . $self->path;
1383
1304 $self->{last_save} = $cf::RUNTIME; 1384 $self->{last_save} = $cf::RUNTIME;
1305 1385
1306 return unless $self->dirty; 1386 return unless $self->dirty;
1307 1387
1308 my $save = $self->{path}->save_path; utf8::encode $save; 1388 my $save = $self->{path}->save_path; utf8::encode $save;
1309 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq; 1389 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1310 1390
1311 $self->{load_path} = $save; 1391 $self->{load_path} = $save;
1312 1392
1313 return if $self->{deny_save}; 1393 return if $self->{deny_save};
1394
1395 local $self->{last_access} = $self->last_access;#d#
1396
1397 cf::async {
1398 $_->contr->save for $self->players;
1399 };
1314 1400
1315 if ($uniq) { 1401 if ($uniq) {
1316 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1402 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1317 $self->save_objects ($uniq, cf::IO_UNIQUES); 1403 $self->save_objects ($uniq, cf::IO_UNIQUES);
1318 } else { 1404 } else {
… …
1324 my ($self) = @_; 1410 my ($self) = @_;
1325 1411
1326 # save first because save cedes 1412 # save first because save cedes
1327 $self->save; 1413 $self->save;
1328 1414
1415 my $lock = cf::lock_acquire "map_data:" . $self->path;
1416
1329 return if $self->players; 1417 return if $self->players;
1330 return if $self->in_memory != cf::MAP_IN_MEMORY; 1418 return if $self->in_memory != cf::MAP_IN_MEMORY;
1331 return if $self->{deny_save}; 1419 return if $self->{deny_save};
1332 1420
1333 $self->clear; 1421 $self->clear;
… …
1375} 1463}
1376 1464
1377sub reset { 1465sub reset {
1378 my ($self) = @_; 1466 my ($self) = @_;
1379 1467
1468 my $lock = cf::lock_acquire "map_data:" . $self->path;
1469
1380 return if $self->players; 1470 return if $self->players;
1381 return if $self->{path}{user_rel};#d# 1471 return if $self->{path}{user_rel};#d#
1382 1472
1383 warn "resetting map ", $self->path;#d# 1473 warn "resetting map ", $self->path;#d#
1384 1474
… …
1403 1493
1404sub customise_for { 1494sub customise_for {
1405 my ($map, $ob) = @_; 1495 my ($map, $ob) = @_;
1406 1496
1407 if ($map->per_player) { 1497 if ($map->per_player) {
1408 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path}; 1498 return cf::map::find "~" . $ob->name . "/" . $map->{path}{path};
1409 } 1499 }
1410 1500
1411 $map 1501 $map
1412} 1502}
1413 1503
1414sub emergency_save { 1504sub emergency_save {
1415 local $cf::FREEZE = 1; 1505 my $freeze_guard = cf::freeze_mainloop;
1416 1506
1417 warn "enter emergency map save\n"; 1507 warn "enter emergency perl save\n";
1418 1508
1419 cf::sync_job { 1509 cf::sync_job {
1510 warn "begin emergency player save\n";
1511 $_->save for values %cf::PLAYER;
1512 warn "end emergency player save\n";
1513
1420 warn "begin emergency map save\n"; 1514 warn "begin emergency map save\n";
1421 $_->save for values %cf::MAP; 1515 $_->save for values %cf::MAP;
1516 warn "end emergency map save\n";
1422 }; 1517 };
1423 1518
1424 warn "end emergency map save\n"; 1519 warn "leave emergency perl save\n";
1425} 1520}
1426 1521
1427package cf; 1522package cf;
1428 1523
1429=back 1524=back
… …
1510 my $link_pos = delete $self->{_link_pos}; 1605 my $link_pos = delete $self->{_link_pos};
1511 1606
1512 unless ($map) { 1607 unless ($map) {
1513 # restore original map position 1608 # restore original map position
1514 ($map, $x, $y) = @{ $link_pos || [] }; 1609 ($map, $x, $y) = @{ $link_pos || [] };
1515 $map = cf::map::find_map $map; 1610 $map = cf::map::find $map;
1516 1611
1517 unless ($map) { 1612 unless ($map) {
1518 ($map, $x, $y) = @$EMERGENCY_POSITION; 1613 ($map, $x, $y) = @$EMERGENCY_POSITION;
1519 $map = cf::map::find_map $map 1614 $map = cf::map::find $map
1520 or die "FATAL: cannot load emergency map\n"; 1615 or die "FATAL: cannot load emergency map\n";
1521 } 1616 }
1522 } 1617 }
1523 1618
1524 ($x, $y) = (-1, -1) 1619 ($x, $y) = (-1, -1)
… …
1528 ($x, $y) = ($map->enter_x, $map->enter_y) 1623 ($x, $y) = ($map->enter_x, $map->enter_y)
1529 if $x <=0 && $y <= 0; 1624 if $x <=0 && $y <= 0;
1530 1625
1531 $map->load; 1626 $map->load;
1532 1627
1628 return unless $self->contr->active;
1533 $self->activate_recursive; 1629 $self->activate_recursive;
1534 $self->enter_map ($map, $x, $y); 1630 $self->enter_map ($map, $x, $y);
1535} 1631}
1536 1632
1537cf::player->attach ( 1633cf::player->attach (
… …
1550 1646
1551 # try to abort aborted map switching on player login :) 1647 # try to abort aborted map switching on player login :)
1552 # should happen only on crashes 1648 # should happen only on crashes
1553 if ($pl->ob->{_link_pos}) { 1649 if ($pl->ob->{_link_pos}) {
1554 $pl->ob->enter_link; 1650 $pl->ob->enter_link;
1555 cf::async { 1651 (async {
1556 # we need this sleep as the login has a concurrent enter_exit running 1652 # we need this sleep as the login has a concurrent enter_exit running
1557 # and this sleep increases chances of the player not ending up in scorn 1653 # and this sleep increases chances of the player not ending up in scorn
1654 $pl->ob->reply (undef,
1655 "There was an internal problem at your last logout, "
1656 . "the server will try to bring you to your intended destination in a second.",
1657 cf::NDI_RED);
1558 Coro::Timer::sleep 1; 1658 Coro::Timer::sleep 1;
1559 $pl->ob->leave_link; 1659 $pl->ob->leave_link;
1560 }; 1660 })->prio (2);
1561 } 1661 }
1562 }, 1662 },
1563); 1663);
1564 1664
1565=item $player_object->goto_map ($path, $x, $y) 1665=item $player_object->goto ($path, $x, $y)
1566 1666
1567=cut 1667=cut
1568 1668
1569sub cf::object::player::goto_map { 1669sub cf::object::player::goto {
1570 my ($self, $path, $x, $y) = @_; 1670 my ($self, $path, $x, $y) = @_;
1571 1671
1572 $self->enter_link; 1672 $self->enter_link;
1573 1673
1574 (cf::async { 1674 (async {
1575 $path = new cf::path $path; 1675 $path = new cf::path $path;
1576 1676
1577 my $map = cf::map::find_map $path->as_string; 1677 my $map = cf::map::find $path->as_string;
1578 $map = $map->customise_for ($self) if $map; 1678 $map = $map->customise_for ($self) if $map;
1579 1679
1580# warn "entering ", $map->path, " at ($x, $y)\n" 1680# warn "entering ", $map->path, " at ($x, $y)\n"
1581# if $map; 1681# if $map;
1582 1682
1683 $map or $map->cluck ("oy");#d#
1583 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1684 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1584 1685
1585 $self->leave_link ($map, $x, $y); 1686 $self->leave_link ($map, $x, $y);
1586 })->prio (1); 1687 })->prio (1);
1587} 1688}
1588 1689
… …
1641 1742
1642 return unless $self->type == cf::PLAYER; 1743 return unless $self->type == cf::PLAYER;
1643 1744
1644 $self->enter_link; 1745 $self->enter_link;
1645 1746
1646 (cf::async { 1747 (async {
1748 $self->deactivate_recursive; # just to be sure
1647 unless (eval { 1749 unless (eval {
1648 prepare_random_map $exit 1750 prepare_random_map $exit
1649 if $exit->slaying eq "/!"; 1751 if $exit->slaying eq "/!";
1650 1752
1651 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path; 1753 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1652 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp); 1754 $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
1653 1755
1654 1; 1756 1;
1655 }) { 1757 }) {
1656 $self->message ("Something went wrong deep within the crossfire server. " 1758 $self->message ("Something went wrong deep within the crossfire server. "
1657 . "I'll try to bring you back to the map you were before. " 1759 . "I'll try to bring you back to the map you were before. "
… …
1731 } 1833 }
1732 } 1834 }
1733 }, 1835 },
1734); 1836);
1735 1837
1736=item $client->coro (\&cb) 1838=item $client->async (\&cb)
1737 1839
1738Create a new coroutine, running the specified callback. The coroutine will 1840Create a new coroutine, running the specified callback. The coroutine will
1739be automatically cancelled when the client gets destroyed (e.g. on logout, 1841be automatically cancelled when the client gets destroyed (e.g. on logout,
1740or loss of connection). 1842or loss of connection).
1741 1843
1742=cut 1844=cut
1743 1845
1744sub cf::client::coro { 1846sub cf::client::async {
1745 my ($self, $cb) = @_; 1847 my ($self, $cb) = @_;
1746 1848
1747 my $coro = &cf::async ($cb); 1849 my $coro = &Coro::async ($cb);
1748 1850
1749 $coro->on_destroy (sub { 1851 $coro->on_destroy (sub {
1750 delete $self->{_coro}{$coro+0}; 1852 delete $self->{_coro}{$coro+0};
1751 }); 1853 });
1752 1854
… …
1990 local $/; 2092 local $/;
1991 *CFG = YAML::Syck::Load <$fh>; 2093 *CFG = YAML::Syck::Load <$fh>;
1992 2094
1993 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 2095 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
1994 2096
2097 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2098 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2099
1995 if (exists $CFG{mlockall}) { 2100 if (exists $CFG{mlockall}) {
1996 eval { 2101 eval {
1997 $CFG{mlockall} ? &mlockall : &munlockall 2102 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
1998 and die "WARNING: m(un)lockall failed: $!\n"; 2103 and die "WARNING: m(un)lockall failed: $!\n";
1999 }; 2104 };
2000 warn $@ if $@; 2105 warn $@ if $@;
2001 } 2106 }
2002} 2107}
2003 2108
2004sub main { 2109sub main {
2005 # we must not ever block the main coroutine 2110 # we must not ever block the main coroutine
2006 local $Coro::idle = sub { 2111 local $Coro::idle = sub {
2007 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 2112 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
2008 (Coro::unblock_sub {
2009 Event::one_event; 2113 async { Event::one_event };
2010 })->();
2011 }; 2114 };
2012 2115
2013 cfg_load; 2116 cfg_load;
2014 db_load; 2117 db_load;
2015 load_extensions; 2118 load_extensions;
… …
2026 return; 2129 return;
2027 } 2130 }
2028 2131
2029 warn "reloading..."; 2132 warn "reloading...";
2030 2133
2031 local $FREEZE = 1; 2134 my $guard = freeze_mainloop;
2032 cf::emergency_save; 2135 cf::emergency_save;
2033 2136
2034 eval { 2137 eval {
2035 # if anything goes wrong in here, we should simply crash as we already saved 2138 # if anything goes wrong in here, we should simply crash as we already saved
2036 2139
… …
2098 cf::load_extensions; 2201 cf::load_extensions;
2099 2202
2100 # reattach attachments to objects 2203 # reattach attachments to objects
2101 warn "reattach"; 2204 warn "reattach";
2102 _global_reattach; 2205 _global_reattach;
2206 reattach $_ for values %MAP;
2103 }; 2207 };
2104 2208
2105 if ($@) { 2209 if ($@) {
2106 warn $@; 2210 warn $@;
2107 warn "error while reloading, exiting."; 2211 warn "error while reloading, exiting.";
… …
2123 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2227 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2124 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2228 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2125 2229
2126 # dirty hack because... archetypes are not yet loaded 2230 # dirty hack because... archetypes are not yet loaded
2127 Event->timer ( 2231 Event->timer (
2128 after => 2, 2232 after => 10,
2129 cb => sub { 2233 cb => sub {
2130 $_[0]->w->cancel; 2234 $_[0]->w->cancel;
2131 2235
2132 # provide some exits "home" 2236 # provide some exits "home"
2133 my $exit = cf::object::new "exit"; 2237 my $exit = cf::object::new "exit";
… …
2172 reentrant => 0, 2276 reentrant => 0,
2173 prio => 0, 2277 prio => 0,
2174 at => $NEXT_TICK || $TICK, 2278 at => $NEXT_TICK || $TICK,
2175 data => WF_AUTOCANCEL, 2279 data => WF_AUTOCANCEL,
2176 cb => sub { 2280 cb => sub {
2177 unless ($FREEZE) {
2178 cf::server_tick; # one server iteration 2281 cf::server_tick; # one server iteration
2179 $RUNTIME += $TICK; 2282 $RUNTIME += $TICK;
2180 }
2181
2182 $NEXT_TICK += $TICK; 2283 $NEXT_TICK += $TICK;
2183 2284
2184 # if we are delayed by four ticks or more, skip them all 2285 # if we are delayed by four ticks or more, skip them all
2185 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4; 2286 $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2186 2287

Diff Legend

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