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.156 by root, Tue Jan 9 22:07:08 2007 UTC vs.
Revision 1.165 by root, Fri Jan 12 22:09:22 2007 UTC

… …
33 33
34$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority 34$Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority
35 35
36our %COMMAND = (); 36our %COMMAND = ();
37our %COMMAND_TIME = (); 37our %COMMAND_TIME = ();
38
39our @EXTS = (); # list of extension package names
38our %EXTCMD = (); 40our %EXTCMD = ();
41our %EXT_CORO = (); # coroutines bound to extensions
42our %EXT_MAP = (); # pluggable maps
39 43
40our @EVENT; 44our @EVENT;
41our $LIBDIR = datadir . "/ext"; 45our $LIBDIR = datadir . "/ext";
42 46
43our $TICK = MAX_TIME * 1e-6; 47our $TICK = MAX_TIME * 1e-6;
… …
52 56
53our %PLAYER; # all users 57our %PLAYER; # all users
54our %MAP; # all maps 58our %MAP; # all maps
55our $LINK_MAP; # the special {link} map 59our $LINK_MAP; # the special {link} map
56our $RANDOM_MAPS = cf::localdir . "/random"; 60our $RANDOM_MAPS = cf::localdir . "/random";
57our %EXT_CORO; # coroutines bound to extensions
58 61
59our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal; 62our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal;
60our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal; 63our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal;
61 64
62binmode STDOUT; 65binmode STDOUT;
… …
156} 159}
157 160
158$Event::DIED = sub { 161$Event::DIED = sub {
159 warn "error in event callback: @_"; 162 warn "error in event callback: @_";
160}; 163};
161
162my %ext_pkg;
163my @exts;
164my @hook;
165 164
166=head2 UTILITY FUNCTIONS 165=head2 UTILITY FUNCTIONS
167 166
168=over 4 167=over 4
169 168
… …
319 } 318 }
320} 319}
321 320
322=item $coro = cf::async_ext { BLOCK } 321=item $coro = cf::async_ext { BLOCK }
323 322
324Like async, but this coro is automcatially being canceled when the 323Like async, but this coro is automatically being canceled when the
325extension calling this is being unloaded. 324extension calling this is being unloaded.
326 325
327=cut 326=cut
328 327
329sub async_ext(&) { 328sub async_ext(&) {
… …
367 366
368############################################################################# 367#############################################################################
369 368
370package cf::path; 369package cf::path;
371 370
371use overload
372 '""' => \&as_string;
373
372# used to convert map paths into valid unix filenames by repalcing / by ∕ 374# used to convert map paths into valid unix filenames by repalcing / by ∕
373our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons 375our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons
374 376
377sub register {
378 my ($pkg, $prefix) = @_;
379
380 $EXT_MAP{$prefix} = $pkg;
381}
382
375sub new { 383sub new {
376 my ($class, $path, $base) = @_; 384 my ($class, $path, $base) = @_;
377 385
378 $path = $path->as_string if ref $path; 386 return $path if ref $path;
379 387
380 my $self = bless { }, $class; 388 my $self = {};
381 389
382 # {... are special paths that are not touched 390 # {... are special paths that are not being touched
383 # ?xxx/... are special absolute paths 391 # ?xxx/... are special absolute paths
384 # ?random/... random maps 392 # ?random/... random maps
385 # /! non-realised random map exit 393 # /! non-realised random map exit
386 # /... normal maps 394 # /... normal maps
387 # ~/... per-player maps without a specific player (DO NOT USE) 395 # ~/... per-player maps without a specific player (DO NOT USE)
388 # ~user/... per-player map of a specific user 396 # ~user/... per-player map of a specific user
389 397
398 $path =~ s/$PATH_SEP/\//go;
399
390 if ($path =~ /^{/) { 400 if ($path =~ /^{/) {
391 # fine as it is 401 # fine as it is
392 } elsif ($path =~ s{^\?random/}{}) {
393 Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
394 $self->{random} = cf::from_json $data;
395 } else { 402 } else {
396 if ($path =~ s{^~([^/]+)?}{}) { 403 if ($path =~ s{^~([^/]+)?}{}) {
404 # ~user
397 $self->{user_rel} = 1; 405 $self->{user_rel} = 1;
398 406
399 if (defined $1) { 407 if (defined $1) {
400 $self->{user} = $1; 408 $self->{user} = $1;
401 } elsif ($base =~ m{^~([^/]+)/}) { 409 } elsif ($base =~ m{^~([^/]+)/}) {
402 $self->{user} = $1; 410 $self->{user} = $1;
403 } else { 411 } else {
404 warn "cannot resolve user-relative path without user <$path,$base>\n"; 412 warn "cannot resolve user-relative path without user <$path,$base>\n";
405 } 413 }
414 } elsif ($path =~ s{^\?([^/]+)/}{}) {
415 # ?...
416 $self->{ext} = $1;
417 if (my $ext = $EXT_MAP{$1}) {
418 bless $self, $ext;
419 }
406 } elsif ($path =~ /^\//) { 420 } elsif ($path =~ /^\//) {
421 # /...
407 # already absolute 422 # already absolute
408 } else { 423 } else {
424 # relative
409 $base =~ s{[^/]+/?$}{}; 425 $base =~ s{[^/]+/?$}{};
410 return $class->new ("$base/$path"); 426 return $class->new ("$base/$path");
411 } 427 }
412 428
413 for ($path) { 429 for ($path) {
… …
416 } 432 }
417 } 433 }
418 434
419 $self->{path} = $path; 435 $self->{path} = $path;
420 436
437 if ("HASH" eq ref $self) {
438 bless $self, $class;
439 } else {
440 $self->init;
441 }
442
443 for my $ext (values %EXT_MAP) {
444 if (my $subst = $ext->substitute ($self)) {
445 return $subst;
446 }
447 }
448
421 $self 449 $self
450}
451
452sub init {
453 # nop
454}
455
456sub substitute {
457 ()
422} 458}
423 459
424# the name / primary key / in-game path 460# the name / primary key / in-game path
425sub as_string { 461sub as_string {
426 my ($self) = @_; 462 my ($self) = @_;
427 463
428 $self->{user_rel} ? "~$self->{user}$self->{path}" 464 $self->{user_rel} ? "~$self->{user}$self->{path}"
429 : $self->{random} ? "?random/$self->{path}" 465 : $self->{ext} ? "?$self->{ext}/$self->{path}"
430 : $self->{path} 466 : $self->{path}
431} 467}
432 468
433# the displayed name, this is a one way mapping 469# the displayed name, this is a one way mapping
434sub visible_name { 470sub visible_name {
435 my ($self) = @_; 471 &as_string
436
437# if (my $rmp = $self->{random}) {
438# # todo: be more intelligent about this
439# "?random/$rmp->{origin_map}+$rmp->{origin_x}+$rmp->{origin_y}/$rmp->{dungeon_level}"
440# } else {
441 $self->as_string
442# }
443} 472}
444 473
445# escape the /'s in the path 474# escape the /'s in the path
446sub _escaped_path { 475sub _escaped_path {
447 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g; 476 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/g;
477
448 $path 478 $path
449} 479}
450 480
451# the original (read-only) location 481# the original (read-only) location
452sub load_path { 482sub load_path {
… …
457 487
458# the temporary/swap location 488# the temporary/swap location
459sub save_path { 489sub save_path {
460 my ($self) = @_; 490 my ($self) = @_;
461 491
492 $self->{user_rel}
462 $self->{user_rel} ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path 493 ? sprintf "%s/%s/%s/%s", cf::localdir, cf::playerdir, $self->{user}, $self->_escaped_path
463 : $self->{random} ? sprintf "%s/%s", $RANDOM_MAPS, $self->{path}
464 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path 494 : sprintf "%s/%s/%s", cf::localdir, cf::tmpdir, $self->_escaped_path
465} 495}
466 496
467# the unique path, might be eq to save_path 497# the unique path, undef == no special unique path
468sub uniq_path { 498sub uniq_path {
469 my ($self) = @_; 499 my ($self) = @_;
470 500
471 $self->{user_rel} || $self->{random} 501 $self->{user_rel} || $self->{ext}
472 ? undef 502 ? undef
473 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path 503 : sprintf "%s/%s/%s", cf::localdir, cf::uniquedir, $self->_escaped_path
474} 504}
475 505
476# return random map parameters, or undef 506sub customise_for {
477sub random_map_params {
478 my ($self) = @_; 507 my ($self, $map, $ob) = @_;
479 508
480 $self->{random} 509 if ($map->per_player) {
510 return cf::map::find ("~" . $ob->name . "/" . $map->{path}{path});
511 }
512
513 $map
481} 514}
482 515
483# this is somewhat ugly, but style maps do need special treatment 516# this is somewhat ugly, but style maps do need special treatment
484sub is_style_map { 517sub is_style_map {
485 $_[0]{path} =~ m{^/styles/} 518 $_[0]{path} =~ m{^/styles/}
519}
520
521sub load_orig {
522 my ($self) = @_;
523
524 &cf::map::load_map_header ($self->load_path)
525}
526
527sub load_temp {
528 my ($self) = @_;
529
530 &cf::map::load_map_header ($self->save_path)
531}
532
533sub unlink_save {
534 my ($self) = @_;
535
536 utf8::encode (my $save = $self->save_path);
537 IO::AIO::aioreq_pri 4; IO::AIO::aio_unlink $save;
538 IO::AIO::aioreq_pri 4; IO::AIO::aio_unlink "$save.pst";
486} 539}
487 540
488package cf; 541package cf;
489 542
490############################################################################# 543#############################################################################
… …
940=cut 993=cut
941 994
942sub register_extcmd { 995sub register_extcmd {
943 my ($name, $cb) = @_; 996 my ($name, $cb) = @_;
944 997
945 my $caller = caller;
946 #warn "registering extcmd '$name' to '$caller'";
947
948 $EXTCMD{$name} = [$cb, $caller]; 998 $EXTCMD{$name} = $cb;
949} 999}
950 1000
951cf::player->attach ( 1001cf::player->attach (
952 on_command => sub { 1002 on_command => sub {
953 my ($pl, $name, $params) = @_; 1003 my ($pl, $name, $params) = @_;
… …
966 1016
967 my $msg = eval { from_json $buf }; 1017 my $msg = eval { from_json $buf };
968 1018
969 if (ref $msg) { 1019 if (ref $msg) {
970 if (my $cb = $EXTCMD{$msg->{msgtype}}) { 1020 if (my $cb = $EXTCMD{$msg->{msgtype}}) {
971 if (my %reply = $cb->[0]->($pl, $msg)) { 1021 if (my %reply = $cb->($pl, $msg)) {
972 $pl->ext_reply ($msg->{msgid}, %reply); 1022 $pl->ext_reply ($msg->{msgid}, %reply);
973 } 1023 }
974 } 1024 }
975 } else { 1025 } else {
976 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n"; 1026 warn "player " . ($pl->ob->name) . " sent unparseable ext message: <$buf>\n";
… …
978 1028
979 cf::override; 1029 cf::override;
980 }, 1030 },
981); 1031);
982 1032
983sub register {
984 my ($base, $pkg) = @_;
985
986 #TODO
987}
988
989sub load_extension { 1033sub load_extension {
990 my ($path) = @_; 1034 my ($path) = @_;
991 1035
992 $path =~ /([^\/\\]+)\.ext$/ or die "$path"; 1036 $path =~ /([^\/\\]+)\.ext$/ or die "$path";
993 my $base = $1; 1037 my $base = $1;
994 my $pkg = $1; 1038 my $pkg = $1;
995 $pkg =~ s/[^[:word:]]/_/g; 1039 $pkg =~ s/[^[:word:]]/_/g;
996 $pkg = "ext::$pkg"; 1040 $pkg = "ext::$pkg";
997 1041
998 warn "loading '$path' into '$pkg'\n"; 1042 warn "... loading '$path' into '$pkg'\n";
999 1043
1000 open my $fh, "<:utf8", $path 1044 open my $fh, "<:utf8", $path
1001 or die "$path: $!"; 1045 or die "$path: $!";
1002 1046
1003 my $source = 1047 my $source =
… …
1008 1052
1009 eval $source 1053 eval $source
1010 or die $@ ? "$path: $@\n" 1054 or die $@ ? "$path: $@\n"
1011 : "extension disabled.\n"; 1055 : "extension disabled.\n";
1012 1056
1013 push @exts, $pkg; 1057 push @EXTS, $pkg;
1014 $ext_pkg{$base} = $pkg;
1015
1016# no strict 'refs';
1017# @{"$pkg\::ISA"} = ext::;
1018
1019 register $base, $pkg;
1020}
1021
1022sub unload_extension {
1023 my ($pkg) = @_;
1024
1025 warn "removing extension $pkg\n";
1026
1027 # remove hooks
1028 #TODO
1029# for my $idx (0 .. $#PLUGIN_EVENT) {
1030# delete $hook[$idx]{$pkg};
1031# }
1032
1033 # remove commands
1034 for my $name (keys %COMMAND) {
1035 my @cb = grep $_->[0] ne $pkg, @{ $COMMAND{$name} };
1036
1037 if (@cb) {
1038 $COMMAND{$name} = \@cb;
1039 } else {
1040 delete $COMMAND{$name};
1041 }
1042 }
1043
1044 # remove extcmds
1045 for my $name (grep $EXTCMD{$_}[1] eq $pkg, keys %EXTCMD) {
1046 delete $EXTCMD{$name};
1047 }
1048
1049 if (my $cb = $pkg->can ("unload")) {
1050 eval {
1051 $cb->($pkg);
1052 1
1053 } or warn "$pkg unloaded, but with errors: $@";
1054 }
1055
1056 Symbol::delete_package $pkg;
1057} 1058}
1058 1059
1059sub load_extensions { 1060sub load_extensions {
1060 for my $ext (<$LIBDIR/*.ext>) { 1061 for my $ext (<$LIBDIR/*.ext>) {
1061 next unless -r $ext; 1062 next unless -r $ext;
… …
1240 my @paths; 1241 my @paths;
1241 1242
1242 for (@$files) { 1243 for (@$files) {
1243 utf8::decode $_; 1244 utf8::decode $_;
1244 next if /\.(?:pl|pst)$/; 1245 next if /\.(?:pl|pst)$/;
1245 next unless /^$PATH_SEP/; 1246 next unless /^$PATH_SEP/o;
1246 1247
1247 s/$PATH_SEP/\//g;
1248 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_; 1248 push @paths, new cf::path "~" . $pl->ob->name . "/" . $_;
1249 } 1249 }
1250 1250
1251 \@paths 1251 \@paths
1252} 1252}
… …
1286 1286
1287sub generate_random_map { 1287sub generate_random_map {
1288 my ($path, $rmp) = @_; 1288 my ($path, $rmp) = @_;
1289 1289
1290 # mit "rum" bekleckern, nicht 1290 # mit "rum" bekleckern, nicht
1291 cf::map::_create_random_map 1291 cf::map::_create_random_map (
1292 $path, 1292 $path,
1293 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle}, 1293 $rmp->{wallstyle}, $rmp->{wall_name}, $rmp->{floorstyle}, $rmp->{monsterstyle},
1294 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle}, 1294 $rmp->{treasurestyle}, $rmp->{layoutstyle}, $rmp->{doorstyle}, $rmp->{decorstyle},
1295 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map}, 1295 $rmp->{origin_map}, $rmp->{final_map}, $rmp->{exitstyle}, $rmp->{this_map},
1296 $rmp->{exit_on_final_map}, 1296 $rmp->{exit_on_final_map},
… …
1298 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3}, 1298 $rmp->{expand2x}, $rmp->{layoutoptions1}, $rmp->{layoutoptions2}, $rmp->{layoutoptions3},
1299 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase}, 1299 $rmp->{symmetry}, $rmp->{difficulty}, $rmp->{difficulty_given}, $rmp->{difficulty_increase},
1300 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation}, 1300 $rmp->{dungeon_level}, $rmp->{dungeon_depth}, $rmp->{decoroptions}, $rmp->{orientation},
1301 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp}, 1301 $rmp->{origin_y}, $rmp->{origin_x}, $rmp->{random_seed}, $rmp->{total_map_hp},
1302 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used}, 1302 $rmp->{map_layout_style}, $rmp->{treasureoptions}, $rmp->{symmetry_used},
1303 (cf::region::find $rmp->{region}) 1303 (cf::region::find $rmp->{region}), $rmp->{custom}
1304 )
1304} 1305}
1305 1306
1306# and all this just because we cannot iterate over 1307# and all this just because we cannot iterate over
1307# all maps in C++... 1308# all maps in C++...
1308sub change_all_map_light { 1309sub change_all_map_light {
… …
1310 1311
1311 $_->change_map_light ($change) 1312 $_->change_map_light ($change)
1312 for grep $_->outdoor, values %cf::MAP; 1313 for grep $_->outdoor, values %cf::MAP;
1313} 1314}
1314 1315
1315sub try_load_header($) { 1316sub load_map_header($) {
1316 my ($path) = @_; 1317 my ($path) = @_;
1317 1318
1318 utf8::encode $path; 1319 utf8::encode $path;
1319 aio_open $path, O_RDONLY, 0 1320 aio_open $path, O_RDONLY, 0
1320 or return; 1321 or return;
1321 1322
1322 my $map = cf::map::new 1323 my $map = cf::map::new
1323 or return; 1324 or return;
1324 1325
1325 # for better error messages only, will be overwritten 1326 # for better error messages only, will be overwritten later
1326 $map->path ($path); 1327 $map->path ($path);
1327 1328
1328 $map->load_header ($path) 1329 $map->load_header ($path)
1329 or return; 1330 or return;
1330 1331
… …
1346 1347
1347 $cf::MAP{$key} || do { 1348 $cf::MAP{$key} || do {
1348 my $guard = cf::lock_acquire "map_find:$key"; 1349 my $guard = cf::lock_acquire "map_find:$key";
1349 1350
1350 # do it the slow way 1351 # do it the slow way
1351 my $map = try_load_header $path->save_path; 1352 my $map = $path->load_temp;
1352 1353
1353 Coro::cede; 1354 Coro::cede;
1354 1355
1355 if ($map) { 1356 if ($map) {
1356 $map->last_access ((delete $map->{last_access}) 1357 $map->last_access ((delete $map->{last_access})
1357 || $cf::RUNTIME); #d# 1358 || $cf::RUNTIME); #d#
1358 # safety 1359 # safety
1359 $map->{instantiate_time} = $cf::RUNTIME 1360 $map->{instantiate_time} = $cf::RUNTIME
1360 if $map->{instantiate_time} > $cf::RUNTIME; 1361 if $map->{instantiate_time} > $cf::RUNTIME;
1361 } else { 1362 } else {
1362 if (my $rmp = $path->random_map_params) { 1363 $map = $path->load_orig
1363 $map = generate_random_map $key, $rmp;
1364 } else {
1365 $map = try_load_header $path->load_path;
1366 }
1367
1368 $map or return; 1364 or return;
1369 1365
1370 $map->{load_original} = 1; 1366 $map->{load_original} = 1;
1371 $map->{instantiate_time} = $cf::RUNTIME; 1367 $map->{instantiate_time} = $cf::RUNTIME;
1372 $map->last_access ($cf::RUNTIME); 1368 $map->last_access ($cf::RUNTIME);
1373 $map->instantiate; 1369 $map->instantiate;
… …
1425 1421
1426 if ($self->{path}->is_style_map) { 1422 if ($self->{path}->is_style_map) {
1427 $self->{deny_save} = 1; 1423 $self->{deny_save} = 1;
1428 $self->{deny_reset} = 1; 1424 $self->{deny_reset} = 1;
1429 } else { 1425 } else {
1426 $self->decay_objects;
1430 $self->fix_auto_apply; 1427 $self->fix_auto_apply;
1431 $self->decay_objects;
1432 $self->update_buttons; 1428 $self->update_buttons;
1433 $self->set_darkness_map; 1429 $self->set_darkness_map;
1434 $self->difficulty ($self->estimate_difficulty) 1430 $self->difficulty ($self->estimate_difficulty)
1435 unless $self->difficulty; 1431 unless $self->difficulty;
1436 $self->activate; 1432 $self->activate;
… …
1439 Coro::cede; 1435 Coro::cede;
1440 1436
1441 $self->in_memory (cf::MAP_IN_MEMORY); 1437 $self->in_memory (cf::MAP_IN_MEMORY);
1442} 1438}
1443 1439
1440# find and load all maps in the 3x3 area around a map
1441sub load_diag {
1442 my ($map) = @_;
1443
1444 my @diag; # diagonal neighbours
1445
1446 for (0 .. 3) {
1447 my $neigh = $map->tile_path ($_)
1448 or next;
1449 $neigh = find $neigh, $map
1450 or next;
1451 $neigh->load;
1452
1453 push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh],
1454 [$neigh->tile_path (($_ + 1) % 4), $neigh];
1455 }
1456
1457 for (@diag) {
1458 my $neigh = find @$_
1459 or next;
1460 $neigh->load;
1461 }
1462}
1463
1444sub find_sync { 1464sub find_sync {
1445 my ($path, $origin) = @_; 1465 my ($path, $origin) = @_;
1446 1466
1447 cf::sync_job { cf::map::find $path, $origin } 1467 cf::sync_job { find $path, $origin }
1448} 1468}
1449 1469
1450sub do_load_sync { 1470sub do_load_sync {
1451 my ($map) = @_; 1471 my ($map) = @_;
1452 1472
1453 cf::sync_job { $map->load }; 1473 cf::sync_job { $map->load };
1474}
1475
1476our %MAP_PREFETCH;
1477our $MAP_PREFETCHER = Coro::async {
1478 while () {
1479 while (%MAP_PREFETCH) {
1480 my $key = each %MAP_PREFETCH
1481 or next;
1482 my $path = delete $MAP_PREFETCH{$key};
1483
1484 my $map = find $path
1485 or next;
1486 $map->load;
1487 }
1488 Coro::schedule;
1489 }
1490};
1491
1492sub find_async {
1493 my ($path, $origin) = @_;
1494
1495 $path = new cf::path $path, $origin && $origin->path;
1496 my $key = $path->as_string;
1497
1498 if (my $map = $cf::MAP{$key}) {
1499 return $map if $map->in_memory == cf::MAP_IN_MEMORY;
1500 }
1501
1502 $MAP_PREFETCH{$key} = $path;
1503 $MAP_PREFETCHER->ready;
1504
1505 ()
1454} 1506}
1455 1507
1456sub save { 1508sub save {
1457 my ($self) = @_; 1509 my ($self) = @_;
1458 1510
… …
1516 my ($self) = @_; 1568 my ($self) = @_;
1517 1569
1518 $self->reset_at <= $cf::RUNTIME 1570 $self->reset_at <= $cf::RUNTIME
1519} 1571}
1520 1572
1521sub unlink_save {
1522 my ($self) = @_;
1523
1524 utf8::encode (my $save = $self->{path}->save_path);
1525 aioreq_pri 3; IO::AIO::aio_unlink $save;
1526 aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
1527}
1528
1529sub rename { 1573sub rename {
1530 my ($self, $new_path) = @_; 1574 my ($self, $new_path) = @_;
1531 1575
1532 $self->unlink_save; 1576 $self->{path}->unlink_save;
1533 1577
1534 delete $cf::MAP{$self->path}; 1578 delete $cf::MAP{$self->path};
1535 $self->{path} = new cf::path $new_path; 1579 $self->{path} = new cf::path $new_path;
1536 $self->path ($self->{path}->as_string); 1580 $self->path ($self->{path}->as_string);
1537 $cf::MAP{$self->path} = $self; 1581 $cf::MAP{$self->path} = $self;
… …
1551 1595
1552 delete $cf::MAP{$self->path}; 1596 delete $cf::MAP{$self->path};
1553 1597
1554 $_->clear_links_to ($self) for values %cf::MAP; 1598 $_->clear_links_to ($self) for values %cf::MAP;
1555 1599
1556 $self->unlink_save; 1600 $self->{path}->unlink_save;
1557 $self->destroy; 1601 $self->destroy;
1558} 1602}
1559 1603
1560my $nuke_counter = "aaaa"; 1604my $nuke_counter = "aaaa";
1561 1605
… …
1566 $self->reset_timeout (1); 1610 $self->reset_timeout (1);
1567 $self->rename ("{nuke}/" . ($nuke_counter++)); 1611 $self->rename ("{nuke}/" . ($nuke_counter++));
1568 $self->reset; # polite request, might not happen 1612 $self->reset; # polite request, might not happen
1569} 1613}
1570 1614
1571sub customise_for { 1615=item cf::map::unique_maps
1572 my ($map, $ob) = @_;
1573 1616
1574 if ($map->per_player) { 1617Returns an arrayref of cf::path's of all shared maps that have
1575 return cf::map::find "~" . $ob->name . "/" . $map->{path}{path}; 1618instantiated unique items. May block.
1576 }
1577 1619
1578 $map 1620=cut
1621
1622sub unique_maps() {
1623 my $files = aio_readdir cf::localdir . "/" . cf::uniquedir
1624 or return;
1625
1626 my @paths;
1627
1628 for (@$files) {
1629 utf8::decode $_;
1630 next if /\.pst$/;
1631 next unless /^$PATH_SEP/o;
1632
1633 push @paths, new cf::path $_;
1634 }
1635
1636 \@paths
1579} 1637}
1580 1638
1581package cf; 1639package cf;
1582 1640
1583=back 1641=back
… …
1707 # use -1 or undef as default coordinates, not 0, 0 1765 # use -1 or undef as default coordinates, not 0, 0
1708 ($x, $y) = ($map->enter_x, $map->enter_y) 1766 ($x, $y) = ($map->enter_x, $map->enter_y)
1709 if $x <=0 && $y <= 0; 1767 if $x <=0 && $y <= 0;
1710 1768
1711 $map->load; 1769 $map->load;
1770 $map->load_diag;
1712 1771
1713 return unless $self->contr->active; 1772 return unless $self->contr->active;
1714 $self->activate_recursive; 1773 $self->activate_recursive;
1715 $self->enter_map ($map, $x, $y); 1774 $self->enter_map ($map, $x, $y);
1716} 1775}
… …
1753 1812
1754sub cf::object::player::goto { 1813sub cf::object::player::goto {
1755 my ($self, $path, $x, $y) = @_; 1814 my ($self, $path, $x, $y) = @_;
1756 1815
1757 $path = new cf::path $path; 1816 $path = new cf::path $path;
1758 $path ne "/" or Carp::cluck ("oy");#d#
1759 1817
1760 $self->enter_link; 1818 $self->enter_link;
1761 1819
1762 (async { 1820 (async {
1763 my $map = cf::map::find $path->as_string; 1821 my $map = cf::map::find $path->as_string;
1764 $map = $map->customise_for ($self) if $map; 1822 $map = $map->{path}->customise_for ($map, $self) if $map;
1765 1823
1766# warn "entering ", $map->path, " at ($x, $y)\n" 1824# warn "entering ", $map->path, " at ($x, $y)\n"
1767# if $map; 1825# if $map;
1768 1826
1769 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED); 1827 $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
… …
1840 1898
1841 1; 1899 1;
1842 }) { 1900 }) {
1843 $self->message ("Something went wrong deep within the crossfire server. " 1901 $self->message ("Something went wrong deep within the crossfire server. "
1844 . "I'll try to bring you back to the map you were before. " 1902 . "I'll try to bring you back to the map you were before. "
1845 . "Please report this to the dungeon master", 1903 . "Please report this to the dungeon master!",
1846 cf::NDI_UNIQUE | cf::NDI_RED); 1904 cf::NDI_UNIQUE | cf::NDI_RED);
1847 1905
1848 warn "ERROR in enter_exit: $@"; 1906 warn "ERROR in enter_exit: $@";
1849 $self->leave_link; 1907 $self->leave_link;
1850 } 1908 }
… …
2256 return; 2314 return;
2257 } 2315 }
2258 2316
2259 warn "reloading..."; 2317 warn "reloading...";
2260 2318
2319 warn "freezing server";
2261 my $guard = freeze_mainloop; 2320 my $guard = freeze_mainloop;
2262 cf::emergency_save; 2321 cf::emergency_save;
2263 2322
2323 warn "sync database to disk";
2324 cf::db_sync;
2325 IO::AIO::flush;
2326
2264 eval { 2327 eval {
2265 # if anything goes wrong in here, we should simply crash as we already saved 2328 # if anything goes wrong in here, we should simply crash as we already saved
2266 2329
2267 # cancel all watchers 2330 warn "cancel all watchers";
2268 for (Event::all_watchers) { 2331 for (Event::all_watchers) {
2269 $_->cancel if $_->data & WF_AUTOCANCEL; 2332 $_->cancel if $_->data & WF_AUTOCANCEL;
2270 } 2333 }
2271 2334
2272 # cancel all extension coros 2335 warn "cancel all extension coros";
2273 $_->cancel for values %EXT_CORO; 2336 $_->cancel for values %EXT_CORO;
2274 %EXT_CORO = (); 2337 %EXT_CORO = ();
2275 2338
2339 warn "remove commands";
2340 %COMMAND = ();
2341
2342 warn "remove ext commands";
2343 %EXTCMD = ();
2344
2276 # unload all extensions 2345 warn "unload/nuke all extensions";
2277 for (@exts) { 2346 for my $pkg (@EXTS) {
2278 warn "unloading <$_>"; 2347 warn "... unloading $pkg";
2279 unload_extension $_; 2348
2349 if (my $cb = $pkg->can ("unload")) {
2350 eval {
2351 $cb->($pkg);
2352 1
2353 } or warn "$pkg unloaded, but with errors: $@";
2280 } 2354 }
2281 2355
2356 warn "... nuking $pkg";
2357 Symbol::delete_package $pkg;
2358 }
2359
2282 # unload all modules loaded from $LIBDIR 2360 warn "unload all perl modules loaded from $LIBDIR";
2283 while (my ($k, $v) = each %INC) { 2361 while (my ($k, $v) = each %INC) {
2284 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/; 2362 next unless $v =~ /^\Q$LIBDIR\E\/.*\.pm$/;
2285 2363
2286 warn "removing <$k>"; 2364 warn "removing <$k>";
2287 delete $INC{$k}; 2365 delete $INC{$k};
… …
2294 } 2372 }
2295 2373
2296 Symbol::delete_package $k; 2374 Symbol::delete_package $k;
2297 } 2375 }
2298 2376
2299 # sync database to disk
2300 cf::db_sync;
2301 IO::AIO::flush;
2302
2303 # get rid of safe::, as good as possible 2377 warn "get rid of safe::, as good as possible";
2304 Symbol::delete_package "safe::$_" 2378 Symbol::delete_package "safe::$_"
2305 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region); 2379 for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
2306 2380
2307 # remove register_script_function callbacks
2308 # TODO
2309
2310 # unload cf.pm "a bit" 2381 warn "unload cf.pm \"a bit\"";
2311 delete $INC{"cf.pm"}; 2382 delete $INC{"cf.pm"};
2312 2383
2313 # don't, removes xs symbols, too, 2384 # don't, removes xs symbols, too,
2314 # and global variables created in xs 2385 # and global variables created in xs
2315 #Symbol::delete_package __PACKAGE__; 2386 #Symbol::delete_package __PACKAGE__;
2316 2387
2317 # reload cf.pm
2318 warn "reloading cf.pm"; 2388 warn "reloading cf.pm";
2319 require cf; 2389 require cf;
2320 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt 2390 cf::_connect_to_perl; # nominally unnecessary, but cannot hurt
2321 2391
2322 # load config and database again 2392 warn "load config and database again";
2323 cf::cfg_load; 2393 cf::cfg_load;
2324 cf::db_load; 2394 cf::db_load;
2325 2395
2326 # load extensions
2327 warn "load extensions"; 2396 warn "load extensions";
2328 cf::load_extensions; 2397 cf::load_extensions;
2329 2398
2330 # reattach attachments to objects 2399 warn "reattach attachments to objects/players";
2331 warn "reattach";
2332 _global_reattach; 2400 _global_reattach;
2401 warn "reattach attachments to maps";
2333 reattach $_ for values %MAP; 2402 reattach $_ for values %MAP;
2334 }; 2403 };
2335 2404
2336 if ($@) { 2405 if ($@) {
2337 warn $@; 2406 warn $@;
2338 warn "error while reloading, exiting."; 2407 warn "error while reloading, exiting.";
2339 exit 1; 2408 exit 1;
2340 } 2409 }
2341 2410
2342 warn "reloaded successfully"; 2411 warn "reloaded";
2343}; 2412};
2344 2413
2345############################################################################# 2414#############################################################################
2346 2415
2347unless ($LINK_MAP) { 2416unless ($LINK_MAP) {
… …
2383 $LINK_MAP->{deny_reset} = 1; 2452 $LINK_MAP->{deny_reset} = 1;
2384 2453
2385 $cf::MAP{$LINK_MAP->path} = $LINK_MAP; 2454 $cf::MAP{$LINK_MAP->path} = $LINK_MAP;
2386} 2455}
2387 2456
2388register "<global>", __PACKAGE__;
2389
2390register_command "reload" => sub { 2457register_command "reload" => sub {
2391 my ($who, $arg) = @_; 2458 my ($who, $arg) = @_;
2392 2459
2393 if ($who->flag (FLAG_WIZ)) { 2460 if ($who->flag (FLAG_WIZ)) {
2394 $who->message ("start of reload."); 2461 $who->message ("start of reload.");
… …
2403 reentrant => 0, 2470 reentrant => 0,
2404 prio => 0, 2471 prio => 0,
2405 at => $NEXT_TICK || $TICK, 2472 at => $NEXT_TICK || $TICK,
2406 data => WF_AUTOCANCEL, 2473 data => WF_AUTOCANCEL,
2407 cb => sub { 2474 cb => sub {
2475 $NOW = Event::time;
2476
2408 cf::server_tick; # one server iteration 2477 cf::server_tick; # one server iteration
2409 $RUNTIME += $TICK; 2478 $RUNTIME += $TICK;
2410 $NEXT_TICK += $TICK; 2479 $NEXT_TICK += $TICK;
2411 2480
2412 $WAIT_FOR_TICK->broadcast; 2481 $WAIT_FOR_TICK->broadcast;

Diff Legend

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