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.137 by root, Fri Jan 5 10:23:05 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;
1554 my ($pl) = @_; 1547 my ($pl) = @_;
1555 1548
1556 # try to abort aborted map switching on player login :) 1549 # try to abort aborted map switching on player login :)
1557 # should happen only on crashes 1550 # should happen only on crashes
1558 if ($pl->ob->{_link_pos}) { 1551 if ($pl->ob->{_link_pos}) {
1552
1559 $pl->ob->enter_link; 1553 $pl->ob->enter_link;
1560 cf::async { 1554 (async {
1561 # 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
1562 # 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);
1563 Coro::Timer::sleep 1; 1561 Coro::Timer::sleep 1;
1564 $pl->ob->leave_link; 1562 $pl->ob->leave_link;
1565 }; 1563 })->prio (2);
1566 } 1564 }
1567 }, 1565 },
1568); 1566);
1569 1567
1570=item $player_object->goto ($path, $x, $y) 1568=item $player_object->goto ($path, $x, $y)
1574sub cf::object::player::goto { 1572sub cf::object::player::goto {
1575 my ($self, $path, $x, $y) = @_; 1573 my ($self, $path, $x, $y) = @_;
1576 1574
1577 $self->enter_link; 1575 $self->enter_link;
1578 1576
1579 (cf::async { 1577 (async {
1580 $path = new cf::path $path; 1578 $path = new cf::path $path;
1581 1579
1582 my $map = cf::map::find $path->as_string; 1580 my $map = cf::map::find $path->as_string;
1583 $map = $map->customise_for ($self) if $map; 1581 $map = $map->customise_for ($self) if $map;
1584 1582
1646 1644
1647 return unless $self->type == cf::PLAYER; 1645 return unless $self->type == cf::PLAYER;
1648 1646
1649 $self->enter_link; 1647 $self->enter_link;
1650 1648
1651 (cf::async { 1649 (async {
1652 $self->deactivate_recursive; # just to be sure 1650 $self->deactivate_recursive; # just to be sure
1653 unless (eval { 1651 unless (eval {
1654 prepare_random_map $exit 1652 prepare_random_map $exit
1655 if $exit->slaying eq "/!"; 1653 if $exit->slaying eq "/!";
1656 1654
1737 } 1735 }
1738 } 1736 }
1739 }, 1737 },
1740); 1738);
1741 1739
1742=item $client->coro (\&cb) 1740=item $client->async (\&cb)
1743 1741
1744Create a new coroutine, running the specified callback. The coroutine will 1742Create a new coroutine, running the specified callback. The coroutine will
1745be automatically cancelled when the client gets destroyed (e.g. on logout, 1743be automatically cancelled when the client gets destroyed (e.g. on logout,
1746or loss of connection). 1744or loss of connection).
1747 1745
1748=cut 1746=cut
1749 1747
1750sub cf::client::coro { 1748sub cf::client::async {
1751 my ($self, $cb) = @_; 1749 my ($self, $cb) = @_;
1752 1750
1753 my $coro = &cf::async ($cb); 1751 my $coro = &Coro::async ($cb);
1754 1752
1755 $coro->on_destroy (sub { 1753 $coro->on_destroy (sub {
1756 delete $self->{_coro}{$coro+0}; 1754 delete $self->{_coro}{$coro+0};
1757 }); 1755 });
1758 1756
1996 local $/; 1994 local $/;
1997 *CFG = YAML::Syck::Load <$fh>; 1995 *CFG = YAML::Syck::Load <$fh>;
1998 1996
1999 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 1997 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
2000 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
2001 if (exists $CFG{mlockall}) { 2002 if (exists $CFG{mlockall}) {
2002 eval { 2003 eval {
2003 $CFG{mlockall} ? &mlockall : &munlockall 2004 $CFG{mlockall} ? &mlockall : &munlockall
2004 and die "WARNING: m(un)lockall failed: $!\n"; 2005 and die "WARNING: m(un)lockall failed: $!\n";
2005 }; 2006 };
2009 2010
2010sub main { 2011sub main {
2011 # we must not ever block the main coroutine 2012 # we must not ever block the main coroutine
2012 local $Coro::idle = sub { 2013 local $Coro::idle = sub {
2013 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#
2014 (Coro::unblock_sub {
2015 Event::one_event; 2015 async { Event::one_event };
2016 })->();
2017 }; 2016 };
2018 2017
2019 cfg_load; 2018 cfg_load;
2020 db_load; 2019 db_load;
2021 load_extensions; 2020 load_extensions;
2129 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2128 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2130 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2129 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2131 2130
2132 # dirty hack because... archetypes are not yet loaded 2131 # dirty hack because... archetypes are not yet loaded
2133 Event->timer ( 2132 Event->timer (
2134 after => 2, 2133 after => 10,
2135 cb => sub { 2134 cb => sub {
2136 $_[0]->w->cancel; 2135 $_[0]->w->cancel;
2137 2136
2138 # provide some exits "home" 2137 # provide some exits "home"
2139 my $exit = cf::object::new "exit"; 2138 my $exit = cf::object::new "exit";

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines