ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.153 by root, Mon Jan 8 23:36:16 2007 UTC vs.
Revision 1.154 by root, Tue Jan 9 15:36:19 2007 UTC

… …
15use Coro::Timer; 15use Coro::Timer;
16use Coro::Signal; 16use Coro::Signal;
17use Coro::Semaphore; 17use Coro::Semaphore;
18use Coro::AIO; 18use Coro::AIO;
19 19
20use Data::Dumper;
20use Digest::MD5; 21use Digest::MD5;
21use Fcntl; 22use Fcntl;
22use IO::AIO 2.32 (); 23use IO::AIO 2.32 ();
23use YAML::Syck (); 24use YAML::Syck ();
24use Time::HiRes; 25use Time::HiRes;
… …
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
164sub 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
161use JSON::Syck (); # TODO# replace by JSON::PC once working 183use 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
338package cf::path; 360package cf::path;
361
362# used to convert map paths into valid unix filenames by repalcing / by ∕
363our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
339 364
340sub new { 365sub 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
411sub _escaped_path { 436sub _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
418sub load_path { 442sub load_path {
… …
1076 1100
1077=cut 1101=cut
1078 1102
1079package cf::player; 1103package cf::player;
1080 1104
1105use 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
… …
1137 my $path = path $pl; 1163 my $path = path $pl;
1138 my $guard = cf::lock_acquire "user_save:$path"; 1164 my $guard = cf::lock_acquire "user_save:$path";
1139 1165
1140 return if $pl->{deny_save}; 1166 return if $pl->{deny_save};
1141 1167
1142 Coro::AIO::aio_mkdir playerdir $pl, 0770; 1168 aio_mkdir playerdir $pl, 0770;
1143 $pl->{last_save} = $cf::RUNTIME; 1169 $pl->{last_save} = $cf::RUNTIME;
1144 1170
1145 $pl->save_pl ($path); 1171 $pl->save_pl ($path);
1146 Coro::cede; 1172 Coro::cede;
1147} 1173}
… …
1156 1182
1157 $cf::PLAYER{$login} = $self; 1183 $cf::PLAYER{$login} = $self;
1158 1184
1159 $self 1185 $self
1160} 1186}
1187
1188=item $pl->quit_character
1189
1190Nukes the player without looking back. If logged in, the connection will
1191be destroyed. May block for a long time.
1192
1193=cut
1161 1194
1162sub quit_character { 1195sub quit_character {
1163 my ($pl) = @_; 1196 my ($pl) = @_;
1164 1197
1165 $pl->{deny_save} = 1; 1198 $pl->{deny_save} = 1;
… …
1170 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1203 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1171 $pl->ns->destroy if $pl->ns; 1204 $pl->ns->destroy if $pl->ns;
1172 1205
1173 my $path = playerdir $pl; 1206 my $path = playerdir $pl;
1174 my $temp = "$path~$cf::RUNTIME~deleting~"; 1207 my $temp = "$path~$cf::RUNTIME~deleting~";
1175 Coro::AIO::aio_rename $path, $temp; 1208 aio_rename $path, $temp;
1176 delete $cf::PLAYER{$pl->ob->name}; 1209 delete $cf::PLAYER{$pl->ob->name};
1177 $pl->destroy; 1210 $pl->destroy;
1178 IO::AIO::aio_rmtree $temp; 1211 IO::AIO::aio_rmtree $temp;
1212}
1213
1214=item cf::player::list_logins
1215
1216Returns am arrayref of all valid playernames in the system, can take a
1217while and may block, so not sync_job-capable, ever.
1218
1219=cut
1220
1221sub 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
1241Returns an arrayref of cf::path's of all maps that are private for this
1242player. May block.
1243
1244=cut
1245
1246sub 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
1179} 1264}
1180 1265
1181=item $player->ext_reply ($msgid, $msgtype, %msg) 1266=item $player->ext_reply ($msgid, $msgtype, %msg)
1182 1267
1183Sends an ext reply to the player. 1268Sends an ext reply to the player.

Diff Legend

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