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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.462 by root, Tue Dec 23 06:58:23 2008 UTC vs.
Revision 1.468 by root, Thu Jan 8 19:23:44 2009 UTC

 package cf;
 use 5.10.0;
 use utf8;
-use strict "vars", "subs";
+use strict qw(vars subs);
 use Symbol;
 use List::Util;
 use Socket;
 use EV;
 our $BDB_DEADLOCK_WATCHER;
 our $BDB_CHECKPOINT_WATCHER;
 our $BDB_TRICKLE_WATCHER;
 our $DB_ENV;
+our @EXTRA_MODULES = qw(pod mapscript);
 our %CFG;
 our $UPTIME; $UPTIME ||= time;
 our $RUNTIME;
 our $NOW;
 unless ($RUNTIME || !-e $RUNTIMEFILE) {
    open my $fh, "<", $RUNTIMEFILE
       or die "unable to read $RUNTIMEFILE file: $!";
    $RUNTIME = <$fh> + 0.;
 }
+eval "sub TICK() { $TICK } 1" or die;
 mkdir $_
    for $LOCALDIR, $TMPDIR, $UNIQUEDIR, $PLAYERDIR, $RANDOMDIR, $BDBDIR;
 our $EMERGENCY_POSITION;
 our $SAY_CHANNEL = {
    id      => "say",
    title   => "Map",
    reply   => "say ",
-   tooltip => "Things said to and replied from npcs near you and other players on the same map only.",
+   tooltip => "Things said to and replied from NPCs near you and other players on the same map only.",
 };
 our $CHAT_CHANNEL = {
    id      => "chat",
    title   => "Chat",
       id      => "infobox",
       title   => "Body Parts",
       reply   => undef,
       tooltip => "Shows which body parts you posess and are available",
    },
+   "c/statistics" => {
+      id      => "infobox",
+      title   => "Statistics",
+      reply   => undef,
+      tooltip => "Shows your primary statistics",
+   },
    "c/skills" => {
       id      => "infobox",
       title   => "Skills",
       reply   => undef,
       tooltip => "Shows your experience per skill and item power",
+   },
+   "c/resistances" => {
+      id      => "infobox",
+      title   => "Resistances",
+      reply   => undef,
+      tooltip => "Shows your resistances",
+   },
+   "c/pets" => {
+      id      => "infobox",
+      title   => "Pets",
+      reply   => undef,
+      tooltip => "Shows information abotu your pets/a specific pet",
    },
    "c/uptime" => {
       id      => "infobox",
       title   => "Uptime",
       reply   => undef,
       id      => "party",
       title   => "Party",
       reply   => "gsay ",
       tooltip => "Messages and chat related to your party",
    },
+   "c/death" => {
+      id      => "death",
+      title   => "Death",
+      reply   => undef,
+      tooltip => "Reason for and more info about your most recent death",
+   },
    "c/say"     => $SAY_CHANNEL,
    "c/chat"    => $CHAT_CHANNEL,
 );
 sub cf::client::send_msg {
    # check predefined channels, for the benefit of C
    if ($CHANNEL{$channel}) {
       $channel = $CHANNEL{$channel};
-      $self->ext_msg (channel_info => $channel)
+      $self->ext_msg (channel_info => $channel);
-         if $self->can_msg;
       $channel = $channel->{id};
    } elsif (ref $channel) {
       # send meta info to client, if not yet sent
       unless (exists $self->{channel}{$channel->{id}}) {
          $self->{channel}{$channel->{id}} = $channel;
-         $self->ext_msg (channel_info => $channel)
+         $self->ext_msg (channel_info => $channel);
-            if $self->can_msg;
       }
       $channel = $channel->{id};
    }
    return unless @extra || length $msg;
-   if ($self->can_msg) {
-      # default colour, mask it out
+   # default colour, mask it out
-      $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF)
+   $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF)
-         if $color & cf::NDI_DEF;
+      if $color & cf::NDI_DEF;
-      my $pkt = "msg "
+   my $pkt = "msg "
-                . $self->{json_coder}->encode (
+             . $self->{json_coder}->encode (
-                   [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
+                [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
-                );
+             );
-      # try lzf for large packets
+   # try lzf for large packets
-      $pkt = "lzf " . Compress::LZF::compress $pkt
+   $pkt = "lzf " . Compress::LZF::compress $pkt
-         if 1024 <= length $pkt and $self->{can_lzf};
+      if 1024 <= length $pkt and $self->{can_lzf};
-      # split very large packets
+   # split very large packets
-      if (8192 < length $pkt and $self->{can_lzf}) {
+   if (8192 < length $pkt and $self->{can_lzf}) {
-         $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
+      $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
-         $pkt = "frag";
+      $pkt = "frag";
-      }
+   }
-      $self->send_packet ($pkt);
+   $self->send_packet ($pkt);
-   } else {
-      if ($color >= 0) {
-         # replace some tags by gcfclient-compatible ones
-         for ($msg) {
-            1 while
-               s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
-               || s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
-               || s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
-               || s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
-               || s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
-         }
-         $color &= cf::NDI_COLOR_MASK;
-         utf8::encode $msg;
-         if (0 && $msg =~ /\[/) {
-            # COMMAND/INFO
-            $self->send_packet ("drawextinfo $color 10 8 $msg")
-         } else {
-            $msg =~ s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g;
-            $self->send_packet ("drawinfo $color $msg")
-         }
-      }
-   }
 }
 =item $client->ext_msg ($type, @msg)
 Sends an ext event to the client.
 The following functions and methods are available within a safe environment:
   cf::object
      contr pay_amount pay_player map x y force_find force_add destroy
      insert remove name archname title slaying race decrease split
+     value
   cf::object::player
      player
   cf::player
 =cut
 for (
    ["cf::object"         => qw(contr pay_amount pay_player map force_find force_add x y
                                insert remove inv nrof name archname title slaying race
-                               decrease split destroy change_exp)],
+                               decrease split destroy change_exp value msg lore send_msg)],
    ["cf::object::player" => qw(player)],
-   ["cf::player"         => qw(peaceful)],
+   ["cf::player"         => qw(peaceful send_msg)],
    ["cf::map"            => qw(trigger)],
 ) {
    no strict 'refs';
    my ($pkg, @funs) = @$_;
    *{"safe::$pkg\::$_"} = $safe_hole->wrap (\&{"$pkg\::$_"})
    my ($code, %vars) = @_;
    my $qcode = $code;
    $qcode =~ s/"/‟/g; # not allowed in #line filenames
    $qcode =~ s/\n/\\n/g;
+   %vars = (_dummy => 0) unless %vars;
    local $_;
    local @safe::cf::_safe_eval_args = values %vars;
    my $eval =
          clear_package "safe::$_"
             for qw(cf::attachable cf::object cf::object::player cf::client cf::player cf::map cf::party cf::region);
          warn "unloading cf.pm \"a bit\"";
          delete $INC{"cf.pm"};
-         delete $INC{"cf/pod.pm"};
+         delete $INC{"cf/$_.pm"} for @EXTRA_MODULES;
          # don't, removes xs symbols, too,
          # and global variables created in xs
          #clear_package __PACKAGE__;
       LOG llevInfo, "[ABT] [suppressed]\n";
    }
 }
 # load additional modules
-use cf::pod;
+require "cf/$_.pm" for @EXTRA_MODULES;
 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.462 by root, Tue Dec 23 06:58:23 2008 UTC vs. Revision 1.468 by root, Thu Jan 8 19:23:44 2009 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.462 by root, Tue Dec 23 06:58:23 2008 UTC vs.
Revision 1.468 by root, Thu Jan 8 19:23:44 2009 UTC