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.110 by root, Mon Jan 1 11:21:55 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;
… …
1120 $map = try_load_header $path->load_path; 1135 $map = try_load_header $path->load_path;
1121 } 1136 }
1122 1137
1123 $map or return; 1138 $map or return;
1124 1139
1140 $map->{load_original} = 1;
1125 $map->{instantiate_time} = $cf::RUNTIME; 1141 $map->{instantiate_time} = $cf::RUNTIME;
1126 $map->instantiate; 1142 $map->instantiate;
1127 1143
1128 # per-player maps become, after loading, normal maps 1144 # per-player maps become, after loading, normal maps
1129 $map->per_player (0) if $path->{user_rel}; 1145 $map->per_player (0) if $path->{user_rel};
1130 } 1146 }
1147 #Coro::Timer::sleep 1;#d#
1131 1148
1132 $map->path ($key); 1149 $map->path ($key);
1133 $map->{path} = $path; 1150 $map->{path} = $path;
1151 $map->{last_save} = $cf::RUNTIME;
1134 $map->last_access ($cf::RUNTIME); 1152 $map->last_access ($cf::RUNTIME);
1135 1153
1136 $map->reset if $map->should_reset; 1154 if ($map->should_reset) {
1155 $map->reset;
1156 $map = find_map $path;
1157 }
1137 1158
1138 $cf::MAP{$key} = $map 1159 $cf::MAP{$key} = $map
1139 } 1160 }
1140} 1161}
1141 1162
… …
1149 my $path = $self->{path}; 1170 my $path = $self->{path};
1150 1171
1151 $self->alloc; 1172 $self->alloc;
1152 $self->load_objects ($self->{load_path}, 1) 1173 $self->load_objects ($self->{load_path}, 1)
1153 or return; 1174 or return;
1175
1176 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1177 if delete $self->{load_original};
1154 1178
1155 if (my $uniq = $path->uniq_path) { 1179 if (my $uniq = $path->uniq_path) {
1156 utf8::encode $uniq; 1180 utf8::encode $uniq;
1157 if (aio_open $uniq, O_RDONLY, 0) { 1181 if (aio_open $uniq, O_RDONLY, 0) {
1158 $self->clear_unique_items; 1182 $self->clear_unique_items;
… …
1193} 1217}
1194 1218
1195sub save { 1219sub save {
1196 my ($self) = @_; 1220 my ($self) = @_;
1197 1221
1222 $self->{last_save} = $cf::RUNTIME;
1223
1224 return unless $self->dirty;
1225
1198 my $save = $self->{path}->save_path; utf8::encode $save; 1226 my $save = $self->{path}->save_path; utf8::encode $save;
1199 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq; 1227 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1200 1228
1201 $self->{last_save} = $cf::RUNTIME;
1202
1203 return unless $self->dirty;
1204
1205 $self->{load_path} = $save; 1229 $self->{load_path} = $save;
1206 1230
1207 return if $self->{deny_save}; 1231 return if $self->{deny_save};
1208
1209 warn "saving map ", $self->path;
1210 1232
1211 if ($uniq) { 1233 if ($uniq) {
1212 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1234 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1213 $self->save_objects ($uniq, cf::IO_UNIQUES); 1235 $self->save_objects ($uniq, cf::IO_UNIQUES);
1214 } else { 1236 } else {
… …
1226 $self->save; 1248 $self->save;
1227 $self->clear; 1249 $self->clear;
1228 $self->in_memory (cf::MAP_SWAPPED); 1250 $self->in_memory (cf::MAP_SWAPPED);
1229} 1251}
1230 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
1231sub should_reset { 1266sub should_reset {
1232 my ($map) = @_;
1233
1234 # TODO: safety, remove and allow resettable per-player maps
1235 return if $map->{path}{user_rel};#d#
1236 return if $map->{deny_reset};
1237 #return unless $map->reset_timeout;
1238
1239 my $time = $map->fixed_resettime ? $map->{instantiate_time} : $map->last_access;
1240
1241 $time + ($map->reset_timeout || $DEFAULT_RESET) < $cf::RUNTIME
1242}
1243
1244sub reset {
1245 my ($self) = @_; 1267 my ($self) = @_;
1246 1268
1247 return if $self->players; 1269 $self->reset_at <= $cf::RUNTIME
1248 return if $self->{path}{user_rel};#d# 1270}
1249 1271
1250 warn "resetting map ", $self->path;#d# 1272sub unlink_save {
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";
1278}
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
1293sub reset {
1294 my ($self) = @_;
1295
1296 return if $self->players;
1297 return if $self->{path}{user_rel};#d#
1298
1299 warn "resetting map ", $self->path;#d#
1300
1301 delete $cf::MAP{$self->path};
1255 1302
1256 $_->clear_links_to ($self) for values %cf::MAP; 1303 $_->clear_links_to ($self) for values %cf::MAP;
1257 1304
1305 $self->unlink_save;
1258 $self->clear; 1306 $self->destroy;
1259 $self->in_memory (cf::MAP_SWAPPED); 1307}
1260 utf8::encode ($self->{load_path} = $self->{path}->load_path); 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
1261} 1318}
1262 1319
1263sub customise_for { 1320sub customise_for {
1264 my ($map, $ob) = @_; 1321 my ($map, $ob) = @_;
1265 1322
… …
1330 (ref $cf::CFG{"may_$access"} 1387 (ref $cf::CFG{"may_$access"}
1331 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1388 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
1332 : $cf::CFG{"may_$access"}) 1389 : $cf::CFG{"may_$access"})
1333} 1390}
1334 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
1335sub cf::object::player::enter_link { 1410sub cf::object::player::enter_link {
1336 my ($self) = @_; 1411 my ($self) = @_;
1337 1412
1338 return if $self->map == $LINK_MAP; 1413 return if $self->map == $LINK_MAP;
1339 1414
… …
1348 my ($self, $map, $x, $y) = @_; 1423 my ($self, $map, $x, $y) = @_;
1349 1424
1350 my $link_pos = delete $self->{_link_pos}; 1425 my $link_pos = delete $self->{_link_pos};
1351 1426
1352 unless ($map) { 1427 unless ($map) {
1353 $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1354
1355 # restore original map position 1428 # restore original map position
1356 ($map, $x, $y) = @{ $link_pos || [] }; 1429 ($map, $x, $y) = @{ $link_pos || [] };
1357 $map = cf::map::find_map $map; 1430 $map = cf::map::find_map $map;
1358 1431
1359 unless ($map) { 1432 unless ($map) {
… …
1374 1447
1375 $self->activate_recursive; 1448 $self->activate_recursive;
1376 $self->enter_map ($map, $x, $y); 1449 $self->enter_map ($map, $x, $y);
1377} 1450}
1378 1451
1379=item $player_object->goto_map ($map, $x, $y) 1452=item $player_object->goto_map ($path, $x, $y)
1380 1453
1381=cut 1454=cut
1382 1455
1383sub cf::object::player::goto_map { 1456sub cf::object::player::goto_map {
1384 my ($self, $path, $x, $y) = @_; 1457 my ($self, $path, $x, $y) = @_;
… …
1389 $path = new cf::path $path; 1462 $path = new cf::path $path;
1390 1463
1391 my $map = cf::map::find_map $path->as_string; 1464 my $map = cf::map::find_map $path->as_string;
1392 $map = $map->customise_for ($self) if $map; 1465 $map = $map->customise_for ($self) if $map;
1393 1466
1394 warn "entering ", $map->path, " at ($x, $y)\n" 1467# warn "entering ", $map->path, " at ($x, $y)\n"
1395 if $map; 1468# if $map;
1469
1470 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1396 1471
1397 $self->leave_link ($map, $x, $y); 1472 $self->leave_link ($map, $x, $y);
1398 })->prio (1); 1473 })->prio (1);
1399} 1474}
1400 1475
… …
1811} 1886}
1812 1887
1813sub main { 1888sub main {
1814 # we must not ever block the main coroutine 1889 # we must not ever block the main coroutine
1815 local $Coro::idle = sub { 1890 local $Coro::idle = sub {
1816 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#
1817 (Coro::unblock_sub { 1892 (Coro::unblock_sub {
1818 Event::one_event; 1893 Event::one_event;
1819 })->(); 1894 })->();
1820 }; 1895 };
1821 1896
… …
1826} 1901}
1827 1902
1828############################################################################# 1903#############################################################################
1829# initialisation 1904# initialisation
1830 1905
1831sub perl_reload() { 1906sub reload() {
1832 # can/must only be called in main 1907 # can/must only be called in main
1833 if ($Coro::current != $Coro::main) { 1908 if ($Coro::current != $Coro::main) {
1834 warn "can only reload from main coroutine\n"; 1909 warn "can only reload from main coroutine\n";
1835 return; 1910 return;
1836 } 1911 }
… …
1963 $cf::MAP{$LINK_MAP->path} = $LINK_MAP; 2038 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1964} 2039}
1965 2040
1966register "<global>", __PACKAGE__; 2041register "<global>", __PACKAGE__;
1967 2042
1968register_command "perl-reload" => sub { 2043register_command "reload" => sub {
1969 my ($who, $arg) = @_; 2044 my ($who, $arg) = @_;
1970 2045
1971 if ($who->flag (FLAG_WIZ)) { 2046 if ($who->flag (FLAG_WIZ)) {
1972 $who->message ("start of reload."); 2047 $who->message ("start of reload.");
1973 perl_reload; 2048 reload;
1974 $who->message ("end of reload."); 2049 $who->message ("end of reload.");
1975 } 2050 }
1976}; 2051};
1977 2052
1978unshift @INC, $LIBDIR; 2053unshift @INC, $LIBDIR;

Diff Legend

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