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.133 by root, Thu Jan 4 16:19:32 2007 UTC vs.
Revision 1.140 by root, Fri Jan 5 20:04:02 2007 UTC

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 = ();
179sub to_json($) { 179sub to_json($) {
180 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 180 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
181 JSON::Syck::Dump $_[0] 181 JSON::Syck::Dump $_[0]
182} 182}
183 183
184=item my $guard = cf::guard { BLOCK }
185
186Run the given callback when the guard object gets destroyed (useful for
187coroutine cancellations).
188
189You can call C<< ->cancel >> on the guard object to stop the block from
190being executed.
191
192=cut
193
194sub guard(&) {
195 bless \(my $cb = $_[0]), cf::guard::;
196}
197
198sub cf::guard::cancel {
199 ${$_[0]} = sub { };
200}
201
202sub cf::guard::DESTROY {
203 ${$_[0]}->();
204}
205
206=item cf::lock_wait $string 184=item cf::lock_wait $string
207 185
208Wait until the given lock is available. See cf::lock_acquire. 186Wait until the given lock is available. See cf::lock_acquire.
209 187
210=item my $lock = cf::lock_acquire $string 188=item my $lock = cf::lock_acquire $string
211 189
212Wait until the given lock is available and then acquires it and returns 190Wait until the given lock is available and then acquires it and returns
213a guard object. If the guard object gets destroyed (goes out of scope, 191a Coro::guard object. If the guard object gets destroyed (goes out of scope,
214for example when the coroutine gets canceled), the lock is automatically 192for example when the coroutine gets canceled), the lock is automatically
215returned. 193returned.
216 194
217Lock names should begin with a unique identifier (for example, cf::map::find 195Lock names should begin with a unique identifier (for example, cf::map::find
218uses map_find and cf::map::load uses map_load). 196uses map_find and cf::map::load uses map_load).
237 # wait, to be sure we are not locked 215 # wait, to be sure we are not locked
238 lock_wait $key; 216 lock_wait $key;
239 217
240 $LOCK{$key} = []; 218 $LOCK{$key} = [];
241 219
242 cf::guard { 220 Coro::guard {
243 # wake up all waiters, to be on the safe side 221 # wake up all waiters, to be on the safe side
244 $_->ready for @{ delete $LOCK{$key} }; 222 $_->ready for @{ delete $LOCK{$key} };
245 } 223 }
246} 224}
247 225
248=item cf::async { BLOCK }
249
250Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the
251error instead of exiting the server in case of a problem.
252
253=cut
254
255sub async(&) {
256 my ($cb) = @_;
257
258 Coro::async {
259 eval { $cb->() };
260 warn $@ if $@;
261 }
262}
263
264sub freeze_mainloop { 226sub freeze_mainloop {
265 return unless $TICK_WATCHER->is_active; 227 return unless $TICK_WATCHER->is_active;
266 228
267 my $guard = guard { $TICK_WATCHER->start }; 229 my $guard = Coro::guard { $TICK_WATCHER->start };
268 $TICK_WATCHER->stop; 230 $TICK_WATCHER->stop;
269 $guard 231 $guard
270} 232}
233
234=item cf::async { BLOCK }
235
236Currently the same as Coro::async_pool, meaning you cannot use
237C<on_destroy>, C<join> or other gimmicks on these coroutines. The only
238thing you are allowed to do is call C<prio> on it.
239
240=cut
241
242BEGIN { *async = \&Coro::async_pool }
271 243
272=item cf::sync_job { BLOCK } 244=item cf::sync_job { BLOCK }
273 245
274The design of crossfire+ requires that the main coro ($Coro::main) is 246The design of crossfire+ requires that the main coro ($Coro::main) is
275always able to handle events or runnable, as crossfire+ is only partly 247always able to handle events or runnable, as crossfire+ is only partly
294 my $freeze_guard = freeze_mainloop; 266 my $freeze_guard = freeze_mainloop;
295 267
296 my $busy = 1; 268 my $busy = 1;
297 my @res; 269 my @res;
298 270
299 (Coro::async { 271 (async {
300 @res = eval { $job->() }; 272 @res = eval { $job->() };
301 warn $@ if $@; 273 warn $@ if $@;
302 undef $busy; 274 undef $busy;
303 })->prio (Coro::PRIO_MAX); 275 })->prio (Coro::PRIO_MAX);
304 276
305 while ($busy) { 277 while ($busy) {
306 Coro::cede_notself; 278 unless (Coro::cede) {
307 Event::one_event unless Coro::nready; 279 Coro::nready ? Event::one_event 0 : Event::one_event;
280 Coro::cede_notself unless Coro::cede;
281 }
308 } 282 }
309 283
310 wantarray ? @res : $res[0] 284 wantarray ? @res : $res[0]
311 } else { 285 } else {
312 # we are in another coroutine, how wonderful, everything just works 286 # we are in another coroutine, how wonderful, everything just works
313 287
314 $job->() 288 $job->()
315 } 289 }
316} 290}
317 291
318=item $coro = cf::coro { BLOCK } 292=item $coro = cf::async_ext { BLOCK }
319 293
320Creates and returns a new coro. This coro is automcatially being canceled 294Like async, but this coro is automcatially being canceled when the
321when the extension calling this is being unloaded. 295extension calling this is being unloaded.
322 296
323=cut 297=cut
324 298
325sub coro(&) { 299sub async_ext(&) {
326 my $cb = shift; 300 my $cb = shift;
327 301
328 my $coro = &cf::async ($cb); 302 my $coro = &Coro::async ($cb);
329 303
330 $coro->on_destroy (sub { 304 $coro->on_destroy (sub {
331 delete $EXT_CORO{$coro+0}; 305 delete $EXT_CORO{$coro+0};
332 }); 306 });
333 $EXT_CORO{$coro+0} = $coro; 307 $EXT_CORO{$coro+0} = $coro;
1184 or return; 1158 or return;
1185 1159
1186 my $map = cf::map::new 1160 my $map = cf::map::new
1187 or return; 1161 or return;
1188 1162
1163 # for better error messages only, will be overwritten
1164 $map->path ($path);
1165
1189 $map->load_header ($path) 1166 $map->load_header ($path)
1190 or return; 1167 or return;
1191 1168
1192 $map->{load_path} = $path; 1169 $map->{load_path} = $path;
1193 1170
1208 $cf::MAP{$key} || do { 1185 $cf::MAP{$key} || do {
1209 my $guard = cf::lock_acquire "map_find:$key"; 1186 my $guard = cf::lock_acquire "map_find:$key";
1210 1187
1211 # do it the slow way 1188 # do it the slow way
1212 my $map = try_load_header $path->save_path; 1189 my $map = try_load_header $path->save_path;
1190
1191 Coro::cede;
1213 1192
1214 if ($map) { 1193 if ($map) {
1215 $map->last_access ((delete $map->{last_access}) 1194 $map->last_access ((delete $map->{last_access})
1216 || $cf::RUNTIME); #d# 1195 || $cf::RUNTIME); #d#
1217 # safety 1196 # safety
1237 1216
1238 $map->path ($key); 1217 $map->path ($key);
1239 $map->{path} = $path; 1218 $map->{path} = $path;
1240 $map->{last_save} = $cf::RUNTIME; 1219 $map->{last_save} = $cf::RUNTIME;
1241 1220
1221 Coro::cede;
1222
1242 if ($map->should_reset) { 1223 if ($map->should_reset) {
1243 $map->reset; 1224 $map->reset;
1244 undef $guard; 1225 undef $guard;
1245 $map = find $path 1226 $map = find $path
1246 or return; 1227 or return;
1272 if (aio_open $uniq, O_RDONLY, 0) { 1253 if (aio_open $uniq, O_RDONLY, 0) {
1273 $self->clear_unique_items; 1254 $self->clear_unique_items;
1274 $self->load_objects ($uniq, 0); 1255 $self->load_objects ($uniq, 0);
1275 } 1256 }
1276 } 1257 }
1258
1259 Coro::cede;
1277 1260
1278 # now do the right thing for maps 1261 # now do the right thing for maps
1279 $self->link_multipart_objects; 1262 $self->link_multipart_objects;
1280 1263
1281 if ($self->{path}->is_style_map) { 1264 if ($self->{path}->is_style_map) {
1289 $self->difficulty ($self->estimate_difficulty) 1272 $self->difficulty ($self->estimate_difficulty)
1290 unless $self->difficulty; 1273 unless $self->difficulty;
1291 $self->activate; 1274 $self->activate;
1292 } 1275 }
1293 1276
1277 Coro::cede;
1278
1294 $self->in_memory (cf::MAP_IN_MEMORY); 1279 $self->in_memory (cf::MAP_IN_MEMORY);
1295} 1280}
1296 1281
1297sub find_sync { 1282sub find_sync {
1298 my ($path, $origin) = @_; 1283 my ($path, $origin) = @_;
1306 cf::sync_job { $map->load }; 1291 cf::sync_job { $map->load };
1307} 1292}
1308 1293
1309sub save { 1294sub save {
1310 my ($self) = @_; 1295 my ($self) = @_;
1296
1297 my $lock = cf::lock_acquire "map_data:" . $self->path;
1311 1298
1312 $self->{last_save} = $cf::RUNTIME; 1299 $self->{last_save} = $cf::RUNTIME;
1313 1300
1314 return unless $self->dirty; 1301 return unless $self->dirty;
1315 1302
1334 my ($self) = @_; 1321 my ($self) = @_;
1335 1322
1336 # save first because save cedes 1323 # save first because save cedes
1337 $self->save; 1324 $self->save;
1338 1325
1326 my $lock = cf::lock_acquire "map_data:" . $self->path;
1327
1339 return if $self->players; 1328 return if $self->players;
1340 return if $self->in_memory != cf::MAP_IN_MEMORY; 1329 return if $self->in_memory != cf::MAP_IN_MEMORY;
1341 return if $self->{deny_save}; 1330 return if $self->{deny_save};
1342 1331
1343 $self->clear; 1332 $self->clear;
1384 $self->save; 1373 $self->save;
1385} 1374}
1386 1375
1387sub reset { 1376sub reset {
1388 my ($self) = @_; 1377 my ($self) = @_;
1378
1379 my $lock = cf::lock_acquire "map_data:" . $self->path;
1389 1380
1390 return if $self->players; 1381 return if $self->players;
1391 return if $self->{path}{user_rel};#d# 1382 return if $self->{path}{user_rel};#d#
1392 1383
1393 warn "resetting map ", $self->path;#d# 1384 warn "resetting map ", $self->path;#d#
1559 my ($pl) = @_; 1550 my ($pl) = @_;
1560 1551
1561 # try to abort aborted map switching on player login :) 1552 # try to abort aborted map switching on player login :)
1562 # should happen only on crashes 1553 # should happen only on crashes
1563 if ($pl->ob->{_link_pos}) { 1554 if ($pl->ob->{_link_pos}) {
1555
1564 $pl->ob->enter_link; 1556 $pl->ob->enter_link;
1565 cf::async { 1557 (async {
1566 # we need this sleep as the login has a concurrent enter_exit running 1558 # we need this sleep as the login has a concurrent enter_exit running
1567 # and this sleep increases chances of the player not ending up in scorn 1559 # and this sleep increases chances of the player not ending up in scorn
1560 $pl->ob->reply (undef,
1561 "There was an internal problem at your last logout, "
1562 . "the server will try to bring you to your intended destination in a second.",
1563 cf::NDI_RED);
1568 Coro::Timer::sleep 1; 1564 Coro::Timer::sleep 1;
1569 $pl->ob->leave_link; 1565 $pl->ob->leave_link;
1570 }; 1566 })->prio (2);
1571 } 1567 }
1572 }, 1568 },
1573); 1569);
1574 1570
1575=item $player_object->goto_map ($path, $x, $y) 1571=item $player_object->goto ($path, $x, $y)
1576 1572
1577=cut 1573=cut
1578 1574
1579sub cf::object::player::goto_map { 1575sub cf::object::player::goto {
1580 my ($self, $path, $x, $y) = @_; 1576 my ($self, $path, $x, $y) = @_;
1581 1577
1582 $self->enter_link; 1578 $self->enter_link;
1583 1579
1584 (cf::async { 1580 (async {
1585 $path = new cf::path $path; 1581 $path = new cf::path $path;
1586 1582
1587 my $map = cf::map::find $path->as_string; 1583 my $map = cf::map::find $path->as_string;
1588 $map = $map->customise_for ($self) if $map; 1584 $map = $map->customise_for ($self) if $map;
1589 1585
1651 1647
1652 return unless $self->type == cf::PLAYER; 1648 return unless $self->type == cf::PLAYER;
1653 1649
1654 $self->enter_link; 1650 $self->enter_link;
1655 1651
1656 (cf::async { 1652 (async {
1657 $self->deactivate_recursive; # just to be sure 1653 $self->deactivate_recursive; # just to be sure
1658 unless (eval { 1654 unless (eval {
1659 prepare_random_map $exit 1655 prepare_random_map $exit
1660 if $exit->slaying eq "/!"; 1656 if $exit->slaying eq "/!";
1661 1657
1662 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path; 1658 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1663 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp); 1659 $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
1664 1660
1665 1; 1661 1;
1666 }) { 1662 }) {
1667 $self->message ("Something went wrong deep within the crossfire server. " 1663 $self->message ("Something went wrong deep within the crossfire server. "
1668 . "I'll try to bring you back to the map you were before. " 1664 . "I'll try to bring you back to the map you were before. "
1742 } 1738 }
1743 } 1739 }
1744 }, 1740 },
1745); 1741);
1746 1742
1747=item $client->coro (\&cb) 1743=item $client->async (\&cb)
1748 1744
1749Create a new coroutine, running the specified callback. The coroutine will 1745Create a new coroutine, running the specified callback. The coroutine will
1750be automatically cancelled when the client gets destroyed (e.g. on logout, 1746be automatically cancelled when the client gets destroyed (e.g. on logout,
1751or loss of connection). 1747or loss of connection).
1752 1748
1753=cut 1749=cut
1754 1750
1755sub cf::client::coro { 1751sub cf::client::async {
1756 my ($self, $cb) = @_; 1752 my ($self, $cb) = @_;
1757 1753
1758 my $coro = &cf::async ($cb); 1754 my $coro = &Coro::async ($cb);
1759 1755
1760 $coro->on_destroy (sub { 1756 $coro->on_destroy (sub {
1761 delete $self->{_coro}{$coro+0}; 1757 delete $self->{_coro}{$coro+0};
1762 }); 1758 });
1763 1759
2001 local $/; 1997 local $/;
2002 *CFG = YAML::Syck::Load <$fh>; 1998 *CFG = YAML::Syck::Load <$fh>;
2003 1999
2004 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 2000 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
2005 2001
2002 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2003 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2004
2006 if (exists $CFG{mlockall}) { 2005 if (exists $CFG{mlockall}) {
2007 eval { 2006 eval {
2008 $CFG{mlockall} ? &mlockall : &munlockall 2007 $CFG{mlockall} ? &mlockall : &munlockall
2009 and die "WARNING: m(un)lockall failed: $!\n"; 2008 and die "WARNING: m(un)lockall failed: $!\n";
2010 }; 2009 };
2014 2013
2015sub main { 2014sub main {
2016 # we must not ever block the main coroutine 2015 # we must not ever block the main coroutine
2017 local $Coro::idle = sub { 2016 local $Coro::idle = sub {
2018 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 2017 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
2019 (Coro::unblock_sub {
2020 Event::one_event; 2018 async { Event::one_event };
2021 })->();
2022 }; 2019 };
2023 2020
2024 cfg_load; 2021 cfg_load;
2025 db_load; 2022 db_load;
2026 load_extensions; 2023 load_extensions;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines