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.119 by root, Tue Jan 2 08:26:42 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
822 warn sprintf "loading %s (%d)\n",
823 $filename, length $data, scalar @{$av || []};#d#
806 return ($data, $av); 824 return ($data, $av);
807} 825}
808 826
809############################################################################# 827#############################################################################
810# command handling &c 828# command handling &c
… …
1046use Fcntl; 1064use Fcntl;
1047use Coro::AIO; 1065use Coro::AIO;
1048 1066
1049our $MAX_RESET = 7200; 1067our $MAX_RESET = 7200;
1050our $DEFAULT_RESET = 3600; 1068our $DEFAULT_RESET = 3600;
1051$MAX_RESET = 10;#d#
1052$DEFAULT_RESET = 10;#d#
1053 1069
1054sub generate_random_map { 1070sub generate_random_map {
1055 my ($path, $rmp) = @_; 1071 my ($path, $rmp) = @_;
1056 1072
1057 # mit "rum" bekleckern, nicht 1073 # mit "rum" bekleckern, nicht
… …
1090 1106
1091 $map->load_header ($path) 1107 $map->load_header ($path)
1092 or return; 1108 or return;
1093 1109
1094 $map->{load_path} = $path; 1110 $map->{load_path} = $path;
1095 use Data::Dumper; warn Dumper $map;#d#
1096 1111
1097 $map 1112 $map
1098} 1113}
1099 1114
1100sub find_map { 1115sub find_map {
1101 my ($path, $origin) = @_; 1116 my ($path, $origin) = @_;
1102 1117
1103 #warn "find_map<$path,$origin>\n";#d# 1118 #warn "find_map<$path,$origin>\n";#d#
1104 1119
1105 $path = ref $path ? $path : new cf::path $path, $origin && $origin->path; 1120 $path = new cf::path $path, $origin && $origin->path;
1106 my $key = $path->as_string; 1121 my $key = $path->as_string;
1107 1122
1108 $cf::MAP{$key} || do { 1123 $cf::MAP{$key} || do {
1109 # do it the slow way 1124 # do it the slow way
1110 my $map = try_load_header $path->save_path; 1125 my $map = try_load_header $path->save_path;
… …
1127 $map->instantiate; 1142 $map->instantiate;
1128 1143
1129 # per-player maps become, after loading, normal maps 1144 # per-player maps become, after loading, normal maps
1130 $map->per_player (0) if $path->{user_rel}; 1145 $map->per_player (0) if $path->{user_rel};
1131 } 1146 }
1147 #Coro::Timer::sleep 1;#d#
1132 1148
1133 $map->path ($key); 1149 $map->path ($key);
1134 $map->{path} = $path; 1150 $map->{path} = $path;
1151 $map->{last_save} = $cf::RUNTIME;
1135 $map->last_access ($cf::RUNTIME); 1152 $map->last_access ($cf::RUNTIME);
1136 1153
1137 $map->reset if $map->should_reset; 1154 if ($map->should_reset) {
1155 $map->reset;
1156 $map = find_map $path;
1157 }
1138 1158
1139 $cf::MAP{$key} = $map 1159 $cf::MAP{$key} = $map
1140 } 1160 }
1141} 1161}
1142 1162
… …
1151 1171
1152 $self->alloc; 1172 $self->alloc;
1153 $self->load_objects ($self->{load_path}, 1) 1173 $self->load_objects ($self->{load_path}, 1)
1154 or return; 1174 or return;
1155 1175
1156 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) if delete $self->{load_original}; 1176 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1177 if delete $self->{load_original};
1157 1178
1158 if (my $uniq = $path->uniq_path) { 1179 if (my $uniq = $path->uniq_path) {
1159 utf8::encode $uniq; 1180 utf8::encode $uniq;
1160 if (aio_open $uniq, O_RDONLY, 0) { 1181 if (aio_open $uniq, O_RDONLY, 0) {
1161 $self->clear_unique_items; 1182 $self->clear_unique_items;
… …
1196} 1217}
1197 1218
1198sub save { 1219sub save {
1199 my ($self) = @_; 1220 my ($self) = @_;
1200 1221
1222 $self->{last_save} = $cf::RUNTIME;
1223
1224 return unless $self->dirty;
1225
1201 my $save = $self->{path}->save_path; utf8::encode $save; 1226 my $save = $self->{path}->save_path; utf8::encode $save;
1202 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq; 1227 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1203 1228
1204 $self->{last_save} = $cf::RUNTIME;
1205
1206 return unless $self->dirty;
1207
1208 $self->{load_path} = $save; 1229 $self->{load_path} = $save;
1209 1230
1210 return if $self->{deny_save}; 1231 return if $self->{deny_save};
1211
1212 warn "saving map ", $self->path;
1213 1232
1214 if ($uniq) { 1233 if ($uniq) {
1215 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1234 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1216 $self->save_objects ($uniq, cf::IO_UNIQUES); 1235 $self->save_objects ($uniq, cf::IO_UNIQUES);
1217 } else { 1236 } else {
… …
1229 $self->save; 1248 $self->save;
1230 $self->clear; 1249 $self->clear;
1231 $self->in_memory (cf::MAP_SWAPPED); 1250 $self->in_memory (cf::MAP_SWAPPED);
1232} 1251}
1233 1252
1253sub reset_at {
1254 my ($self) = @_;
1255
1256 # TODO: safety, remove and allow resettable per-player maps
1257 return 1e99 if $self->{path}{user_rel};
1258 return 1e99 if $self->{deny_reset};
1259
1260 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1261 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
1262
1263 $time + $to
1264}
1265
1234sub should_reset { 1266sub should_reset {
1235 my ($map) = @_; 1267 my ($self) = @_;
1236 1268
1237 # TODO: safety, remove and allow resettable per-player maps 1269 $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} 1270}
1248 1271
1249sub unlink_save { 1272sub unlink_save {
1250 my ($self) = @_; 1273 my ($self) = @_;
1251 1274
1252 utf8::encode (my $save = $self->{path}->save_path); 1275 utf8::encode (my $save = $self->{path}->save_path);
1253 aioreq_pri 3; IO::AIO::aio_unlink $save; 1276 aioreq_pri 3; IO::AIO::aio_unlink $save;
1254 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst"; 1277 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1255} 1278}
1256 1279
1280sub rename {
1281 my ($self, $new_path) = @_;
1282
1283 $self->unlink_save;
1284
1285 delete $cf::MAP{$self->path};
1286 $self->{path} = new cf::path $new_path;
1287 $self->path ($self->{path}->as_string);
1288 $cf::MAP{$self->path} = $self;
1289
1290 $self->save;
1291}
1292
1257sub reset { 1293sub reset {
1258 my ($self) = @_; 1294 my ($self) = @_;
1259 1295
1260 return if $self->players; 1296 return if $self->players;
1261 return if $self->{path}{user_rel};#d# 1297 return if $self->{path}{user_rel};#d#
… …
1266 1302
1267 $_->clear_links_to ($self) for values %cf::MAP; 1303 $_->clear_links_to ($self) for values %cf::MAP;
1268 1304
1269 $self->unlink_save; 1305 $self->unlink_save;
1270 $self->destroy; 1306 $self->destroy;
1307}
1308
1309my $nuke_counter = "aaaa";
1310
1311sub nuke {
1312 my ($self) = @_;
1313
1314 $self->{deny_save} = 1;
1315 $self->reset_timeout (1);
1316 $self->rename ("{nuke}/" . ($nuke_counter++));
1317 $self->reset; # polite request, might not happen
1271} 1318}
1272 1319
1273sub customise_for { 1320sub customise_for {
1274 my ($map, $ob) = @_; 1321 my ($map, $ob) = @_;
1275 1322
… …
1340 (ref $cf::CFG{"may_$access"} 1387 (ref $cf::CFG{"may_$access"}
1341 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1388 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
1342 : $cf::CFG{"may_$access"}) 1389 : $cf::CFG{"may_$access"})
1343} 1390}
1344 1391
1392=item $player_object->enter_link
1393
1394Freezes the player and moves him/her to a special map (C<{link}>).
1395
1396The player should be reaosnably safe there for short amounts of time. You
1397I<MUST> call C<leave_link> as soon as possible, though.
1398
1399=item $player_object->leave_link ($map, $x, $y)
1400
1401Moves the player out of the specila link map onto the given map. If the
1402map is not valid (or omitted), the player will be moved back to the
1403location he/she was before the call to C<enter_link>, or, if that fails,
1404to the emergency map position.
1405
1406Might block.
1407
1408=cut
1409
1345sub cf::object::player::enter_link { 1410sub cf::object::player::enter_link {
1346 my ($self) = @_; 1411 my ($self) = @_;
1347 1412
1348 return if $self->map == $LINK_MAP; 1413 return if $self->map == $LINK_MAP;
1349 1414
… …
1358 my ($self, $map, $x, $y) = @_; 1423 my ($self, $map, $x, $y) = @_;
1359 1424
1360 my $link_pos = delete $self->{_link_pos}; 1425 my $link_pos = delete $self->{_link_pos};
1361 1426
1362 unless ($map) { 1427 unless ($map) {
1363 $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1364
1365 # restore original map position 1428 # restore original map position
1366 ($map, $x, $y) = @{ $link_pos || [] }; 1429 ($map, $x, $y) = @{ $link_pos || [] };
1367 $map = cf::map::find_map $map; 1430 $map = cf::map::find_map $map;
1368 1431
1369 unless ($map) { 1432 unless ($map) {
… …
1384 1447
1385 $self->activate_recursive; 1448 $self->activate_recursive;
1386 $self->enter_map ($map, $x, $y); 1449 $self->enter_map ($map, $x, $y);
1387} 1450}
1388 1451
1389=item $player_object->goto_map ($map, $x, $y) 1452=item $player_object->goto_map ($path, $x, $y)
1390 1453
1391=cut 1454=cut
1392 1455
1393sub cf::object::player::goto_map { 1456sub cf::object::player::goto_map {
1394 my ($self, $path, $x, $y) = @_; 1457 my ($self, $path, $x, $y) = @_;
… …
1399 $path = new cf::path $path; 1462 $path = new cf::path $path;
1400 1463
1401 my $map = cf::map::find_map $path->as_string; 1464 my $map = cf::map::find_map $path->as_string;
1402 $map = $map->customise_for ($self) if $map; 1465 $map = $map->customise_for ($self) if $map;
1403 1466
1404 warn "entering ", $map->path, " at ($x, $y)\n" 1467# warn "entering ", $map->path, " at ($x, $y)\n"
1405 if $map; 1468# if $map;
1469
1470 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1406 1471
1407 $self->leave_link ($map, $x, $y); 1472 $self->leave_link ($map, $x, $y);
1408 })->prio (1); 1473 })->prio (1);
1409} 1474}
1410 1475
… …
1821} 1886}
1822 1887
1823sub main { 1888sub main {
1824 # we must not ever block the main coroutine 1889 # we must not ever block the main coroutine
1825 local $Coro::idle = sub { 1890 local $Coro::idle = sub {
1826 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 1891 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
1827 (Coro::unblock_sub { 1892 (Coro::unblock_sub {
1828 Event::one_event; 1893 Event::one_event;
1829 })->(); 1894 })->();
1830 }; 1895 };
1831 1896

Diff Legend

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