[ViewVC] Diff of: cvs/deliantra/server/lib/cf.pm

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.112 by root, Mon Jan 1 13:31:47 2007 UTC vs.
Revision 1.130 by root, Thu Jan 4 00:08:08 2007 UTC

 use Storable;
 use Opcode;
 use Safe;
 use Safe::Hole;
-use Coro 3.3;
+use Coro 3.3 ();
 use Coro::Event;
 use Coro::Timer;
 use Coro::Signal;
 use Coro::Semaphore;
 use Coro::AIO;
 sub to_json($) {
    $JSON::Syck::ImplicitUnicode = 0;  # work around JSON::Syck bugs
    JSON::Syck::Dump $_[0]
 }
+=item my $guard = cf::guard { BLOCK }
+Run the given callback when the guard object gets destroyed (useful for
+coroutine cancellations).
+You can call C<< ->cancel >> on the guard object to stop the block from
+being executed.
+=cut
+sub guard(&) {
+   bless \(my $cb = $_[0]), cf::guard::;
+}
+sub cf::guard::cancel {
+   ${$_[0]} = sub { };
+}
+sub cf::guard::DESTROY {
+   ${$_[0]}->();
+}
+=item cf::lock_wait $string
+Wait until the given lock is available. See cf::lock_acquire.
+=item my $lock = cf::lock_acquire $string
+Wait until the given lock is available and then acquires it and returns
+a guard object. If the guard object gets destroyed (goes out of scope,
+for example when the coroutine gets canceled), the lock is automatically
+returned.
+Lock names should begin with a unique identifier (for example, find_map
+uses map_find and load_map uses map_load).
+=cut
+our %LOCK;
+sub lock_wait($) {
+   my ($key) = @_;
+   # wait for lock, if any
+   while ($LOCK{$key}) {
+      push @{ $LOCK{$key} }, $Coro::current;
+      Coro::schedule;
+   }
+}
+sub lock_acquire($) {
+   my ($key) = @_;
+   # wait, to be sure we are not locked
+   lock_wait $key;
+   $LOCK{$key} = [];
+   cf::guard {
+      # wake up all waiters, to be on the safe side
+      $_->ready for @{ delete $LOCK{$key} };
+   }
+}
+=item cf::async { BLOCK }
+Like C<Coro::async>, but runs the given BLOCK in an eval and only logs the
+error instead of exiting the server in case of a problem.
+=cut
+sub async(&) {
+   my ($cb) = @_;
+   Coro::async {
+      eval { $cb->() };
+      warn $@ if $@;
+   }
+}
 =item cf::sync_job { BLOCK }
 The design of crossfire+ requires that the main coro ($Coro::main) is
 always able to handle events or runnable, as crossfire+ is only partly
 reentrant. Thus "blocking" it by e.g. waiting for I/O is not acceptable.
 =cut
 sub coro(&) {
    my $cb = shift;
-   my $coro; $coro = async {
+   my $coro = &cf::async ($cb);
-      eval {
-         $cb->();
-      };
-      warn $@ if $@;
-   };
    $coro->on_destroy (sub {
       delete $EXT_CORO{$coro+0};
    });
    $EXT_CORO{$coro+0} = $coro;
    $path = $path->as_string if ref $path;
    my $self = bless { }, $class;
+   # {...        are special paths that are not touched
+   # ?xxx/...    are special absolute paths
+   # ?random/... random maps
+   # /!          non-realised random map exit
+   # /...        normal maps
+   # ~/...       per-player maps without a specific player (DO NOT USE)
+   # ~user/...   per-player map of a specific user
+   if ($path =~ /^{/) {
+      # fine as it is
-   if ($path =~ s{^\?random/}{}) {
+   } elsif ($path =~ s{^\?random/}{}) {
       Coro::AIO::aio_load "$cf::RANDOM_MAPS/$path.meta", my $data;
       $self->{random} = cf::from_json $data;
    } else {
       if ($path =~ s{^~([^/]+)?}{}) {
          $self->{user_rel} = 1;
       or return;
    unless (aio_stat "$filename.pst") {
       (aio_load "$filename.pst", $av) >= 0
          or return;
-      $av = eval { (Storable::thaw <$av>)->{objs} };
+      $av = eval { (Storable::thaw $av)->{objs} };
    }
+   warn sprintf "loading %s (%d)\n",
+      $filename, length $data, scalar @{$av || []};#d#
    return ($data, $av);
 }
 #############################################################################
 # command handling &c
 # and all this just because we cannot iterate over
 # all maps in C++...
 sub change_all_map_light {
    my ($change) = @_;
-   $_->change_map_light ($change) for values %cf::MAP;
+   $_->change_map_light ($change)
+      for grep $_->outdoor, values %cf::MAP;
 }
 sub try_load_header($) {
    my ($path) = @_;
    $map->{load_path} = $path;
    $map
 }
+sub find_map;
 sub find_map {
    my ($path, $origin) = @_;
    #warn "find_map<$path,$origin>\n";#d#
    $path = new cf::path $path, $origin && $origin->path;
    my $key = $path->as_string;
+   cf::lock_wait "map_find:$key";
    $cf::MAP{$key} || do {
+      my $guard = cf::lock_acquire "map_find:$key";
       # do it the slow way
       my $map = try_load_header $path->save_path;
       if ($map) {
          # safety
          $map->per_player (0) if $path->{user_rel};
       }
       $map->path ($key);
       $map->{path} = $path;
+      $map->{last_save} = $cf::RUNTIME;
       $map->last_access ($cf::RUNTIME);
       if ($map->should_reset) {
          $map->reset;
+         undef $guard;
-         $map = find_map $path;
+         $map = find_map $path
+            or return;
       }
       $cf::MAP{$key} = $map
    }
 }
 sub load {
    my ($self) = @_;
+   my $path = $self->{path};
+   my $guard = cf::lock_acquire "map_load:" . $path->as_string;
    return if $self->in_memory != cf::MAP_SWAPPED;
    $self->in_memory (cf::MAP_LOADING);
-   my $path = $self->{path};
    $self->alloc;
    $self->load_objects ($self->{load_path}, 1)
       or return;
 }
 sub save {
    my ($self) = @_;
+   $self->{last_save} = $cf::RUNTIME;
+   return unless $self->dirty;
    my $save = $self->{path}->save_path; utf8::encode $save;
    my $uniq = $self->{path}->uniq_path; utf8::encode $uniq;
-   $self->{last_save} = $cf::RUNTIME;
-   return unless $self->dirty;
    $self->{load_path} = $save;
    return if $self->{deny_save};
 }
 sub swap_out {
    my ($self) = @_;
+   # save first because save cedes
+   $self->save;
    return if $self->players;
    return if $self->in_memory != cf::MAP_IN_MEMORY;
    return if $self->{deny_save};
-   $self->save;
    $self->clear;
    $self->in_memory (cf::MAP_SWAPPED);
 }
 sub reset_at {
    my ($self) = @_;
    # TODO: safety, remove and allow resettable per-player maps
-   return 1e100 if $self->{path}{user_rel};
+   return 1e99 if $self->{path}{user_rel};
-   return 1e100 if $self->{deny_reset};
+   return 1e99 if $self->{deny_reset};
    my $time = $self->fixed_resettime ? $self->{instantiate_time} : $self->last_access;
-   my $to = $self->reset_timeout || $DEFAULT_RESET;
+   my $to = List::Util::min $MAX_RESET, $self->reset_timeout || $DEFAULT_RESET;
-   $to = $MAX_RESET if $to > $MAX_RESET;
    $time + $to
 }
 sub should_reset {
    utf8::encode (my $save = $self->{path}->save_path);
    aioreq_pri 3; IO::AIO::aio_unlink $save;
    aioreq_pri 3; IO::AIO::aio_unlink "$save.pst";
 }
+sub rename {
+   my ($self, $new_path) = @_;
+   $self->unlink_save;
+   delete $cf::MAP{$self->path};
+   $self->{path} = new cf::path $new_path;
+   $self->path ($self->{path}->as_string);
+   $cf::MAP{$self->path} = $self;
+   $self->save;
+}
 sub reset {
    my ($self) = @_;
    return if $self->players;
    return if $self->{path}{user_rel};#d#
    $_->clear_links_to ($self) for values %cf::MAP;
    $self->unlink_save;
    $self->destroy;
+}
+my $nuke_counter = "aaaa";
+sub nuke {
+   my ($self) = @_;
+   $self->{deny_save} = 1;
+   $self->reset_timeout (1);
+   $self->rename ("{nuke}/" . ($nuke_counter++));
+   $self->reset; # polite request, might not happen
 }
 sub customise_for {
    my ($map, $ob) = @_;
       (ref $cf::CFG{"may_$access"}
          ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
          : $cf::CFG{"may_$access"})
 }
+=item $player_object->enter_link
+Freezes the player and moves him/her to a special map (C<{link}>).
+The player should be reaosnably safe there for short amounts of time. You
+I<MUST> call C<leave_link> as soon as possible, though.
+=item $player_object->leave_link ($map, $x, $y)
+Moves the player out of the specila link map onto the given map. If the
+map is not valid (or omitted), the player will be moved back to the
+location he/she was before the call to C<enter_link>, or, if that fails,
+to the emergency map position.
+Might block.
+=cut
 sub cf::object::player::enter_link {
    my ($self) = @_;
+   $self->deactivate_recursive;
    return if $self->map == $LINK_MAP;
-   $self->{_link_pos} = [$self->map->{path}, $self->x, $self->y]
+   $self->{_link_pos} ||= [$self->map->{path}, $self->x, $self->y]
       if $self->map;
    $self->enter_map ($LINK_MAP, 20, 20);
-   $self->deactivate_recursive;
 }
 sub cf::object::player::leave_link {
    my ($self, $map, $x, $y) = @_;
    my $link_pos = delete $self->{_link_pos};
    unless ($map) {
-      $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
       # restore original map position
       ($map, $x, $y) = @{ $link_pos || [] };
       $map = cf::map::find_map $map;
       unless ($map) {
    $self->activate_recursive;
    $self->enter_map ($map, $x, $y);
 }
+cf::player->attach (
+   on_logout => sub {
+      my ($pl) = @_;
+      # abort map switching before logout
+      if ($pl->ob->{_link_pos}) {
+         cf::sync_job {
+            $pl->ob->leave_link
+         };
+      }
+   },
+   on_login => sub {
+      my ($pl) = @_;
+      # try to abort aborted map switching on player login :)
+      # should happen only on crashes
+      if ($pl->ob->{_link_pos}) {
+         $pl->ob->enter_link;
+         cf::async {
+            # we need this sleep as the login has a concurrent enter_exit running
+            # and this sleep increases chances of the player not ending up in scorn
+            Coro::Timer::sleep 1;
+            $pl->ob->leave_link;
+         };
+      }
+   },
+);
-=item $player_object->goto_map ($map, $x, $y)
+=item $player_object->goto_map ($path, $x, $y)
 =cut
 sub cf::object::player::goto_map {
    my ($self, $path, $x, $y) = @_;
    $self->enter_link;
-   (Coro::async {
+   (cf::async {
       $path = new cf::path $path;
       my $map = cf::map::find_map $path->as_string;
       $map = $map->customise_for ($self) if $map;
-      warn "entering ", $map->path, " at ($x, $y)\n"
+#      warn "entering ", $map->path, " at ($x, $y)\n"
-         if $map;
+#         if $map;
+      $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
       $self->leave_link ($map, $x, $y);
    })->prio (1);
 }
    return unless $self->type == cf::PLAYER;
    $self->enter_link;
-   (Coro::async {
+   (cf::async {
       unless (eval {
          prepare_random_map $exit
             if $exit->slaying eq "/!";
          my $path = new cf::path $exit->slaying, $exit->map && $exit->map->path;
          $self->goto_map ($path, $exit->stats->hp, $exit->stats->sp);
    on_reply => sub {
       my ($ns, $msg) = @_;
       # this weird shuffling is so that direct followup queries
       # get handled first
-      my $queue = delete $ns->{query_queue};
+      my $queue = delete $ns->{query_queue}
+         or return; # be conservative, not sure how that can happen, but we saw a crash here
       (shift @$queue)->[1]->($msg);
       push @{ $ns->{query_queue} }, @$queue;
 =cut
 sub cf::client::coro {
    my ($self, $cb) = @_;
-   my $coro; $coro = async {
+   my $coro = &cf::async ($cb);
-      eval {
-         $cb->();
-      };
-      warn $@ if $@;
-   };
    $coro->on_destroy (sub {
       delete $self->{_coro}{$coro+0};
    });
 {
    my $path = cf::localdir . "/database.pst";
    sub db_load() {
-      warn "loading database $path\n";#d# remove later
       $DB = stat $path ? Storable::retrieve $path : { };
    }
    my $pid;
    sub db_save() {
-      warn "saving database $path\n";#d# remove later
       waitpid $pid, 0 if $pid;
       if (0 == ($pid = fork)) {
          $DB->{_meta}{version} = 1;
          Storable::nstore $DB, "$path~";
          rename "$path~", $path;
 }
 sub main {
    # we must not ever block the main coroutine
    local $Coro::idle = sub {
-      Carp::cluck "FATAL: Coro::idle was called, major BUG\n";#d#
+      Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
       (Coro::unblock_sub {
          Event::one_event;
       })->();
    };
             or warn "ERROR: unable to write runtime file: $!";
       })->();
    },
 );
+END { cf::emergency_save }
 1

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.112 by root, Mon Jan 1 13:31:47 2007 UTC vs. Revision 1.130 by root, Thu Jan 4 00:08:08 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.112 by root, Mon Jan 1 13:31:47 2007 UTC vs.
Revision 1.130 by root, Thu Jan 4 00:08:08 2007 UTC