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.134 by root, Thu Jan 4 17:28:49 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 = ();
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 Coro::cede or Event::one_event;
307 Event::one_event unless Coro::nready;
308 } 279 }
309 280
310 wantarray ? @res : $res[0] 281 wantarray ? @res : $res[0]
311 } else { 282 } else {
312 # we are in another coroutine, how wonderful, everything just works 283 # we are in another coroutine, how wonderful, everything just works
313 284
314 $job->() 285 $job->()
315 } 286 }
316} 287}
317 288
318=item $coro = cf::coro { BLOCK } 289=item $coro = cf::async_ext { BLOCK }
319 290
320Creates and returns a new coro. This coro is automcatially being canceled 291Like async, but this coro is automcatially being canceled when the
321when the extension calling this is being unloaded. 292extension calling this is being unloaded.
322 293
323=cut 294=cut
324 295
325sub coro(&) { 296sub async_ext(&) {
326 my $cb = shift; 297 my $cb = shift;
327 298
328 my $coro = &cf::async ($cb); 299 my $coro = &Coro::async ($cb);
329 300
330 $coro->on_destroy (sub { 301 $coro->on_destroy (sub {
331 delete $EXT_CORO{$coro+0}; 302 delete $EXT_CORO{$coro+0};
332 }); 303 });
333 $EXT_CORO{$coro+0} = $coro; 304 $EXT_CORO{$coro+0} = $coro;
1184 or return; 1155 or return;
1185 1156
1186 my $map = cf::map::new 1157 my $map = cf::map::new
1187 or return; 1158 or return;
1188 1159
1160 # for better error messages only, will be overwritten
1161 $map->path ($path);
1162
1189 $map->load_header ($path) 1163 $map->load_header ($path)
1190 or return; 1164 or return;
1191 1165
1192 $map->{load_path} = $path; 1166 $map->{load_path} = $path;
1193 1167
1315} 1289}
1316 1290
1317sub save { 1291sub save {
1318 my ($self) = @_; 1292 my ($self) = @_;
1319 1293
1294 my $lock = cf::lock_acquire "map_data:" . $self->path;
1295
1320 $self->{last_save} = $cf::RUNTIME; 1296 $self->{last_save} = $cf::RUNTIME;
1321 1297
1322 return unless $self->dirty; 1298 return unless $self->dirty;
1323 1299
1324 my $save = $self->{path}->save_path; utf8::encode $save; 1300 my $save = $self->{path}->save_path; utf8::encode $save;
1342 my ($self) = @_; 1318 my ($self) = @_;
1343 1319
1344 # save first because save cedes 1320 # save first because save cedes
1345 $self->save; 1321 $self->save;
1346 1322
1323 my $lock = cf::lock_acquire "map_data:" . $self->path;
1324
1347 return if $self->players; 1325 return if $self->players;
1348 return if $self->in_memory != cf::MAP_IN_MEMORY; 1326 return if $self->in_memory != cf::MAP_IN_MEMORY;
1349 return if $self->{deny_save}; 1327 return if $self->{deny_save};
1350 1328
1351 $self->clear; 1329 $self->clear;
1392 $self->save; 1370 $self->save;
1393} 1371}
1394 1372
1395sub reset { 1373sub reset {
1396 my ($self) = @_; 1374 my ($self) = @_;
1375
1376 my $lock = cf::lock_acquire "map_data:" . $self->path;
1397 1377
1398 return if $self->players; 1378 return if $self->players;
1399 return if $self->{path}{user_rel};#d# 1379 return if $self->{path}{user_rel};#d#
1400 1380
1401 warn "resetting map ", $self->path;#d# 1381 warn "resetting map ", $self->path;#d#
1567 my ($pl) = @_; 1547 my ($pl) = @_;
1568 1548
1569 # try to abort aborted map switching on player login :) 1549 # try to abort aborted map switching on player login :)
1570 # should happen only on crashes 1550 # should happen only on crashes
1571 if ($pl->ob->{_link_pos}) { 1551 if ($pl->ob->{_link_pos}) {
1552
1572 $pl->ob->enter_link; 1553 $pl->ob->enter_link;
1573 cf::async { 1554 (async {
1574 # 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
1575 # 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);
1576 Coro::Timer::sleep 1; 1561 Coro::Timer::sleep 1;
1577 $pl->ob->leave_link; 1562 $pl->ob->leave_link;
1578 }; 1563 })->prio (2);
1579 } 1564 }
1580 }, 1565 },
1581); 1566);
1582 1567
1583=item $player_object->goto_map ($path, $x, $y) 1568=item $player_object->goto ($path, $x, $y)
1584 1569
1585=cut 1570=cut
1586 1571
1587sub cf::object::player::goto_map { 1572sub cf::object::player::goto {
1588 my ($self, $path, $x, $y) = @_; 1573 my ($self, $path, $x, $y) = @_;
1589 1574
1590 $self->enter_link; 1575 $self->enter_link;
1591 1576
1592 (cf::async { 1577 (async {
1593 $path = new cf::path $path; 1578 $path = new cf::path $path;
1594 1579
1595 my $map = cf::map::find $path->as_string; 1580 my $map = cf::map::find $path->as_string;
1596 $map = $map->customise_for ($self) if $map; 1581 $map = $map->customise_for ($self) if $map;
1597 1582
1659 1644
1660 return unless $self->type == cf::PLAYER; 1645 return unless $self->type == cf::PLAYER;
1661 1646
1662 $self->enter_link; 1647 $self->enter_link;
1663 1648
1664 (cf::async { 1649 (async {
1665 $self->deactivate_recursive; # just to be sure 1650 $self->deactivate_recursive; # just to be sure
1666 unless (eval { 1651 unless (eval {
1667 prepare_random_map $exit 1652 prepare_random_map $exit
1668 if $exit->slaying eq "/!"; 1653 if $exit->slaying eq "/!";
1669 1654
1670 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path; 1655 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1671 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp); 1656 $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
1672 1657
1673 1; 1658 1;
1674 }) { 1659 }) {
1675 $self->message ("Something went wrong deep within the crossfire server. " 1660 $self->message ("Something went wrong deep within the crossfire server. "
1676 . "I'll try to bring you back to the map you were before. " 1661 . "I'll try to bring you back to the map you were before. "
1750 } 1735 }
1751 } 1736 }
1752 }, 1737 },
1753); 1738);
1754 1739
1755=item $client->coro (\&cb) 1740=item $client->async (\&cb)
1756 1741
1757Create a new coroutine, running the specified callback. The coroutine will 1742Create a new coroutine, running the specified callback. The coroutine will
1758be automatically cancelled when the client gets destroyed (e.g. on logout, 1743be automatically cancelled when the client gets destroyed (e.g. on logout,
1759or loss of connection). 1744or loss of connection).
1760 1745
1761=cut 1746=cut
1762 1747
1763sub cf::client::coro { 1748sub cf::client::async {
1764 my ($self, $cb) = @_; 1749 my ($self, $cb) = @_;
1765 1750
1766 my $coro = &cf::async ($cb); 1751 my $coro = &Coro::async ($cb);
1767 1752
1768 $coro->on_destroy (sub { 1753 $coro->on_destroy (sub {
1769 delete $self->{_coro}{$coro+0}; 1754 delete $self->{_coro}{$coro+0};
1770 }); 1755 });
1771 1756
2009 local $/; 1994 local $/;
2010 *CFG = YAML::Syck::Load <$fh>; 1995 *CFG = YAML::Syck::Load <$fh>;
2011 1996
2012 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 1997 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
2013 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
2014 if (exists $CFG{mlockall}) { 2002 if (exists $CFG{mlockall}) {
2015 eval { 2003 eval {
2016 $CFG{mlockall} ? &mlockall : &munlockall 2004 $CFG{mlockall} ? &mlockall : &munlockall
2017 and die "WARNING: m(un)lockall failed: $!\n"; 2005 and die "WARNING: m(un)lockall failed: $!\n";
2018 }; 2006 };
2022 2010
2023sub main { 2011sub main {
2024 # we must not ever block the main coroutine 2012 # we must not ever block the main coroutine
2025 local $Coro::idle = sub { 2013 local $Coro::idle = sub {
2026 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#
2027 (Coro::unblock_sub {
2028 Event::one_event; 2015 async { Event::one_event };
2029 })->();
2030 }; 2016 };
2031 2017
2032 cfg_load; 2018 cfg_load;
2033 db_load; 2019 db_load;
2034 load_extensions; 2020 load_extensions;
2142 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2128 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2143 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2129 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2144 2130
2145 # dirty hack because... archetypes are not yet loaded 2131 # dirty hack because... archetypes are not yet loaded
2146 Event->timer ( 2132 Event->timer (
2147 after => 2, 2133 after => 10,
2148 cb => sub { 2134 cb => sub {
2149 $_[0]->w->cancel; 2135 $_[0]->w->cancel;
2150 2136
2151 # provide some exits "home" 2137 # provide some exits "home"
2152 my $exit = cf::object::new "exit"; 2138 my $exit = cf::object::new "exit";

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines