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.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
1315} 1292}
1316 1293
1317sub save { 1294sub save {
1318 my ($self) = @_; 1295 my ($self) = @_;
1319 1296
1297 my $lock = cf::lock_acquire "map_data:" . $self->path;
1298
1320 $self->{last_save} = $cf::RUNTIME; 1299 $self->{last_save} = $cf::RUNTIME;
1321 1300
1322 return unless $self->dirty; 1301 return unless $self->dirty;
1323 1302
1324 my $save = $self->{path}->save_path; utf8::encode $save; 1303 my $save = $self->{path}->save_path; utf8::encode $save;
1342 my ($self) = @_; 1321 my ($self) = @_;
1343 1322
1344 # save first because save cedes 1323 # save first because save cedes
1345 $self->save; 1324 $self->save;
1346 1325
1326 my $lock = cf::lock_acquire "map_data:" . $self->path;
1327
1347 return if $self->players; 1328 return if $self->players;
1348 return if $self->in_memory != cf::MAP_IN_MEMORY; 1329 return if $self->in_memory != cf::MAP_IN_MEMORY;
1349 return if $self->{deny_save}; 1330 return if $self->{deny_save};
1350 1331
1351 $self->clear; 1332 $self->clear;
1392 $self->save; 1373 $self->save;
1393} 1374}
1394 1375
1395sub reset { 1376sub reset {
1396 my ($self) = @_; 1377 my ($self) = @_;
1378
1379 my $lock = cf::lock_acquire "map_data:" . $self->path;
1397 1380
1398 return if $self->players; 1381 return if $self->players;
1399 return if $self->{path}{user_rel};#d# 1382 return if $self->{path}{user_rel};#d#
1400 1383
1401 warn "resetting map ", $self->path;#d# 1384 warn "resetting map ", $self->path;#d#
1567 my ($pl) = @_; 1550 my ($pl) = @_;
1568 1551
1569 # try to abort aborted map switching on player login :) 1552 # try to abort aborted map switching on player login :)
1570 # should happen only on crashes 1553 # should happen only on crashes
1571 if ($pl->ob->{_link_pos}) { 1554 if ($pl->ob->{_link_pos}) {
1555
1572 $pl->ob->enter_link; 1556 $pl->ob->enter_link;
1573 cf::async { 1557 (async {
1574 # 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
1575 # 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);
1576 Coro::Timer::sleep 1; 1564 Coro::Timer::sleep 1;
1577 $pl->ob->leave_link; 1565 $pl->ob->leave_link;
1578 }; 1566 })->prio (2);
1579 } 1567 }
1580 }, 1568 },
1581); 1569);
1582 1570
1583=item $player_object->goto_map ($path, $x, $y) 1571=item $player_object->goto ($path, $x, $y)
1584 1572
1585=cut 1573=cut
1586 1574
1587sub cf::object::player::goto_map { 1575sub cf::object::player::goto {
1588 my ($self, $path, $x, $y) = @_; 1576 my ($self, $path, $x, $y) = @_;
1589 1577
1590 $self->enter_link; 1578 $self->enter_link;
1591 1579
1592 (cf::async { 1580 (async {
1593 $path = new cf::path $path; 1581 $path = new cf::path $path;
1594 1582
1595 my $map = cf::map::find $path->as_string; 1583 my $map = cf::map::find $path->as_string;
1596 $map = $map->customise_for ($self) if $map; 1584 $map = $map->customise_for ($self) if $map;
1597 1585
1659 1647
1660 return unless $self->type == cf::PLAYER; 1648 return unless $self->type == cf::PLAYER;
1661 1649
1662 $self->enter_link; 1650 $self->enter_link;
1663 1651
1664 (cf::async { 1652 (async {
1665 $self->deactivate_recursive; # just to be sure 1653 $self->deactivate_recursive; # just to be sure
1666 unless (eval { 1654 unless (eval {
1667 prepare_random_map $exit 1655 prepare_random_map $exit
1668 if $exit->slaying eq "/!"; 1656 if $exit->slaying eq "/!";
1669 1657
1670 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;
1671 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp); 1659 $self->goto ($path, $exit->stats->hp, $exit->stats->sp);
1672 1660
1673 1; 1661 1;
1674 }) { 1662 }) {
1675 $self->message ("Something went wrong deep within the crossfire server. " 1663 $self->message ("Something went wrong deep within the crossfire server. "
1676 . "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. "
1750 } 1738 }
1751 } 1739 }
1752 }, 1740 },
1753); 1741);
1754 1742
1755=item $client->coro (\&cb) 1743=item $client->async (\&cb)
1756 1744
1757Create a new coroutine, running the specified callback. The coroutine will 1745Create a new coroutine, running the specified callback. The coroutine will
1758be automatically cancelled when the client gets destroyed (e.g. on logout, 1746be automatically cancelled when the client gets destroyed (e.g. on logout,
1759or loss of connection). 1747or loss of connection).
1760 1748
1761=cut 1749=cut
1762 1750
1763sub cf::client::coro { 1751sub cf::client::async {
1764 my ($self, $cb) = @_; 1752 my ($self, $cb) = @_;
1765 1753
1766 my $coro = &cf::async ($cb); 1754 my $coro = &Coro::async ($cb);
1767 1755
1768 $coro->on_destroy (sub { 1756 $coro->on_destroy (sub {
1769 delete $self->{_coro}{$coro+0}; 1757 delete $self->{_coro}{$coro+0};
1770 }); 1758 });
1771 1759
2009 local $/; 1997 local $/;
2010 *CFG = YAML::Syck::Load <$fh>; 1998 *CFG = YAML::Syck::Load <$fh>;
2011 1999
2012 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 2000 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
2013 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
2014 if (exists $CFG{mlockall}) { 2005 if (exists $CFG{mlockall}) {
2015 eval { 2006 eval {
2016 $CFG{mlockall} ? &mlockall : &munlockall 2007 $CFG{mlockall} ? &mlockall : &munlockall
2017 and die "WARNING: m(un)lockall failed: $!\n"; 2008 and die "WARNING: m(un)lockall failed: $!\n";
2018 }; 2009 };
2022 2013
2023sub main { 2014sub main {
2024 # we must not ever block the main coroutine 2015 # we must not ever block the main coroutine
2025 local $Coro::idle = sub { 2016 local $Coro::idle = sub {
2026 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#
2027 (Coro::unblock_sub {
2028 Event::one_event; 2018 async { Event::one_event };
2029 })->();
2030 }; 2019 };
2031 2020
2032 cfg_load; 2021 cfg_load;
2033 db_load; 2022 db_load;
2034 load_extensions; 2023 load_extensions;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines