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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.117 by root, Mon Jan 1 17:50:26 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;
…		…
817	(aio_load "$filename.pst", $av) >= 0	891	(aio_load "$filename.pst", $av) >= 0
818	or return;	892	or return;
819	$av = eval { (Storable::thaw $av)->{objs} };	893	$av = eval { (Storable::thaw $av)->{objs} };
820	}	894	}
821		895
		896	warn sprintf "loading %s (%d)\n",
		897	$filename, length $data, scalar @{$av \|\| []};#d#
822	return ($data, $av);	898	return ($data, $av);
823	}	899	}
824		900
825	#############################################################################	901	#############################################################################
826	# command handling &c	902	# command handling &c
…		…
1087	# and all this just because we cannot iterate over	1163	# and all this just because we cannot iterate over
1088	# all maps in C++...	1164	# all maps in C++...
1089	sub change_all_map_light {	1165	sub change_all_map_light {
1090	my ($change) = @_;	1166	my ($change) = @_;
1091		1167
1092	$_->change_map_light ($change) for values %cf::MAP;	1168	$_->change_map_light ($change)
		1169	for grep $_->outdoor, values %cf::MAP;
1093	}	1170	}
1094		1171
1095	sub try_load_header($) {	1172	sub try_load_header($) {
1096	my ($path) = @_;	1173	my ($path) = @_;
1097		1174
…		…
1108	$map->{load_path} = $path;	1185	$map->{load_path} = $path;
1109		1186
1110	$map	1187	$map
1111	}	1188	}
1112		1189
		1190	sub find_map;
1113	sub find_map {	1191	sub find_map {
1114	my ($path, $origin) = @_;	1192	my ($path, $origin) = @_;
1115		1193
1116	#warn "find_map<$path,$origin>\n";#d#	1194	#warn "find_map<$path,$origin>\n";#d#
1117		1195
1118	$path = new cf::path $path, $origin && $origin->path;	1196	$path = new cf::path $path, $origin && $origin->path;
1119	my $key = $path->as_string;	1197	my $key = $path->as_string;
1120		1198
		1199	cf::lock_wait "map_find:$key";
		1200
1121	$cf::MAP{$key} \|\| do {	1201	$cf::MAP{$key} \|\| do {
		1202	my $guard = cf::lock_acquire "map_find:$key";
		1203
1122	# do it the slow way	1204	# do it the slow way
1123	my $map = try_load_header $path->save_path;	1205	my $map = try_load_header $path->save_path;
1124		1206
1125	if ($map) {	1207	if ($map) {
1126	# safety	1208	# safety
…		…
1148	$map->{last_save} = $cf::RUNTIME;	1230	$map->{last_save} = $cf::RUNTIME;
1149	$map->last_access ($cf::RUNTIME);	1231	$map->last_access ($cf::RUNTIME);
1150		1232
1151	if ($map->should_reset) {	1233	if ($map->should_reset) {
1152	$map->reset;	1234	$map->reset;
		1235	undef $guard;
1153	$map = find_map $path;	1236	$map = find_map $path
		1237	or return;
1154	}	1238	}
1155		1239
1156	$cf::MAP{$key} = $map	1240	$cf::MAP{$key} = $map
1157	}	1241	}
1158	}	1242	}
1159		1243
1160	sub load {	1244	sub load {
1161	my ($self) = @_;	1245	my ($self) = @_;
1162		1246
		1247	my $path = $self->{path};
		1248	my $guard = cf::lock_acquire "map_load:" . $path->as_string;
		1249
1163	return if $self->in_memory != cf::MAP_SWAPPED;	1250	return if $self->in_memory != cf::MAP_SWAPPED;
1164		1251
1165	$self->in_memory (cf::MAP_LOADING);	1252	$self->in_memory (cf::MAP_LOADING);
1166
1167	my $path = $self->{path};
1168		1253
1169	$self->alloc;	1254	$self->alloc;
1170	$self->load_objects ($self->{load_path}, 1)	1255	$self->load_objects ($self->{load_path}, 1)
1171	or return;	1256	or return;
1172		1257
…		…
1236	}	1321	}
1237		1322
1238	sub swap_out {	1323	sub swap_out {
1239	my ($self) = @_;	1324	my ($self) = @_;
1240		1325
		1326	# save first because save cedes
		1327	$self->save;
		1328
1241	return if $self->players;	1329	return if $self->players;
1242	return if $self->in_memory != cf::MAP_IN_MEMORY;	1330	return if $self->in_memory != cf::MAP_IN_MEMORY;
1243	return if $self->{deny_save};	1331	return if $self->{deny_save};
1244		1332
1245	$self->save;
1246	$self->clear;	1333	$self->clear;
1247	$self->in_memory (cf::MAP_SWAPPED);	1334	$self->in_memory (cf::MAP_SWAPPED);
1248	}	1335	}
1249		1336
1250	sub reset_at {	1337	sub reset_at {
…		…
1405	=cut	1492	=cut
1406		1493
1407	sub cf::object::player::enter_link {	1494	sub cf::object::player::enter_link {
1408	my ($self) = @_;	1495	my ($self) = @_;
1409		1496
		1497	$self->deactivate_recursive;
		1498
1410	return if $self->map == $LINK_MAP;	1499	return if $self->map == $LINK_MAP;
1411		1500
1412	$self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]	1501	$self->{_link_pos} \|\|= [$self->map->{path}, $self->x, $self->y]
1413	if $self->map;	1502	if $self->map;
1414		1503
1415	$self->enter_map ($LINK_MAP, 20, 20);	1504	$self->enter_map ($LINK_MAP, 20, 20);
1416	$self->deactivate_recursive;
1417	}	1505	}
1418		1506
1419	sub cf::object::player::leave_link {	1507	sub cf::object::player::leave_link {
1420	my ($self, $map, $x, $y) = @_;	1508	my ($self, $map, $x, $y) = @_;
1421		1509
…		…
1444		1532
1445	$self->activate_recursive;	1533	$self->activate_recursive;
1446	$self->enter_map ($map, $x, $y);	1534	$self->enter_map ($map, $x, $y);
1447	}	1535	}
1448		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
1449	=item $player_object->goto_map ($map, $x, $y)	1565	=item $player_object->goto_map ($path, $x, $y)
1450		1566
1451	=cut	1567	=cut
1452		1568
1453	sub cf::object::player::goto_map {	1569	sub cf::object::player::goto_map {
1454	my ($self, $path, $x, $y) = @_;	1570	my ($self, $path, $x, $y) = @_;
1455		1571
1456	$self->enter_link;	1572	$self->enter_link;
1457		1573
1458	(Coro::async {	1574	(cf::async {
1459	$path = new cf::path $path;	1575	$path = new cf::path $path;
1460		1576
1461	my $map = cf::map::find_map $path->as_string;	1577	my $map = cf::map::find_map $path->as_string;
1462	$map = $map->customise_for ($self) if $map;	1578	$map = $map->customise_for ($self) if $map;
1463		1579
1464	warn "entering ", $map->path, " at ($x, $y)\n"	1580	# warn "entering ", $map->path, " at ($x, $y)\n"
1465	if $map;	1581	# if $map;
1466		1582
1467	$map or $self->message ("The exit is closed", cf::NDI_UNIQUE \| cf::NDI_RED);	1583	$map or $self->message ("The exit is closed", cf::NDI_UNIQUE \| cf::NDI_RED);
1468		1584
1469	$self->leave_link ($map, $x, $y);	1585	$self->leave_link ($map, $x, $y);
1470	})->prio (1);	1586	})->prio (1);
…		…
1525		1641
1526	return unless $self->type == cf::PLAYER;	1642	return unless $self->type == cf::PLAYER;
1527		1643
1528	$self->enter_link;	1644	$self->enter_link;
1529		1645
1530	(Coro::async {	1646	(cf::async {
1531	unless (eval {	1647	unless (eval {
1532
1533	prepare_random_map $exit	1648	prepare_random_map $exit
1534	if $exit->slaying eq "/!";	1649	if $exit->slaying eq "/!";
1535		1650
1536	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;
1537	$self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);	1652	$self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
…		…
1599	on_reply => sub {	1714	on_reply => sub {
1600	my ($ns, $msg) = @_;	1715	my ($ns, $msg) = @_;
1601		1716
1602	# this weird shuffling is so that direct followup queries	1717	# this weird shuffling is so that direct followup queries
1603	# get handled first	1718	# get handled first
1604	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
1605		1721
1606	(shift @$queue)->[1]->($msg);	1722	(shift @$queue)->[1]->($msg);
1607		1723
1608	push @{ $ns->{query_queue} }, @$queue;	1724	push @{ $ns->{query_queue} }, @$queue;
1609		1725
…		…
1626	=cut	1742	=cut
1627		1743
1628	sub cf::client::coro {	1744	sub cf::client::coro {
1629	my ($self, $cb) = @_;	1745	my ($self, $cb) = @_;
1630		1746
1631	my $coro; $coro = async {	1747	my $coro = &cf::async ($cb);
1632	eval {
1633	$cb->();
1634	};
1635	warn $@ if $@;
1636	};
1637		1748
1638	$coro->on_destroy (sub {	1749	$coro->on_destroy (sub {
1639	delete $self->{_coro}{$coro+0};	1750	delete $self->{_coro}{$coro+0};
1640	});	1751	});
1641		1752
…		…
1813		1924
1814	{	1925	{
1815	my $path = cf::localdir . "/database.pst";	1926	my $path = cf::localdir . "/database.pst";
1816		1927
1817	sub db_load() {	1928	sub db_load() {
1818	warn "loading database $path\n";#d# remove later
1819	$DB = stat $path ? Storable::retrieve $path : { };	1929	$DB = stat $path ? Storable::retrieve $path : { };
1820	}	1930	}
1821		1931
1822	my $pid;	1932	my $pid;
1823		1933
1824	sub db_save() {	1934	sub db_save() {
1825	warn "saving database $path\n";#d# remove later
1826	waitpid $pid, 0 if $pid;	1935	waitpid $pid, 0 if $pid;
1827	if (0 == ($pid = fork)) {	1936	if (0 == ($pid = fork)) {
1828	$DB->{_meta}{version} = 1;	1937	$DB->{_meta}{version} = 1;
1829	Storable::nstore $DB, "$path~";	1938	Storable::nstore $DB, "$path~";
1830	rename "$path~", $path;	1939	rename "$path~", $path;
…		…
1878	open my $fh, "<:utf8", cf::confdir . "/config"	1987	open my $fh, "<:utf8", cf::confdir . "/config"
1879	or return;	1988	or return;
1880		1989
1881	local $/;	1990	local $/;
1882	*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	}
1883	}	2002	}
1884		2003
1885	sub main {	2004	sub main {
1886	# we must not ever block the main coroutine	2005	# we must not ever block the main coroutine
1887	local $Coro::idle = sub {	2006	local $Coro::idle = sub {
…		…
2090	or warn "ERROR: unable to write runtime file: $!";	2209	or warn "ERROR: unable to write runtime file: $!";
2091	})->();	2210	})->();
2092	},	2211	},
2093	);	2212	);
2094		2213
		2214	END { cf::emergency_save }
		2215
2095	1	2216	1
2096		2217

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.117 by root, Mon Jan 1 17:50:26 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.117 by root, Mon Jan 1 17:50:26 2007 UTC vs.
Revision 1.131 by root, Thu Jan 4 00:53:54 2007 UTC