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.109 by root, Sun Dec 31 22:23:12 2006 UTC vs.
Revision 1.114 by root, Mon Jan 1 16:00:10 2007 UTC

71mkdir cf::localdir . "/" . cf::uniquedir; 71mkdir cf::localdir . "/" . cf::uniquedir;
72mkdir $RANDOM_MAPS; 72mkdir $RANDOM_MAPS;
73 73
74# a special map that is always available 74# a special map that is always available
75our $LINK_MAP; 75our $LINK_MAP;
76
77our $EMERGENCY_POSITION = $cf::CFG{emergency_position} || ["/world/world_105_115", 5, 37];
76 78
77############################################################################# 79#############################################################################
78 80
79=head2 GLOBAL VARIABLES 81=head2 GLOBAL VARIABLES
80 82
195=cut 197=cut
196 198
197sub sync_job(&) { 199sub sync_job(&) {
198 my ($job) = @_; 200 my ($job) = @_;
199 201
200 my $busy = 1;
201 my @res;
202
203 # TODO: use suspend/resume instead
204 local $FREEZE = 1;
205
206 my $coro = Coro::async {
207 @res = eval { $job->() };
208 warn $@ if $@;
209 undef $busy;
210 };
211
212 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
206 # TODO: use suspend/resume instead
207 # (but this is cancel-safe)
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;
213 $coro->prio (Coro::PRIO_MAX); 217 })->prio (Coro::PRIO_MAX);
218
214 while ($busy) { 219 while ($busy) {
215 Coro::cede_notself; 220 Coro::cede_notself;
216 Event::one_event unless Coro::nready; 221 Event::one_event unless Coro::nready;
217 } 222 }
223
224 wantarray ? @res : $res[0]
218 } else { 225 } else {
219 $coro->join; 226 # we are in another coroutine, how wonderful, everything just works
227
228 $job->()
220 } 229 }
221
222 wantarray ? @res : $res[0]
223} 230}
224 231
225=item $coro = cf::coro { BLOCK } 232=item $coro = cf::coro { BLOCK }
226 233
227Creates and returns a new coro. This coro is automcatially being canceled 234Creates and returns a new coro. This coro is automcatially being canceled
251 my $runtime = cf::localdir . "/runtime"; 258 my $runtime = cf::localdir . "/runtime";
252 259
253 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644 260 my $fh = aio_open "$runtime~", O_WRONLY | O_CREAT, 0644
254 or return; 261 or return;
255 262
256 my $value = $cf::RUNTIME; 263 my $value = $cf::RUNTIME + 1 + 10; # 10 is the runtime save interval, for a monotonic clock
257 (aio_write $fh, 0, (length $value), $value, 0) <= 0 264 (aio_write $fh, 0, (length $value), $value, 0) <= 0
258 and return; 265 and return;
259 266
260 aio_fsync $fh 267 aio_fsync $fh
261 and return; 268 and return;
278package cf::path; 285package cf::path;
279 286
280sub new { 287sub new {
281 my ($class, $path, $base) = @_; 288 my ($class, $path, $base) = @_;
282 289
290 $path = $path->as_string if ref $path;
291
283 my $self = bless { }, $class; 292 my $self = bless { }, $class;
284 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
285 if ($path =~ s{^\?random/}{}) { 304 } elsif ($path =~ s{^\?random/}{}) {
286 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data; 305 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
287 $self->{random} = cf::from_json $data; 306 $self->{random} = cf::from_json $data;
288 } else { 307 } else {
289 if ($path =~ s{^~([^/]+)?}{}) { 308 if ($path =~ s{^~([^/]+)?}{}) {
290 $self->{user_rel} = 1; 309 $self->{user_rel} = 1;
795 or return; 814 or return;
796 815
797 unless (aio_stat "$filename.pst") { 816 unless (aio_stat "$filename.pst") {
798 (aio_load "$filename.pst", $av) >= 0 817 (aio_load "$filename.pst", $av) >= 0
799 or return; 818 or return;
800 $av = eval { (Storable::thaw <$av>)->{objs} }; 819 $av = eval { (Storable::thaw $av)->{objs} };
801 } 820 }
802 821
803 return ($data, $av); 822 return ($data, $av);
804} 823}
805 824
1029 $self->send ("ext " . to_json \%msg); 1048 $self->send ("ext " . to_json \%msg);
1030} 1049}
1031 1050
1032=back 1051=back
1033 1052
1053
1054=head3 cf::map
1055
1056=over 4
1057
1058=cut
1059
1060package cf::map;
1061
1062use Fcntl;
1063use Coro::AIO;
1064
1065our $MAX_RESET = 7200;
1066our $DEFAULT_RESET = 3600;
1067
1068sub generate_random_map {
1069 my ($path, $rmp) = @_;
1070
1071 # mit "rum" bekleckern, nicht
1072 cf::map::_create_random_map
1073 $path,
1074 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1075 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1076 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1077 $rmp->{exit_on_final_map},
1078 $rmp->{xsize}, $rmp->{ysize},
1079 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1080 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1081 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1082 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1083 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1084 (cf::region::find $rmp->{region})
1085}
1086
1087# and all this just because we cannot iterate over
1088# all maps in C++...
1089sub change_all_map_light {
1090 my ($change) = @_;
1091
1092 $_->change_map_light ($change) for values %cf::MAP;
1093}
1094
1095sub try_load_header($) {
1096 my ($path) = @_;
1097
1098 utf8::encode $path;
1099 aio_open $path, O_RDONLY, 0
1100 or return;
1101
1102 my $map = cf::map::new
1103 or return;
1104
1105 $map->load_header ($path)
1106 or return;
1107
1108 $map->{load_path} = $path;
1109
1110 $map
1111}
1112
1113sub find_map {
1114 my ($path, $origin) = @_;
1115
1116 #warn "find_map<$path,$origin>\n";#d#
1117
1118 $path = new cf::path $path, $origin && $origin->path;
1119 my $key = $path->as_string;
1120
1121 $cf::MAP{$key} || do {
1122 # do it the slow way
1123 my $map = try_load_header $path->save_path;
1124
1125 if ($map) {
1126 # safety
1127 $map->{instantiate_time} = $cf::RUNTIME
1128 if $map->{instantiate_time} > $cf::RUNTIME;
1129 } else {
1130 if (my $rmp = $path->random_map_params) {
1131 $map = generate_random_map $key, $rmp;
1132 } else {
1133 $map = try_load_header $path->load_path;
1134 }
1135
1136 $map or return;
1137
1138 $map->{load_original} = 1;
1139 $map->{instantiate_time} = $cf::RUNTIME;
1140 $map->instantiate;
1141
1142 # per-player maps become, after loading, normal maps
1143 $map->per_player (0) if $path->{user_rel};
1144 }
1145
1146 $map->path ($key);
1147 $map->{path} = $path;
1148 $map->last_access ($cf::RUNTIME);
1149
1150 if ($map->should_reset) {
1151 $map->reset;
1152 $map = find_map $path;
1153 }
1154
1155 $cf::MAP{$key} = $map
1156 }
1157}
1158
1159sub load {
1160 my ($self) = @_;
1161
1162 return if $self->in_memory != cf::MAP_SWAPPED;
1163
1164 $self->in_memory (cf::MAP_LOADING);
1165
1166 my $path = $self->{path};
1167
1168 $self->alloc;
1169 $self->load_objects ($self->{load_path}, 1)
1170 or return;
1171
1172 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1173 if delete $self->{load_original};
1174
1175 if (my $uniq = $path->uniq_path) {
1176 utf8::encode $uniq;
1177 if (aio_open $uniq, O_RDONLY, 0) {
1178 $self->clear_unique_items;
1179 $self->load_objects ($uniq, 0);
1180 }
1181 }
1182
1183 # now do the right thing for maps
1184 $self->link_multipart_objects;
1185
1186 if ($self->{path}->is_style_map) {
1187 $self->{deny_save} = 1;
1188 $self->{deny_reset} = 1;
1189 } else {
1190 $self->fix_auto_apply;
1191 $self->decay_objects;
1192 $self->update_buttons;
1193 $self->set_darkness_map;
1194 $self->difficulty ($self->estimate_difficulty)
1195 unless $self->difficulty;
1196 $self->activate;
1197 }
1198
1199 $self->in_memory (cf::MAP_IN_MEMORY);
1200}
1201
1202sub load_map_sync {
1203 my ($path, $origin) = @_;
1204
1205 #warn "load_map_sync<$path, $origin>\n";#d#
1206
1207 cf::sync_job {
1208 my $map = cf::map::find_map $path, $origin
1209 or return;
1210 $map->load;
1211 $map
1212 }
1213}
1214
1215sub save {
1216 my ($self) = @_;
1217
1218 my $save = $self->{path}->save_path; utf8::encode $save;
1219 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1220
1221 $self->{last_save} = $cf::RUNTIME;
1222
1223 return unless $self->dirty;
1224
1225 $self->{load_path} = $save;
1226
1227 return if $self->{deny_save};
1228
1229 if ($uniq) {
1230 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1231 $self->save_objects ($uniq, cf::IO_UNIQUES);
1232 } else {
1233 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1234 }
1235}
1236
1237sub swap_out {
1238 my ($self) = @_;
1239
1240 return if $self->players;
1241 return if $self->in_memory != cf::MAP_IN_MEMORY;
1242 return if $self->{deny_save};
1243
1244 $self->save;
1245 $self->clear;
1246 $self->in_memory (cf::MAP_SWAPPED);
1247}
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
1262sub should_reset {
1263 my ($self) = @_;
1264
1265 $self->reset_at <= $cf::RUNTIME
1266}
1267
1268sub unlink_save {
1269 my ($self) = @_;
1270
1271 utf8::encode (my $save = $self->{path}->save_path);
1272 aioreq_pri 3; IO::AIO::aio_unlink $save;
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};
1298
1299 $_->clear_links_to ($self) for values %cf::MAP;
1300
1301 $self->unlink_save;
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
1314}
1315
1316sub customise_for {
1317 my ($map, $ob) = @_;
1318
1319 if ($map->per_player) {
1320 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path};
1321 }
1322
1323 $map
1324}
1325
1326sub emergency_save {
1327 local $cf::FREEZE = 1;
1328
1329 warn "enter emergency map save\n";
1330
1331 cf::sync_job {
1332 warn "begin emergency map save\n";
1333 $_->save for values %cf::MAP;
1334 };
1335
1336 warn "end emergency map save\n";
1337}
1338
1339package cf;
1340
1341=back
1342
1343
1034=head3 cf::object::player 1344=head3 cf::object::player
1035 1345
1036=over 4 1346=over 4
1037 1347
1038=item $player_object->reply ($npc, $msg[, $flags]) 1348=item $player_object->reply ($npc, $msg[, $flags])
1071 1381
1072 $self->flag (cf::FLAG_WIZ) || 1382 $self->flag (cf::FLAG_WIZ) ||
1073 (ref $cf::CFG{"may_$access"} 1383 (ref $cf::CFG{"may_$access"}
1074 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1384 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
1075 : $cf::CFG{"may_$access"}) 1385 : $cf::CFG{"may_$access"})
1386}
1387
1388sub cf::object::player::enter_link {
1389 my ($self) = @_;
1390
1391 return if $self->map == $LINK_MAP;
1392
1393 $self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]
1394 if $self->map;
1395
1396 $self->enter_map ($LINK_MAP, 20, 20);
1397 $self->deactivate_recursive;
1398}
1399
1400sub cf::object::player::leave_link {
1401 my ($self, $map, $x, $y) = @_;
1402
1403 my $link_pos = delete $self->{_link_pos};
1404
1405 unless ($map) {
1406 $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1407
1408 # restore original map position
1409 ($map, $x, $y) = @{ $link_pos || [] };
1410 $map = cf::map::find_map $map;
1411
1412 unless ($map) {
1413 ($map, $x, $y) = @$EMERGENCY_POSITION;
1414 $map = cf::map::find_map $map
1415 or die "FATAL: cannot load emergency map\n";
1416 }
1417 }
1418
1419 ($x, $y) = (-1, -1)
1420 unless (defined $x) && (defined $y);
1421
1422 # use -1 or undef as default coordinates, not 0, 0
1423 ($x, $y) = ($map->enter_x, $map->enter_y)
1424 if $x <=0 && $y <= 0;
1425
1426 $map->load;
1427
1428 $self->activate_recursive;
1429 $self->enter_map ($map, $x, $y);
1430}
1431
1432=item $player_object->goto_map ($map, $x, $y)
1433
1434=cut
1435
1436sub cf::object::player::goto_map {
1437 my ($self, $path, $x, $y) = @_;
1438
1439 $self->enter_link;
1440
1441 (Coro::async {
1442 $path = new cf::path $path;
1443
1444 my $map = cf::map::find_map $path->as_string;
1445 $map = $map->customise_for ($self) if $map;
1446
1447 warn "entering ", $map->path, " at ($x, $y)\n"
1448 if $map;
1449
1450 $self->leave_link ($map, $x, $y);
1451 })->prio (1);
1452}
1453
1454=item $player_object->enter_exit ($exit_object)
1455
1456=cut
1457
1458sub parse_random_map_params {
1459 my ($spec) = @_;
1460
1461 my $rmp = { # defaults
1462 xsize => 10,
1463 ysize => 10,
1464 };
1465
1466 for (split /\n/, $spec) {
1467 my ($k, $v) = split /\s+/, $_, 2;
1468
1469 $rmp->{lc $k} = $v if (length $k) && (length $v);
1470 }
1471
1472 $rmp
1473}
1474
1475sub prepare_random_map {
1476 my ($exit) = @_;
1477
1478 # all this does is basically replace the /! path by
1479 # a new random map path (?random/...) with a seed
1480 # that depends on the exit object
1481
1482 my $rmp = parse_random_map_params $exit->msg;
1483
1484 if ($exit->map) {
1485 $rmp->{region} = $exit->map->region_name;
1486 $rmp->{origin_map} = $exit->map->path;
1487 $rmp->{origin_x} = $exit->x;
1488 $rmp->{origin_y} = $exit->y;
1489 }
1490
1491 $rmp->{random_seed} ||= $exit->random_seed;
1492
1493 my $data = cf::to_json $rmp;
1494 my $md5 = Digest::MD5::md5_hex $data;
1495
1496 if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) {
1497 aio_write $fh, 0, (length $data), $data, 0;
1498
1499 $exit->slaying ("?random/$md5");
1500 $exit->msg (undef);
1501 }
1502}
1503
1504sub cf::object::player::enter_exit {
1505 my ($self, $exit) = @_;
1506
1507 return unless $self->type == cf::PLAYER;
1508
1509 $self->enter_link;
1510
1511 (Coro::async {
1512 unless (eval {
1513
1514 prepare_random_map $exit
1515 if $exit->slaying eq "/!";
1516
1517 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1518 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
1519
1520 1;
1521 }) {
1522 $self->message ("Something went wrong deep within the crossfire server. "
1523 . "I'll try to bring you back to the map you were before. "
1524 . "Please report this to the dungeon master",
1525 cf::NDI_UNIQUE | cf::NDI_RED);
1526
1527 warn "ERROR in enter_exit: $@";
1528 $self->leave_link;
1529 }
1530 })->prio (1);
1076} 1531}
1077 1532
1078=head3 cf::client 1533=head3 cf::client
1079 1534
1080=over 4 1535=over 4
1424} 1879}
1425 1880
1426############################################################################# 1881#############################################################################
1427# initialisation 1882# initialisation
1428 1883
1429sub perl_reload() { 1884sub reload() {
1430 # can/must only be called in main 1885 # can/must only be called in main
1431 if ($Coro::current != $Coro::main) { 1886 if ($Coro::current != $Coro::main) {
1432 warn "can only reload from main coroutine\n"; 1887 warn "can only reload from main coroutine\n";
1433 return; 1888 return;
1434 } 1889 }
1527 $LINK_MAP->height (41); 1982 $LINK_MAP->height (41);
1528 $LINK_MAP->alloc; 1983 $LINK_MAP->alloc;
1529 $LINK_MAP->path ("{link}"); 1984 $LINK_MAP->path ("{link}");
1530 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 1985 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1531 $LINK_MAP->in_memory (MAP_IN_MEMORY); 1986 $LINK_MAP->in_memory (MAP_IN_MEMORY);
1987
1988 # dirty hack because... archetypes are not yet loaded
1989 Event->timer (
1990 after => 2,
1991 cb => sub {
1992 $_[0]->w->cancel;
1993
1994 # provide some exits "home"
1995 my $exit = cf::object::new "exit";
1996
1997 $exit->slaying ($EMERGENCY_POSITION->[0]);
1998 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
1999 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
2000
2001 $LINK_MAP->insert ($exit->clone, 19, 19);
2002 $LINK_MAP->insert ($exit->clone, 19, 20);
2003 $LINK_MAP->insert ($exit->clone, 19, 21);
2004 $LINK_MAP->insert ($exit->clone, 20, 19);
2005 $LINK_MAP->insert ($exit->clone, 20, 21);
2006 $LINK_MAP->insert ($exit->clone, 21, 19);
2007 $LINK_MAP->insert ($exit->clone, 21, 20);
2008 $LINK_MAP->insert ($exit->clone, 21, 21);
2009
2010 $exit->destroy;
2011 });
2012
2013 $LINK_MAP->{deny_save} = 1;
2014 $LINK_MAP->{deny_reset} = 1;
2015
2016 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1532} 2017}
1533 2018
1534register "<global>", __PACKAGE__; 2019register "<global>", __PACKAGE__;
1535 2020
1536register_command "perl-reload" => sub { 2021register_command "reload" => sub {
1537 my ($who, $arg) = @_; 2022 my ($who, $arg) = @_;
1538 2023
1539 if ($who->flag (FLAG_WIZ)) { 2024 if ($who->flag (FLAG_WIZ)) {
1540 $who->message ("start of reload."); 2025 $who->message ("start of reload.");
1541 perl_reload; 2026 reload;
1542 $who->message ("end of reload."); 2027 $who->message ("end of reload.");
1543 } 2028 }
1544}; 2029};
1545 2030
1546unshift @INC, $LIBDIR; 2031unshift @INC, $LIBDIR;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines