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.112 by root, Mon Jan 1 13:31:47 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;
… …
1046use Fcntl; 1052use Fcntl;
1047use Coro::AIO; 1053use Coro::AIO;
1048 1054
1049our $MAX_RESET = 7200; 1055our $MAX_RESET = 7200;
1050our $DEFAULT_RESET = 3600; 1056our $DEFAULT_RESET = 3600;
1051$MAX_RESET = 10;#d#
1052$DEFAULT_RESET = 10;#d#
1053 1057
1054sub generate_random_map { 1058sub generate_random_map {
1055 my ($path, $rmp) = @_; 1059 my ($path, $rmp) = @_;
1056 1060
1057 # mit "rum" bekleckern, nicht 1061 # mit "rum" bekleckern, nicht
… …
1090 1094
1091 $map->load_header ($path) 1095 $map->load_header ($path)
1092 or return; 1096 or return;
1093 1097
1094 $map->{load_path} = $path; 1098 $map->{load_path} = $path;
1095 use Data::Dumper; warn Dumper $map;#d#
1096 1099
1097 $map 1100 $map
1098} 1101}
1099 1102
1100sub find_map { 1103sub find_map {
1101 my ($path, $origin) = @_; 1104 my ($path, $origin) = @_;
1102 1105
1103 #warn "find_map<$path,$origin>\n";#d# 1106 #warn "find_map<$path,$origin>\n";#d#
1104 1107
1105 $path = ref $path ? $path : new cf::path $path, $origin && $origin->path; 1108 $path = new cf::path $path, $origin && $origin->path;
1106 my $key = $path->as_string; 1109 my $key = $path->as_string;
1107 1110
1108 $cf::MAP{$key} || do { 1111 $cf::MAP{$key} || do {
1109 # do it the slow way 1112 # do it the slow way
1110 my $map = try_load_header $path->save_path; 1113 my $map = try_load_header $path->save_path;
… …
1120 $map = try_load_header $path->load_path; 1123 $map = try_load_header $path->load_path;
1121 } 1124 }
1122 1125
1123 $map or return; 1126 $map or return;
1124 1127
1128 $map->{load_original} = 1;
1125 $map->{instantiate_time} = $cf::RUNTIME; 1129 $map->{instantiate_time} = $cf::RUNTIME;
1126 $map->instantiate; 1130 $map->instantiate;
1127 1131
1128 # per-player maps become, after loading, normal maps 1132 # per-player maps become, after loading, normal maps
1129 $map->per_player (0) if $path->{user_rel}; 1133 $map->per_player (0) if $path->{user_rel};
… …
1131 1135
1132 $map->path ($key); 1136 $map->path ($key);
1133 $map->{path} = $path; 1137 $map->{path} = $path;
1134 $map->last_access ($cf::RUNTIME); 1138 $map->last_access ($cf::RUNTIME);
1135 1139
1136 $map->reset if $map->should_reset; 1140 if ($map->should_reset) {
1141 $map->reset;
1142 $map = find_map $path;
1143 }
1137 1144
1138 $cf::MAP{$key} = $map 1145 $cf::MAP{$key} = $map
1139 } 1146 }
1140} 1147}
1141 1148
… …
1149 my $path = $self->{path}; 1156 my $path = $self->{path};
1150 1157
1151 $self->alloc; 1158 $self->alloc;
1152 $self->load_objects ($self->{load_path}, 1) 1159 $self->load_objects ($self->{load_path}, 1)
1153 or return; 1160 or return;
1161
1162 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1163 if delete $self->{load_original};
1154 1164
1155 if (my $uniq = $path->uniq_path) { 1165 if (my $uniq = $path->uniq_path) {
1156 utf8::encode $uniq; 1166 utf8::encode $uniq;
1157 if (aio_open $uniq, O_RDONLY, 0) { 1167 if (aio_open $uniq, O_RDONLY, 0) {
1158 $self->clear_unique_items; 1168 $self->clear_unique_items;
… …
1204 1214
1205 $self->{load_path} = $save; 1215 $self->{load_path} = $save;
1206 1216
1207 return if $self->{deny_save}; 1217 return if $self->{deny_save};
1208 1218
1209 warn "saving map ", $self->path;
1210
1211 if ($uniq) { 1219 if ($uniq) {
1212 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS); 1220 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1213 $self->save_objects ($uniq, cf::IO_UNIQUES); 1221 $self->save_objects ($uniq, cf::IO_UNIQUES);
1214 } else { 1222 } else {
1215 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES); 1223 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
… …
1226 $self->save; 1234 $self->save;
1227 $self->clear; 1235 $self->clear;
1228 $self->in_memory (cf::MAP_SWAPPED); 1236 $self->in_memory (cf::MAP_SWAPPED);
1229} 1237}
1230 1238
1239sub reset_at {
1240 my ($self) = @_;
1241
1242 # TODO: safety, remove and allow resettable per-player maps
1243 return 1e100 if $self->{path}{user_rel};
1244 return 1e100 if $self->{deny_reset};
1245
1246 my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
1247 my $to = $self->reset_timeout || $DEFAULT_RESET;
1248 $to = $MAX_RESET if $to > $MAX_RESET;
1249
1250 $time + $to
1251}
1252
1231sub should_reset { 1253sub 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) = @_; 1254 my ($self) = @_;
1246 1255
1247 return if $self->players; 1256 $self->reset_at <= $cf::RUNTIME
1248 return if $self->{path}{user_rel};#d# 1257}
1249 1258
1250 warn "resetting map ", $self->path;#d# 1259sub unlink_save {
1260 my ($self) = @_;
1251 1261
1252 utf8::encode (my $save = $self->{path}->save_path); 1262 utf8::encode (my $save = $self->{path}->save_path);
1253 aioreq_pri 3; IO::AIO::aio_unlink $save; 1263 aioreq_pri 3; IO::AIO::aio_unlink $save;
1254 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst"; 1264 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1265}
1266
1267sub reset {
1268 my ($self) = @_;
1269
1270 return if $self->players;
1271 return if $self->{path}{user_rel};#d#
1272
1273 warn "resetting map ", $self->path;#d#
1274
1275 delete $cf::MAP{$self->path};
1255 1276
1256 $_->clear_links_to ($self) for values %cf::MAP; 1277 $_->clear_links_to ($self) for values %cf::MAP;
1257 1278
1279 $self->unlink_save;
1258 $self->clear; 1280 $self->destroy;
1259 $self->in_memory (cf::MAP_SWAPPED);
1260 utf8::encode ($self->{load_path} = $self->{path}->load_path);
1261} 1281}
1262 1282
1263sub customise_for { 1283sub customise_for {
1264 my ($map, $ob) = @_; 1284 my ($map, $ob) = @_;
1265 1285
… …
1826} 1846}
1827 1847
1828############################################################################# 1848#############################################################################
1829# initialisation 1849# initialisation
1830 1850
1831sub perl_reload() { 1851sub reload() {
1832 # can/must only be called in main 1852 # can/must only be called in main
1833 if ($Coro::current != $Coro::main) { 1853 if ($Coro::current != $Coro::main) {
1834 warn "can only reload from main coroutine\n"; 1854 warn "can only reload from main coroutine\n";
1835 return; 1855 return;
1836 } 1856 }
… …
1963 $cf::MAP{$LINK_MAP->path} = $LINK_MAP; 1983 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1964} 1984}
1965 1985
1966register "<global>", __PACKAGE__; 1986register "<global>", __PACKAGE__;
1967 1987
1968register_command "perl-reload" => sub { 1988register_command "reload" => sub {
1969 my ($who, $arg) = @_; 1989 my ($who, $arg) = @_;
1970 1990
1971 if ($who->flag (FLAG_WIZ)) { 1991 if ($who->flag (FLAG_WIZ)) {
1972 $who->message ("start of reload."); 1992 $who->message ("start of reload.");
1973 perl_reload; 1993 reload;
1974 $who->message ("end of reload."); 1994 $who->message ("end of reload.");
1975 } 1995 }
1976}; 1996};
1977 1997
1978unshift @INC, $LIBDIR; 1998unshift @INC, $LIBDIR;

Diff Legend

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