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.111 by root, Mon Jan 1 12:28:47 2007 UTC vs.
Revision 1.116 by root, Mon Jan 1 17:30:34 2007 UTC

197=cut 197=cut
198 198
199sub sync_job(&) { 199sub sync_job(&) {
200 my ($job) = @_; 200 my ($job) = @_;
201 201
202 my $busy = 1;
203 my @res;
204
205 my $coro = Coro::async {
206 @res = eval { $job->() };
207 warn $@ if $@;
208 undef $busy;
209 };
210
211 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
212 # TODO: use suspend/resume instead 206 # TODO: use suspend/resume instead
207 # (but this is cancel-safe)
213 local $FREEZE = 1; 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;
214 $coro->prio (Coro::PRIO_MAX); 217 })->prio (Coro::PRIO_MAX);
218
215 while ($busy) { 219 while ($busy) {
216 Coro::cede_notself; 220 Coro::cede_notself;
217 Event::one_event unless Coro::nready; 221 Event::one_event unless Coro::nready;
218 } 222 }
223
224 wantarray ? @res : $res[0]
219 } else { 225 } else {
220 $coro->join; 226 # we are in another coroutine, how wonderful, everything just works
227
228 $job->()
221 } 229 }
222
223 wantarray ? @res : $res[0]
224} 230}
225 231
226=item $coro = cf::coro { BLOCK } 232=item $coro = cf::coro { BLOCK }
227 233
228Creates and returns a new coro. This coro is automcatially being canceled 234Creates and returns a new coro. This coro is automcatially being canceled
252 my $runtime = cf::localdir . "/runtime"; 258 my $runtime = cf::localdir . "/runtime";
253 259
254 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 260 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
255 or return; 261 or return;
256 262
257 my $value = $cf::RUNTIME; 263 my $value = $cf::RUNTIME + 1 + 10; # 10 is the runtime save interval, for a monotonic clock
258 (aio_write $fh, 0, (length $value), $value, 0) <= 0 264 (aio_write $fh, 0, (length $value), $value, 0) <= 0
259 and return; 265 and return;
260 266
261 aio_fsync $fh 267 aio_fsync $fh
262 and return; 268 and return;
283 289
284 $path = $path->as_string if ref $path; 290 $path = $path->as_string if ref $path;
285 291
286 my $self = bless { }, $class; 292 my $self = bless { }, $class;
287 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
288 if ($path =~ s{^\?random/}{}) { 304 } elsif ($path =~ s{^\?random/}{}) {
289 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data; 305 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
290 $self->{random} = cf::from_json $data; 306 $self->{random} = cf::from_json $data;
291 } else { 307 } else {
292 if ($path =~ s{^~([^/]+)?}{}) { 308 if ($path =~ s{^~([^/]+)?}{}) {
293 $self->{user_rel} = 1; 309 $self->{user_rel} = 1;
798 or return; 814 or return;
799 815
800 unless (aio_stat "$filename.pst") { 816 unless (aio_stat "$filename.pst") {
801 (aio_load "$filename.pst", $av) >= 0 817 (aio_load "$filename.pst", $av) >= 0
802 or return; 818 or return;
803 $av = eval { (Storable::thaw <$av>)->{objs} }; 819 $av = eval { (Storable::thaw $av)->{objs} };
804 } 820 }
805 821
806 return ($data, $av); 822 return ($data, $av);
807} 823}
808 824
1046use Fcntl; 1062use Fcntl;
1047use Coro::AIO; 1063use Coro::AIO;
1048 1064
1049our $MAX_RESET = 7200; 1065our $MAX_RESET = 7200;
1050our $DEFAULT_RESET = 3600; 1066our $DEFAULT_RESET = 3600;
1051$MAX_RESET = 10;#d#
1052$DEFAULT_RESET = 10;#d#
1053 1067
1054sub generate_random_map { 1068sub generate_random_map {
1055 my ($path, $rmp) = @_; 1069 my ($path, $rmp) = @_;
1056 1070
1057 # mit "rum" bekleckern, nicht 1071 # mit "rum" bekleckern, nicht
1090 1104
1091 $map->load_header ($path) 1105 $map->load_header ($path)
1092 or return; 1106 or return;
1093 1107
1094 $map->{load_path} = $path; 1108 $map->{load_path} = $path;
1095 use Data::Dumper; warn Dumper $map;#d#
1096 1109
1097 $map 1110 $map
1098} 1111}
1099 1112
1100sub find_map { 1113sub find_map {
1101 my ($path, $origin) = @_; 1114 my ($path, $origin) = @_;
1102 1115
1103 #warn "find_map<$path,$origin>\n";#d# 1116 #warn "find_map<$path,$origin>\n";#d#
1104 1117
1105 $path = ref $path ? $path : new cf::path $path, $origin && $origin->path; 1118 $path = new cf::path $path, $origin && $origin->path;
1106 my $key = $path->as_string; 1119 my $key = $path->as_string;
1107 1120
1108 $cf::MAP{$key} || do { 1121 $cf::MAP{$key} || do {
1109 # do it the slow way 1122 # do it the slow way
1110 my $map = try_load_header $path->save_path; 1123 my $map = try_load_header $path->save_path;
1130 $map->per_player (0) if $path->{user_rel}; 1143 $map->per_player (0) if $path->{user_rel};
1131 } 1144 }
1132 1145
1133 $map->path ($key); 1146 $map->path ($key);
1134 $map->{path} = $path; 1147 $map->{path} = $path;
1148 $map->{last_save} = $cf::RUNTIME;
1135 $map->last_access ($cf::RUNTIME); 1149 $map->last_access ($cf::RUNTIME);
1136 1150
1137 $map->reset if $map->should_reset; 1151 if ($map->should_reset) {
1152 $map->reset;
1153 $map = find_map $path;
1154 }
1138 1155
1139 $cf::MAP{$key} = $map 1156 $cf::MAP{$key} = $map
1140 } 1157 }
1141} 1158}
1142 1159
1151 1168
1152 $self->alloc; 1169 $self->alloc;
1153 $self->load_objects ($self->{load_path}, 1) 1170 $self->load_objects ($self->{load_path}, 1)
1154 or return; 1171 or return;
1155 1172
1156 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) if delete $self->{load_original}; 1173 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1174 if delete $self->{load_original};
1157 1175
1158 if (my $uniq = $path->uniq_path) { 1176 if (my $uniq = $path->uniq_path) {
1159 utf8::encode $uniq; 1177 utf8::encode $uniq;
1160 if (aio_open $uniq, O_RDONLY, 0) { 1178 if (aio_open $uniq, O_RDONLY, 0) {
1161 $self->clear_unique_items; 1179 $self->clear_unique_items;
1207 1225
1208 $self->{load_path} = $save; 1226 $self->{load_path} = $save;
1209 1227
1210 return if $self->{deny_save}; 1228 return if $self->{deny_save};
1211 1229
1212 warn "saving map ", $self->path;
1213
1214 if ($uniq) { 1230 if ($uniq) {
1215 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1231 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1216 $self->save_objects ($uniq, cf::IO_UNIQUES); 1232 $self->save_objects ($uniq, cf::IO_UNIQUES);
1217 } else { 1233 } else {
1218 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 1234 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1229 $self->save; 1245 $self->save;
1230 $self->clear; 1246 $self->clear;
1231 $self->in_memory (cf::MAP_SWAPPED); 1247 $self->in_memory (cf::MAP_SWAPPED);
1232} 1248}
1233 1249
1250sub reset_at {
1251 my ($self) = @_;
1252
1253 # TODO: safety, remove and allow resettable per-player maps
1254 return 1e99 if $self->{path}{user_rel};
1255 return 1e99 if $self->{deny_reset};
1256
1257 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1258 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
1259
1260 $time + $to
1261}
1262
1234sub should_reset { 1263sub should_reset {
1235 my ($map) = @_; 1264 my ($self) = @_;
1236 1265
1237 # TODO: safety, remove and allow resettable per-player maps 1266 $self->reset_at <= $cf::RUNTIME
1238 return if $map->{path}{user_rel};#d#
1239 return if $map->{deny_reset};
1240 #return unless $map->reset_timeout;
1241
1242 my $time = $map->fixed_resettime ? $map->{instantiate_time} : $map->last_access;
1243 my $to = $map->reset_timeout || $DEFAULT_RESET;
1244 $to = $MAX_RESET if $to > $MAX_RESET;
1245
1246 $time + $to < $cf::RUNTIME
1247} 1267}
1248 1268
1249sub unlink_save { 1269sub unlink_save {
1250 my ($self) = @_; 1270 my ($self) = @_;
1251 1271
1252 utf8::encode (my $save = $self->{path}->save_path); 1272 utf8::encode (my $save = $self->{path}->save_path);
1253 aioreq_pri 3; IO::AIO::aio_unlink $save; 1273 aioreq_pri 3; IO::AIO::aio_unlink $save;
1254 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst"; 1274 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1255} 1275}
1256 1276
1277sub rename {
1278 my ($self, $new_path) = @_;
1279
1280 $self->unlink_save;
1281
1282 delete $cf::MAP{$self->path};
1283 $self->{path} = new cf::path $new_path;
1284 $self->path ($self->{path}->as_string);
1285 $cf::MAP{$self->path} = $self;
1286
1287 $self->save;
1288}
1289
1257sub reset { 1290sub reset {
1258 my ($self) = @_; 1291 my ($self) = @_;
1259 1292
1260 return if $self->players; 1293 return if $self->players;
1261 return if $self->{path}{user_rel};#d# 1294 return if $self->{path}{user_rel};#d#
1266 1299
1267 $_->clear_links_to ($self) for values %cf::MAP; 1300 $_->clear_links_to ($self) for values %cf::MAP;
1268 1301
1269 $self->unlink_save; 1302 $self->unlink_save;
1270 $self->destroy; 1303 $self->destroy;
1304}
1305
1306my $nuke_counter = "aaaa";
1307
1308sub nuke {
1309 my ($self) = @_;
1310
1311 $self->{deny_save} = 1;
1312 $self->reset_timeout (1);
1313 $self->rename ("{nuke}/" . ($nuke_counter++));
1314 $self->reset; # polite request, might not happen
1271} 1315}
1272 1316
1273sub customise_for { 1317sub customise_for {
1274 my ($map, $ob) = @_; 1318 my ($map, $ob) = @_;
1275 1319
1340 (ref $cf::CFG{"may_$access"} 1384 (ref $cf::CFG{"may_$access"}
1341 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1385 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
1342 : $cf::CFG{"may_$access"}) 1386 : $cf::CFG{"may_$access"})
1343} 1387}
1344 1388
1389=item $player_object->enter_link
1390
1391Freezes the player and moves him/her to a special map (C<{link}>).
1392
1393The player should be reaosnably safe there for short amounts of time. You
1394I<MUST> call C<leave_link> as soon as possible, though.
1395
1396=item $player_object->leave_link ($map, $x, $y)
1397
1398Moves the player out of the specila link map onto the given map. If the
1399map is not valid (or omitted), the player will be moved back to the
1400location he/she was before the call to C<enter_link>, or, if that fails,
1401to the emergency map position.
1402
1403Might block.
1404
1405=cut
1406
1345sub cf::object::player::enter_link { 1407sub cf::object::player::enter_link {
1346 my ($self) = @_; 1408 my ($self) = @_;
1347 1409
1348 return if $self->map == $LINK_MAP; 1410 return if $self->map == $LINK_MAP;
1349 1411
1358 my ($self, $map, $x, $y) = @_; 1420 my ($self, $map, $x, $y) = @_;
1359 1421
1360 my $link_pos = delete $self->{_link_pos}; 1422 my $link_pos = delete $self->{_link_pos};
1361 1423
1362 unless ($map) { 1424 unless ($map) {
1363 $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1364
1365 # restore original map position 1425 # restore original map position
1366 ($map, $x, $y) = @{ $link_pos || [] }; 1426 ($map, $x, $y) = @{ $link_pos || [] };
1367 $map = cf::map::find_map $map; 1427 $map = cf::map::find_map $map;
1368 1428
1369 unless ($map) { 1429 unless ($map) {
1401 my $map = cf::map::find_map $path->as_string; 1461 my $map = cf::map::find_map $path->as_string;
1402 $map = $map->customise_for ($self) if $map; 1462 $map = $map->customise_for ($self) if $map;
1403 1463
1404 warn "entering ", $map->path, " at ($x, $y)\n" 1464 warn "entering ", $map->path, " at ($x, $y)\n"
1405 if $map; 1465 if $map;
1466
1467 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1406 1468
1407 $self->leave_link ($map, $x, $y); 1469 $self->leave_link ($map, $x, $y);
1408 })->prio (1); 1470 })->prio (1);
1409} 1471}
1410 1472
1821} 1883}
1822 1884
1823sub main { 1885sub main {
1824 # we must not ever block the main coroutine 1886 # we must not ever block the main coroutine
1825 local $Coro::idle = sub { 1887 local $Coro::idle = sub {
1826 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 1888 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
1827 (Coro::unblock_sub { 1889 (Coro::unblock_sub {
1828 Event::one_event; 1890 Event::one_event;
1829 })->(); 1891 })->();
1830 }; 1892 };
1831 1893

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines