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.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;
… …
1120 $map = try_load_header $path->load_path; 1133 $map = try_load_header $path->load_path;
1121 } 1134 }
1122 1135
1123 $map or return; 1136 $map or return;
1124 1137
1138 $map->{load_original} = 1;
1125 $map->{instantiate_time} = $cf::RUNTIME; 1139 $map->{instantiate_time} = $cf::RUNTIME;
1126 $map->instantiate; 1140 $map->instantiate;
1127 1141
1128 # per-player maps become, after loading, normal maps 1142 # per-player maps become, after loading, normal maps
1129 $map->per_player (0) if $path->{user_rel}; 1143 $map->per_player (0) if $path->{user_rel};
… …
1131 1145
1132 $map->path ($key); 1146 $map->path ($key);
1133 $map->{path} = $path; 1147 $map->{path} = $path;
1134 $map->last_access ($cf::RUNTIME); 1148 $map->last_access ($cf::RUNTIME);
1135 1149
1136 $map->reset if $map->should_reset; 1150 if ($map->should_reset) {
1151 $map->reset;
1152 $map = find_map $path;
1153 }
1137 1154
1138 $cf::MAP{$key} = $map 1155 $cf::MAP{$key} = $map
1139 } 1156 }
1140} 1157}
1141 1158
… …
1149 my $path = $self->{path}; 1166 my $path = $self->{path};
1150 1167
1151 $self->alloc; 1168 $self->alloc;
1152 $self->load_objects ($self->{load_path}, 1) 1169 $self->load_objects ($self->{load_path}, 1)
1153 or return; 1170 or return;
1171
1172 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1173 if delete $self->{load_original};
1154 1174
1155 if (my $uniq = $path->uniq_path) { 1175 if (my $uniq = $path->uniq_path) {
1156 utf8::encode $uniq; 1176 utf8::encode $uniq;
1157 if (aio_open $uniq, O_RDONLY, 0) { 1177 if (aio_open $uniq, O_RDONLY, 0) {
1158 $self->clear_unique_items; 1178 $self->clear_unique_items;
… …
1204 1224
1205 $self->{load_path} = $save; 1225 $self->{load_path} = $save;
1206 1226
1207 return if $self->{deny_save}; 1227 return if $self->{deny_save};
1208 1228
1209 warn "saving map ", $self->path;
1210
1211 if ($uniq) { 1229 if ($uniq) {
1212 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1230 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1213 $self->save_objects ($uniq, cf::IO_UNIQUES); 1231 $self->save_objects ($uniq, cf::IO_UNIQUES);
1214 } else { 1232 } else {
1215 $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);
… …
1226 $self->save; 1244 $self->save;
1227 $self->clear; 1245 $self->clear;
1228 $self->in_memory (cf::MAP_SWAPPED); 1246 $self->in_memory (cf::MAP_SWAPPED);
1229} 1247}
1230 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
1231sub should_reset { 1262sub 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) = @_; 1263 my ($self) = @_;
1246 1264
1247 return if $self->players; 1265 $self->reset_at <= $cf::RUNTIME
1248 return if $self->{path}{user_rel};#d# 1266}
1249 1267
1250 warn "resetting map ", $self->path;#d# 1268sub unlink_save {
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";
1274}
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
1289sub reset {
1290 my ($self) = @_;
1291
1292 return if $self->players;
1293 return if $self->{path}{user_rel};#d#
1294
1295 warn "resetting map ", $self->path;#d#
1296
1297 delete $cf::MAP{$self->path};
1255 1298
1256 $_->clear_links_to ($self) for values %cf::MAP; 1299 $_->clear_links_to ($self) for values %cf::MAP;
1257 1300
1301 $self->unlink_save;
1258 $self->clear; 1302 $self->destroy;
1259 $self->in_memory (cf::MAP_SWAPPED); 1303}
1260 utf8::encode ($self->{load_path} = $self->{path}->load_path); 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
1261} 1314}
1262 1315
1263sub customise_for { 1316sub customise_for {
1264 my ($map, $ob) = @_; 1317 my ($map, $ob) = @_;
1265 1318
… …
1330 (ref $cf::CFG{"may_$access"} 1383 (ref $cf::CFG{"may_$access"}
1331 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1384 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
1332 : $cf::CFG{"may_$access"}) 1385 : $cf::CFG{"may_$access"})
1333} 1386}
1334 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
1335sub cf::object::player::enter_link { 1406sub cf::object::player::enter_link {
1336 my ($self) = @_; 1407 my ($self) = @_;
1337 1408
1338 return if $self->map == $LINK_MAP; 1409 return if $self->map == $LINK_MAP;
1339 1410
… …
1348 my ($self, $map, $x, $y) = @_; 1419 my ($self, $map, $x, $y) = @_;
1349 1420
1350 my $link_pos = delete $self->{_link_pos}; 1421 my $link_pos = delete $self->{_link_pos};
1351 1422
1352 unless ($map) { 1423 unless ($map) {
1353 $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1354
1355 # restore original map position 1424 # restore original map position
1356 ($map, $x, $y) = @{ $link_pos || [] }; 1425 ($map, $x, $y) = @{ $link_pos || [] };
1357 $map = cf::map::find_map $map; 1426 $map = cf::map::find_map $map;
1358 1427
1359 unless ($map) { 1428 unless ($map) {
… …
1391 my $map = cf::map::find_map $path->as_string; 1460 my $map = cf::map::find_map $path->as_string;
1392 $map = $map->customise_for ($self) if $map; 1461 $map = $map->customise_for ($self) if $map;
1393 1462
1394 warn "entering ", $map->path, " at ($x, $y)\n" 1463 warn "entering ", $map->path, " at ($x, $y)\n"
1395 if $map; 1464 if $map;
1465
1466 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1396 1467
1397 $self->leave_link ($map, $x, $y); 1468 $self->leave_link ($map, $x, $y);
1398 })->prio (1); 1469 })->prio (1);
1399} 1470}
1400 1471
… …
1811} 1882}
1812 1883
1813sub main { 1884sub main {
1814 # we must not ever block the main coroutine 1885 # we must not ever block the main coroutine
1815 local $Coro::idle = sub { 1886 local $Coro::idle = sub {
1816 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#
1817 (Coro::unblock_sub { 1888 (Coro::unblock_sub {
1818 Event::one_event; 1889 Event::one_event;
1819 })->(); 1890 })->();
1820 }; 1891 };
1821 1892
… …
1826} 1897}
1827 1898
1828############################################################################# 1899#############################################################################
1829# initialisation 1900# initialisation
1830 1901
1831sub perl_reload() { 1902sub reload() {
1832 # can/must only be called in main 1903 # can/must only be called in main
1833 if ($Coro::current != $Coro::main) { 1904 if ($Coro::current != $Coro::main) {
1834 warn "can only reload from main coroutine\n"; 1905 warn "can only reload from main coroutine\n";
1835 return; 1906 return;
1836 } 1907 }
… …
1963 $cf::MAP{$LINK_MAP->path} = $LINK_MAP; 2034 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1964} 2035}
1965 2036
1966register "<global>", __PACKAGE__; 2037register "<global>", __PACKAGE__;
1967 2038
1968register_command "perl-reload" => sub { 2039register_command "reload" => sub {
1969 my ($who, $arg) = @_; 2040 my ($who, $arg) = @_;
1970 2041
1971 if ($who->flag (FLAG_WIZ)) { 2042 if ($who->flag (FLAG_WIZ)) {
1972 $who->message ("start of reload."); 2043 $who->message ("start of reload.");
1973 perl_reload; 2044 reload;
1974 $who->message ("end of reload."); 2045 $who->message ("end of reload.");
1975 } 2046 }
1976}; 2047};
1977 2048
1978unshift @INC, $LIBDIR; 2049unshift @INC, $LIBDIR;

Diff Legend

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