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.115 by root, Mon Jan 1 16:50:10 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;
1132 1145
1133 $map->path ($key); 1146 $map->path ($key);
1134 $map->{path} = $path; 1147 $map->{path} = $path;
1135 $map->last_access ($cf::RUNTIME); 1148 $map->last_access ($cf::RUNTIME);
1136 1149
1137 $map->reset if $map->should_reset; 1150 if ($map->should_reset) {
1151 $map->reset;
1152 $map = find_map $path;
1153 }
1138 1154
1139 $cf::MAP{$key} = $map 1155 $cf::MAP{$key} = $map
1140 } 1156 }
1141} 1157}
1142 1158
1151 1167
1152 $self->alloc; 1168 $self->alloc;
1153 $self->load_objects ($self->{load_path}, 1) 1169 $self->load_objects ($self->{load_path}, 1)
1154 or return; 1170 or return;
1155 1171
1156 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1) if delete $self->{load_original}; 1172 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1173 if delete $self->{load_original};
1157 1174
1158 if (my $uniq = $path->uniq_path) { 1175 if (my $uniq = $path->uniq_path) {
1159 utf8::encode $uniq; 1176 utf8::encode $uniq;
1160 if (aio_open $uniq, O_RDONLY, 0) { 1177 if (aio_open $uniq, O_RDONLY, 0) {
1161 $self->clear_unique_items; 1178 $self->clear_unique_items;
1207 1224
1208 $self->{load_path} = $save; 1225 $self->{load_path} = $save;
1209 1226
1210 return if $self->{deny_save}; 1227 return if $self->{deny_save};
1211 1228
1212 warn "saving map ", $self->path;
1213
1214 if ($uniq) { 1229 if ($uniq) {
1215 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1230 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1216 $self->save_objects ($uniq, cf::IO_UNIQUES); 1231 $self->save_objects ($uniq, cf::IO_UNIQUES);
1217 } else { 1232 } else {
1218 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 1233 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1229 $self->save; 1244 $self->save;
1230 $self->clear; 1245 $self->clear;
1231 $self->in_memory (cf::MAP_SWAPPED); 1246 $self->in_memory (cf::MAP_SWAPPED);
1232} 1247}
1233 1248
1249sub reset_at {
1250 my ($self) = @_;
1251
1252 # TODO: safety, remove and allow resettable per-player maps
1253 return 1e99 if $self->{path}{user_rel};
1254 return 1e99 if $self->{deny_reset};
1255
1256 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1257 my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
1258
1259 $time + $to
1260}
1261
1234sub should_reset { 1262sub should_reset {
1235 my ($map) = @_; 1263 my ($self) = @_;
1236 1264
1237 # TODO: safety, remove and allow resettable per-player maps 1265 $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} 1266}
1248 1267
1249sub unlink_save { 1268sub unlink_save {
1250 my ($self) = @_; 1269 my ($self) = @_;
1251 1270
1252 utf8::encode (my $save = $self->{path}->save_path); 1271 utf8::encode (my $save = $self->{path}->save_path);
1253 aioreq_pri 3; IO::AIO::aio_unlink $save; 1272 aioreq_pri 3; IO::AIO::aio_unlink $save;
1254 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst"; 1273 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1255} 1274}
1256 1275
1276sub rename {
1277 my ($self, $new_path) = @_;
1278
1279 $self->unlink_save;
1280
1281 delete $cf::MAP{$self->path};
1282 $self->{path} = new cf::path $new_path;
1283 $self->path ($self->{path}->as_string);
1284 $cf::MAP{$self->path} = $self;
1285
1286 $self->save;
1287}
1288
1257sub reset { 1289sub reset {
1258 my ($self) = @_; 1290 my ($self) = @_;
1259 1291
1260 return if $self->players; 1292 return if $self->players;
1261 return if $self->{path}{user_rel};#d# 1293 return if $self->{path}{user_rel};#d#
1266 1298
1267 $_->clear_links_to ($self) for values %cf::MAP; 1299 $_->clear_links_to ($self) for values %cf::MAP;
1268 1300
1269 $self->unlink_save; 1301 $self->unlink_save;
1270 $self->destroy; 1302 $self->destroy;
1303}
1304
1305my $nuke_counter = "aaaa";
1306
1307sub nuke {
1308 my ($self) = @_;
1309
1310 $self->{deny_save} = 1;
1311 $self->reset_timeout (1);
1312 $self->rename ("{nuke}/" . ($nuke_counter++));
1313 $self->reset; # polite request, might not happen
1271} 1314}
1272 1315
1273sub customise_for { 1316sub customise_for {
1274 my ($map, $ob) = @_; 1317 my ($map, $ob) = @_;
1275 1318
1340 (ref $cf::CFG{"may_$access"} 1383 (ref $cf::CFG{"may_$access"}
1341 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1384 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
1342 : $cf::CFG{"may_$access"}) 1385 : $cf::CFG{"may_$access"})
1343} 1386}
1344 1387
1388=item $player_object->enter_link
1389
1390Freezes the player and moves him/her to a special map (C<{link}>).
1391
1392The player should be reaosnably safe there for short amounts of time. You
1393I<MUST> call C<leave_link> as soon as possible, though.
1394
1395=item $player_object->leave_link ($map, $x, $y)
1396
1397Moves the player out of the specila link map onto the given map. If the
1398map is not valid (or omitted), the player will be moved back to the
1399location he/she was before the call to C<enter_link>, or, if that fails,
1400to the emergency map position.
1401
1402Might block.
1403
1404=cut
1405
1345sub cf::object::player::enter_link { 1406sub cf::object::player::enter_link {
1346 my ($self) = @_; 1407 my ($self) = @_;
1347 1408
1348 return if $self->map == $LINK_MAP; 1409 return if $self->map == $LINK_MAP;
1349 1410
1358 my ($self, $map, $x, $y) = @_; 1419 my ($self, $map, $x, $y) = @_;
1359 1420
1360 my $link_pos = delete $self->{_link_pos}; 1421 my $link_pos = delete $self->{_link_pos};
1361 1422
1362 unless ($map) { 1423 unless ($map) {
1363 $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1364
1365 # restore original map position 1424 # restore original map position
1366 ($map, $x, $y) = @{ $link_pos || [] }; 1425 ($map, $x, $y) = @{ $link_pos || [] };
1367 $map = cf::map::find_map $map; 1426 $map = cf::map::find_map $map;
1368 1427
1369 unless ($map) { 1428 unless ($map) {
1401 my $map = cf::map::find_map $path->as_string; 1460 my $map = cf::map::find_map $path->as_string;
1402 $map = $map->customise_for ($self) if $map; 1461 $map = $map->customise_for ($self) if $map;
1403 1462
1404 warn "entering ", $map->path, " at ($x, $y)\n" 1463 warn "entering ", $map->path, " at ($x, $y)\n"
1405 if $map; 1464 if $map;
1465
1466 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1406 1467
1407 $self->leave_link ($map, $x, $y); 1468 $self->leave_link ($map, $x, $y);
1408 })->prio (1); 1469 })->prio (1);
1409} 1470}
1410 1471
1821} 1882}
1822 1883
1823sub main { 1884sub main {
1824 # we must not ever block the main coroutine 1885 # we must not ever block the main coroutine
1825 local $Coro::idle = sub { 1886 local $Coro::idle = sub {
1826 Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d# 1887 Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
1827 (Coro::unblock_sub { 1888 (Coro::unblock_sub {
1828 Event::one_event; 1889 Event::one_event;
1829 })->(); 1890 })->();
1830 }; 1891 };
1831 1892

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines