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.119 by root, Tue Jan 2 08:26:42 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
822 warn sprintf "loading %s (%d)\n",
823 $filename, length $data, scalar @{$av || []};#d#
803 return ($data, $av); 824 return ($data, $av);
804} 825}
805 826
806############################################################################# 827#############################################################################
807# command handling &c 828# command handling &c
… …
1029 $self->send ("ext " . to_json \%msg); 1050 $self->send ("ext " . to_json \%msg);
1030} 1051}
1031 1052
1032=back 1053=back
1033 1054
1055
1056=head3 cf::map
1057
1058=over 4
1059
1060=cut
1061
1062package cf::map;
1063
1064use Fcntl;
1065use Coro::AIO;
1066
1067our $MAX_RESET = 7200;
1068our $DEFAULT_RESET = 3600;
1069
1070sub generate_random_map {
1071 my ($path, $rmp) = @_;
1072
1073 # mit "rum" bekleckern, nicht
1074 cf::map::_create_random_map
1075 $path,
1076 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1077 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1078 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1079 $rmp->{exit_on_final_map},
1080 $rmp->{xsize}, $rmp->{ysize},
1081 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1082 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1083 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1084 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1085 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1086 (cf::region::find $rmp->{region})
1087}
1088
1089# and all this just because we cannot iterate over
1090# all maps in C++...
1091sub change_all_map_light {
1092 my ($change) = @_;
1093
1094 $_->change_map_light ($change) for values %cf::MAP;
1095}
1096
1097sub try_load_header($) {
1098 my ($path) = @_;
1099
1100 utf8::encode $path;
1101 aio_open $path, O_RDONLY, 0
1102 or return;
1103
1104 my $map = cf::map::new
1105 or return;
1106
1107 $map->load_header ($path)
1108 or return;
1109
1110 $map->{load_path} = $path;
1111
1112 $map
1113}
1114
1115sub find_map {
1116 my ($path, $origin) = @_;
1117
1118 #warn "find_map<$path,$origin>\n";#d#
1119
1120 $path = new cf::path $path, $origin && $origin->path;
1121 my $key = $path->as_string;
1122
1123 $cf::MAP{$key} || do {
1124 # do it the slow way
1125 my $map = try_load_header $path->save_path;
1126
1127 if ($map) {
1128 # safety
1129 $map->{instantiate_time} = $cf::RUNTIME
1130 if $map->{instantiate_time} > $cf::RUNTIME;
1131 } else {
1132 if (my $rmp = $path->random_map_params) {
1133 $map = generate_random_map $key, $rmp;
1134 } else {
1135 $map = try_load_header $path->load_path;
1136 }
1137
1138 $map or return;
1139
1140 $map->{load_original} = 1;
1141 $map->{instantiate_time} = $cf::RUNTIME;
1142 $map->instantiate;
1143
1144 # per-player maps become, after loading, normal maps
1145 $map->per_player (0) if $path->{user_rel};
1146 }
1147 #Coro::Timer::sleep 1;#d#
1148
1149 $map->path ($key);
1150 $map->{path} = $path;
1151 $map->{last_save} = $cf::RUNTIME;
1152 $map->last_access ($cf::RUNTIME);
1153
1154 if ($map->should_reset) {
1155 $map->reset;
1156 $map = find_map $path;
1157 }
1158
1159 $cf::MAP{$key} = $map
1160 }
1161}
1162
1163sub load {
1164 my ($self) = @_;
1165
1166 return if $self->in_memory != cf::MAP_SWAPPED;
1167
1168 $self->in_memory (cf::MAP_LOADING);
1169
1170 my $path = $self->{path};
1171
1172 $self->alloc;
1173 $self->load_objects ($self->{load_path}, 1)
1174 or return;
1175
1176 $self->set_object_flag (cf::FLAG_OBJ_ORIGINAL, 1)
1177 if delete $self->{load_original};
1178
1179 if (my $uniq = $path->uniq_path) {
1180 utf8::encode $uniq;
1181 if (aio_open $uniq, O_RDONLY, 0) {
1182 $self->clear_unique_items;
1183 $self->load_objects ($uniq, 0);
1184 }
1185 }
1186
1187 # now do the right thing for maps
1188 $self->link_multipart_objects;
1189
1190 if ($self->{path}->is_style_map) {
1191 $self->{deny_save} = 1;
1192 $self->{deny_reset} = 1;
1193 } else {
1194 $self->fix_auto_apply;
1195 $self->decay_objects;
1196 $self->update_buttons;
1197 $self->set_darkness_map;
1198 $self->difficulty ($self->estimate_difficulty)
1199 unless $self->difficulty;
1200 $self->activate;
1201 }
1202
1203 $self->in_memory (cf::MAP_IN_MEMORY);
1204}
1205
1206sub load_map_sync {
1207 my ($path, $origin) = @_;
1208
1209 #warn "load_map_sync<$path, $origin>\n";#d#
1210
1211 cf::sync_job {
1212 my $map = cf::map::find_map $path, $origin
1213 or return;
1214 $map->load;
1215 $map
1216 }
1217}
1218
1219sub save {
1220 my ($self) = @_;
1221
1222 $self->{last_save} = $cf::RUNTIME;
1223
1224 return unless $self->dirty;
1225
1226 my $save = $self->{path}->save_path; utf8::encode $save;
1227 my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
1228
1229 $self->{load_path} = $save;
1230
1231 return if $self->{deny_save};
1232
1233 if ($uniq) {
1234 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
1235 $self->save_objects ($uniq, cf::IO_UNIQUES);
1236 } else {
1237 $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS | cf::IO_UNIQUES);
1238 }
1239}
1240
1241sub swap_out {
1242 my ($self) = @_;
1243
1244 return if $self->players;
1245 return if $self->in_memory != cf::MAP_IN_MEMORY;
1246 return if $self->{deny_save};
1247
1248 $self->save;
1249 $self->clear;
1250 $self->in_memory (cf::MAP_SWAPPED);
1251}
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
1266sub should_reset {
1267 my ($self) = @_;
1268
1269 $self->reset_at <= $cf::RUNTIME
1270}
1271
1272sub unlink_save {
1273 my ($self) = @_;
1274
1275 utf8::encode (my $save = $self->{path}->save_path);
1276 aioreq_pri 3; IO::AIO::aio_unlink $save;
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};
1302
1303 $_->clear_links_to ($self) for values %cf::MAP;
1304
1305 $self->unlink_save;
1306 $self->destroy;
1307}
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
1318}
1319
1320sub customise_for {
1321 my ($map, $ob) = @_;
1322
1323 if ($map->per_player) {
1324 return cf::map::find_map "~" . $ob->name . "/" . $map->{path}{path};
1325 }
1326
1327 $map
1328}
1329
1330sub emergency_save {
1331 local $cf::FREEZE = 1;
1332
1333 warn "enter emergency map save\n";
1334
1335 cf::sync_job {
1336 warn "begin emergency map save\n";
1337 $_->save for values %cf::MAP;
1338 };
1339
1340 warn "end emergency map save\n";
1341}
1342
1343package cf;
1344
1345=back
1346
1347
1034=head3 cf::object::player 1348=head3 cf::object::player
1035 1349
1036=over 4 1350=over 4
1037 1351
1038=item $player_object->reply ($npc, $msg[, $flags]) 1352=item $player_object->reply ($npc, $msg[, $flags])
… …
1071 1385
1072 $self->flag (cf::FLAG_WIZ) || 1386 $self->flag (cf::FLAG_WIZ) ||
1073 (ref $cf::CFG{"may_$access"} 1387 (ref $cf::CFG{"may_$access"}
1074 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 1388 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
1075 : $cf::CFG{"may_$access"}) 1389 : $cf::CFG{"may_$access"})
1390}
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
1410sub cf::object::player::enter_link {
1411 my ($self) = @_;
1412
1413 return if $self->map == $LINK_MAP;
1414
1415 $self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]
1416 if $self->map;
1417
1418 $self->enter_map ($LINK_MAP, 20, 20);
1419 $self->deactivate_recursive;
1420}
1421
1422sub cf::object::player::leave_link {
1423 my ($self, $map, $x, $y) = @_;
1424
1425 my $link_pos = delete $self->{_link_pos};
1426
1427 unless ($map) {
1428 # restore original map position
1429 ($map, $x, $y) = @{ $link_pos || [] };
1430 $map = cf::map::find_map $map;
1431
1432 unless ($map) {
1433 ($map, $x, $y) = @$EMERGENCY_POSITION;
1434 $map = cf::map::find_map $map
1435 or die "FATAL: cannot load emergency map\n";
1436 }
1437 }
1438
1439 ($x, $y) = (-1, -1)
1440 unless (defined $x) && (defined $y);
1441
1442 # use -1 or undef as default coordinates, not 0, 0
1443 ($x, $y) = ($map->enter_x, $map->enter_y)
1444 if $x <=0 && $y <= 0;
1445
1446 $map->load;
1447
1448 $self->activate_recursive;
1449 $self->enter_map ($map, $x, $y);
1450}
1451
1452=item $player_object->goto_map ($path, $x, $y)
1453
1454=cut
1455
1456sub cf::object::player::goto_map {
1457 my ($self, $path, $x, $y) = @_;
1458
1459 $self->enter_link;
1460
1461 (Coro::async {
1462 $path = new cf::path $path;
1463
1464 my $map = cf::map::find_map $path->as_string;
1465 $map = $map->customise_for ($self) if $map;
1466
1467# warn "entering ", $map->path, " at ($x, $y)\n"
1468# if $map;
1469
1470 $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
1471
1472 $self->leave_link ($map, $x, $y);
1473 })->prio (1);
1474}
1475
1476=item $player_object->enter_exit ($exit_object)
1477
1478=cut
1479
1480sub parse_random_map_params {
1481 my ($spec) = @_;
1482
1483 my $rmp = { # defaults
1484 xsize => 10,
1485 ysize => 10,
1486 };
1487
1488 for (split /\n/, $spec) {
1489 my ($k, $v) = split /\s+/, $_, 2;
1490
1491 $rmp->{lc $k} = $v if (length $k) && (length $v);
1492 }
1493
1494 $rmp
1495}
1496
1497sub prepare_random_map {
1498 my ($exit) = @_;
1499
1500 # all this does is basically replace the /! path by
1501 # a new random map path (?random/...) with a seed
1502 # that depends on the exit object
1503
1504 my $rmp = parse_random_map_params $exit->msg;
1505
1506 if ($exit->map) {
1507 $rmp->{region} = $exit->map->region_name;
1508 $rmp->{origin_map} = $exit->map->path;
1509 $rmp->{origin_x} = $exit->x;
1510 $rmp->{origin_y} = $exit->y;
1511 }
1512
1513 $rmp->{random_seed} ||= $exit->random_seed;
1514
1515 my $data = cf::to_json $rmp;
1516 my $md5 = Digest::MD5::md5_hex $data;
1517
1518 if (my $fh = aio_open "$cf::RANDOM_MAPS/$md5.meta", O_WRONLY | O_CREAT, 0666) {
1519 aio_write $fh, 0, (length $data), $data, 0;
1520
1521 $exit->slaying ("?random/$md5");
1522 $exit->msg (undef);
1523 }
1524}
1525
1526sub cf::object::player::enter_exit {
1527 my ($self, $exit) = @_;
1528
1529 return unless $self->type == cf::PLAYER;
1530
1531 $self->enter_link;
1532
1533 (Coro::async {
1534 unless (eval {
1535
1536 prepare_random_map $exit
1537 if $exit->slaying eq "/!";
1538
1539 my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
1540 $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
1541
1542 1;
1543 }) {
1544 $self->message ("Something went wrong deep within the crossfire server. "
1545 . "I'll try to bring you back to the map you were before. "
1546 . "Please report this to the dungeon master",
1547 cf::NDI_UNIQUE | cf::NDI_RED);
1548
1549 warn "ERROR in enter_exit: $@";
1550 $self->leave_link;
1551 }
1552 })->prio (1);
1076} 1553}
1077 1554
1078=head3 cf::client 1555=head3 cf::client
1079 1556
1080=over 4 1557=over 4
… …
1409} 1886}
1410 1887
1411sub main { 1888sub main {
1412 # we must not ever block the main coroutine 1889 # we must not ever block the main coroutine
1413 local $Coro::idle = sub { 1890 local $Coro::idle = sub {
1414 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#
1415 (Coro::unblock_sub { 1892 (Coro::unblock_sub {
1416 Event::one_event; 1893 Event::one_event;
1417 })->(); 1894 })->();
1418 }; 1895 };
1419 1896
… …
1424} 1901}
1425 1902
1426############################################################################# 1903#############################################################################
1427# initialisation 1904# initialisation
1428 1905
1429sub perl_reload() { 1906sub reload() {
1430 # can/must only be called in main 1907 # can/must only be called in main
1431 if ($Coro::current != $Coro::main) { 1908 if ($Coro::current != $Coro::main) {
1432 warn "can only reload from main coroutine\n"; 1909 warn "can only reload from main coroutine\n";
1433 return; 1910 return;
1434 } 1911 }
… …
1527 $LINK_MAP->height (41); 2004 $LINK_MAP->height (41);
1528 $LINK_MAP->alloc; 2005 $LINK_MAP->alloc;
1529 $LINK_MAP->path ("{link}"); 2006 $LINK_MAP->path ("{link}");
1530 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path"; 2007 $LINK_MAP->{path} = bless { path => "{link}" }, "cf::path";
1531 $LINK_MAP->in_memory (MAP_IN_MEMORY); 2008 $LINK_MAP->in_memory (MAP_IN_MEMORY);
2009
2010 # dirty hack because... archetypes are not yet loaded
2011 Event->timer (
2012 after => 2,
2013 cb => sub {
2014 $_[0]->w->cancel;
2015
2016 # provide some exits "home"
2017 my $exit = cf::object::new "exit";
2018
2019 $exit->slaying ($EMERGENCY_POSITION->[0]);
2020 $exit->stats->hp ($EMERGENCY_POSITION->[1]);
2021 $exit->stats->sp ($EMERGENCY_POSITION->[2]);
2022
2023 $LINK_MAP->insert ($exit->clone, 19, 19);
2024 $LINK_MAP->insert ($exit->clone, 19, 20);
2025 $LINK_MAP->insert ($exit->clone, 19, 21);
2026 $LINK_MAP->insert ($exit->clone, 20, 19);
2027 $LINK_MAP->insert ($exit->clone, 20, 21);
2028 $LINK_MAP->insert ($exit->clone, 21, 19);
2029 $LINK_MAP->insert ($exit->clone, 21, 20);
2030 $LINK_MAP->insert ($exit->clone, 21, 21);
2031
2032 $exit->destroy;
2033 });
2034
2035 $LINK_MAP->{deny_save} = 1;
2036 $LINK_MAP->{deny_reset} = 1;
2037
2038 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
1532} 2039}
1533 2040
1534register "<global>", __PACKAGE__; 2041register "<global>", __PACKAGE__;
1535 2042
1536register_command "perl-reload" => sub { 2043register_command "reload" => sub {
1537 my ($who, $arg) = @_; 2044 my ($who, $arg) = @_;
1538 2045
1539 if ($who->flag (FLAG_WIZ)) { 2046 if ($who->flag (FLAG_WIZ)) {
1540 $who->message ("start of reload."); 2047 $who->message ("start of reload.");
1541 perl_reload; 2048 reload;
1542 $who->message ("end of reload."); 2049 $who->message ("end of reload.");
1543 } 2050 }
1544}; 2051};
1545 2052
1546unshift @INC, $LIBDIR; 2053unshift @INC, $LIBDIR;

Diff Legend

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