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.118 by root, Mon Jan 1 21:19:52 2007 UTC vs.
Revision 1.132 by root, Thu Jan 4 01:35:56 2007 UTC

… …
8use Storable; 8use Storable;
9use Opcode; 9use Opcode;
10use Safe; 10use Safe;
11use Safe::Hole; 11use Safe::Hole;
12 12
13use Coro 3.3; 13use Coro 3.3 ();
14use Coro::Event; 14use Coro::Event;
15use Coro::Timer; 15use Coro::Timer;
16use Coro::Signal; 16use Coro::Signal;
17use Coro::Semaphore; 17use Coro::Semaphore;
18use Coro::AIO; 18use Coro::AIO;
… …
71mkdir cf::localdir . "/" . cf::uniquedir; 71mkdir cf::localdir . "/" . cf::uniquedir;
72mkdir $RANDOM_MAPS; 72mkdir $RANDOM_MAPS;
73 73
74# a special map that is always available 74# a special map that is always available
75our $LINK_MAP; 75our $LINK_MAP;
76 76our $EMERGENCY_POSITION;
77our $EMERGENCY_POSITION = $cf::CFG{emergency_position} || ["/world/world_105_115", 5, 37];
78 77
79############################################################################# 78#############################################################################
80 79
81=head2 GLOBAL VARIABLES 80=head2 GLOBAL VARIABLES
82 81
… …
181sub to_json($) { 180sub to_json($) {
182 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs 181 $JSON::Syck::ImplicitUnicode = 0; # work around JSON::Syck bugs
183 JSON::Syck::Dump $_[0] 182 JSON::Syck::Dump $_[0]
184} 183}
185 184
185=item my $guard = cf::guard { BLOCK }
186
187Run the given callback when the guard object gets destroyed (useful for
188coroutine cancellations).
189
190You can call C<< ->cancel >> on the guard object to stop the block from
191being executed.
192
193=cut
194
195sub guard(&) {
196 bless \(my $cb = $_[0]), cf::guard::;
197}
198
199sub cf::guard::cancel {
200 ${$_[0]} = sub { };
201}
202
203sub cf::guard::DESTROY {
204 ${$_[0]}->();
205}
206
207=item cf::lock_wait $string
208
209Wait until the given lock is available. See cf::lock_acquire.
210
211=item my $lock = cf::lock_acquire $string
212
213Wait until the given lock is available and then acquires it and returns
214a guard object. If the guard object gets destroyed (goes out of scope,
215for example when the coroutine gets canceled), the lock is automatically
216returned.
217
218Lock names should begin with a unique identifier (for example, find_map
219uses map_find and load_map uses map_load).
220
221=cut
222
223our %LOCK;
224
225sub lock_wait($) {
226 my ($key) = @_;
227
228 # wait for lock, if any
229 while ($LOCK{$key}) {
230 push @{ $LOCK{$key} }, $Coro::current;
231 Coro::schedule;
232 }
233}
234
235sub lock_acquire($) {
236 my ($key) = @_;
237
238 # wait, to be sure we are not locked
239 lock_wait $key;
240
241 $LOCK{$key} = [];
242
243 cf::guard {
244 # wake up all waiters, to be on the safe side
245 $_->ready for @{ delete $LOCK{$key} };
246 }
247}
248
249=item cf::async { BLOCK }
250
251Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the
252error instead of exiting the server in case of a problem.
253
254=cut
255
256sub async(&) {
257 my ($cb) = @_;
258
259 Coro::async {
260 eval { $cb->() };
261 warn $@ if $@;
262 }
263}
264
186=item cf::sync_job { BLOCK } 265=item cf::sync_job { BLOCK }
187 266
188The design of crossfire+ requires that the main coro ($Coro::main) is 267The design of crossfire+ requires that the main coro ($Coro::main) is
189always able to handle events or runnable, as crossfire+ is only partly 268always able to handle events or runnable, as crossfire+ is only partly
190reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable. 269reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
… …
237=cut 316=cut
238 317
239sub coro(&) { 318sub coro(&) {
240 my $cb = shift; 319 my $cb = shift;
241 320
242 my $coro; $coro = async { 321 my $coro = &cf::async ($cb);
243 eval {
244 $cb->();
245 };
246 warn $@ if $@;
247 };
248 322
249 $coro->on_destroy (sub { 323 $coro->on_destroy (sub {
250 delete $EXT_CORO{$coro+0}; 324 delete $EXT_CORO{$coro+0};
251 }); 325 });
252 $EXT_CORO{$coro+0} = $coro; 326 $EXT_CORO{$coro+0} = $coro;
… …
1089# and all this just because we cannot iterate over 1163# and all this just because we cannot iterate over
1090# all maps in C++... 1164# all maps in C++...
1091sub change_all_map_light { 1165sub change_all_map_light {
1092 my ($change) = @_; 1166 my ($change) = @_;
1093 1167
1094 $_->change_map_light ($change) for values %cf::MAP; 1168 $_->change_map_light ($change)
1169 for grep $_->outdoor, values %cf::MAP;
1095} 1170}
1096 1171
1097sub try_load_header($) { 1172sub try_load_header($) {
1098 my ($path) = @_; 1173 my ($path) = @_;
1099 1174
… …
1110 $map->{load_path} = $path; 1185 $map->{load_path} = $path;
1111 1186
1112 $map 1187 $map
1113} 1188}
1114 1189
1190sub find_map;
1115sub find_map { 1191sub find_map {
1116 my ($path, $origin) = @_; 1192 my ($path, $origin) = @_;
1117 1193
1118 #warn "find_map<$path,$origin>\n";#d# 1194 #warn "find_map<$path,$origin>\n";#d#
1119 1195
1120 $path = new cf::path $path, $origin && $origin->path; 1196 $path = new cf::path $path, $origin && $origin->path;
1121 my $key = $path->as_string; 1197 my $key = $path->as_string;
1122 1198
1199 cf::lock_wait "map_find:$key";
1200
1123 $cf::MAP{$key} || do { 1201 $cf::MAP{$key} || do {
1202 my $guard = cf::lock_acquire "map_find:$key";
1203
1124 # do it the slow way 1204 # do it the slow way
1125 my $map = try_load_header $path->save_path; 1205 my $map = try_load_header $path->save_path;
1126 1206
1127 if ($map) { 1207 if ($map) {
1208 $map->last_access ((delete $map->{last_access})
1209 || $cf::RUNTIME); #d#
1128 # safety 1210 # safety
1129 $map->{instantiate_time} = $cf::RUNTIME 1211 $map->{instantiate_time} = $cf::RUNTIME
1130 if $map->{instantiate_time} > $cf::RUNTIME; 1212 if $map->{instantiate_time} > $cf::RUNTIME;
1131 } else { 1213 } else {
1132 if (my $rmp = $path->random_map_params) { 1214 if (my $rmp = $path->random_map_params) {
… …
1137 1219
1138 $map or return; 1220 $map or return;
1139 1221
1140 $map->{load_original} = 1; 1222 $map->{load_original} = 1;
1141 $map->{instantiate_time} = $cf::RUNTIME; 1223 $map->{instantiate_time} = $cf::RUNTIME;
1224 $map->last_access ($cf::RUNTIME);
1142 $map->instantiate; 1225 $map->instantiate;
1143 1226
1144 # per-player maps become, after loading, normal maps 1227 # per-player maps become, after loading, normal maps
1145 $map->per_player (0) if $path->{user_rel}; 1228 $map->per_player (0) if $path->{user_rel};
1146 } 1229 }
1147 #Coro::Timer::sleep 1;#d#
1148 1230
1149 $map->path ($key); 1231 $map->path ($key);
1150 $map->{path} = $path; 1232 $map->{path} = $path;
1151 $map->{last_save} = $cf::RUNTIME; 1233 $map->{last_save} = $cf::RUNTIME;
1152 $map->last_access ($cf::RUNTIME);
1153 1234
1154 if ($map->should_reset) { 1235 if ($map->should_reset) {
1155 $map->reset; 1236 $map->reset;
1237 undef $guard;
1156 $map = find_map $path; 1238 $map = find_map $path
1239 or return;
1157 } 1240 }
1158 1241
1159 $cf::MAP{$key} = $map 1242 $cf::MAP{$key} = $map
1160 } 1243 }
1161} 1244}
1162 1245
1163sub load { 1246sub load {
1164 my ($self) = @_; 1247 my ($self) = @_;
1165 1248
1249 my $path = $self->{path};
1250 my $guard = cf::lock_acquire "map_load:" . $path->as_string;
1251
1166 return if $self->in_memory != cf::MAP_SWAPPED; 1252 return if $self->in_memory != cf::MAP_SWAPPED;
1167 1253
1168 $self->in_memory (cf::MAP_LOADING); 1254 $self->in_memory (cf::MAP_LOADING);
1169
1170 my $path = $self->{path};
1171 1255
1172 $self->alloc; 1256 $self->alloc;
1173 $self->load_objects ($self->{load_path}, 1) 1257 $self->load_objects ($self->{load_path}, 1)
1174 or return; 1258 or return;
1175 1259
… …
1228 1312
1229 $self->{load_path} = $save; 1313 $self->{load_path} = $save;
1230 1314
1231 return if $self->{deny_save}; 1315 return if $self->{deny_save};
1232 1316
1317 local $self->{last_access} = $self->last_access;#d#
1318
1233 if ($uniq) { 1319 if ($uniq) {
1234 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1320 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1235 $self->save_objects ($uniq, cf::IO_UNIQUES); 1321 $self->save_objects ($uniq, cf::IO_UNIQUES);
1236 } else { 1322 } else {
1237 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 1323 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
… …
1239} 1325}
1240 1326
1241sub swap_out { 1327sub swap_out {
1242 my ($self) = @_; 1328 my ($self) = @_;
1243 1329
1330 # save first because save cedes
1331 $self->save;
1332
1244 return if $self->players; 1333 return if $self->players;
1245 return if $self->in_memory != cf::MAP_IN_MEMORY; 1334 return if $self->in_memory != cf::MAP_IN_MEMORY;
1246 return if $self->{deny_save}; 1335 return if $self->{deny_save};
1247 1336
1248 $self->save;
1249 $self->clear; 1337 $self->clear;
1250 $self->in_memory (cf::MAP_SWAPPED); 1338 $self->in_memory (cf::MAP_SWAPPED);
1251} 1339}
1252 1340
1253sub reset_at { 1341sub reset_at {
… …
1408=cut 1496=cut
1409 1497
1410sub cf::object::player::enter_link { 1498sub cf::object::player::enter_link {
1411 my ($self) = @_; 1499 my ($self) = @_;
1412 1500
1501 $self->deactivate_recursive;
1502
1413 return if $self->map == $LINK_MAP; 1503 return if $self->map == $LINK_MAP;
1414 1504
1415 $self->{_link_pos} = [$self->map->{path}, $self->x, $self->y] 1505 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
1416 if $self->map; 1506 if $self->map;
1417 1507
1418 $self->enter_map ($LINK_MAP, 20, 20); 1508 $self->enter_map ($LINK_MAP, 20, 20);
1419 $self->deactivate_recursive;
1420} 1509}
1421 1510
1422sub cf::object::player::leave_link { 1511sub cf::object::player::leave_link {
1423 my ($self, $map, $x, $y) = @_; 1512 my ($self, $map, $x, $y) = @_;
1424 1513
… …
1447 1536
1448 $self->activate_recursive; 1537 $self->activate_recursive;
1449 $self->enter_map ($map, $x, $y); 1538 $self->enter_map ($map, $x, $y);
1450} 1539}
1451 1540
1541cf::player->attach (
1542 on_logout => sub {
1543 my ($pl) = @_;
1544
1545 # abort map switching before logout
1546 if ($pl->ob->{_link_pos}) {
1547 cf::sync_job {
1548 $pl->ob->leave_link
1549 };
1550 }
1551 },
1552 on_login => sub {
1553 my ($pl) = @_;
1554
1555 # try to abort aborted map switching on player login :)
1556 # should happen only on crashes
1557 if ($pl->ob->{_link_pos}) {
1558 $pl->ob->enter_link;
1559 cf::async {
1560 # we need this sleep as the login has a concurrent enter_exit running
1561 # and this sleep increases chances of the player not ending up in scorn
1562 Coro::Timer::sleep 1;
1563 $pl->ob->leave_link;
1564 };
1565 }
1566 },
1567);
1568
1452=item $player_object->goto_map ($path, $x, $y) 1569=item $player_object->goto_map ($path, $x, $y)
1453 1570
1454=cut 1571=cut
1455 1572
1456sub cf::object::player::goto_map { 1573sub cf::object::player::goto_map {
1457 my ($self, $path, $x, $y) = @_; 1574 my ($self, $path, $x, $y) = @_;
1458 1575
1459 $self->enter_link; 1576 $self->enter_link;
1460 1577
1461 (Coro::async { 1578 (cf::async {
1462 $path = new cf::path $path; 1579 $path = new cf::path $path;
1463 1580
1464 my $map = cf::map::find_map $path->as_string; 1581 my $map = cf::map::find_map $path->as_string;
1465 $map = $map->customise_for ($self) if $map; 1582 $map = $map->customise_for ($self) if $map;
1466 1583
1467 warn "entering ", $map->path, " at ($x, $y)\n" 1584# warn "entering ", $map->path, " at ($x, $y)\n"
1468 if $map; 1585# if $map;
1469 1586
1470 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1587 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1471 1588
1472 $self->leave_link ($map, $x, $y); 1589 $self->leave_link ($map, $x, $y);
1473 })->prio (1); 1590 })->prio (1);
… …
1528 1645
1529 return unless $self->type == cf::PLAYER; 1646 return unless $self->type == cf::PLAYER;
1530 1647
1531 $self->enter_link; 1648 $self->enter_link;
1532 1649
1533 (Coro::async { 1650 (cf::async {
1534 unless (eval { 1651 unless (eval {
1535
1536 prepare_random_map $exit 1652 prepare_random_map $exit
1537 if $exit->slaying eq "/!"; 1653 if $exit->slaying eq "/!";
1538 1654
1539 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;
1540 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp); 1656 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
… …
1602 on_reply => sub { 1718 on_reply => sub {
1603 my ($ns, $msg) = @_; 1719 my ($ns, $msg) = @_;
1604 1720
1605 # this weird shuffling is so that direct followup queries 1721 # this weird shuffling is so that direct followup queries
1606 # get handled first 1722 # get handled first
1607 my $queue = delete $ns->{query_queue}; 1723 my $queue = delete $ns->{query_queue}
1724 or return; # be conservative, not sure how that can happen, but we saw a crash here
1608 1725
1609 (shift @$queue)->[1]->($msg); 1726 (shift @$queue)->[1]->($msg);
1610 1727
1611 push @{ $ns->{query_queue} }, @$queue; 1728 push @{ $ns->{query_queue} }, @$queue;
1612 1729
… …
1629=cut 1746=cut
1630 1747
1631sub cf::client::coro { 1748sub cf::client::coro {
1632 my ($self, $cb) = @_; 1749 my ($self, $cb) = @_;
1633 1750
1634 my $coro; $coro = async { 1751 my $coro = &cf::async ($cb);
1635 eval {
1636 $cb->();
1637 };
1638 warn $@ if $@;
1639 };
1640 1752
1641 $coro->on_destroy (sub { 1753 $coro->on_destroy (sub {
1642 delete $self->{_coro}{$coro+0}; 1754 delete $self->{_coro}{$coro+0};
1643 }); 1755 });
1644 1756
… …
1816 1928
1817{ 1929{
1818 my $path = cf::localdir . "/database.pst"; 1930 my $path = cf::localdir . "/database.pst";
1819 1931
1820 sub db_load() { 1932 sub db_load() {
1821 warn "loading database $path\n";#d# remove later
1822 $DB = stat $path ? Storable::retrieve $path : { }; 1933 $DB = stat $path ? Storable::retrieve $path : { };
1823 } 1934 }
1824 1935
1825 my $pid; 1936 my $pid;
1826 1937
1827 sub db_save() { 1938 sub db_save() {
1828 warn "saving database $path\n";#d# remove later
1829 waitpid $pid, 0 if $pid; 1939 waitpid $pid, 0 if $pid;
1830 if (0 == ($pid = fork)) { 1940 if (0 == ($pid = fork)) {
1831 $DB->{_meta}{version} = 1; 1941 $DB->{_meta}{version} = 1;
1832 Storable::nstore $DB, "$path~"; 1942 Storable::nstore $DB, "$path~";
1833 rename "$path~", $path; 1943 rename "$path~", $path;
… …
1881 open my $fh, "<:utf8", cf::confdir . "/config" 1991 open my $fh, "<:utf8", cf::confdir . "/config"
1882 or return; 1992 or return;
1883 1993
1884 local $/; 1994 local $/;
1885 *CFG = YAML::Syck::Load <$fh>; 1995 *CFG = YAML::Syck::Load <$fh>;
1996
1997 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37];
1998
1999 if (exists $CFG{mlockall}) {
2000 eval {
2001 $CFG{mlockall} ? &mlockall : &munlockall
2002 and die "WARNING: m(un)lockall failed: $!\n";
2003 };
2004 warn $@ if $@;
2005 }
1886} 2006}
1887 2007
1888sub main { 2008sub main {
1889 # we must not ever block the main coroutine 2009 # we must not ever block the main coroutine
1890 local $Coro::idle = sub { 2010 local $Coro::idle = sub {
… …
2093 or warn "ERROR: unable to write runtime file: $!"; 2213 or warn "ERROR: unable to write runtime file: $!";
2094 })->(); 2214 })->();
2095 }, 2215 },
2096); 2216);
2097 2217
2218END { cf::emergency_save }
2219
20981 22201
2099 2221

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines