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.521 by root, Fri Apr 16 23:28:42 2010 UTC vs.
Revision 1.531 by root, Wed Apr 28 21:07:41 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
1626 $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
1627 1636
1628 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active; 1637 $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
1629 $pl->deactivate; 1638 $pl->deactivate;
1630 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;
1631 $pl->ob->check_score;
1632 $pl->invoke (cf::EVENT_PLAYER_QUIT); 1640 $pl->invoke (cf::EVENT_PLAYER_QUIT);
1633 $pl->ns->destroy if $pl->ns; 1641 $pl->ns->destroy if $pl->ns;
1634 1642
1635 my $path = playerdir $pl; 1643 my $path = playerdir $pl;
1636 my $temp = "$path~$cf::RUNTIME~deleting~"; 1644 my $temp = "$path~$cf::RUNTIME~deleting~";
1691 \@logins 1699 \@logins
1692} 1700}
1693 1701
1694=item $player->maps 1702=item $player->maps
1695 1703
1704=item cf::player::maps $login
1705
1696Returns an arrayref of map paths that are private for this 1706Returns an arrayref of map paths that are private for this
1697player. May block. 1707player. May block.
1698 1708
1699=cut 1709=cut
1700 1710
1761 1771
1762=cut 1772=cut
1763 1773
1764sub find_by_path($) { 1774sub find_by_path($) {
1765 my ($path) = @_; 1775 my ($path) = @_;
1776
1777 $path =~ s/^~[^\/]*//; # skip ~login
1766 1778
1767 my ($match, $specificity); 1779 my ($match, $specificity);
1768 1780
1769 for my $region (list) { 1781 for my $region (list) {
1770 if ($region->{match} && $path =~ $region->{match}) { 1782 if ($region->{match} && $path =~ $region->{match}) {
1834 1846
1835 $EXT_MAP{$pkg} = [$prio, qr<$regex>]; 1847 $EXT_MAP{$pkg} = [$prio, qr<$regex>];
1836} 1848}
1837 1849
1838# also paths starting with '/' 1850# also paths starting with '/'
1839$EXT_MAP{"cf::map"} = [0, qr{^(?=/)}]; 1851$EXT_MAP{"cf::map::wrap"} = [0, qr{^(?=/)}];
1840 1852
1841sub thawer_merge { 1853sub thawer_merge {
1842 my ($self, $merge) = @_; 1854 my ($self, $merge) = @_;
1843 1855
1844 # we have to keep some variables in memory intact 1856 # we have to keep some variables in memory intact
2154 or next; 2166 or next;
2155 $neigh = find $neigh, $map 2167 $neigh = find $neigh, $map
2156 or next; 2168 or next;
2157 $neigh->load; 2169 $neigh->load;
2158 2170
2171 # now find the diagonal neighbours
2159 push @neigh, 2172 push @neigh,
2160 [$neigh->tile_path (($_ + 3) % 4), $neigh], 2173 [$neigh->tile_path (($_ + 3) % 4), $neigh],
2161 [$neigh->tile_path (($_ + 1) % 4), $neigh]; 2174 [$neigh->tile_path (($_ + 1) % 4), $neigh];
2162 } 2175 }
2163 2176
2335 2348
2336 delete $cf::MAP{$self->path}; 2349 delete $cf::MAP{$self->path};
2337 2350
2338 $self->unlink_save; 2351 $self->unlink_save;
2339 2352
2340 bless $self, "cf::map"; 2353 bless $self, "cf::map::wrap";
2341 delete $self->{deny_reset}; 2354 delete $self->{deny_reset};
2342 $self->{deny_save} = 1; 2355 $self->{deny_save} = 1;
2343 $self->reset_timeout (1); 2356 $self->reset_timeout (1);
2344 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++)); 2357 $self->path ($self->{path} = "{nuke}/" . ($nuke_counter++));
2345 2358
2575 2588
2576Freezes 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}>).
2577 2590
2578The 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.
2579for 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,
2580though, 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
2581map. 2594map.
2582 2595
2583Will never block. 2596Will never block.
2584 2597
2585=item $player_object->leave_link ($map, $x, $y) 2598=item $player_object->leave_link ($map, $x, $y)
2606sub cf::object::player::enter_link { 2619sub cf::object::player::enter_link {
2607 my ($self) = @_; 2620 my ($self) = @_;
2608 2621
2609 $self->deactivate_recursive; 2622 $self->deactivate_recursive;
2610 2623
2624 ++$self->{_link_recursion};
2625
2611 return if UNIVERSAL::isa $self->map, "ext::map_link"; 2626 return if UNIVERSAL::isa $self->map, "ext::map_link";
2612 2627
2613 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y] 2628 $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
2614 if $self->map && $self->map->{path} ne "{link}"; 2629 if $self->map && $self->map->{path} ne "{link}";
2615 2630
2646 $map->load_neighbours; 2661 $map->load_neighbours;
2647 2662
2648 return unless $self->contr->active; 2663 return unless $self->contr->active;
2649 2664
2650 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext 2665 local $self->{_prev_pos} = $link_pos; # ugly hack for rent.ext
2651 $self->enter_map ($map, $x, $y); 2666 if ($self->enter_map ($map, $x, $y)) {
2652 2667 # entering was successful
2668 delete $self->{_link_recursion};
2653 # only activate afterwards, to support waiting in hooks 2669 # only activate afterwards, to support waiting in hooks
2654 $self->activate_recursive; 2670 $self->activate_recursive;
2655} 2671 }
2656 2672
2673}
2674
2657=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)]])
2658 2676
2659Moves 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
2660her, loading and preparing them map, calling the provided $check callback 2678her, loading and preparing them map, calling the provided $check callback
2661that 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
2662the 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
2669 2687
2670our $GOTOGEN; 2688our $GOTOGEN;
2671 2689
2672sub cf::object::player::goto { 2690sub cf::object::player::goto {
2673 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 }
2674 2698
2675 # 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
2676 my $gen = $self->{_goto_generation} = ++$GOTOGEN; 2700 my $gen = $self->{_goto_generation} = ++$GOTOGEN;
2677 2701
2678 $self->enter_link; 2702 $self->enter_link;
2702 my $map = eval { 2726 my $map = eval {
2703 my $map = defined $path ? cf::map::find $path : undef; 2727 my $map = defined $path ? cf::map::find $path : undef;
2704 2728
2705 if ($map) { 2729 if ($map) {
2706 $map = $map->customise_for ($self); 2730 $map = $map->customise_for ($self);
2707 $map = $check->($map) if $check && $map; 2731 $map = $check->($map, $x, $y, $self) if $check && $map;
2708 } else { 2732 } else {
2709 $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);
2710 } 2734 }
2711 2735
2712 $map 2736 $map
2720 if ($gen == $self->{_goto_generation}) { 2744 if ($gen == $self->{_goto_generation}) {
2721 delete $self->{_goto_generation}; 2745 delete $self->{_goto_generation};
2722 $self->leave_link ($map, $x, $y); 2746 $self->leave_link ($map, $x, $y);
2723 } 2747 }
2724 2748
2725 $done->() if $done; 2749 $done->($self) if $done;
2726 })->prio (1); 2750 })->prio (1);
2727} 2751}
2728 2752
2729=item $player_object->enter_exit ($exit_object) 2753=item $player_object->enter_exit ($exit_object)
2730 2754
3404 my $idx = (cf::face::find $name) || cf::face::alloc $name; 3428 my $idx = (cf::face::find $name) || cf::face::alloc $name;
3405 3429
3406 cf::face::set_data $idx, 0, $info->{data}, $info->{hash}; 3430 cf::face::set_data $idx, 0, $info->{data}, $info->{hash};
3407 cf::face::set_type $idx, $info->{type}; 3431 cf::face::set_type $idx, $info->{type};
3408 } else { 3432 } else {
3409 $RESOURCE{$name} = $info; 3433 $RESOURCE{$name} = $info; # unused
3410 } 3434 }
3411 3435
3412 cf::cede_to_tick; 3436 cf::cede_to_tick;
3413 } 3437 }
3414 } 3438 }
3415 3439
3416 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE); 3440 cf::global->invoke (EVENT_GLOBAL_RESOURCE_UPDATE);
3417 3441
3418 1 3442 1
3419} 3443}
3420
3421cf::global->attach (on_resource_update => sub {
3422 if (my $soundconf = $RESOURCE{"res/sound.conf"}) {
3423 $soundconf = JSON::XS->new->utf8->relaxed->decode ($soundconf->{data});
3424
3425 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3426 my $sound = $soundconf->{compat}[$_]
3427 or next;
3428
3429 my $face = cf::face::find "sound/$sound->[1]";
3430 cf::sound::set $sound->[0] => $face;
3431 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3432 }
3433
3434 while (my ($k, $v) = each %{$soundconf->{event}}) {
3435 my $face = cf::face::find "sound/$v";
3436 cf::sound::set $k => $face;
3437 }
3438 }
3439});
3440 3444
3441register_exticmd fx_want => sub { 3445register_exticmd fx_want => sub {
3442 my ($ns, $want) = @_; 3446 my ($ns, $want) = @_;
3443 3447
3444 while (my ($k, $v) = each %$want) { 3448 while (my ($k, $v) = each %$want) {
3483sub reload_treasures { 3487sub reload_treasures {
3484 load_resource_file "$DATADIR/treasures" 3488 load_resource_file "$DATADIR/treasures"
3485 or die "unable to load treasurelists\n"; 3489 or die "unable to load treasurelists\n";
3486} 3490}
3487 3491
3492sub reload_sound {
3493 warn "loading sound config from $DATADIR/sound\n";
3494
3495 0 < Coro::AIO::aio_load "$DATADIR/sound", my $data
3496 or die "$DATADIR/sound $!";
3497
3498 my $soundconf = JSON::XS->new->utf8->relaxed->decode ($data);
3499
3500 for (0 .. SOUND_CAST_SPELL_0 - 1) {
3501 my $sound = $soundconf->{compat}[$_]
3502 or next;
3503
3504 my $face = cf::face::find "sound/$sound->[1]";
3505 cf::sound::set $sound->[0] => $face;
3506 cf::sound::old_sound_index $_, $face; # gcfclient-compat
3507 }
3508
3509 while (my ($k, $v) = each %{$soundconf->{event}}) {
3510 my $face = cf::face::find "sound/$v";
3511 cf::sound::set $k => $face;
3512 }
3513}
3514
3488sub reload_resources { 3515sub reload_resources {
3489 warn "reloading resource files...\n"; 3516 warn "reloading resource files...\n";
3490 3517
3491 reload_facedata; 3518 reload_facedata;
3519 reload_sound;
3492 reload_archetypes; 3520 reload_archetypes;
3493 reload_regions; 3521 reload_regions;
3494 reload_treasures; 3522 reload_treasures;
3495 3523
3496 warn "finished reloading resource files\n"; 3524 warn "finished reloading resource files\n";
3503 or return; 3531 or return;
3504 3532
3505 local $/; 3533 local $/;
3506 *CFG = YAML::XS::Load scalar <$fh>; 3534 *CFG = YAML::XS::Load scalar <$fh>;
3507 3535
3508 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_105_115", 5, 37]; 3536 $EMERGENCY_POSITION = $CFG{emergency_position} || ["/world/world_104_115", 49, 38];
3509 3537
3510 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset}; 3538 $cf::map::MAX_RESET = $CFG{map_max_reset} if exists $CFG{map_max_reset};
3511 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset}; 3539 $cf::map::DEFAULT_RESET = $CFG{map_default_reset} if exists $CFG{map_default_reset};
3512 3540
3513 if (exists $CFG{mlockall}) { 3541 if (exists $CFG{mlockall}) {
3792 } 3820 }
3793} 3821}
3794 3822
3795sub do_reload_perl() { 3823sub do_reload_perl() {
3796 # can/must only be called in main 3824 # can/must only be called in main
3797 if ($Coro::current != $Coro::main) { 3825 if (in_main) {
3798 warn "can only reload from main coroutine"; 3826 warn "can only reload from main coroutine";
3799 return; 3827 return;
3800 } 3828 }
3801 3829
3802 return if $RELOAD++; 3830 return if $RELOAD++;

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines