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.519 by root, Fri Apr 16 02:32:25 2010 UTC vs.
Revision 1.530 by root, Wed Apr 28 21:05:33 2010 UTC

… …
106our $RANDOMDIR = "$LOCALDIR/random"; 106our $RANDOMDIR = "$LOCALDIR/random";
107our $BDBDIR = "$LOCALDIR/db"; 107our $BDBDIR = "$LOCALDIR/db";
108our $PIDFILE = "$LOCALDIR/pid"; 108our $PIDFILE = "$LOCALDIR/pid";
109our $RUNTIMEFILE = "$LOCALDIR/runtime"; 109our $RUNTIMEFILE = "$LOCALDIR/runtime";
110 110
111our %RESOURCE; 111our %RESOURCE; # unused
112 112
113our $OUTPUT_RATE_MIN = 4000; 113our $OUTPUT_RATE_MIN = 3000;
114our $OUTPUT_RATE_MAX = 100000; 114our $OUTPUT_RATE_MAX = 1000000;
115
116our $MAX_LINKS = 32; # how many chained exits to follow
117our $VERBOSE_IO = 1;
115 118
116our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!) 119our $TICK = MAX_TIME * 1e-6; # this is a CONSTANT(!)
117our $NEXT_RUNTIME_WRITE; # when should the runtime file be written 120our $NEXT_RUNTIME_WRITE; # when should the runtime file be written
118our $NEXT_TICK; 121our $NEXT_TICK;
119our $USE_FSYNC = 1; # use fsync to write maps - default on 122our $USE_FSYNC = 1; # use fsync to write maps - default on
… …
165 168
166our $EMERGENCY_POSITION; 169our $EMERGENCY_POSITION;
167 170
168sub cf::map::normalise; 171sub cf::map::normalise;
169 172
173sub in_main() {
174 $Coro::current == $Coro::main
175}
176
170############################################################################# 177#############################################################################
171 178
172%REFLECT = (); 179%REFLECT = ();
173for (@REFLECT) { 180for (@REFLECT) {
174 my $reflect = JSON::XS::decode_json $_; 181 my $reflect = JSON::XS::decode_json $_;
… …
261$Coro::State::DIEHOOK = sub { 268$Coro::State::DIEHOOK = sub {
262 return unless $^S eq 0; # "eq", not "==" 269 return unless $^S eq 0; # "eq", not "=="
263 270
264 warn Carp::longmess $_[0]; 271 warn Carp::longmess $_[0];
265 272
266 if ($Coro::current == $Coro::main) {#d# 273 if (in_main) {#d#
267 warn "DIEHOOK called in main context, Coro bug?\n";#d# 274 warn "DIEHOOK called in main context, Coro bug?\n";#d#
268 return;#d# 275 return;#d#
269 }#d# 276 }#d#
270 277
271 # kill coroutine otherwise 278 # kill coroutine otherwise
… …
1188 1195
1189 sync_job { 1196 sync_job {
1190 if (length $$rdata) { 1197 if (length $$rdata) {
1191 utf8::decode (my $decname = $filename); 1198 utf8::decode (my $decname = $filename);
1192 warn sprintf "saving %s (%d,%d)\n", 1199 warn sprintf "saving %s (%d,%d)\n",
1193 $decname, length $$rdata, scalar @$objs; 1200 $decname, length $$rdata, scalar @$objs
1201 if $VERBOSE_IO;
1194 1202
1195 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) { 1203 if (my $fh = aio_open "$filename~", O_WRONLY | O_CREAT, 0600) {
1196 aio_chmod $fh, SAVE_MODE; 1204 aio_chmod $fh, SAVE_MODE;
1197 aio_write $fh, 0, (length $$rdata), $$rdata, 0; 1205 aio_write $fh, 0, (length $$rdata), $$rdata, 0;
1198 if ($cf::USE_FSYNC) { 1206 if ($cf::USE_FSYNC) {
… …
1255 $av = $st->{objs}; 1263 $av = $st->{objs};
1256 } 1264 }
1257 1265
1258 utf8::decode (my $decname = $filename); 1266 utf8::decode (my $decname = $filename);
1259 warn sprintf "loading %s (%d,%d)\n", 1267 warn sprintf "loading %s (%d,%d)\n",
1260 $decname, length $data, scalar @{$av || []}; 1268 $decname, length $data, scalar @{$av || []}
1269 if $VERBOSE_IO;
1261 1270
1262 ($data, $av) 1271 ($data, $av)
1263} 1272}
1264 1273
1265=head2 COMMAND CALLBACKS 1274=head2 COMMAND CALLBACKS
… …
1436 if (length $@) { 1445 if (length $@) {
1437 warn "$v->{path}: $@\n"; 1446 warn "$v->{path}: $@\n";
1438 1447
1439 cf::cleanup "mandatory extension '$k' failed to load, exiting." 1448 cf::cleanup "mandatory extension '$k' failed to load, exiting."
1440 if exists $v->{meta}{mandatory}; 1449 if exists $v->{meta}{mandatory};
1450
1451 warn "$v->{base}: optional extension cannot be loaded, skipping.\n";
1452 delete $todo{$k};
1441 } else { 1453 } else {
1442 $done{$k} = delete $todo{$k}; 1454 $done{$k} = delete $todo{$k};
1443 push @EXTS, $v->{pkg}; 1455 push @EXTS, $v->{pkg};
1444 $progress = 1; 1456 $progress = 1;
1445 1457
… …
1623 $pl->password ("*"); # this should lock out the player until we have nuked the dir 1635 $pl->password ("*"); # this should lock out the player until we have nuked the dir
1624 1636
1625 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active; 1637 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1626 $pl->deactivate; 1638 $pl->deactivate;
1627 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy; 1639 my $killer = cf::arch::get "killer_quit"; $pl->killer ($killer); $killer->destroy;
1628 $pl->ob->check_score;
1629 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1640 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1630 $pl->ns->destroy if $pl->ns; 1641 $pl->ns->destroy if $pl->ns;
1631 1642
1632 my $path = playerdir $pl; 1643 my $path = playerdir $pl;
1633 my $temp = "$path~$cf::RUNTIME~deleting~"; 1644 my $temp = "$path~$cf::RUNTIME~deleting~";
… …
1688 \@logins 1699 \@logins
1689} 1700}
1690 1701
1691=item $player->maps 1702=item $player->maps
1692 1703
1704=item cf::player::maps $login
1705
1693Returns an arrayref of map paths that are private for this 1706Returns an arrayref of map paths that are private for this
1694player. May block. 1707player. May block.
1695 1708
1696=cut 1709=cut
1697 1710
… …
1758 1771
1759=cut 1772=cut
1760 1773
1761sub find_by_path($) { 1774sub find_by_path($) {
1762 my ($path) = @_; 1775 my ($path) = @_;
1776
1777 $path =~ s/^~[^\/]*//; # skip ~login
1763 1778
1764 my ($match, $specificity); 1779 my ($match, $specificity);
1765 1780
1766 for my $region (list) { 1781 for my $region (list) {
1767 if ($region->{match} && $path =~ $region->{match}) { 1782 if ($region->{match} && $path =~ $region->{match}) {
… …
1831 1846
1832 $EXT_MAP{$pkg} = [$prio, qr<$regex>]; 1847 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1833} 1848}
1834 1849
1835# also paths starting with '/' 1850# also paths starting with '/'
1836$EXT_MAP{"cf::map"} = [0, qr{^(?=/)}]; 1851$EXT_MAP{"cf::map::wrap"} = [0, qr{^(?=/)}];
1837 1852
1838sub thawer_merge { 1853sub thawer_merge {
1839 my ($self, $merge) = @_; 1854 my ($self, $merge) = @_;
1840 1855
1841 # we have to keep some variables in memory intact 1856 # we have to keep some variables in memory intact
… …
2151 or next; 2166 or next;
2152 $neigh = find $neigh, $map 2167 $neigh = find $neigh, $map
2153 or next; 2168 or next;
2154 $neigh->load; 2169 $neigh->load;
2155 2170
2171 # now find the diagonal neighbours
2156 push @neigh, 2172 push @neigh,
2157 [$neigh->tile_path (($_ + 3) % 4), $neigh], 2173 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2158 [$neigh->tile_path (($_ + 1) % 4), $neigh]; 2174 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2159 } 2175 }
2160 2176
… …
2332 2348
2333 delete $cf::MAP{$self->path}; 2349 delete $cf::MAP{$self->path};
2334 2350
2335 $self->unlink_save; 2351 $self->unlink_save;
2336 2352
2337 bless $self, "cf::map"; 2353 bless $self, "cf::map::wrap";
2338 delete $self->{deny_reset}; 2354 delete $self->{deny_reset};
2339 $self->{deny_save} = 1; 2355 $self->{deny_save} = 1;
2340 $self->reset_timeout (1); 2356 $self->reset_timeout (1);
2341 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++)); 2357 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
2342 2358
… …
2572 2588
2573Freezes the player and moves him/her to a special map (C<{link}>). 2589Freezes the player and moves him/her to a special map (C<{link}>).
2574 2590
2575The player should be reasonably safe there for short amounts of time (e.g. 2591The player should be reasonably safe there for short amounts of time (e.g.
2576for loading a map). You I<MUST> call C<leave_link> as soon as possible, 2592for loading a map). You I<MUST> call C<leave_link> as soon as possible,
2577though, as the palyer cannot control the character while it is on the link 2593though, as the player cannot control the character while it is on the link
2578map. 2594map.
2579 2595
2580Will never block. 2596Will never block.
2581 2597
2582=item $player_object->leave_link ($map, $x, $y) 2598=item $player_object->leave_link ($map, $x, $y)
… …
2603sub cf::object::player::enter_link { 2619sub cf::object::player::enter_link {
2604 my ($self) = @_; 2620 my ($self) = @_;
2605 2621
2606 $self->deactivate_recursive; 2622 $self->deactivate_recursive;
2607 2623
2624 ++$self->{_link_recursion};
2625
2608 return if UNIVERSAL::isa $self->map, "ext::map_link"; 2626 return if UNIVERSAL::isa $self->map, "ext::map_link";
2609 2627
2610 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y] 2628 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
2611 if $self->map && $self->map->{path} ne "{link}"; 2629 if $self->map && $self->map->{path} ne "{link}";
2612 2630
… …
2643 $map->load_neighbours; 2661 $map->load_neighbours;
2644 2662
2645 return unless $self->contr->active; 2663 return unless $self->contr->active;
2646 2664
2647 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2665 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2648 $self->enter_map ($map, $x, $y); 2666 if ($self->enter_map ($map, $x, $y)) {
2649 2667 # entering was successful
2668 delete $self->{_link_recursion};
2650 # only activate afterwards, to support waiting in hooks 2669 # only activate afterwards, to support waiting in hooks
2651 $self->activate_recursive; 2670 $self->activate_recursive;
2652} 2671 }
2653 2672
2673}
2674
2654=item $player_object->goto ($path, $x, $y[, $check->($map)[, $done->()]]) 2675=item $player_object->goto ($path, $x, $y[, $check->($map, $x, $y, $player)[, $done->($player)]])
2655 2676
2656Moves the player to the given map-path and coordinates by first freezing 2677Moves the player to the given map-path and coordinates by first freezing
2657her, loading and preparing them map, calling the provided $check callback 2678her, loading and preparing them map, calling the provided $check callback
2658that has to return the map if sucecssful, and then unfreezes the player on 2679that has to return the map if sucecssful, and then unfreezes the player on
2659the new (success) or old (failed) map position. In either case, $done will 2680the new (success) or old (failed) map position. In either case, $done will
… …
2666 2687
2667our $GOTOGEN; 2688our $GOTOGEN;
2668 2689
2669sub cf::object::player::goto { 2690sub cf::object::player::goto {
2670 my ($self, $path, $x, $y, $check, $done) = @_; 2691 my ($self, $path, $x, $y, $check, $done) = @_;
2692
2693 if ($self->{_link_recursion} >= $MAX_LINKS) {
2694 warn "FATAL: link recursion exceeded, ", $self->name, " goto $path $x $y, redirecting.";
2695 $self->failmsg ("Something went wrong inside the server - please contact an administrator!");
2696 ($path, $x, $y) = @$EMERGENCY_POSITION;
2697 }
2671 2698
2672 # do generation counting so two concurrent goto's will be executed in-order 2699 # do generation counting so two concurrent goto's will be executed in-order
2673 my $gen = $self->{_goto_generation} = ++$GOTOGEN; 2700 my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2674 2701
2675 $self->enter_link; 2702 $self->enter_link;
… …
2699 my $map = eval { 2726 my $map = eval {
2700 my $map = defined $path ? cf::map::find $path : undef; 2727 my $map = defined $path ? cf::map::find $path : undef;
2701 2728
2702 if ($map) { 2729 if ($map) {
2703 $map = $map->customise_for ($self); 2730 $map = $map->customise_for ($self);
2704 $map = $check->($map) if $check && $map; 2731 $map = $check->($map, $x, $y, $self) if $check && $map;
2705 } else { 2732 } else {
2706 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED); 2733 $self->message ("The exit to '$path' is closed.", cf::NDI_UNIQUE | cf::NDI_RED);
2707 } 2734 }
2708 2735
2709 $map 2736 $map
… …
2717 if ($gen == $self->{_goto_generation}) { 2744 if ($gen == $self->{_goto_generation}) {
2718 delete $self->{_goto_generation}; 2745 delete $self->{_goto_generation};
2719 $self->leave_link ($map, $x, $y); 2746 $self->leave_link ($map, $x, $y);
2720 } 2747 }
2721 2748
2722 $done->() if $done; 2749 $done->($self) if $done;
2723 })->prio (1); 2750 })->prio (1);
2724} 2751}
2725 2752
2726=item $player_object->enter_exit ($exit_object) 2753=item $player_object->enter_exit ($exit_object)
2727 2754
… …
3401 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3428 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3402 3429
3403 cf::face::set_data $idx, 0, $info->{data}, $info->{hash}; 3430 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3404 cf::face::set_type $idx, $info->{type}; 3431 cf::face::set_type $idx, $info->{type};
3405 } else { 3432 } else {
3406 $RESOURCE{$name} = $info; 3433 $RESOURCE{$name} = $info; # unused
3407 } 3434 }
3408 3435
3409 cf::cede_to_tick; 3436 cf::cede_to_tick;
3410 } 3437 }
3411 } 3438 }
3412 3439
3413 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE); 3440 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3414 3441
3415 1 3442 1
3416} 3443}
3417
3418cf::global->attach (on_resource_update => sub {
3419 if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
3420 $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
3421
3422 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3423 my $sound = $soundconf->{compat}[$_]
3424 or next;
3425
3426 my $face = cf::face::find "sound/$sound->[1]";
3427 cf::sound::set $sound->[0] => $face;
3428 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3429 }
3430
3431 while (my ($k, $v) = each %{$soundconf->{event}}) {
3432 my $face = cf::face::find "sound/$v";
3433 cf::sound::set $k => $face;
3434 }
3435 }
3436});
3437 3444
3438register_exticmd fx_want => sub { 3445register_exticmd fx_want => sub {
3439 my ($ns, $want) = @_; 3446 my ($ns, $want) = @_;
3440 3447
3441 while (my ($k, $v) = each %$want) { 3448 while (my ($k, $v) = each %$want) {
… …
3480sub reload_treasures { 3487sub reload_treasures {
3481 load_resource_file "$DATADIR/treasures" 3488 load_resource_file "$DATADIR/treasures"
3482 or die "unable to load treasurelists\n"; 3489 or die "unable to load treasurelists\n";
3483} 3490}
3484 3491
3492sub reload_sound {
3493 0 < Coro::AIO::aio_load "$DATADIR/sound", my $data
3494 or die "$DATADIR/sound $!";
3495
3496 my $soundconf = JSON::XS->new->utf8->relaxed->decode ($data);
3497
3498 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3499 my $sound = $soundconf->{compat}[$_]
3500 or next;
3501
3502 my $face = cf::face::find "sound/$sound->[1]";
3503 cf::sound::set $sound->[0] => $face;
3504 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3505 }
3506
3507 while (my ($k, $v) = each %{$soundconf->{event}}) {
3508 my $face = cf::face::find "sound/$v";
3509 cf::sound::set $k => $face;
3510 }
3511}
3512
3485sub reload_resources { 3513sub reload_resources {
3486 warn "reloading resource files...\n"; 3514 warn "reloading resource files...\n";
3487 3515
3488 reload_facedata; 3516 reload_facedata;
3517 reload_sound;
3489 reload_archetypes; 3518 reload_archetypes;
3490 reload_regions; 3519 reload_regions;
3491 reload_treasures; 3520 reload_treasures;
3492 3521
3493 warn "finished reloading resource files\n"; 3522 warn "finished reloading resource files\n";
… …
3500 or return; 3529 or return;
3501 3530
3502 local $/; 3531 local $/;
3503 *CFG = YAML::XS::Load scalar <$fh>; 3532 *CFG = YAML::XS::Load scalar <$fh>;
3504 3533
3505 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3534 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38];
3506 3535
3507 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3536 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3508 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3537 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
3509 3538
3510 if (exists $CFG{mlockall}) { 3539 if (exists $CFG{mlockall}) {
… …
3785 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH}; 3814 my $leaf_symtab = *{$stem_symtab->{$leaf}}{HASH};
3786 for my $name (keys %$leaf_symtab) { 3815 for my $name (keys %$leaf_symtab) {
3787 _gv_clear *{"$pkg$name"}; 3816 _gv_clear *{"$pkg$name"};
3788# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"}; 3817# use PApp::Util; PApp::Util::sv_dump *{"$pkg$name"};
3789 } 3818 }
3790 warn "cleared package $pkg\n";#d#
3791} 3819}
3792 3820
3793sub do_reload_perl() { 3821sub do_reload_perl() {
3794 # can/must only be called in main 3822 # can/must only be called in main
3795 if ($Coro::current != $Coro::main) { 3823 if (in_main) {
3796 warn "can only reload from main coroutine"; 3824 warn "can only reload from main coroutine";
3797 return; 3825 return;
3798 } 3826 }
3799 3827
3800 return if $RELOAD++; 3828 return if $RELOAD++;

Diff Legend

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