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.150 by root, Mon Jan 8 19:25:53 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
… …
1119 return $cf::PLAYER{$_[0]} || do { 1145 return $cf::PLAYER{$_[0]} || do {
1120 my $login = $_[0]; 1146 my $login = $_[0];
1121 1147
1122 my $guard = cf::lock_acquire "user_find:$login"; 1148 my $guard = cf::lock_acquire "user_find:$login";
1123 1149
1124 $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 }
1125 }; 1155 }
1126} 1156}
1127 1157
1128sub save($) { 1158sub save($) {
1129 my ($pl) = @_; 1159 my ($pl) = @_;
1130 1160
… …
1133 my $path = path $pl; 1163 my $path = path $pl;
1134 my $guard = cf::lock_acquire "user_save:$path"; 1164 my $guard = cf::lock_acquire "user_save:$path";
1135 1165
1136 return if $pl->{deny_save}; 1166 return if $pl->{deny_save};
1137 1167
1138 Coro::AIO::aio_mkdir playerdir $pl, 0770; 1168 aio_mkdir playerdir $pl, 0770;
1139 $pl->{last_save} = $cf::RUNTIME; 1169 $pl->{last_save} = $cf::RUNTIME;
1140 1170
1141 $pl->save_pl ($path); 1171 $pl->save_pl ($path);
1142 Coro::cede; 1172 Coro::cede;
1143} 1173}
… …
1152 1182
1153 $cf::PLAYER{$login} = $self; 1183 $cf::PLAYER{$login} = $self;
1154 1184
1155 $self 1185 $self
1156} 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
1157 1194
1158sub quit_character { 1195sub quit_character {
1159 my ($pl) = @_; 1196 my ($pl) = @_;
1160 1197
1161 $pl->{deny_save} = 1; 1198 $pl->{deny_save} = 1;
… …
1166 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1203 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1167 $pl->ns->destroy if $pl->ns; 1204 $pl->ns->destroy if $pl->ns;
1168 1205
1169 my $path = playerdir $pl; 1206 my $path = playerdir $pl;
1170 my $temp = "$path~$cf::RUNTIME~deleting~"; 1207 my $temp = "$path~$cf::RUNTIME~deleting~";
1171 Coro::AIO::aio_rename $path, $temp; 1208 aio_rename $path, $temp;
1172 delete $cf::PLAYER{$pl->ob->name}; 1209 delete $cf::PLAYER{$pl->ob->name};
1173 $pl->destroy; 1210 $pl->destroy;
1174 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
1175} 1264}
1176 1265
1177=item $player->ext_reply ($msgid, $msgtype, %msg) 1266=item $player->ext_reply ($msgid, $msgtype, %msg)
1178 1267
1179Sends an ext reply to the player. 1268Sends an ext reply to the player.
… …
1667=cut 1756=cut
1668 1757
1669sub cf::object::player::goto { 1758sub cf::object::player::goto {
1670 my ($self, $path, $x, $y) = @_; 1759 my ($self, $path, $x, $y) = @_;
1671 1760
1761 $path = new cf::path $path;
1762 $path ne "/" or Carp::cluck ("oy");#d#
1763
1672 $self->enter_link; 1764 $self->enter_link;
1673 1765
1674 (async { 1766 (async {
1675 $path = new cf::path $path;
1676
1677 my $map = cf::map::find $path->as_string; 1767 my $map = cf::map::find $path->as_string;
1678 $map = $map->customise_for ($self) if $map; 1768 $map = $map->customise_for ($self) if $map;
1679 1769
1680# warn "entering ", $map->path, " at ($x, $y)\n" 1770# warn "entering ", $map->path, " at ($x, $y)\n"
1681# if $map; 1771# if $map;
1682 1772
1683 $map or $map->cluck ("oy");#d#
1684 $map or $self->message ("The exit to '" . ($path->visible_name) . "' 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);
1685 1774
1686 $self->leave_link ($map, $x, $y); 1775 $self->leave_link ($map, $x, $y);
1687 })->prio (1); 1776 })->prio (1);
1688} 1777}

Diff Legend

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