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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.140 by root, Fri Jan 5 20:04:02 2007 UTC vs.
Revision 1.158 by root, Wed Jan 10 19:52:43 2007 UTC

…		…
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;
19		19
		20	use Data::Dumper;
20	use Digest::MD5;	21	use Digest::MD5;
21	use Fcntl;	22	use Fcntl;
22	use IO::AIO 2.31 ();	23	use IO::AIO 2.32 ();
23	use YAML::Syck ();	24	use YAML::Syck ();
24	use Time::HiRes;	25	use Time::HiRes;
25		26
26	use Event; $Event::Eval = 1; # no idea why this is required, but it is	27	use Event; $Event::Eval = 1; # no idea why this is required, but it is
27		28
		29	sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
		30
28	# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?	31	# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
29	$YAML::Syck::ImplicitUnicode = 1;	32	$YAML::Syck::ImplicitUnicode = 1;
30		33
31	$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority	34	$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
32
33	sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload
34		35
35	our %COMMAND = ();	36	our %COMMAND = ();
36	our %COMMAND_TIME = ();	37	our %COMMAND_TIME = ();
37	our %EXTCMD = ();	38	our %EXTCMD = ();
38		39
…		…
47	our %CFG;	48	our %CFG;
48		49
49	our $UPTIME; $UPTIME \|\|= time;	50	our $UPTIME; $UPTIME \|\|= time;
50	our $RUNTIME;	51	our $RUNTIME;
51		52
		53	our %PLAYER; # all users
52	our %MAP; # all maps	54	our %MAP; # all maps
53	our $LINK_MAP; # the special {link} map	55	our $LINK_MAP; # the special {link} map
54	our $RANDOM_MAPS = cf::localdir . "/random";	56	our $RANDOM_MAPS = cf::localdir . "/random";
55	our %EXT_CORO;	57	our %EXT_CORO; # coroutines bound to extensions
		58
		59	our $WAIT_FOR_TICK; $WAIT_FOR_TICK \|\|= new Coro::Signal;
		60	our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE \|\|= new Coro::Signal;
56		61
57	binmode STDOUT;	62	binmode STDOUT;
58	binmode STDERR;	63	binmode STDERR;
59		64
60	# read virtual server time, if available	65	# read virtual server time, if available
…		…
105	=item %cf::CFG	110	=item %cf::CFG
106		111
107	Configuration for the server, loaded from C</etc/crossfire/config>, or	112	Configuration for the server, loaded from C</etc/crossfire/config>, or
108	from wherever your confdir points to.	113	from wherever your confdir points to.
109		114
		115	=item $cf::WAIT_FOR_TICK, $cf::WAIT_FOR_TICK_ONE
		116
		117	These are Coro::Signal objects that are C<< ->broadcast >> (WAIT_FOR_TICK)
		118	or C<< ->send >> (WAIT_FOR_TICK_ONE) on after normal server tick
		119	processing has been done. Call C<< ->wait >> on them to maximise the
		120	window of cpu time available, or simply to synchronise to the server tick.
		121
110	=back	122	=back
111		123
112	=cut	124	=cut
113		125
114	BEGIN {	126	BEGIN {
…		…
117	utf8::encode $msg;	129	utf8::encode $msg;
118		130
119	$msg .= "\n"	131	$msg .= "\n"
120	unless $msg =~ /\n$/;	132	unless $msg =~ /\n$/;
121		133
122	LOG llevError, "cfperl: $msg";	134	LOG llevError, $msg;
123	};	135	};
124	}	136	}
125		137
126	@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';	138	@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
127	@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';	139	@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
…		…
153		165
154	=head2 UTILITY FUNCTIONS	166	=head2 UTILITY FUNCTIONS
155		167
156	=over 4	168	=over 4
157		169
		170	=item dumpval $ref
		171
158	=cut	172	=cut
		173
		174	sub dumpval {
		175	eval {
		176	local $SIG{__DIE__};
		177	my $d;
		178	if (1) {
		179	$d = new Data::Dumper([$_[0]], ["*var"]);
		180	$d->Terse(1);
		181	$d->Indent(2);
		182	$d->Quotekeys(0);
		183	$d->Useqq(1);
		184	#$d->Bless(...);
		185	$d->Seen($_[1]) if @_ > 1;
		186	$d = $d->Dump();
		187	}
		188	$d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
		189	$d
		190	} \|\| "[unable to dump $_[0]: '$@']";
		191	}
159		192
160	use JSON::Syck (); # TODO# replace by JSON::PC once working	193	use JSON::Syck (); # TODO# replace by JSON::PC once working
161		194
162	=item $ref = cf::from_json $json	195	=item $ref = cf::from_json $json
163		196
…		…
273	warn $@ if $@;	306	warn $@ if $@;
274	undef $busy;	307	undef $busy;
275	})->prio (Coro::PRIO_MAX);	308	})->prio (Coro::PRIO_MAX);
276		309
277	while ($busy) {	310	while ($busy) {
278	unless (Coro::cede) {	311	Coro::cede or Event::one_event;
279	Coro::nready ? Event::one_event 0 : Event::one_event;
280	Coro::cede_notself unless Coro::cede;
281	}
282	}	312	}
283		313
284	wantarray ? @res : $res[0]	314	wantarray ? @res : $res[0]
285	} else {	315	} else {
286	# we are in another coroutine, how wonderful, everything just works	316	# we are in another coroutine, how wonderful, everything just works
…		…
336	=cut	366	=cut
337		367
338	#############################################################################	368	#############################################################################
339		369
340	package cf::path;	370	package cf::path;
		371
		372	use overload
		373	'""' => \&as_string;
		374
		375	# used to convert map paths into valid unix filenames by repalcing / by ∕
		376	our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
341		377
342	sub new {	378	sub new {
343	my ($class, $path, $base) = @_;	379	my ($class, $path, $base) = @_;
344		380
345	$path = $path->as_string if ref $path;	381	$path = $path->as_string if ref $path;
…		…
351	# ?random/... random maps	387	# ?random/... random maps
352	# /! non-realised random map exit	388	# /! non-realised random map exit
353	# /... normal maps	389	# /... normal maps
354	# ~/... per-player maps without a specific player (DO NOT USE)	390	# ~/... per-player maps without a specific player (DO NOT USE)
355	# ~user/... per-player map of a specific user	391	# ~user/... per-player map of a specific user
		392
		393	$path =~ s/$PATH_SEP/\//go;
356		394
357	if ($path =~ /^{/) {	395	if ($path =~ /^{/) {
358	# fine as it is	396	# fine as it is
359	} elsif ($path =~ s{^\?random/}{}) {	397	} elsif ($path =~ s{^\?random/}{}) {
360	Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;	398	Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
…		…
409	# }	447	# }
410	}	448	}
411		449
412	# escape the /'s in the path	450	# escape the /'s in the path
413	sub _escaped_path {	451	sub _escaped_path {
414	# ∕ is U+2215
415	(my $path = $_[0]{path}) =~ s/\//∕/g;	452	(my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
416	$path	453	$path
417	}	454	}
418		455
419	# the original (read-only) location	456	# the original (read-only) location
420	sub load_path {	457	sub load_path {
…		…
1047	};	1084	};
1048		1085
1049	cf::map->attach (prio => -10000, package => cf::mapsupport::);	1086	cf::map->attach (prio => -10000, package => cf::mapsupport::);
1050		1087
1051	#############################################################################	1088	#############################################################################
1052	# load/save perl data associated with player->ob objects
1053
1054	sub all_objects(@) {
1055	@_, map all_objects ($_->inv), @_
1056	}
1057
1058	# TODO: compatibility cruft, remove when no longer needed
1059	cf::player->attach (
1060	on_load => sub {
1061	my ($pl, $path) = @_;
1062
1063	for my $o (all_objects $pl->ob) {
1064	if (my $value = $o->get_ob_key_value ("_perl_data")) {
1065	$o->set_ob_key_value ("_perl_data");
1066
1067	%$o = %{ Storable::thaw pack "H*", $value };
1068	}
1069	}
1070	},
1071	);
1072
1073	#############################################################################
1074		1089
1075	=head2 CORE EXTENSIONS	1090	=head2 CORE EXTENSIONS
1076		1091
1077	Functions and methods that extend core crossfire objects.	1092	Functions and methods that extend core crossfire objects.
1078		1093
		1094	=cut
		1095
		1096	package cf::player;
		1097
		1098	use Coro::AIO;
		1099
1079	=head3 cf::player	1100	=head3 cf::player
1080		1101
1081	=over 4	1102	=over 4
1082		1103
1083	=item cf::player::exists $login	1104	=item cf::player::find $login
1084		1105
1085	Returns true when the given account exists.	1106	Returns the given player object, loading it if necessary (might block).
1086		1107
1087	=cut	1108	=cut
1088		1109
1089	sub cf::player::exists($) {	1110	sub playerdir($) {
1090	cf::player::find $_[0]	1111	cf::localdir
1091	or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;	1112	. "/"
		1113	. cf::playerdir
		1114	. "/"
		1115	. (ref $_[0] ? $_[0]->ob->name : $_[0])
		1116	}
		1117
		1118	sub path($) {
		1119	my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
		1120
		1121	(playerdir $login) . "/$login.pl"
		1122	}
		1123
		1124	sub find_active($) {
		1125	$cf::PLAYER{$_[0]}
		1126	and $cf::PLAYER{$_[0]}->active
		1127	and $cf::PLAYER{$_[0]}
		1128	}
		1129
		1130	sub exists($) {
		1131	my ($login) = @_;
		1132
		1133	$cf::PLAYER{$login}
		1134	or cf::sync_job { !aio_stat $login }
		1135	}
		1136
		1137	sub find($) {
		1138	return $cf::PLAYER{$_[0]} \|\| do {
		1139	my $login = $_[0];
		1140
		1141	my $guard = cf::lock_acquire "user_find:$login";
		1142
		1143	$cf::PLAYER{$_[0]} \|\| do {
		1144	my $pl = load_pl path $login
		1145	or return;
		1146	$cf::PLAYER{$login} = $pl
		1147	}
		1148	}
		1149	}
		1150
		1151	sub save($) {
		1152	my ($pl) = @_;
		1153
		1154	return if $pl->{deny_save};
		1155
		1156	my $path = path $pl;
		1157	my $guard = cf::lock_acquire "user_save:$path";
		1158
		1159	return if $pl->{deny_save};
		1160
		1161	aio_mkdir playerdir $pl, 0770;
		1162	$pl->{last_save} = $cf::RUNTIME;
		1163
		1164	$pl->save_pl ($path);
		1165	Coro::cede;
		1166	}
		1167
		1168	sub new($) {
		1169	my ($login) = @_;
		1170
		1171	my $self = create;
		1172
		1173	$self->ob->name ($login);
		1174	$self->{deny_save} = 1;
		1175
		1176	$cf::PLAYER{$login} = $self;
		1177
		1178	$self
		1179	}
		1180
		1181	=item $pl->quit_character
		1182
		1183	Nukes the player without looking back. If logged in, the connection will
		1184	be destroyed. May block for a long time.
		1185
		1186	=cut
		1187
		1188	sub quit_character {
		1189	my ($pl) = @_;
		1190
		1191	$pl->{deny_save} = 1;
		1192	$pl->password ("*"); # this should lock out the player until we nuked the dir
		1193
		1194	$pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
		1195	$pl->deactivate;
		1196	$pl->invoke (cf::EVENT_PLAYER_QUIT);
		1197	$pl->ns->destroy if $pl->ns;
		1198
		1199	my $path = playerdir $pl;
		1200	my $temp = "$path~$cf::RUNTIME~deleting~";
		1201	aio_rename $path, $temp;
		1202	delete $cf::PLAYER{$pl->ob->name};
		1203	$pl->destroy;
		1204	IO::AIO::aio_rmtree $temp;
		1205	}
		1206
		1207	=item cf::player::list_logins
		1208
		1209	Returns am arrayref of all valid playernames in the system, can take a
		1210	while and may block, so not sync_job-capable, ever.
		1211
		1212	=cut
		1213
		1214	sub list_logins {
		1215	my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir
		1216	or return [];
		1217
		1218	my @logins;
		1219
		1220	for my $login (@$dirs) {
		1221	my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next;
		1222	aio_read $fh, 0, 512, my $buf, 0 or next;
		1223	$buf !~ /^password -------------$/m or next; # official not-valid tag
		1224
		1225	utf8::decode $login;
		1226	push @logins, $login;
		1227	}
		1228
		1229	\@logins
		1230	}
		1231
		1232	=item $player->maps
		1233
		1234	Returns an arrayref of cf::path's of all maps that are private for this
		1235	player. May block.
		1236
		1237	=cut
		1238
		1239	sub maps($) {
		1240	my ($pl) = @_;
		1241
		1242	my $files = aio_readdir playerdir $pl
		1243	or return;
		1244
		1245	my @paths;
		1246
		1247	for (@$files) {
		1248	utf8::decode $_;
		1249	next if /\.(?:pl\|pst)$/;
		1250	next unless /^$PATH_SEP/o;
		1251
		1252	push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
		1253	}
		1254
		1255	\@paths
1092	}	1256	}
1093		1257
1094	=item $player->ext_reply ($msgid, $msgtype, %msg)	1258	=item $player->ext_reply ($msgid, $msgtype, %msg)
1095		1259
1096	Sends an ext reply to the player.	1260	Sends an ext reply to the player.
1097		1261
1098	=cut	1262	=cut
1099		1263
1100	sub cf::player::ext_reply($$$%) {	1264	sub ext_reply($$$%) {
1101	my ($self, $id, %msg) = @_;	1265	my ($self, $id, %msg) = @_;
1102		1266
1103	$msg{msgid} = $id;	1267	$msg{msgid} = $id;
1104		1268
1105	$self->send ("ext " . to_json \%msg);	1269	$self->send ("ext " . cf::to_json \%msg);
1106	}	1270	}
		1271
		1272	package cf;
1107		1273
1108	=back	1274	=back
1109		1275
1110		1276
1111	=head3 cf::map	1277	=head3 cf::map
…		…
1277	Coro::cede;	1443	Coro::cede;
1278		1444
1279	$self->in_memory (cf::MAP_IN_MEMORY);	1445	$self->in_memory (cf::MAP_IN_MEMORY);
1280	}	1446	}
1281		1447
		1448	# find and load all maps in the 3x3 area around a map
		1449	sub load_diag {
		1450	my ($map) = @_;
		1451
		1452	my @diag; # diagonal neighbours
		1453
		1454	for (0 .. 3) {
		1455	my $neigh = $map->tile_path ($_)
		1456	or next;
		1457	$neigh = find $neigh, $map
		1458	or next;
		1459	$neigh->load;
		1460
		1461	push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
		1462	[$neigh->tile_path (($_ + 1) % 4), $neigh];
		1463	}
		1464
		1465	for (@diag) {
		1466	my $neigh = find @$_
		1467	or next;
		1468	$neigh->load;
		1469	}
		1470	}
		1471
1282	sub find_sync {	1472	sub find_sync {
1283	my ($path, $origin) = @_;	1473	my ($path, $origin) = @_;
1284		1474
1285	cf::sync_job { cf::map::find $path, $origin }	1475	cf::sync_job { find $path, $origin }
1286	}	1476	}
1287		1477
1288	sub do_load_sync {	1478	sub do_load_sync {
1289	my ($map) = @_;	1479	my ($map) = @_;
1290		1480
1291	cf::sync_job { $map->load };	1481	cf::sync_job { $map->load };
1292	}	1482	}
1293		1483
		1484	our %MAP_PREFETCH;
		1485	our $MAP_PREFETCHER = Coro::async {
		1486	while () {
		1487	while (%MAP_PREFETCH) {
		1488	my $key = each %MAP_PREFETCH
		1489	or next;
		1490	my $path = delete $MAP_PREFETCH{$key};
		1491
		1492	my $map = find $path
		1493	or next;
		1494	$map->load;
		1495	}
		1496	Coro::schedule;
		1497	}
		1498	};
		1499
		1500	sub find_async {
		1501	my ($path, $origin) = @_;
		1502
		1503	$path = new cf::path $path, $origin && $origin->path;
		1504	my $key = $path->as_string;
		1505
		1506	if (my $map = $cf::MAP{$key}) {
		1507	return $map if $map->in_memory == cf::MAP_IN_MEMORY;
		1508	}
		1509
		1510	$MAP_PREFETCH{$key} = $path;
		1511	$MAP_PREFETCHER->ready;
		1512
		1513	()
		1514	}
		1515
1294	sub save {	1516	sub save {
1295	my ($self) = @_;	1517	my ($self) = @_;
1296		1518
1297	my $lock = cf::lock_acquire "map_data:" . $self->path;	1519	my $lock = cf::lock_acquire "map_data:" . $self->path;
1298		1520
…		…
1306	$self->{load_path} = $save;	1528	$self->{load_path} = $save;
1307		1529
1308	return if $self->{deny_save};	1530	return if $self->{deny_save};
1309		1531
1310	local $self->{last_access} = $self->last_access;#d#	1532	local $self->{last_access} = $self->last_access;#d#
		1533
		1534	cf::async {
		1535	$_->contr->save for $self->players;
		1536	};
1311		1537
1312	if ($uniq) {	1538	if ($uniq) {
1313	$self->save_objects ($save, cf::IO_HEADER \| cf::IO_OBJECTS);	1539	$self->save_objects ($save, cf::IO_HEADER \| cf::IO_OBJECTS);
1314	$self->save_objects ($uniq, cf::IO_UNIQUES);	1540	$self->save_objects ($uniq, cf::IO_UNIQUES);
1315	} else {	1541	} else {
…		…
1410	}	1636	}
1411		1637
1412	$map	1638	$map
1413	}	1639	}
1414		1640
1415	sub emergency_save {	1641	=item cf::map::unique_maps
1416	my $freeze_guard = cf::freeze_mainloop;
1417		1642
1418	warn "enter emergency map save\n";	1643	Returns an arrayref of cf::path's of all shared maps that have
		1644	instantiated unique items. May block.
1419		1645
1420	cf::sync_job {	1646	=cut
1421	warn "begin emergency map save\n";	1647
1422	$_->save for values %cf::MAP;	1648	sub unique_maps() {
		1649	my $files = aio_readdir cf::localdir . "/" . cf::uniquedir
		1650	or return;
		1651
		1652	my @paths;
		1653
		1654	for (@$files) {
		1655	utf8::decode $_;
		1656	next if /\.pst$/;
		1657	next unless /^$PATH_SEP/o;
		1658
		1659	push @paths, new cf::path $_;
1423	};	1660	}
1424		1661
1425	warn "end emergency map save\n";	1662	\@paths
1426	}	1663	}
1427		1664
1428	package cf;	1665	package cf;
1429		1666
1430	=back	1667	=back
1431		1668
		1669	=head3 cf::object
		1670
		1671	=cut
		1672
		1673	package cf::object;
		1674
		1675	=over 4
		1676
		1677	=item $ob->inv_recursive
		1678
		1679	Returns the inventory of the object _and_ their inventories, recursively.
		1680
		1681	=cut
		1682
		1683	sub inv_recursive_;
		1684	sub inv_recursive_ {
		1685	map { $_, inv_recursive_ $_->inv } @_
		1686	}
		1687
		1688	sub inv_recursive {
		1689	inv_recursive_ inv $_[0]
		1690	}
		1691
		1692	package cf;
		1693
		1694	=back
1432		1695
1433	=head3 cf::object::player	1696	=head3 cf::object::player
1434		1697
1435	=over 4	1698	=over 4
1436		1699
…		…
1528	# use -1 or undef as default coordinates, not 0, 0	1791	# use -1 or undef as default coordinates, not 0, 0
1529	($x, $y) = ($map->enter_x, $map->enter_y)	1792	($x, $y) = ($map->enter_x, $map->enter_y)
1530	if $x <=0 && $y <= 0;	1793	if $x <=0 && $y <= 0;
1531		1794
1532	$map->load;	1795	$map->load;
		1796	$map->load_diag;
1533		1797
		1798	return unless $self->contr->active;
1534	$self->activate_recursive;	1799	$self->activate_recursive;
1535	$self->enter_map ($map, $x, $y);	1800	$self->enter_map ($map, $x, $y);
1536	}	1801	}
1537		1802
1538	cf::player->attach (	1803	cf::player->attach (
…		…
1550	my ($pl) = @_;	1815	my ($pl) = @_;
1551		1816
1552	# try to abort aborted map switching on player login :)	1817	# try to abort aborted map switching on player login :)
1553	# should happen only on crashes	1818	# should happen only on crashes
1554	if ($pl->ob->{_link_pos}) {	1819	if ($pl->ob->{_link_pos}) {
1555
1556	$pl->ob->enter_link;	1820	$pl->ob->enter_link;
1557	(async {	1821	(async {
1558	# we need this sleep as the login has a concurrent enter_exit running	1822	# we need this sleep as the login has a concurrent enter_exit running
1559	# and this sleep increases chances of the player not ending up in scorn	1823	# and this sleep increases chances of the player not ending up in scorn
1560	$pl->ob->reply (undef,	1824	$pl->ob->reply (undef,
…		…
1573	=cut	1837	=cut
1574		1838
1575	sub cf::object::player::goto {	1839	sub cf::object::player::goto {
1576	my ($self, $path, $x, $y) = @_;	1840	my ($self, $path, $x, $y) = @_;
1577		1841
		1842	$path = new cf::path $path;
		1843
1578	$self->enter_link;	1844	$self->enter_link;
1579		1845
1580	(async {	1846	(async {
1581	$path = new cf::path $path;
1582
1583	my $map = cf::map::find $path->as_string;	1847	my $map = cf::map::find $path->as_string;
1584	$map = $map->customise_for ($self) if $map;	1848	$map = $map->customise_for ($self) if $map;
1585		1849
1586	# warn "entering ", $map->path, " at ($x, $y)\n"	1850	# warn "entering ", $map->path, " at ($x, $y)\n"
1587	# if $map;	1851	# if $map;
1588		1852
1589	$map or $self->message ("The exit is closed", cf::NDI_UNIQUE \| cf::NDI_RED);	1853	$map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE \| cf::NDI_RED);
1590		1854
1591	$self->leave_link ($map, $x, $y);	1855	$self->leave_link ($map, $x, $y);
1592	})->prio (1);	1856	})->prio (1);
1593	}	1857	}
1594		1858
…		…
1660		1924
1661	1;	1925	1;
1662	}) {	1926	}) {
1663	$self->message ("Something went wrong deep within the crossfire server. "	1927	$self->message ("Something went wrong deep within the crossfire server. "
1664	. "I'll try to bring you back to the map you were before. "	1928	. "I'll try to bring you back to the map you were before. "
1665	. "Please report this to the dungeon master",	1929	. "Please report this to the dungeon master!",
1666	cf::NDI_UNIQUE \| cf::NDI_RED);	1930	cf::NDI_UNIQUE \| cf::NDI_RED);
1667		1931
1668	warn "ERROR in enter_exit: $@";	1932	warn "ERROR in enter_exit: $@";
1669	$self->leave_link;	1933	$self->leave_link;
1670	}	1934	}
…		…
2002	$cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};	2266	$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};	2267	$cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2004		2268
2005	if (exists $CFG{mlockall}) {	2269	if (exists $CFG{mlockall}) {
2006	eval {	2270	eval {
2007	$CFG{mlockall} ? &mlockall : &munlockall	2271	$CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2008	and die "WARNING: m(un)lockall failed: $!\n";	2272	and die "WARNING: m(un)lockall failed: $!\n";
2009	};	2273	};
2010	warn $@ if $@;	2274	warn $@ if $@;
2011	}	2275	}
2012	}	2276	}
…		…
2023	load_extensions;	2287	load_extensions;
2024	Event::loop;	2288	Event::loop;
2025	}	2289	}
2026		2290
2027	#############################################################################	2291	#############################################################################
2028	# initialisation	2292	# initialisation and cleanup
		2293
		2294	# install some emergency cleanup handlers
		2295	BEGIN {
		2296	for my $signal (qw(INT HUP TERM)) {
		2297	Event->signal (
		2298	data => WF_AUTOCANCEL,
		2299	signal => $signal,
		2300	cb => sub {
		2301	cf::cleanup "SIG$signal";
		2302	},
		2303	);
		2304	}
		2305	}
		2306
		2307	sub emergency_save() {
		2308	my $freeze_guard = cf::freeze_mainloop;
		2309
		2310	warn "enter emergency perl save\n";
		2311
		2312	cf::sync_job {
		2313	# use a peculiar iteration method to avoid tripping on perl
		2314	# refcount bugs in for. also avoids problems with players
		2315	# and maps saved/Destroyed asynchronously.
		2316	warn "begin emergency player save\n";
		2317	for my $login (keys %cf::PLAYER) {
		2318	my $pl = $cf::PLAYER{$login} or next;
		2319	$pl->valid or next;
		2320	$pl->save;
		2321	}
		2322	warn "end emergency player save\n";
		2323
		2324	warn "begin emergency map save\n";
		2325	for my $path (keys %cf::MAP) {
		2326	my $map = $cf::MAP{$path} or next;
		2327	$map->valid or next;
		2328	$map->save;
		2329	}
		2330	warn "end emergency map save\n";
		2331	};
		2332
		2333	warn "leave emergency perl save\n";
		2334	}
2029		2335
2030	sub reload() {	2336	sub reload() {
2031	# can/must only be called in main	2337	# can/must only be called in main
2032	if ($Coro::current != $Coro::main) {	2338	if ($Coro::current != $Coro::main) {
2033	warn "can only reload from main coroutine\n";	2339	warn "can only reload from main coroutine\n";
…		…
2106	cf::load_extensions;	2412	cf::load_extensions;
2107		2413
2108	# reattach attachments to objects	2414	# reattach attachments to objects
2109	warn "reattach";	2415	warn "reattach";
2110	_global_reattach;	2416	_global_reattach;
		2417	reattach $_ for values %MAP;
2111	};	2418	};
2112		2419
2113	if ($@) {	2420	if ($@) {
2114	warn $@;	2421	warn $@;
2115	warn "error while reloading, exiting.";	2422	warn "error while reloading, exiting.";
…		…
2131	$LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";	2438	$LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
2132	$LINK_MAP->in_memory (MAP_IN_MEMORY);	2439	$LINK_MAP->in_memory (MAP_IN_MEMORY);
2133		2440
2134	# dirty hack because... archetypes are not yet loaded	2441	# dirty hack because... archetypes are not yet loaded
2135	Event->timer (	2442	Event->timer (
2136	after => 2,	2443	after => 10,
2137	cb => sub {	2444	cb => sub {
2138	$_[0]->w->cancel;	2445	$_[0]->w->cancel;
2139		2446
2140	# provide some exits "home"	2447	# provide some exits "home"
2141	my $exit = cf::object::new "exit";	2448	my $exit = cf::object::new "exit";
…		…
2183	data => WF_AUTOCANCEL,	2490	data => WF_AUTOCANCEL,
2184	cb => sub {	2491	cb => sub {
2185	cf::server_tick; # one server iteration	2492	cf::server_tick; # one server iteration
2186	$RUNTIME += $TICK;	2493	$RUNTIME += $TICK;
2187	$NEXT_TICK += $TICK;	2494	$NEXT_TICK += $TICK;
		2495
		2496	$WAIT_FOR_TICK->broadcast;
		2497	$WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited;
2188		2498
2189	# if we are delayed by four ticks or more, skip them all	2499	# if we are delayed by four ticks or more, skip them all
2190	$NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;	2500	$NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;
2191		2501
2192	$TICK_WATCHER->at ($NEXT_TICK);	2502	$TICK_WATCHER->at ($NEXT_TICK);

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.140 by root, Fri Jan 5 20:04:02 2007 UTC vs. Revision 1.158 by root, Wed Jan 10 19:52:43 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.140 by root, Fri Jan 5 20:04:02 2007 UTC vs.
Revision 1.158 by root, Wed Jan 10 19:52:43 2007 UTC