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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.602 by root, Sun Nov 11 18:21:21 2012 UTC vs.
Revision 1.622 by root, Wed Nov 23 06:05:33 2016 UTC

 use JSON::XS 2.01 ();
 use BDB ();
 use Data::Dumper;
 use Fcntl;
 use YAML::XS ();
+use CBOR::XS ();
 use IO::AIO ();
 use Compress::LZF;
 use Digest::MD5 ();
 AnyEvent::detect;
 =item $cf::RUNTIME
 The time this server has run, starts at 0 and is increased by $cf::TICK on
 every server tick.
-=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR  $cf::PODDIR
+=item $cf::CONFDIR $cf::DATADIR $cf::LIBDIR $cf::PODDIR
 $cf::MAPDIR $cf::LOCALDIR $cf::TMPDIR $cf::UNIQUEDIR
 $cf::PLAYERDIR $cf::RANDOMDIR $cf::BDBDIR
 Various directories - "/etc", read-only install directory, perl-library
 directory, pod-directory, read-only maps directory, "/var", "/var/tmp",
 sub decode_yaml($) {
    fork_call { YAML::XS::Load $_[0] } @_
 }
+=item $scalar = cf::decode_cbor $scalar
+Same as CBOR::XS::decode_cbor, but takes server ticks into account, so
+blocks. For small amounts of data, C<CBOR::XS::decode_cbor> is the better
+alternative.
+=cut
+sub decode_cbor($) {
+   # we assume 10mb/s minimum decoding speed (on a ~2ghz machine)
+   cf::get_slot +(length $_[0]) / 10_000_000, 0, "decode_cbor";
+   CBOR::XS::decode_cbor $_[0]
+}
 =item $scalar = cf::unlzf $scalar
 Same as Compress::LZF::compress, but takes server ticks into account, so
 blocks.
    }
 }
 =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 L<Guard> object. If the guard object gets destroyed (goes out of scope,
 Allocate $time seconds of blocking CPU time at priority C<$priority>
 (default: 0):  This call blocks and returns only when you have at least
 C<$time> seconds of cpu time till the next tick. The slot is only valid
 till the next cede.
-Background jobs should use a priority les than zero, interactive jobs
+Background jobs should use a priority less than zero, interactive jobs
 should use 100 or more.
 The optional C<$name> can be used to identify the job to run. It might be
 used for statistical purposes and should identify the same time-class.
    my $signal = new Coro::Signal;
    my $busy;
    while () {
       next_job:
+      Coro::cede;
       my $avail = cf::till_tick;
       for (0 .. $#SLOT_QUEUE) {
          if ($SLOT_QUEUE[$_][0] <= $avail) {
             $busy = 0;
             my $job = splice @SLOT_QUEUE, $_, 1, ();
             $job->[2]->send;
-            Coro::cede;
             goto next_job;
          } else {
             $SLOT_QUEUE[$_][0] *= $SLOT_DECAY;
          }
       }
       if (@SLOT_QUEUE) {
-         # we do not use wait_for_tick() as it returns immediately when tick is inactive
+         wait_for_tick;
-         $WAIT_FOR_TICK->wait;
       } else {
          $busy = 0;
          Coro::schedule;
       }
    }
 BEGIN { *async = \&Coro::async_pool }
 =item cf::sync_job { BLOCK }
 The design of Deliantra requires that the main coroutine ($Coro::main)
-is always able to handle events or runnable, as Deliantra is only
+is always able to handle events or is runnable, as Deliantra is only
 partly reentrant. Thus "blocking" it by e.g. waiting for I/O is not
 acceptable.
 If it must be done, put the blocking parts into C<sync_job>. This will run
 the given BLOCK in another coroutine while waiting for the result. The
       while ($busy) {
          if (Coro::nready) {
             Coro::cede_notself;
          } else {
-            EV::loop EV::LOOP_ONESHOT;
+            EV::run EV::RUN_ONCE;
          }
       }
       my $time = AE::time - $time;
    reset_signals;
 }
 sub fork_call(&@) {
    my ($cb, @args) = @_;
-   # we seemingly have to make a local copy of the whole thing,
-   # otherwise perl prematurely frees the stuff :/
-   # TODO: investigate and fix (likely this will be rather laborious)
    my @res = Coro::Util::fork_eval {
       cf::post_fork;
       &$cb
    } @args;
    $MAP_PREFETCHER ||= cf::async {
       $Coro::current->{desc} = "map prefetcher";
       while (%MAP_PREFETCH) {
-         while (my ($k, $v) = each %MAP_PREFETCH) {
+         for my $k (keys %MAP_PREFETCH) {
             if (my $map = find $k) {
-               $map->load if $v;
+               $map->load if $MAP_PREFETCH{$k};
             }
             delete $MAP_PREFETCH{$k};
          }
       }
 =item $player_object->may ("access")
 Returns wether the given player is authorized to access resource "access"
 (e.g. "command_wizcast").
+This is implemented by checking a config setting of C<may_access> where
+C<access> is replaced by the access string. The following alternatives are
+possible (and are tested in order):
+=over 4
+=item * Player is DM
+The request will succeed.
+=item * may_access is an array reference
+If either the player nickname or UUID is in the array, the request will
+succeed, otherwise it will fail.
+=item * may_access is a true value
+The request will succeed.
+=item * may_access is missing or false
+The request will fail.
+=back
 =cut
 sub cf::object::player::may {
    my ($self, $access) = @_;
    $self->flag (cf::FLAG_WIZ) ||
       (ref $cf::CFG{"may_$access"}
-         ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
+         ? scalar grep $self->name eq $_ || $self->uuid eq $_, @{$cf::CFG{"may_$access"}}
          : $cf::CFG{"may_$access"})
 }
 =item $player_object->enter_link
 The player should be reasonably safe there for short amounts of time (e.g.
 for loading a map). You I<MUST> call C<leave_link> as soon as possible,
 though, as the player cannot control the character while it is on the link
 map.
-Will never block.
+This method will never block, which is the whole reaosn for it's
+existance: you can I<always> put a player onto the link map, which is the
+only place to put objects that is guaranteed to exist.
+A typical usage pattern is to call C<enter_link> synchronously from the
+server, then start a new thread, do your blocking stuff there and then
+call C<leave_link> from that thread.
 =item $player_object->leave_link ($map, $x, $y)
 Moves the player out of the special C<{link}> map onto the specified
 map. If the map is not valid (or omitted), the player will be moved back
 =head3 cf::client
 =over 4
-=item $client->send_drawinfo ($text, $flags)
-Sends a drawinfo packet to the client. Circumvents output buffering so
-should not be used under normal circumstances.
-=cut
-sub cf::client::send_drawinfo {
-   my ($self, $text, $flags) = @_;
-   utf8::encode $text;
-   $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
-}
 =item $client->send_big_packet ($pkt)
 Like C<send_packet>, but tries to compress large packets, and fragments
 them as required.
    $self->send_packet ($pkt);
 }
 =item $client->send_msg ($channel, $msg, $color, [extra...])
-Send a drawinfo or msg packet to the client, formatting the msg for the
+Send a msg packet to the client, formatting the msg for the client if
-client if neccessary. C<$type> should be a string identifying the type of
+necessary. C<$type> should be a string identifying the type of the
-the message, with C<log> being the default. If C<$color> is negative, suppress
+message, with C<log> being the default. If C<$color> is negative, suppress
 the message unless the client supports the msg packet.
 =cut
 # non-persistent channels (usually the info channel)
       id      => "death",
       title   => "Death",
       reply   => undef,
       tooltip => "Reason for and more info about your most recent death",
    },
+   "c/fatal" => {
+      id      => "fatal",
+      title   => "Fatal Error",
+      reply   => undef,
+      tooltip => "Reason for the server disconnect",
+   },
    "c/say"     => $SAY_CHANNEL,
    "c/chat"    => $CHAT_CHANNEL,
 );
 sub cf::client::send_msg {
    $self->send_packet ($self->{query_queue}[0][0])
       if @{ $self->{query_queue} } == 1;
    1
+}
+=item $client->update_command_faces
+=cut
+our %COMMAND_FACE;
+sub cf::client::update_command_faces {
+   my ($self) = @_;
+   my @faces = grep $_,
+      $COMMAND_FACE{preferred},
+      $COMMAND_FACE{standard},
+      $COMMAND_FACE{skill},
+      $self->pl->ob->flag (cf::FLAG_WIZ) ? $COMMAND_FACE{dm} : (),
+      $COMMAND_FACE{emote},
+   ;
+   $self->send_face ($_)
+      for @faces;
+   $self->flush_fx;
+   $self->ext_msg (command_list => @faces);
+}
+=item cf::client::set_command_face $type, $commands
+=cut
+sub cf::client::set_command_face {
+   my ($type, $list) = @_;
+   my $idx = &cf::face::set ( #d# ugly forward reference
+      "command_list/$type" => cf::FT_RSRC,
+      JSON::XS->new->utf8->encode ([ sort @$list ])
+   );
+   $COMMAND_FACE{$type} = $idx;
 }
 cf::client->attach (
    on_connect => sub {
       my ($ns) = @_;
       my ($name, $type, $data) = @_;
       my $idx = cf::face::find $name;
       if ($idx) {
-         delete $HASH{cf::face::get_chksum $idx};
+         delete $HASH{cf::face::get_csum $idx};
       } else {
          $idx = cf::face::alloc $name;
       }
       my $hash = cf::face::mangle_csum Digest::MD5::md5 $data;
    cf::face::set
       "res/spell_paths" => FT_RSRC,
       JSON::XS->new->utf8->canonical->encode (
          [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1]
       );
+   # command completion
+   my @commands;
+   for (0..cf::arch::skillvec_size - 1) {
+      my $skill = cf::arch::skillvec $_;
+      my $name  = $skill->name;
+      my $flags = cf::skill_flags $skill->subtype;
+      push @commands, "ready_skill $name" if $flags & (SF_COMBAT | SF_RANGED | SF_GRACE);
+      push @commands, "use_skill $name"   if $flags & (SF_USE    | SF_AUTARK | SF_GRACE);
+   }
+   cf::client::set_command_face skill => \@commands;
 }
 sub reload_treasures {
    load_resource_file "$DATADIR/treasures"
       or die "unable to load treasurelists\n";
    seek $fh, 0, 0;
    print $fh $$;
 }
 sub main_loop {
-   trace "EV::loop starting\n";
+   trace "EV::run starting\n";
    if (1) {
-      EV::loop;
+      EV::run;
    }
-   trace "EV::loop returned\n";
+   trace "EV::run returned\n";
    goto &main_loop unless $REALLY_UNLOOP;
 }
 sub main {
    cf::init_globals; # initialise logging
    # we must not ever block the main coroutine
    $Coro::idle = sub {
       Carp::cluck "FATAL: Coro::idle was called, major BUG, use cf::sync_job!\n";#d#
       (async {
          $Coro::current->{desc} = "IDLE BUG HANDLER";
-         EV::loop EV::LOOP_ONESHOT;
+         EV::run EV::RUN_ONCE;
       })->prio (Coro::PRIO_MAX);
    };
    evthread_start IO::AIO::poll_fileno;

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.602 by root, Sun Nov 11 18:21:21 2012 UTC vs. Revision 1.622 by root, Wed Nov 23 06:05:33 2016 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.602 by root, Sun Nov 11 18:21:21 2012 UTC vs.
Revision 1.622 by root, Wed Nov 23 06:05:33 2016 UTC