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.136 by root, Fri Jan 5 01:06:28 2007 UTC vs.
Revision 1.142 by root, Fri Jan 5 21:51:42 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 = ();
221 # wake up all waiters, to be on the safe side 221 # wake up all waiters, to be on the safe side
222 $_->ready for @{ delete $LOCK{$key} }; 222 $_->ready for @{ delete $LOCK{$key} };
223 } 223 }
224} 224}
225 225
226=item cf::async { BLOCK }
227
228Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the
229error instead of exiting the server in case of a problem.
230
231=cut
232
233sub async(&) {
234 my ($cb) = @_;
235
236 Coro::async {
237 eval { $cb->() };
238 warn $@ if $@;
239 }
240}
241
242sub freeze_mainloop { 226sub freeze_mainloop {
243 return unless $TICK_WATCHER->is_active; 227 return unless $TICK_WATCHER->is_active;
244 228
245 my $guard = Coro::guard { $TICK_WATCHER->start }; 229 my $guard = Coro::guard { $TICK_WATCHER->start };
246 $TICK_WATCHER->stop; 230 $TICK_WATCHER->stop;
247 $guard 231 $guard
248} 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 }
249 243
250=item cf::sync_job { BLOCK } 244=item cf::sync_job { BLOCK }
251 245
252The design of crossfire+ requires that the main coro ($Coro::main) is 246The design of crossfire+ requires that the main coro ($Coro::main) is
253always able to handle events or runnable, as crossfire+ is only partly 247always able to handle events or runnable, as crossfire+ is only partly
272 my $freeze_guard = freeze_mainloop; 266 my $freeze_guard = freeze_mainloop;
273 267
274 my $busy = 1; 268 my $busy = 1;
275 my @res; 269 my @res;
276 270
277 (Coro::async { 271 (async {
278 @res = eval { $job->() }; 272 @res = eval { $job->() };
279 warn $@ if $@; 273 warn $@ if $@;
280 undef $busy; 274 undef $busy;
281 })->prio (Coro::PRIO_MAX); 275 })->prio (Coro::PRIO_MAX);
282 276
283 while ($busy) { 277 while ($busy) {
284 Coro::cede_notself; 278 Coro::cede or Event::one_event;
285 Event::one_event unless Coro::nready;
286 } 279 }
287 280
288 wantarray ? @res : $res[0] 281 wantarray ? @res : $res[0]
289 } else { 282 } else {
290 # we are in another coroutine, how wonderful, everything just works 283 # we are in another coroutine, how wonderful, everything just works
291 284
292 $job->() 285 $job->()
293 } 286 }
294} 287}
295 288
296=item $coro = cf::coro { BLOCK } 289=item $coro = cf::async_ext { BLOCK }
297 290
298Creates and returns a new coro. This coro is automcatially being canceled 291Like async, but this coro is automcatially being canceled when the
299when the extension calling this is being unloaded. 292extension calling this is being unloaded.
300 293
301=cut 294=cut
302 295
303sub coro(&) { 296sub async_ext(&) {
304 my $cb = shift; 297 my $cb = shift;
305 298
306 my $coro = &cf::async ($cb); 299 my $coro = &Coro::async ($cb);
307 300
308 $coro->on_destroy (sub { 301 $coro->on_destroy (sub {
309 delete $EXT_CORO{$coro+0}; 302 delete $EXT_CORO{$coro+0};
310 }); 303 });
311 $EXT_CORO{$coro+0} = $coro; 304 $EXT_CORO{$coro+0} = $coro;
1296} 1289}
1297 1290
1298sub save { 1291sub save {
1299 my ($self) = @_; 1292 my ($self) = @_;
1300 1293
1294 my $lock = cf::lock_acquire "map_data:" . $self->path;
1295
1301 $self->{last_save} = $cf::RUNTIME; 1296 $self->{last_save} = $cf::RUNTIME;
1302 1297
1303 return unless $self->dirty; 1298 return unless $self->dirty;
1304 1299
1305 my $save = $self->{path}->save_path; utf8::encode $save; 1300 my $save = $self->{path}->save_path; utf8::encode $save;
1323 my ($self) = @_; 1318 my ($self) = @_;
1324 1319
1325 # save first because save cedes 1320 # save first because save cedes
1326 $self->save; 1321 $self->save;
1327 1322
1323 my $lock = cf::lock_acquire "map_data:" . $self->path;
1324
1328 return if $self->players; 1325 return if $self->players;
1329 return if $self->in_memory != cf::MAP_IN_MEMORY; 1326 return if $self->in_memory != cf::MAP_IN_MEMORY;
1330 return if $self->{deny_save}; 1327 return if $self->{deny_save};
1331 1328
1332 $self->clear; 1329 $self->clear;
1373 $self->save; 1370 $self->save;
1374} 1371}
1375 1372
1376sub reset { 1373sub reset {
1377 my ($self) = @_; 1374 my ($self) = @_;
1375
1376 my $lock = cf::lock_acquire "map_data:" . $self->path;
1378 1377
1379 return if $self->players; 1378 return if $self->players;
1380 return if $self->{path}{user_rel};#d# 1379 return if $self->{path}{user_rel};#d#
1381 1380
1382 warn "resetting map ", $self->path;#d# 1381 warn "resetting map ", $self->path;#d#
1548 my ($pl) = @_; 1547 my ($pl) = @_;
1549 1548
1550 # try to abort aborted map switching on player login :) 1549 # try to abort aborted map switching on player login :)
1551 # should happen only on crashes 1550 # should happen only on crashes
1552 if ($pl->ob->{_link_pos}) { 1551 if ($pl->ob->{_link_pos}) {
1552
1553 $pl->ob->enter_link; 1553 $pl->ob->enter_link;
1554 cf::async { 1554 (async {
1555 # we need this sleep as the login has a concurrent enter_exit running 1555 # we need this sleep as the login has a concurrent enter_exit running
1556 # and this sleep increases chances of the player not ending up in scorn 1556 # and this sleep increases chances of the player not ending up in scorn
1557 $pl->ob->reply (undef,
1558 "There was an internal problem at your last logout, "
1559 . "the server will try to bring you to your intended destination in a second.",
1560 cf::NDI_RED);
1557 Coro::Timer::sleep 1; 1561 Coro::Timer::sleep 1;
1558 $pl->ob->leave_link; 1562 $pl->ob->leave_link;
1559 }; 1563 })->prio (2);
1560 } 1564 }
1561 }, 1565 },
1562); 1566);
1563 1567
1564=item $player_object->goto ($path, $x, $y) 1568=item $player_object->goto ($path, $x, $y)
1568sub cf::object::player::goto { 1572sub cf::object::player::goto {
1569 my ($self, $path, $x, $y) = @_; 1573 my ($self, $path, $x, $y) = @_;
1570 1574
1571 $self->enter_link; 1575 $self->enter_link;
1572 1576
1573 (cf::async { 1577 (async {
1574 $path = new cf::path $path; 1578 $path = new cf::path $path;
1575 1579
1576 my $map = cf::map::find $path->as_string; 1580 my $map = cf::map::find $path->as_string;
1577 $map = $map->customise_for ($self) if $map; 1581 $map = $map->customise_for ($self) if $map;
1578 1582
1640 1644
1641 return unless $self->type == cf::PLAYER; 1645 return unless $self->type == cf::PLAYER;
1642 1646
1643 $self->enter_link; 1647 $self->enter_link;
1644 1648
1645 (cf::async { 1649 (async {
1646 $self->deactivate_recursive; # just to be sure 1650 $self->deactivate_recursive; # just to be sure
1647 unless (eval { 1651 unless (eval {
1648 prepare_random_map $exit 1652 prepare_random_map $exit
1649 if $exit->slaying eq "/!"; 1653 if $exit->slaying eq "/!";
1650 1654
1731 } 1735 }
1732 } 1736 }
1733 }, 1737 },
1734); 1738);
1735 1739
1736=item $client->coro (\&cb) 1740=item $client->async (\&cb)
1737 1741
1738Create a new coroutine, running the specified callback. The coroutine will 1742Create a new coroutine, running the specified callback. The coroutine will
1739be automatically cancelled when the client gets destroyed (e.g. on logout, 1743be automatically cancelled when the client gets destroyed (e.g. on logout,
1740or loss of connection). 1744or loss of connection).
1741 1745
1742=cut 1746=cut
1743 1747
1744sub cf::client::coro { 1748sub cf::client::async {
1745 my ($self, $cb) = @_; 1749 my ($self, $cb) = @_;
1746 1750
1747 my $coro = &cf::async ($cb); 1751 my $coro = &Coro::async ($cb);
1748 1752
1749 $coro->on_destroy (sub { 1753 $coro->on_destroy (sub {
1750 delete $self->{_coro}{$coro+0}; 1754 delete $self->{_coro}{$coro+0};
1751 }); 1755 });
1752 1756
1990 local $/; 1994 local $/;
1991 *CFG = YAML::Syck::Load <$fh>; 1995 *CFG = YAML::Syck::Load <$fh>;
1992 1996
1993 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 1997 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
1994 1998
1999 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2000 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2001
1995 if (exists $CFG{mlockall}) { 2002 if (exists $CFG{mlockall}) {
1996 eval { 2003 eval {
1997 $CFG{mlockall} ? &mlockall : &munlockall 2004 $CFG{mlockall} ? &mlockall : &munlockall
1998 and die "WARNING: m(un)lockall failed: $!\n"; 2005 and die "WARNING: m(un)lockall failed: $!\n";
1999 }; 2006 };
2003 2010
2004sub main { 2011sub main {
2005 # we must not ever block the main coroutine 2012 # we must not ever block the main coroutine
2006 local $Coro::idle = sub { 2013 local $Coro::idle = sub {
2007 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d# 2014 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
2008 (Coro::unblock_sub {
2009 Event::one_event; 2015 async { Event::one_event };
2010 })->();
2011 }; 2016 };
2012 2017
2013 cfg_load; 2018 cfg_load;
2014 db_load; 2019 db_load;
2015 load_extensions; 2020 load_extensions;
2123 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2128 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2124 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2129 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2125 2130
2126 # dirty hack because... archetypes are not yet loaded 2131 # dirty hack because... archetypes are not yet loaded
2127 Event->timer ( 2132 Event->timer (
2128 after => 2, 2133 after => 10,
2129 cb => sub { 2134 cb => sub {
2130 $_[0]->w->cancel; 2135 $_[0]->w->cancel;
2131 2136
2132 # provide some exits "home" 2137 # provide some exits "home"
2133 my $exit = cf::object::new "exit"; 2138 my $exit = cf::object::new "exit";

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines