--- deliantra/server/lib/cf.pm 2007/01/09 15:36:19 1.154 +++ deliantra/server/lib/cf.pm 2007/01/10 19:52:43 1.158 @@ -26,13 +26,13 @@ use Event; $Event::Eval = 1; # no idea why this is required, but it is +sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload + # work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode? $YAML::Syck::ImplicitUnicode = 1; $Coro::main->prio (Coro::PRIO_MAX); # run main coroutine ("the server") with very high priority -sub WF_AUTOCANCEL () { 1 } # automatically cancel this watcher on reload - our %COMMAND = (); our %COMMAND_TIME = (); our %EXTCMD = (); @@ -56,6 +56,9 @@ our $RANDOM_MAPS = cf::localdir . "/random"; our %EXT_CORO; # coroutines bound to extensions +our $WAIT_FOR_TICK; $WAIT_FOR_TICK ||= new Coro::Signal; +our $WAIT_FOR_TICK_ONE; $WAIT_FOR_TICK_ONE ||= new Coro::Signal; + binmode STDOUT; binmode STDERR; @@ -109,6 +112,13 @@ Configuration for the server, loaded from C, or from wherever your confdir points to. +=item $cf::WAIT_FOR_TICK, $cf::WAIT_FOR_TICK_ONE + +These are Coro::Signal objects that are C<< ->broadcast >> (WAIT_FOR_TICK) +or C<< ->send >> (WAIT_FOR_TICK_ONE) on after normal server tick +processing has been done. Call C<< ->wait >> on them to maximise the +window of cpu time available, or simply to synchronise to the server tick. + =back =cut @@ -359,6 +369,9 @@ package cf::path; +use overload + '""' => \&as_string; + # used to convert map paths into valid unix filenames by repalcing / by ∕ our $PATH_SEP = "∕"; # U+2215, chosen purely for visual reasons @@ -377,6 +390,8 @@ # ~/... per-player maps without a specific player (DO NOT USE) # ~user/... per-player map of a specific user + $path =~ s/$PATH_SEP/\//go; + if ($path =~ /^{/) { # fine as it is } elsif ($path =~ s{^\?random/}{}) { @@ -1071,28 +1086,6 @@ cf::map->attach (prio => -10000, package => cf::mapsupport::); ############################################################################# -# load/save perl data associated with player->ob objects - -sub all_objects(@) { - @_, map all_objects ($_->inv), @_ -} - -# TODO: compatibility cruft, remove when no longer needed -cf::player->attach ( - on_load => sub { - my ($pl, $path) = @_; - - for my $o (all_objects $pl->ob) { - if (my $value = $o->get_ob_key_value ("_perl_data")) { - $o->set_ob_key_value ("_perl_data"); - - %$o = %{ Storable::thaw pack "H*", $value }; - } - } - }, -); - -############################################################################# =head2 CORE EXTENSIONS @@ -1227,7 +1220,7 @@ for my $login (@$dirs) { my $fh = aio_open path $login, Fcntl::O_RDONLY, 0 or next; aio_read $fh, 0, 512, my $buf, 0 or next; - $buf !~ /^password -------------$/ or next; # official not-valid tag + $buf !~ /^password -------------$/m or next; # official not-valid tag utf8::decode $login; push @logins, $login; @@ -1254,9 +1247,8 @@ for (@$files) { utf8::decode $_; next if /\.(?:pl|pst)$/; - next unless /^$PATH_SEP/; + next unless /^$PATH_SEP/o; - s/$PATH_SEP/\//g; push @paths, new cf::path "~" . $pl->ob->name . "/" . $_; } @@ -1453,10 +1445,34 @@ $self->in_memory (cf::MAP_IN_MEMORY); } +# find and load all maps in the 3x3 area around a map +sub load_diag { + my ($map) = @_; + + my @diag; # diagonal neighbours + + for (0 .. 3) { + my $neigh = $map->tile_path ($_) + or next; + $neigh = find $neigh, $map + or next; + $neigh->load; + + push @diag, [$neigh->tile_path (($_ + 3) % 4), $neigh], + [$neigh->tile_path (($_ + 1) % 4), $neigh]; + } + + for (@diag) { + my $neigh = find @$_ + or next; + $neigh->load; + } +} + sub find_sync { my ($path, $origin) = @_; - cf::sync_job { cf::map::find $path, $origin } + cf::sync_job { find $path, $origin } } sub do_load_sync { @@ -1465,6 +1481,38 @@ cf::sync_job { $map->load }; } +our %MAP_PREFETCH; +our $MAP_PREFETCHER = Coro::async { + while () { + while (%MAP_PREFETCH) { + my $key = each %MAP_PREFETCH + or next; + my $path = delete $MAP_PREFETCH{$key}; + + my $map = find $path + or next; + $map->load; + } + Coro::schedule; + } +}; + +sub find_async { + my ($path, $origin) = @_; + + $path = new cf::path $path, $origin && $origin->path; + my $key = $path->as_string; + + if (my $map = $cf::MAP{$key}) { + return $map if $map->in_memory == cf::MAP_IN_MEMORY; + } + + $MAP_PREFETCH{$key} = $path; + $MAP_PREFETCHER->ready; + + () +} + sub save { my ($self) = @_; @@ -1590,28 +1638,60 @@ $map } -sub emergency_save { - my $freeze_guard = cf::freeze_mainloop; +=item cf::map::unique_maps - warn "enter emergency perl save\n"; +Returns an arrayref of cf::path's of all shared maps that have +instantiated unique items. May block. - cf::sync_job { - warn "begin emergency player save\n"; - $_->save for values %cf::PLAYER; - warn "end emergency player save\n"; +=cut - warn "begin emergency map save\n"; - $_->save for values %cf::MAP; - warn "end emergency map save\n"; - }; +sub unique_maps() { + my $files = aio_readdir cf::localdir . "/" . cf::uniquedir + or return; - warn "leave emergency perl save\n"; + my @paths; + + for (@$files) { + utf8::decode $_; + next if /\.pst$/; + next unless /^$PATH_SEP/o; + + push @paths, new cf::path $_; + } + + \@paths } package cf; =back +=head3 cf::object + +=cut + +package cf::object; + +=over 4 + +=item $ob->inv_recursive + +Returns the inventory of the object _and_ their inventories, recursively. + +=cut + +sub inv_recursive_; +sub inv_recursive_ { + map { $_, inv_recursive_ $_->inv } @_ +} + +sub inv_recursive { + inv_recursive_ inv $_[0] +} + +package cf; + +=back =head3 cf::object::player @@ -1713,6 +1793,7 @@ if $x <=0 && $y <= 0; $map->load; + $map->load_diag; return unless $self->contr->active; $self->activate_recursive; @@ -1759,7 +1840,6 @@ my ($self, $path, $x, $y) = @_; $path = new cf::path $path; - $path ne "/" or Carp::cluck ("oy");#d# $self->enter_link; @@ -1846,7 +1926,7 @@ }) { $self->message ("Something went wrong deep within the crossfire server. " . "I'll try to bring you back to the map you were before. " - . "Please report this to the dungeon master", + . "Please report this to the dungeon master!", cf::NDI_UNIQUE | cf::NDI_RED); warn "ERROR in enter_exit: $@"; @@ -2209,7 +2289,49 @@ } ############################################################################# -# initialisation +# initialisation and cleanup + +# install some emergency cleanup handlers +BEGIN { + for my $signal (qw(INT HUP TERM)) { + Event->signal ( + data => WF_AUTOCANCEL, + signal => $signal, + cb => sub { + cf::cleanup "SIG$signal"; + }, + ); + } +} + +sub emergency_save() { + my $freeze_guard = cf::freeze_mainloop; + + warn "enter emergency perl save\n"; + + cf::sync_job { + # use a peculiar iteration method to avoid tripping on perl + # refcount bugs in for. also avoids problems with players + # and maps saved/Destroyed asynchronously. + warn "begin emergency player save\n"; + for my $login (keys %cf::PLAYER) { + my $pl = $cf::PLAYER{$login} or next; + $pl->valid or next; + $pl->save; + } + warn "end emergency player save\n"; + + warn "begin emergency map save\n"; + for my $path (keys %cf::MAP) { + my $map = $cf::MAP{$path} or next; + $map->valid or next; + $map->save; + } + warn "end emergency map save\n"; + }; + + warn "leave emergency perl save\n"; +} sub reload() { # can/must only be called in main @@ -2371,6 +2493,9 @@ $RUNTIME += $TICK; $NEXT_TICK += $TICK; + $WAIT_FOR_TICK->broadcast; + $WAIT_FOR_TICK_ONE->send if $WAIT_FOR_TICK_ONE->awaited; + # if we are delayed by four ticks or more, skip them all $NEXT_TICK = Event::time if Event::time >= $NEXT_TICK + $TICK * 4;