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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.107 by root, Sun Dec 31 18:10:40 2006 UTC vs.
Revision 1.114 by root, Mon Jan 1 16:00:10 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 Digest::MD5;
20	use Fcntl;	21	use Fcntl;
21	use IO::AIO 2.31 ();	22	use IO::AIO 2.31 ();
22	use YAML::Syck ();	23	use YAML::Syck ();
23	use Time::HiRes;	24	use Time::HiRes;
24		25
…		…
49	our $RUNTIME;	50	our $RUNTIME;
50		51
51	our %MAP; # all maps	52	our %MAP; # all maps
52	our $LINK_MAP; # the special {link} map	53	our $LINK_MAP; # the special {link} map
53	our $FREEZE;	54	our $FREEZE;
		55	our $RANDOM_MAPS = cf::localdir . "/random";
		56	our %EXT_CORO;
54		57
55	binmode STDOUT;	58	binmode STDOUT;
56	binmode STDERR;	59	binmode STDERR;
57		60
58	# read virtual server time, if available	61	# read virtual server time, if available
…		…
64		67
65	mkdir cf::localdir;	68	mkdir cf::localdir;
66	mkdir cf::localdir . "/" . cf::playerdir;	69	mkdir cf::localdir . "/" . cf::playerdir;
67	mkdir cf::localdir . "/" . cf::tmpdir;	70	mkdir cf::localdir . "/" . cf::tmpdir;
68	mkdir cf::localdir . "/" . cf::uniquedir;	71	mkdir cf::localdir . "/" . cf::uniquedir;
		72	mkdir $RANDOM_MAPS;
69		73
70	our %EXT_CORO;	74	# a special map that is always available
		75	our $LINK_MAP;
		76
		77	our $EMERGENCY_POSITION = $cf::CFG{emergency_position} \|\| ["/world/world_105_115", 5, 37];
71		78
72	#############################################################################	79	#############################################################################
73		80
74	=head2 GLOBAL VARIABLES	81	=head2 GLOBAL VARIABLES
75		82
…		…
190	=cut	197	=cut
191		198
192	sub sync_job(&) {	199	sub sync_job(&) {
193	my ($job) = @_;	200	my ($job) = @_;
194		201
195	my $busy = 1;
196	my @res;
197
198	# TODO: use suspend/resume instead
199	local $FREEZE = 1;
200
201	my $coro = Coro::async {
202	@res = eval { $job->() };
203	warn $@ if $@;
204	undef $busy;
205	};
206
207	if ($Coro::current == $Coro::main) {	202	if ($Coro::current == $Coro::main) {
		203	# this is the main coro, too bad, we have to block
		204	# till the operation succeeds, freezing the server :/
		205
		206	# TODO: use suspend/resume instead
		207	# (but this is cancel-safe)
		208	local $FREEZE = 1;
		209
		210	my $busy = 1;
		211	my @res;
		212
		213	(Coro::async {
		214	@res = eval { $job->() };
		215	warn $@ if $@;
		216	undef $busy;
208	$coro->prio (Coro::PRIO_MAX);	217	})->prio (Coro::PRIO_MAX);
		218
209	while ($busy) {	219	while ($busy) {
210	Coro::cede_notself;	220	Coro::cede_notself;
211	Event::one_event unless Coro::nready;	221	Event::one_event unless Coro::nready;
212	}	222	}
		223
		224	wantarray ? @res : $res[0]
213	} else {	225	} else {
214	$coro->join;	226	# we are in another coroutine, how wonderful, everything just works
		227
		228	$job->()
215	}	229	}
216
217	wantarray ? @res : $res[0]
218	}	230	}
219		231
220	=item $coro = cf::coro { BLOCK }	232	=item $coro = cf::coro { BLOCK }
221		233
222	Creates and returns a new coro. This coro is automcatially being canceled	234	Creates and returns a new coro. This coro is automcatially being canceled
…		…
240	$EXT_CORO{$coro+0} = $coro;	252	$EXT_CORO{$coro+0} = $coro;
241		253
242	$coro	254	$coro
243	}	255	}
244		256
		257	sub write_runtime {
		258	my $runtime = cf::localdir . "/runtime";
		259
		260	my $fh = aio_open "$runtime~", O_WRONLY \| O_CREAT, 0644
		261	or return;
		262
		263	my $value = $cf::RUNTIME + 1 + 10; # 10 is the runtime save interval, for a monotonic clock
		264	(aio_write $fh, 0, (length $value), $value, 0) <= 0
		265	and return;
		266
		267	aio_fsync $fh
		268	and return;
		269
		270	close $fh
		271	or return;
		272
		273	aio_rename "$runtime~", $runtime
		274	and return;
		275
		276	1
		277	}
		278
245	=back	279	=back
246		280
247	=cut	281	=cut
		282
		283	#############################################################################
		284
		285	package cf::path;
		286
		287	sub new {
		288	my ($class, $path, $base) = @_;
		289
		290	$path = $path->as_string if ref $path;
		291
		292	my $self = bless { }, $class;
		293
		294	# {... are special paths that are not touched
		295	# ?xxx/... are special absolute paths
		296	# ?random/... random maps
		297	# /! non-realised random map exit
		298	# /... normal maps
		299	# ~/... per-player maps without a specific player (DO NOT USE)
		300	# ~user/... per-player map of a specific user
		301
		302	if ($path =~ /^{/) {
		303	# fine as it is
		304	} elsif ($path =~ s{^\?random/}{}) {
		305	Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
		306	$self->{random} = cf::from_json $data;
		307	} else {
		308	if ($path =~ s{^~([^/]+)?}{}) {
		309	$self->{user_rel} = 1;
		310
		311	if (defined $1) {
		312	$self->{user} = $1;
		313	} elsif ($base =~ m{^~([^/]+)/}) {
		314	$self->{user} = $1;
		315	} else {
		316	warn "cannot resolve user-relative path without user <$path,$base>\n";
		317	}
		318	} elsif ($path =~ /^\//) {
		319	# already absolute
		320	} else {
		321	$base =~ s{[^/]+/?$}{};
		322	return $class->new ("$base/$path");
		323	}
		324
		325	for ($path) {
		326	redo if s{/\.?/}{/};
		327	redo if s{/[^/]+/\.\./}{/};
		328	}
		329	}
		330
		331	$self->{path} = $path;
		332
		333	$self
		334	}
		335
		336	# the name / primary key / in-game path
		337	sub as_string {
		338	my ($self) = @_;
		339
		340	$self->{user_rel} ? "~$self->{user}$self->{path}"
		341	: $self->{random} ? "?random/$self->{path}"
		342	: $self->{path}
		343	}
		344
		345	# the displayed name, this is a one way mapping
		346	sub visible_name {
		347	my ($self) = @_;
		348
		349	# if (my $rmp = $self->{random}) {
		350	# # todo: be more intelligent about this
		351	# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
		352	# } else {
		353	$self->as_string
		354	# }
		355	}
		356
		357	# escape the /'s in the path
		358	sub _escaped_path {
		359	# ∕ is U+2215
		360	(my $path = $_[0]{path}) =~ s/\//∕/g;
		361	$path
		362	}
		363
		364	# the original (read-only) location
		365	sub load_path {
		366	my ($self) = @_;
		367
		368	sprintf "%s/%s/%s", cf::datadir, cf::mapdir, $self->{path}
		369	}
		370
		371	# the temporary/swap location
		372	sub save_path {
		373	my ($self) = @_;
		374
		375	$self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
		376	: $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
		377	: sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
		378	}
		379
		380	# the unique path, might be eq to save_path
		381	sub uniq_path {
		382	my ($self) = @_;
		383
		384	$self->{user_rel} \|\| $self->{random}
		385	? undef
		386	: sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
		387	}
		388
		389	# return random map parameters, or undef
		390	sub random_map_params {
		391	my ($self) = @_;
		392
		393	$self->{random}
		394	}
		395
		396	# this is somewhat ugly, but style maps do need special treatment
		397	sub is_style_map {
		398	$_[0]{path} =~ m{^/styles/}
		399	}
		400
		401	package cf;
248		402
249	#############################################################################	403	#############################################################################
250		404
251	=head2 ATTACHABLE OBJECTS	405	=head2 ATTACHABLE OBJECTS
252		406
…		…
660	or return;	814	or return;
661		815
662	unless (aio_stat "$filename.pst") {	816	unless (aio_stat "$filename.pst") {
663	(aio_load "$filename.pst", $av) >= 0	817	(aio_load "$filename.pst", $av) >= 0
664	or return;	818	or return;
665	$av = eval { (Storable::thaw <$av>)->{objs} };	819	$av = eval { (Storable::thaw $av)->{objs} };
666	}	820	}
667		821
668	return ($data, $av);	822	return ($data, $av);
669	}	823	}
670		824
…		…
894	$self->send ("ext " . to_json \%msg);	1048	$self->send ("ext " . to_json \%msg);
895	}	1049	}
896		1050
897	=back	1051	=back
898		1052
		1053
		1054	=head3 cf::map
		1055
		1056	=over 4
		1057
		1058	=cut
		1059
		1060	package cf::map;
		1061
		1062	use Fcntl;
		1063	use Coro::AIO;
		1064
		1065	our $MAX_RESET = 7200;
		1066	our $DEFAULT_RESET = 3600;
		1067
		1068	sub generate_random_map {
		1069	my ($path, $rmp) = @_;
		1070
		1071	# mit "rum" bekleckern, nicht
		1072	cf::map::_create_random_map
		1073	$path,
		1074	$rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
		1075	$rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
		1076	$rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
		1077	$rmp->{exit_on_final_map},
		1078	$rmp->{xsize}, $rmp->{ysize},
		1079	$rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
		1080	$rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
		1081	$rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
		1082	$rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
		1083	$rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
		1084	(cf::region::find $rmp->{region})
		1085	}
		1086
		1087	# and all this just because we cannot iterate over
		1088	# all maps in C++...
		1089	sub change_all_map_light {
		1090	my ($change) = @_;
		1091
		1092	$_->change_map_light ($change) for values %cf::MAP;
		1093	}
		1094
		1095	sub try_load_header($) {
		1096	my ($path) = @_;
		1097
		1098	utf8::encode $path;
		1099	aio_open $path, O_RDONLY, 0
		1100	or return;
		1101
		1102	my $map = cf::map::new
		1103	or return;
		1104
		1105	$map->load_header ($path)
		1106	or return;
		1107
		1108	$map->{load_path} = $path;
		1109
		1110	$map
		1111	}
		1112
		1113	sub find_map {
		1114	my ($path, $origin) = @_;
		1115
		1116	#warn "find_map<$path,$origin>\n";#d#
		1117
		1118	$path = new cf::path $path, $origin && $origin->path;
		1119	my $key = $path->as_string;
		1120
		1121	$cf::MAP{$key} \|\| do {
		1122	# do it the slow way
		1123	my $map = try_load_header $path->save_path;
		1124
		1125	if ($map) {
		1126	# safety
		1127	$map->{instantiate_time} = $cf::RUNTIME
		1128	if $map->{instantiate_time} > $cf::RUNTIME;
		1129	} else {
		1130	if (my $rmp = $path->random_map_params) {
		1131	$map = generate_random_map $key, $rmp;
		1132	} else {
		1133	$map = try_load_header $path->load_path;
		1134	}
		1135
		1136	$map or return;
		1137
		1138	$map->{load_original} = 1;
		1139	$map->{instantiate_time} = $cf::RUNTIME;
		1140	$map->instantiate;
		1141
		1142	# per-player maps become, after loading, normal maps
		1143	$map->per_player (0) if $path->{user_rel};
		1144	}
		1145
		1146	$map->path ($key);
		1147	$map->{path} = $path;
		1148	$map->last_access ($cf::RUNTIME);
		1149
		1150	if ($map->should_reset) {
		1151	$map->reset;
		1152	$map = find_map $path;
		1153	}
		1154
		1155	$cf::MAP{$key} = $map
		1156	}
		1157	}
		1158
		1159	sub load {
		1160	my ($self) = @_;
		1161
		1162	return if $self->in_memory != cf::MAP_SWAPPED;
		1163
		1164	$self->in_memory (cf::MAP_LOADING);
		1165
		1166	my $path = $self->{path};
		1167
		1168	$self->alloc;
		1169	$self->load_objects ($self->{load_path}, 1)
		1170	or return;
		1171
		1172	$self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
		1173	if delete $self->{load_original};
		1174
		1175	if (my $uniq = $path->uniq_path) {
		1176	utf8::encode $uniq;
		1177	if (aio_open $uniq, O_RDONLY, 0) {
		1178	$self->clear_unique_items;
		1179	$self->load_objects ($uniq, 0);
		1180	}
		1181	}
		1182
		1183	# now do the right thing for maps
		1184	$self->link_multipart_objects;
		1185
		1186	if ($self->{path}->is_style_map) {
		1187	$self->{deny_save} = 1;
		1188	$self->{deny_reset} = 1;
		1189	} else {
		1190	$self->fix_auto_apply;
		1191	$self->decay_objects;
		1192	$self->update_buttons;
		1193	$self->set_darkness_map;
		1194	$self->difficulty ($self->estimate_difficulty)
		1195	unless $self->difficulty;
		1196	$self->activate;
		1197	}
		1198
		1199	$self->in_memory (cf::MAP_IN_MEMORY);
		1200	}
		1201
		1202	sub load_map_sync {
		1203	my ($path, $origin) = @_;
		1204
		1205	#warn "load_map_sync<$path, $origin>\n";#d#
		1206
		1207	cf::sync_job {
		1208	my $map = cf::map::find_map $path, $origin
		1209	or return;
		1210	$map->load;
		1211	$map
		1212	}
		1213	}
		1214
		1215	sub save {
		1216	my ($self) = @_;
		1217
		1218	my $save = $self->{path}->save_path; utf8::encode $save;
		1219	my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
		1220
		1221	$self->{last_save} = $cf::RUNTIME;
		1222
		1223	return unless $self->dirty;
		1224
		1225	$self->{load_path} = $save;
		1226
		1227	return if $self->{deny_save};
		1228
		1229	if ($uniq) {
		1230	$self->save_objects ($save, cf::IO_HEADER \| cf::IO_OBJECTS);
		1231	$self->save_objects ($uniq, cf::IO_UNIQUES);
		1232	} else {
		1233	$self->save_objects ($save, cf::IO_HEADER \| cf::IO_OBJECTS \| cf::IO_UNIQUES);
		1234	}
		1235	}
		1236
		1237	sub swap_out {
		1238	my ($self) = @_;
		1239
		1240	return if $self->players;
		1241	return if $self->in_memory != cf::MAP_IN_MEMORY;
		1242	return if $self->{deny_save};
		1243
		1244	$self->save;
		1245	$self->clear;
		1246	$self->in_memory (cf::MAP_SWAPPED);
		1247	}
		1248
		1249	sub reset_at {
		1250	my ($self) = @_;
		1251
		1252	# TODO: safety, remove and allow resettable per-player maps
		1253	return 1e99 if $self->{path}{user_rel};
		1254	return 1e99 if $self->{deny_reset};
		1255
		1256	my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
		1257	my $to = List::Util::min $MAX_RESET, $self->reset_timeout \|\| $DEFAULT_RESET;
		1258
		1259	$time + $to
		1260	}
		1261
		1262	sub should_reset {
		1263	my ($self) = @_;
		1264
		1265	$self->reset_at <= $cf::RUNTIME
		1266	}
		1267
		1268	sub unlink_save {
		1269	my ($self) = @_;
		1270
		1271	utf8::encode (my $save = $self->{path}->save_path);
		1272	aioreq_pri 3; IO::AIO::aio_unlink $save;
		1273	aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
		1274	}
		1275
		1276	sub rename {
		1277	my ($self, $new_path) = @_;
		1278
		1279	$self->unlink_save;
		1280
		1281	delete $cf::MAP{$self->path};
		1282	$self->{path} = new cf::path $new_path;
		1283	$self->path ($self->{path}->as_string);
		1284	$cf::MAP{$self->path} = $self;
		1285
		1286	$self->save;
		1287	}
		1288
		1289	sub reset {
		1290	my ($self) = @_;
		1291
		1292	return if $self->players;
		1293	return if $self->{path}{user_rel};#d#
		1294
		1295	warn "resetting map ", $self->path;#d#
		1296
		1297	delete $cf::MAP{$self->path};
		1298
		1299	$_->clear_links_to ($self) for values %cf::MAP;
		1300
		1301	$self->unlink_save;
		1302	$self->destroy;
		1303	}
		1304
		1305	my $nuke_counter = "aaaa";
		1306
		1307	sub nuke {
		1308	my ($self) = @_;
		1309
		1310	$self->{deny_save} = 1;
		1311	$self->reset_timeout (1);
		1312	$self->rename ("{nuke}/" . ($nuke_counter++));
		1313	$self->reset; # polite request, might not happen
		1314	}
		1315
		1316	sub customise_for {
		1317	my ($map, $ob) = @_;
		1318
		1319	if ($map->per_player) {
		1320	return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path};
		1321	}
		1322
		1323	$map
		1324	}
		1325
		1326	sub emergency_save {
		1327	local $cf::FREEZE = 1;
		1328
		1329	warn "enter emergency map save\n";
		1330
		1331	cf::sync_job {
		1332	warn "begin emergency map save\n";
		1333	$_->save for values %cf::MAP;
		1334	};
		1335
		1336	warn "end emergency map save\n";
		1337	}
		1338
		1339	package cf;
		1340
		1341	=back
		1342
		1343
899	=head3 cf::object::player	1344	=head3 cf::object::player
900		1345
901	=over 4	1346	=over 4
902		1347
903	=item $player_object->reply ($npc, $msg[, $flags])	1348	=item $player_object->reply ($npc, $msg[, $flags])
…		…
936		1381
937	$self->flag (cf::FLAG_WIZ) \|\|	1382	$self->flag (cf::FLAG_WIZ) \|\|
938	(ref $cf::CFG{"may_$access"}	1383	(ref $cf::CFG{"may_$access"}
939	? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}	1384	? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
940	: $cf::CFG{"may_$access"})	1385	: $cf::CFG{"may_$access"})
		1386	}
		1387
		1388	sub cf::object::player::enter_link {
		1389	my ($self) = @_;
		1390
		1391	return if $self->map == $LINK_MAP;
		1392
		1393	$self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]
		1394	if $self->map;
		1395
		1396	$self->enter_map ($LINK_MAP, 20, 20);
		1397	$self->deactivate_recursive;
		1398	}
		1399
		1400	sub cf::object::player::leave_link {
		1401	my ($self, $map, $x, $y) = @_;
		1402
		1403	my $link_pos = delete $self->{_link_pos};
		1404
		1405	unless ($map) {
		1406	$self->message ("The exit is closed", cf::NDI_UNIQUE \| cf::NDI_RED);
		1407
		1408	# restore original map position
		1409	($map, $x, $y) = @{ $link_pos \|\| [] };
		1410	$map = cf::map::find_map $map;
		1411
		1412	unless ($map) {
		1413	($map, $x, $y) = @$EMERGENCY_POSITION;
		1414	$map = cf::map::find_map $map
		1415	or die "FATAL: cannot load emergency map\n";
		1416	}
		1417	}
		1418
		1419	($x, $y) = (-1, -1)
		1420	unless (defined $x) && (defined $y);
		1421
		1422	# use -1 or undef as default coordinates, not 0, 0
		1423	($x, $y) = ($map->enter_x, $map->enter_y)
		1424	if $x <=0 && $y <= 0;
		1425
		1426	$map->load;
		1427
		1428	$self->activate_recursive;
		1429	$self->enter_map ($map, $x, $y);
		1430	}
		1431
		1432	=item $player_object->goto_map ($map, $x, $y)
		1433
		1434	=cut
		1435
		1436	sub cf::object::player::goto_map {
		1437	my ($self, $path, $x, $y) = @_;
		1438
		1439	$self->enter_link;
		1440
		1441	(Coro::async {
		1442	$path = new cf::path $path;
		1443
		1444	my $map = cf::map::find_map $path->as_string;
		1445	$map = $map->customise_for ($self) if $map;
		1446
		1447	warn "entering ", $map->path, " at ($x, $y)\n"
		1448	if $map;
		1449
		1450	$self->leave_link ($map, $x, $y);
		1451	})->prio (1);
		1452	}
		1453
		1454	=item $player_object->enter_exit ($exit_object)
		1455
		1456	=cut
		1457
		1458	sub parse_random_map_params {
		1459	my ($spec) = @_;
		1460
		1461	my $rmp = { # defaults
		1462	xsize => 10,
		1463	ysize => 10,
		1464	};
		1465
		1466	for (split /\n/, $spec) {
		1467	my ($k, $v) = split /\s+/, $_, 2;
		1468
		1469	$rmp->{lc $k} = $v if (length $k) && (length $v);
		1470	}
		1471
		1472	$rmp
		1473	}
		1474
		1475	sub prepare_random_map {
		1476	my ($exit) = @_;
		1477
		1478	# all this does is basically replace the /! path by
		1479	# a new random map path (?random/...) with a seed
		1480	# that depends on the exit object
		1481
		1482	my $rmp = parse_random_map_params $exit->msg;
		1483
		1484	if ($exit->map) {
		1485	$rmp->{region} = $exit->map->region_name;
		1486	$rmp->{origin_map} = $exit->map->path;
		1487	$rmp->{origin_x} = $exit->x;
		1488	$rmp->{origin_y} = $exit->y;
		1489	}
		1490
		1491	$rmp->{random_seed} \|\|= $exit->random_seed;
		1492
		1493	my $data = cf::to_json $rmp;
		1494	my $md5 = Digest::MD5::md5_hex $data;
		1495
		1496	if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY \| O_CREAT, 0666) {
		1497	aio_write $fh, 0, (length $data), $data, 0;
		1498
		1499	$exit->slaying ("?random/$md5");
		1500	$exit->msg (undef);
		1501	}
		1502	}
		1503
		1504	sub cf::object::player::enter_exit {
		1505	my ($self, $exit) = @_;
		1506
		1507	return unless $self->type == cf::PLAYER;
		1508
		1509	$self->enter_link;
		1510
		1511	(Coro::async {
		1512	unless (eval {
		1513
		1514	prepare_random_map $exit
		1515	if $exit->slaying eq "/!";
		1516
		1517	my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
		1518	$self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
		1519
		1520	1;
		1521	}) {
		1522	$self->message ("Something went wrong deep within the crossfire server. "
		1523	. "I'll try to bring you back to the map you were before. "
		1524	. "Please report this to the dungeon master",
		1525	cf::NDI_UNIQUE \| cf::NDI_RED);
		1526
		1527	warn "ERROR in enter_exit: $@";
		1528	$self->leave_link;
		1529	}
		1530	})->prio (1);
941	}	1531	}
942		1532
943	=head3 cf::client	1533	=head3 cf::client
944		1534
945	=over 4	1535	=over 4
…		…
1272	local $/;	1862	local $/;
1273	*CFG = YAML::Syck::Load <$fh>;	1863	*CFG = YAML::Syck::Load <$fh>;
1274	}	1864	}
1275		1865
1276	sub main {	1866	sub main {
		1867	# we must not ever block the main coroutine
		1868	local $Coro::idle = sub {
		1869	Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
		1870	(Coro::unblock_sub {
		1871	Event::one_event;
		1872	})->();
		1873	};
		1874
1277	cfg_load;	1875	cfg_load;
1278	db_load;	1876	db_load;
1279	load_extensions;	1877	load_extensions;
1280	Event::loop;	1878	Event::loop;
1281	}	1879	}
1282		1880
1283	#############################################################################	1881	#############################################################################
1284	# initialisation	1882	# initialisation
1285		1883
1286	sub perl_reload() {	1884	sub reload() {
1287	# can/must only be called in main	1885	# can/must only be called in main
1288	if ($Coro::current != $Coro::main) {	1886	if ($Coro::current != $Coro::main) {
1289	warn "can only reload from main coroutine\n";	1887	warn "can only reload from main coroutine\n";
1290	return;	1888	return;
1291	}	1889	}
…		…
1373	}	1971	}
1374		1972
1375	warn "reloaded successfully";	1973	warn "reloaded successfully";
1376	};	1974	};
1377		1975
		1976	#############################################################################
		1977
		1978	unless ($LINK_MAP) {
		1979	$LINK_MAP = cf::map::new;
		1980
		1981	$LINK_MAP->width (41);
		1982	$LINK_MAP->height (41);
		1983	$LINK_MAP->alloc;
		1984	$LINK_MAP->path ("{link}");
		1985	$LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
		1986	$LINK_MAP->in_memory (MAP_IN_MEMORY);
		1987
		1988	# dirty hack because... archetypes are not yet loaded
		1989	Event->timer (
		1990	after => 2,
		1991	cb => sub {
		1992	$_[0]->w->cancel;
		1993
		1994	# provide some exits "home"
		1995	my $exit = cf::object::new "exit";
		1996
		1997	$exit->slaying ($EMERGENCY_POSITION->[0]);
		1998	$exit->stats->hp ($EMERGENCY_POSITION->[1]);
		1999	$exit->stats->sp ($EMERGENCY_POSITION->[2]);
		2000
		2001	$LINK_MAP->insert ($exit->clone, 19, 19);
		2002	$LINK_MAP->insert ($exit->clone, 19, 20);
		2003	$LINK_MAP->insert ($exit->clone, 19, 21);
		2004	$LINK_MAP->insert ($exit->clone, 20, 19);
		2005	$LINK_MAP->insert ($exit->clone, 20, 21);
		2006	$LINK_MAP->insert ($exit->clone, 21, 19);
		2007	$LINK_MAP->insert ($exit->clone, 21, 20);
		2008	$LINK_MAP->insert ($exit->clone, 21, 21);
		2009
		2010	$exit->destroy;
		2011	});
		2012
		2013	$LINK_MAP->{deny_save} = 1;
		2014	$LINK_MAP->{deny_reset} = 1;
		2015
		2016	$cf::MAP{$LINK_MAP->path} = $LINK_MAP;
		2017	}
		2018
1378	register "<global>", __PACKAGE__;	2019	register "<global>", __PACKAGE__;
1379		2020
1380	register_command "perl-reload" => sub {	2021	register_command "reload" => sub {
1381	my ($who, $arg) = @_;	2022	my ($who, $arg) = @_;
1382		2023
1383	if ($who->flag (FLAG_WIZ)) {	2024	if ($who->flag (FLAG_WIZ)) {
1384	$who->message ("start of reload.");	2025	$who->message ("start of reload.");
1385	perl_reload;	2026	reload;
1386	$who->message ("end of reload.");	2027	$who->message ("end of reload.");
1387	}	2028	}
1388	};	2029	};
1389		2030
1390	unshift @INC, $LIBDIR;	2031	unshift @INC, $LIBDIR;
…		…
1410	},	2051	},
1411	);	2052	);
1412		2053
1413	IO::AIO::max_poll_time $TICK * 0.2;	2054	IO::AIO::max_poll_time $TICK * 0.2;
1414		2055
		2056	Event->io (
1415	Event->io (fd => IO::AIO::poll_fileno,	2057	fd => IO::AIO::poll_fileno,
1416	poll => 'r',	2058	poll => 'r',
1417	prio => 5,	2059	prio => 5,
1418	data => WF_AUTOCANCEL,	2060	data => WF_AUTOCANCEL,
1419	cb => \&IO::AIO::poll_cb);	2061	cb => \&IO::AIO::poll_cb,
		2062	);
1420		2063
1421	# we must not ever block the main coroutine	2064	Event->timer (
1422	$Coro::idle = sub {	2065	data => WF_AUTOCANCEL,
1423	#Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#	2066	after => 0,
1424	warn "FATAL: Coro::idle was called, major BUG\n";	2067	interval => 10,
		2068	cb => sub {
1425	(Coro::unblock_sub {	2069	(Coro::unblock_sub {
1426	Event::one_event;	2070	write_runtime
		2071	or warn "ERROR: unable to write runtime file: $!";
1427	})->();	2072	})->();
1428	};	2073	},
		2074	);
1429		2075
1430	1	2076	1
1431		2077

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.107 by root, Sun Dec 31 18:10:40 2006 UTC vs. Revision 1.114 by root, Mon Jan 1 16:00:10 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.107 by root, Sun Dec 31 18:10:40 2006 UTC vs.
Revision 1.114 by root, Mon Jan 1 16:00:10 2007 UTC