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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.143 by root, Sun Jan 7 02:39:14 2007 UTC vs.
Revision 1.154 by root, Tue Jan 9 15:36:19 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
…		…
118	utf8::encode $msg;	119	utf8::encode $msg;
119		120
120	$msg .= "\n"	121	$msg .= "\n"
121	unless $msg =~ /\n$/;	122	unless $msg =~ /\n$/;
122		123
123	LOG llevError, "cfperl: $msg";	124	LOG llevError, $msg;
124	};	125	};
125	}	126	}
126		127
127	@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';	128	@safe::cf::global::ISA = @cf::global::ISA = 'cf::attachable';
128	@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';	129	@safe::cf::object::ISA = @cf::object::ISA = 'cf::attachable';
…		…
154		155
155	=head2 UTILITY FUNCTIONS	156	=head2 UTILITY FUNCTIONS
156		157
157	=over 4	158	=over 4
158		159
		160	=item dumpval $ref
		161
159	=cut	162	=cut
		163
		164	sub dumpval {
		165	eval {
		166	local $SIG{__DIE__};
		167	my $d;
		168	if (1) {
		169	$d = new Data::Dumper([$_[0]], ["*var"]);
		170	$d->Terse(1);
		171	$d->Indent(2);
		172	$d->Quotekeys(0);
		173	$d->Useqq(1);
		174	#$d->Bless(...);
		175	$d->Seen($_[1]) if @_ > 1;
		176	$d = $d->Dump();
		177	}
		178	$d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
		179	$d
		180	} \|\| "[unable to dump $_[0]: '$@']";
		181	}
160		182
161	use JSON::Syck (); # TODO# replace by JSON::PC once working	183	use JSON::Syck (); # TODO# replace by JSON::PC once working
162		184
163	=item $ref = cf::from_json $json	185	=item $ref = cf::from_json $json
164		186
…		…
334	=cut	356	=cut
335		357
336	#############################################################################	358	#############################################################################
337		359
338	package cf::path;	360	package cf::path;
		361
		362	# used to convert map paths into valid unix filenames by repalcing / by ∕
		363	our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
339		364
340	sub new {	365	sub new {
341	my ($class, $path, $base) = @_;	366	my ($class, $path, $base) = @_;
342		367
343	$path = $path->as_string if ref $path;	368	$path = $path->as_string if ref $path;
…		…
407	# }	432	# }
408	}	433	}
409		434
410	# escape the /'s in the path	435	# escape the /'s in the path
411	sub _escaped_path {	436	sub _escaped_path {
412	# ∕ is U+2215
413	(my $path = $_[0]{path}) =~ s/\//∕/g;	437	(my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
414	$path	438	$path
415	}	439	}
416		440
417	# the original (read-only) location	441	# the original (read-only) location
418	sub load_path {	442	sub load_path {
…		…
1076		1100
1077	=cut	1101	=cut
1078		1102
1079	package cf::player;	1103	package cf::player;
1080		1104
		1105	use Coro::AIO;
		1106
1081	=head3 cf::player	1107	=head3 cf::player
1082		1108
1083	=over 4	1109	=over 4
1084		1110
1085	=item cf::player::find $login	1111	=item cf::player::find $login
1086		1112
1087	Returns the given player object, loading it if necessary (might block).	1113	Returns the given player object, loading it if necessary (might block).
1088		1114
1089	=cut	1115	=cut
1090		1116
		1117	sub playerdir($) {
		1118	cf::localdir
		1119	. "/"
		1120	. cf::playerdir
		1121	. "/"
		1122	. (ref $_[0] ? $_[0]->ob->name : $_[0])
		1123	}
		1124
1091	sub path($) {	1125	sub path($) {
1092	sprintf "%s/%s/%s/%s.pl",	1126	my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
1093	cf::localdir, cf::playerdir,	1127
1094	(ref $_[0] ? $_[0]->ob->name : $_[0]) x 2	1128	(playerdir $login) . "/$login.pl"
1095	}	1129	}
1096		1130
1097	sub find_active($) {	1131	sub find_active($) {
1098	$cf::PLAYER{$_[0]}	1132	$cf::PLAYER{$_[0]}
1099	and $cf::PLAYER{$_[0]}->active	1133	and $cf::PLAYER{$_[0]}->active
…		…
1111	return $cf::PLAYER{$_[0]} \|\| do {	1145	return $cf::PLAYER{$_[0]} \|\| do {
1112	my $login = $_[0];	1146	my $login = $_[0];
1113		1147
1114	my $guard = cf::lock_acquire "user_find:$login";	1148	my $guard = cf::lock_acquire "user_find:$login";
1115		1149
1116	$cf::PLAYER{$login} \|\|= (load_pl path $login or return);	1150	$cf::PLAYER{$_[0]} \|\| do {
		1151	my $pl = load_pl path $login
		1152	or return;
		1153	$cf::PLAYER{$login} = $pl
		1154	}
1117	};	1155	}
1118	}	1156	}
1119		1157
1120	sub save($) {	1158	sub save($) {
1121	my ($pl) = @_;	1159	my ($pl) = @_;
1122		1160
…		…
1124		1162
1125	my $path = path $pl;	1163	my $path = path $pl;
1126	my $guard = cf::lock_acquire "user_save:$path";	1164	my $guard = cf::lock_acquire "user_save:$path";
1127		1165
1128	return if $pl->{deny_save};	1166	return if $pl->{deny_save};
		1167
		1168	aio_mkdir playerdir $pl, 0770;
1129	$pl->{last_save} = $cf::RUNTIME;	1169	$pl->{last_save} = $cf::RUNTIME;
1130		1170
1131	Coro::cede;
1132	$pl->save_pl ($path);	1171	$pl->save_pl ($path);
1133	Coro::cede;	1172	Coro::cede;
1134	}	1173	}
1135		1174
1136	sub new($) {	1175	sub new($) {
…		…
1142	$self->{deny_save} = 1;	1181	$self->{deny_save} = 1;
1143		1182
1144	$cf::PLAYER{$login} = $self;	1183	$cf::PLAYER{$login} = $self;
1145		1184
1146	$self	1185	$self
		1186	}
		1187
		1188	=item $pl->quit_character
		1189
		1190	Nukes the player without looking back. If logged in, the connection will
		1191	be destroyed. May block for a long time.
		1192
		1193	=cut
		1194
		1195	sub quit_character {
		1196	my ($pl) = @_;
		1197
		1198	$pl->{deny_save} = 1;
		1199	$pl->password ("*"); # this should lock out the player until we nuked the dir
		1200
		1201	$pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
		1202	$pl->deactivate;
		1203	$pl->invoke (cf::EVENT_PLAYER_QUIT);
		1204	$pl->ns->destroy if $pl->ns;
		1205
		1206	my $path = playerdir $pl;
		1207	my $temp = "$path~$cf::RUNTIME~deleting~";
		1208	aio_rename $path, $temp;
		1209	delete $cf::PLAYER{$pl->ob->name};
		1210	$pl->destroy;
		1211	IO::AIO::aio_rmtree $temp;
		1212	}
		1213
		1214	=item cf::player::list_logins
		1215
		1216	Returns am arrayref of all valid playernames in the system, can take a
		1217	while and may block, so not sync_job-capable, ever.
		1218
		1219	=cut
		1220
		1221	sub list_logins {
		1222	my $dirs = aio_readdir cf::localdir . "/" . cf::playerdir
		1223	or return [];
		1224
		1225	my @logins;
		1226
		1227	for my $login (@$dirs) {
		1228	my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next;
		1229	aio_read $fh, 0, 512, my $buf, 0 or next;
		1230	$buf !~ /^password -------------$/ or next; # official not-valid tag
		1231
		1232	utf8::decode $login;
		1233	push @logins, $login;
		1234	}
		1235
		1236	\@logins
		1237	}
		1238
		1239	=item $player->maps
		1240
		1241	Returns an arrayref of cf::path's of all maps that are private for this
		1242	player. May block.
		1243
		1244	=cut
		1245
		1246	sub maps($) {
		1247	my ($pl) = @_;
		1248
		1249	my $files = aio_readdir playerdir $pl
		1250	or return;
		1251
		1252	my @paths;
		1253
		1254	for (@$files) {
		1255	utf8::decode $_;
		1256	next if /\.(?:pl\|pst)$/;
		1257	next unless /^$PATH_SEP/;
		1258
		1259	s/$PATH_SEP/\//g;
		1260	push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
		1261	}
		1262
		1263	\@paths
1147	}	1264	}
1148		1265
1149	=item $player->ext_reply ($msgid, $msgtype, %msg)	1266	=item $player->ext_reply ($msgid, $msgtype, %msg)
1150		1267
1151	Sends an ext reply to the player.	1268	Sends an ext reply to the player.
…		…
1474	}	1591	}
1475		1592
1476	sub emergency_save {	1593	sub emergency_save {
1477	my $freeze_guard = cf::freeze_mainloop;	1594	my $freeze_guard = cf::freeze_mainloop;
1478		1595
1479	warn "enter emergency map save\n";	1596	warn "enter emergency perl save\n";
1480		1597
1481	cf::sync_job {	1598	cf::sync_job {
		1599	warn "begin emergency player save\n";
		1600	$_->save for values %cf::PLAYER;
		1601	warn "end emergency player save\n";
		1602
1482	warn "begin emergency map save\n";	1603	warn "begin emergency map save\n";
1483	$_->save for values %cf::MAP;	1604	$_->save for values %cf::MAP;
		1605	warn "end emergency map save\n";
1484	};	1606	};
1485		1607
1486	warn "end emergency map save\n";	1608	warn "leave emergency perl save\n";
1487	}	1609	}
1488		1610
1489	package cf;	1611	package cf;
1490		1612
1491	=back	1613	=back
…		…
1634	=cut	1756	=cut
1635		1757
1636	sub cf::object::player::goto {	1758	sub cf::object::player::goto {
1637	my ($self, $path, $x, $y) = @_;	1759	my ($self, $path, $x, $y) = @_;
1638		1760
		1761	$path = new cf::path $path;
		1762	$path ne "/" or Carp::cluck ("oy");#d#
		1763
1639	$self->enter_link;	1764	$self->enter_link;
1640		1765
1641	(async {	1766	(async {
1642	$path = new cf::path $path;
1643
1644	my $map = cf::map::find $path->as_string;	1767	my $map = cf::map::find $path->as_string;
1645	$map = $map->customise_for ($self) if $map;	1768	$map = $map->customise_for ($self) if $map;
1646		1769
1647	# warn "entering ", $map->path, " at ($x, $y)\n"	1770	# warn "entering ", $map->path, " at ($x, $y)\n"
1648	# if $map;	1771	# if $map;
1649		1772
1650	$map or $self->message ("The exit is closed", cf::NDI_UNIQUE \| cf::NDI_RED);	1773	$map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE \| cf::NDI_RED);
1651		1774
1652	$self->leave_link ($map, $x, $y);	1775	$self->leave_link ($map, $x, $y);
1653	})->prio (1);	1776	})->prio (1);
1654	}	1777	}
1655		1778
…		…
2063	$cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};	2186	$cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
2064	$cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};	2187	$cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
2065		2188
2066	if (exists $CFG{mlockall}) {	2189	if (exists $CFG{mlockall}) {
2067	eval {	2190	eval {
2068	$CFG{mlockall} ? &mlockall : &munlockall	2191	$CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2069	and die "WARNING: m(un)lockall failed: $!\n";	2192	and die "WARNING: m(un)lockall failed: $!\n";
2070	};	2193	};
2071	warn $@ if $@;	2194	warn $@ if $@;
2072	}	2195	}
2073	}	2196	}
…		…
2167	cf::load_extensions;	2290	cf::load_extensions;
2168		2291
2169	# reattach attachments to objects	2292	# reattach attachments to objects
2170	warn "reattach";	2293	warn "reattach";
2171	_global_reattach;	2294	_global_reattach;
		2295	reattach $_ for values %MAP;
2172	};	2296	};
2173		2297
2174	if ($@) {	2298	if ($@) {
2175	warn $@;	2299	warn $@;
2176	warn "error while reloading, exiting.";	2300	warn "error while reloading, exiting.";

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.143 by root, Sun Jan 7 02:39:14 2007 UTC vs. Revision 1.154 by root, Tue Jan 9 15:36:19 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.143 by root, Sun Jan 7 02:39:14 2007 UTC vs.
Revision 1.154 by root, Tue Jan 9 15:36:19 2007 UTC