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.145 by root, Sun Jan 7 21:54:59 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;
… …
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
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
… …
1132 1162
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};
1167
1168 aio_mkdir playerdir $pl, 0770;
1137 $pl->{last_save} = $cf::RUNTIME; 1169 $pl->{last_save} = $cf::RUNTIME;
1138 1170
1139 Coro::cede;
1140 $pl->save_pl ($path); 1171 $pl->save_pl ($path);
1141 Coro::cede; 1172 Coro::cede;
1142} 1173}
1143 1174
1144sub new($) { 1175sub new($) {
… …
1151 1182
1152 $cf::PLAYER{$login} = $self; 1183 $cf::PLAYER{$login} = $self;
1153 1184
1154 $self 1185 $self
1155} 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
1156 1194
1157sub quit_character { 1195sub quit_character {
1158 my ($pl) = @_; 1196 my ($pl) = @_;
1159 1197
1160 $pl->{deny_save} = 1; 1198 $pl->{deny_save} = 1;
… …
1165 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1203 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1166 $pl->ns->destroy if $pl->ns; 1204 $pl->ns->destroy if $pl->ns;
1167 1205
1168 my $path = playerdir $pl; 1206 my $path = playerdir $pl;
1169 my $temp = "$path~$cf::RUNTIME~deleting~"; 1207 my $temp = "$path~$cf::RUNTIME~deleting~";
1170 IO::AIO::aio_rename $path, $temp, sub { 1208 aio_rename $path, $temp;
1171 delete $cf::PLAYER{$pl->ob->name}; 1209 delete $cf::PLAYER{$pl->ob->name};
1172 $pl->destroy; 1210 $pl->destroy;
1173
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;
1175 }; 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
1176} 1264}
1177 1265
1178=item $player->ext_reply ($msgid, $msgtype, %msg) 1266=item $player->ext_reply ($msgid, $msgtype, %msg)
1179 1267
1180Sends an ext reply to the player. 1268Sends an ext reply to the player.
… …
1668=cut 1756=cut
1669 1757
1670sub cf::object::player::goto { 1758sub cf::object::player::goto {
1671 my ($self, $path, $x, $y) = @_; 1759 my ($self, $path, $x, $y) = @_;
1672 1760
1761 $path = new cf::path $path;
1762 $path ne "/" or Carp::cluck ("oy");#d#
1763
1673 $self->enter_link; 1764 $self->enter_link;
1674 1765
1675 (async { 1766 (async {
1676 $path = new cf::path $path;
1677
1678 my $map = cf::map::find $path->as_string; 1767 my $map = cf::map::find $path->as_string;
1679 $map = $map->customise_for ($self) if $map; 1768 $map = $map->customise_for ($self) if $map;
1680 1769
1681# warn "entering ", $map->path, " at ($x, $y)\n" 1770# warn "entering ", $map->path, " at ($x, $y)\n"
1682# if $map; 1771# if $map;
1683 1772
1684 $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);
1685 1774
1686 $self->leave_link ($map, $x, $y); 1775 $self->leave_link ($map, $x, $y);
1687 })->prio (1); 1776 })->prio (1);
1688} 1777}
1689 1778
… …
2097 $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};
2098 $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};
2099 2188
2100 if (exists $CFG{mlockall}) { 2189 if (exists $CFG{mlockall}) {
2101 eval { 2190 eval {
2102 $CFG{mlockall} ? &mlockall : &munlockall 2191 $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
2103 and die "WARNING: m(un)lockall failed: $!\n"; 2192 and die "WARNING: m(un)lockall failed: $!\n";
2104 }; 2193 };
2105 warn $@ if $@; 2194 warn $@ if $@;
2106 } 2195 }
2107} 2196}

Diff Legend

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