[ViewVC] Diff of: cvs/deliantra/server/lib/cf.pm

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.119 by root, Tue Jan 2 08:26:42 2007 UTC vs.
Revision 1.131 by root, Thu Jan 4 00:53:54 2007 UTC

…		…
8	use Storable;	8	use Storable;
9	use Opcode;	9	use Opcode;
10	use Safe;	10	use Safe;
11	use Safe::Hole;	11	use Safe::Hole;
12		12
13	use Coro 3.3;	13	use Coro 3.3 ();
14	use Coro::Event;	14	use Coro::Event;
15	use Coro::Timer;	15	use Coro::Timer;
16	use Coro::Signal;	16	use Coro::Signal;
17	use Coro::Semaphore;	17	use Coro::Semaphore;
18	use Coro::AIO;	18	use Coro::AIO;
…		…
71	mkdir cf::localdir . "/" . cf::uniquedir;	71	mkdir cf::localdir . "/" . cf::uniquedir;
72	mkdir $RANDOM_MAPS;	72	mkdir $RANDOM_MAPS;
73		73
74	# a special map that is always available	74	# a special map that is always available
75	our $LINK_MAP;	75	our $LINK_MAP;
76		76	our $EMERGENCY_POSITION;
77	our $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
…		…
181	sub to_json($) {	180	sub 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
		187	Run the given callback when the guard object gets destroyed (useful for
		188	coroutine cancellations).
		189
		190	You can call C<< ->cancel >> on the guard object to stop the block from
		191	being executed.
		192
		193	=cut
		194
		195	sub guard(&) {
		196	bless \(my $cb = $_[0]), cf::guard::;
		197	}
		198
		199	sub cf::guard::cancel {
		200	${$_[0]} = sub { };
		201	}
		202
		203	sub cf::guard::DESTROY {
		204	${$_[0]}->();
		205	}
		206
		207	=item cf::lock_wait $string
		208
		209	Wait until the given lock is available. See cf::lock_acquire.
		210
		211	=item my $lock = cf::lock_acquire $string
		212
		213	Wait until the given lock is available and then acquires it and returns
		214	a guard object. If the guard object gets destroyed (goes out of scope,
		215	for example when the coroutine gets canceled), the lock is automatically
		216	returned.
		217
		218	Lock names should begin with a unique identifier (for example, find_map
		219	uses map_find and load_map uses map_load).
		220
		221	=cut
		222
		223	our %LOCK;
		224
		225	sub 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
		235	sub 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
		251	Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the
		252	error instead of exiting the server in case of a problem.
		253
		254	=cut
		255
		256	sub 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
188	The design of crossfire+ requires that the main coro ($Coro::main) is	267	The design of crossfire+ requires that the main coro ($Coro::main) is
189	always able to handle events or runnable, as crossfire+ is only partly	268	always able to handle events or runnable, as crossfire+ is only partly
190	reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.	269	reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
…		…
237	=cut	316	=cut
238		317
239	sub coro(&) {	318	sub 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++...
1091	sub change_all_map_light {	1165	sub 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
1097	sub try_load_header($) {	1172	sub 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
		1190	sub find_map;
1115	sub find_map {	1191	sub 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) {
1128	# safety	1208	# safety
…		…
1142	$map->instantiate;	1222	$map->instantiate;
1143		1223
1144	# per-player maps become, after loading, normal maps	1224	# per-player maps become, after loading, normal maps
1145	$map->per_player (0) if $path->{user_rel};	1225	$map->per_player (0) if $path->{user_rel};
1146	}	1226	}
1147	#Coro::Timer::sleep 1;#d#
1148		1227
1149	$map->path ($key);	1228	$map->path ($key);
1150	$map->{path} = $path;	1229	$map->{path} = $path;
1151	$map->{last_save} = $cf::RUNTIME;	1230	$map->{last_save} = $cf::RUNTIME;
1152	$map->last_access ($cf::RUNTIME);	1231	$map->last_access ($cf::RUNTIME);
1153		1232
1154	if ($map->should_reset) {	1233	if ($map->should_reset) {
1155	$map->reset;	1234	$map->reset;
		1235	undef $guard;
1156	$map = find_map $path;	1236	$map = find_map $path
		1237	or return;
1157	}	1238	}
1158		1239
1159	$cf::MAP{$key} = $map	1240	$cf::MAP{$key} = $map
1160	}	1241	}
1161	}	1242	}
1162		1243
1163	sub load {	1244	sub load {
1164	my ($self) = @_;	1245	my ($self) = @_;
1165		1246
		1247	my $path = $self->{path};
		1248	my $guard = cf::lock_acquire "map_load:" . $path->as_string;
		1249
1166	return if $self->in_memory != cf::MAP_SWAPPED;	1250	return if $self->in_memory != cf::MAP_SWAPPED;
1167		1251
1168	$self->in_memory (cf::MAP_LOADING);	1252	$self->in_memory (cf::MAP_LOADING);
1169
1170	my $path = $self->{path};
1171		1253
1172	$self->alloc;	1254	$self->alloc;
1173	$self->load_objects ($self->{load_path}, 1)	1255	$self->load_objects ($self->{load_path}, 1)
1174	or return;	1256	or return;
1175		1257
…		…
1239	}	1321	}
1240		1322
1241	sub swap_out {	1323	sub swap_out {
1242	my ($self) = @_;	1324	my ($self) = @_;
1243		1325
		1326	# save first because save cedes
		1327	$self->save;
		1328
1244	return if $self->players;	1329	return if $self->players;
1245	return if $self->in_memory != cf::MAP_IN_MEMORY;	1330	return if $self->in_memory != cf::MAP_IN_MEMORY;
1246	return if $self->{deny_save};	1331	return if $self->{deny_save};
1247		1332
1248	$self->save;
1249	$self->clear;	1333	$self->clear;
1250	$self->in_memory (cf::MAP_SWAPPED);	1334	$self->in_memory (cf::MAP_SWAPPED);
1251	}	1335	}
1252		1336
1253	sub reset_at {	1337	sub reset_at {
…		…
1408	=cut	1492	=cut
1409		1493
1410	sub cf::object::player::enter_link {	1494	sub cf::object::player::enter_link {
1411	my ($self) = @_;	1495	my ($self) = @_;
1412		1496
		1497	$self->deactivate_recursive;
		1498
1413	return if $self->map == $LINK_MAP;	1499	return if $self->map == $LINK_MAP;
1414		1500
1415	$self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]	1501	$self->{_link_pos} \|\|= [$self->map->{path}, $self->x, $self->y]
1416	if $self->map;	1502	if $self->map;
1417		1503
1418	$self->enter_map ($LINK_MAP, 20, 20);	1504	$self->enter_map ($LINK_MAP, 20, 20);
1419	$self->deactivate_recursive;
1420	}	1505	}
1421		1506
1422	sub cf::object::player::leave_link {	1507	sub cf::object::player::leave_link {
1423	my ($self, $map, $x, $y) = @_;	1508	my ($self, $map, $x, $y) = @_;
1424		1509
…		…
1447		1532
1448	$self->activate_recursive;	1533	$self->activate_recursive;
1449	$self->enter_map ($map, $x, $y);	1534	$self->enter_map ($map, $x, $y);
1450	}	1535	}
1451		1536
		1537	cf::player->attach (
		1538	on_logout => sub {
		1539	my ($pl) = @_;
		1540
		1541	# abort map switching before logout
		1542	if ($pl->ob->{_link_pos}) {
		1543	cf::sync_job {
		1544	$pl->ob->leave_link
		1545	};
		1546	}
		1547	},
		1548	on_login => sub {
		1549	my ($pl) = @_;
		1550
		1551	# try to abort aborted map switching on player login :)
		1552	# should happen only on crashes
		1553	if ($pl->ob->{_link_pos}) {
		1554	$pl->ob->enter_link;
		1555	cf::async {
		1556	# we need this sleep as the login has a concurrent enter_exit running
		1557	# and this sleep increases chances of the player not ending up in scorn
		1558	Coro::Timer::sleep 1;
		1559	$pl->ob->leave_link;
		1560	};
		1561	}
		1562	},
		1563	);
		1564
1452	=item $player_object->goto_map ($path, $x, $y)	1565	=item $player_object->goto_map ($path, $x, $y)
1453		1566
1454	=cut	1567	=cut
1455		1568
1456	sub cf::object::player::goto_map {	1569	sub cf::object::player::goto_map {
1457	my ($self, $path, $x, $y) = @_;	1570	my ($self, $path, $x, $y) = @_;
1458		1571
1459	$self->enter_link;	1572	$self->enter_link;
1460		1573
1461	(Coro::async {	1574	(cf::async {
1462	$path = new cf::path $path;	1575	$path = new cf::path $path;
1463		1576
1464	my $map = cf::map::find_map $path->as_string;	1577	my $map = cf::map::find_map $path->as_string;
1465	$map = $map->customise_for ($self) if $map;	1578	$map = $map->customise_for ($self) if $map;
1466		1579
…		…
1528		1641
1529	return unless $self->type == cf::PLAYER;	1642	return unless $self->type == cf::PLAYER;
1530		1643
1531	$self->enter_link;	1644	$self->enter_link;
1532		1645
1533	(Coro::async {	1646	(cf::async {
1534	unless (eval {	1647	unless (eval {
1535
1536	prepare_random_map $exit	1648	prepare_random_map $exit
1537	if $exit->slaying eq "/!";	1649	if $exit->slaying eq "/!";
1538		1650
1539	my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;	1651	my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1540	$self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);	1652	$self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
…		…
1602	on_reply => sub {	1714	on_reply => sub {
1603	my ($ns, $msg) = @_;	1715	my ($ns, $msg) = @_;
1604		1716
1605	# this weird shuffling is so that direct followup queries	1717	# this weird shuffling is so that direct followup queries
1606	# get handled first	1718	# get handled first
1607	my $queue = delete $ns->{query_queue};	1719	my $queue = delete $ns->{query_queue}
		1720	or return; # be conservative, not sure how that can happen, but we saw a crash here
1608		1721
1609	(shift @$queue)->[1]->($msg);	1722	(shift @$queue)->[1]->($msg);
1610		1723
1611	push @{ $ns->{query_queue} }, @$queue;	1724	push @{ $ns->{query_queue} }, @$queue;
1612		1725
…		…
1629	=cut	1742	=cut
1630		1743
1631	sub cf::client::coro {	1744	sub cf::client::coro {
1632	my ($self, $cb) = @_;	1745	my ($self, $cb) = @_;
1633		1746
1634	my $coro; $coro = async {	1747	my $coro = &cf::async ($cb);
1635	eval {
1636	$cb->();
1637	};
1638	warn $@ if $@;
1639	};
1640		1748
1641	$coro->on_destroy (sub {	1749	$coro->on_destroy (sub {
1642	delete $self->{_coro}{$coro+0};	1750	delete $self->{_coro}{$coro+0};
1643	});	1751	});
1644		1752
…		…
1816		1924
1817	{	1925	{
1818	my $path = cf::localdir . "/database.pst";	1926	my $path = cf::localdir . "/database.pst";
1819		1927
1820	sub db_load() {	1928	sub db_load() {
1821	warn "loading database $path\n";#d# remove later
1822	$DB = stat $path ? Storable::retrieve $path : { };	1929	$DB = stat $path ? Storable::retrieve $path : { };
1823	}	1930	}
1824		1931
1825	my $pid;	1932	my $pid;
1826		1933
1827	sub db_save() {	1934	sub db_save() {
1828	warn "saving database $path\n";#d# remove later
1829	waitpid $pid, 0 if $pid;	1935	waitpid $pid, 0 if $pid;
1830	if (0 == ($pid = fork)) {	1936	if (0 == ($pid = fork)) {
1831	$DB->{_meta}{version} = 1;	1937	$DB->{_meta}{version} = 1;
1832	Storable::nstore $DB, "$path~";	1938	Storable::nstore $DB, "$path~";
1833	rename "$path~", $path;	1939	rename "$path~", $path;
…		…
1881	open my $fh, "<:utf8", cf::confdir . "/config"	1987	open my $fh, "<:utf8", cf::confdir . "/config"
1882	or return;	1988	or return;
1883		1989
1884	local $/;	1990	local $/;
1885	*CFG = YAML::Syck::Load <$fh>;	1991	*CFG = YAML::Syck::Load <$fh>;
		1992
		1993	$EMERGENCY_POSITION = $CFG{emergency_position} \|\| ["/world/world_105_115", 5, 37];
		1994
		1995	if (exists $CFG{mlockall}) {
		1996	eval {
		1997	$CFG{mlockall} ? &mlockall : &munlockall
		1998	and die "WARNING: m(un)lockall failed: $!\n";
		1999	};
		2000	warn $@ if $@;
		2001	}
1886	}	2002	}
1887		2003
1888	sub main {	2004	sub main {
1889	# we must not ever block the main coroutine	2005	# we must not ever block the main coroutine
1890	local $Coro::idle = sub {	2006	local $Coro::idle = sub {
…		…
2093	or warn "ERROR: unable to write runtime file: $!";	2209	or warn "ERROR: unable to write runtime file: $!";
2094	})->();	2210	})->();
2095	},	2211	},
2096	);	2212	);
2097		2213
		2214	END { cf::emergency_save }
		2215
2098	1	2216	1
2099		2217

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.119 by root, Tue Jan 2 08:26:42 2007 UTC vs. Revision 1.131 by root, Thu Jan 4 00:53:54 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.119 by root, Tue Jan 2 08:26:42 2007 UTC vs.
Revision 1.131 by root, Thu Jan 4 00:53:54 2007 UTC