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

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.287 by root, Mon Jun 25 05:43:45 2007 UTC vs.
Revision 1.292 by root, Tue Jul 3 00:54:57 2007 UTC

 use Coro::Signal;
 use Coro::Semaphore;
 use Coro::AIO;
 use Coro::Storable;
+use JSON::XS 1.4 ();
 use BDB ();
 use Data::Dumper;
 use Digest::MD5;
 use Fcntl;
 use YAML::Syck ();
       $d =~ s/([\x00-\x07\x09\x0b\x0c\x0e-\x1f])/sprintf "\\x%02x", ord($1)/ge;
       $d
    } || "[unable to dump $_[0]: '$@']";
 }
-use JSON::XS ();
 =item $ref = cf::from_json $json
 Converts a JSON string into the corresponding perl data structure.
 =item $json = cf::to_json $ref
 Converts a perl data structure into its JSON representation.
 =cut
-our $json_coder = JSON::XS->new->convert_blessed->utf8;
+our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
 sub to_json   ($) { $json_coder->encode ($_[0]) }
 sub from_json ($) { $json_coder->decode ($_[0]) }
 =item cf::lock_wait $string
       cf::override;
    },
    on_extcmd => sub {
       my ($pl, $buf) = @_;
-      my $msg = eval { from_json $buf };
+      my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
       if (ref $msg) {
          if (my $cb = $EXTCMD{$msg->{msgtype}}) {
             if (my %reply = $cb->($pl, $msg)) {
                $pl->ext_reply ($msg->{msgid}, %reply);
       # replace G<male|female> tags
       || s{G<([^>|]*)\|([^>]*)>}{
          $self->gender ? $2 : $1
       }ge
       # replace H<hint text>
-      || s/H<([^\>]*)>/<fg name="lightblue">[$1]<\/fg>/g;
+      || s{H<([^\>]*)>}
+          {
+             ("<fg name=\"lightblue\">[$1 (Use hintmode to suppress hints)]</fg>",
+              "<fg name=\"lightblue\">[Hint suppressed, see hintmode]</fg>",
+              "")
+                [$self->{hintmode}]
+          }ge;
    # create single paragraphs (very hackish)
    s/(?<=\S)\n(?=\w)/ /g;
+   # compress some whitespace
+   1 while s/\s*\n\s*\n\s*/\n/;
    $_
+}
+sub hintmode {
+   $_[0]{hintmode} = $_[1] if @_ > 1;
+   $_[0]{hintmode}
 }
 =item $player->ext_reply ($msgid, %msg)
 Sends an ext reply to the player.
 sub ext_reply($$%) {
    my ($self, $id, %msg) = @_;
    $msg{msgid} = $id;
-   $self->send ("ext " . cf::to_json \%msg);
+   $self->send ("ext " . $self->ns->{json_coder}->encode (\%msg));
 }
 =item $player->ext_event ($type, %msg)
 Sends an ext event to the client.
    my ($self, $color, $type, $msg, @extra) = @_;
    $msg = $self->pl->expand_cfpod ($msg);
    if ($self->can_msg) {
-      $self->send_packet ("msg " . cf::to_json [$color, $type, $msg, @extra]);
+      $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $type, $msg, @extra]));
    } else {
       # replace some tags by gcfclient-compatible ones
       for ($msg) {
          1 while
             s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
 sub cf::client::ext_event($$%) {
    my ($self, $type, %msg) = @_;
    $msg{msgtype} = "event_$type";
-   $self->send_packet ("ext " . cf::to_json \%msg);
+   $self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));
 }
 =item $success = $client->query ($flags, "text", \&cb)
 Queues a query to the client, calling the given callback with
    1
 }
 cf::client->attach (
+   on_connect => sub {
+      my ($ns) = @_;
+      $ns->{json_coder} = JSON::XS->new->utf8->max_size (1e6)->convert_blessed;
+   },
    on_reply => sub {
       my ($ns, $msg) = @_;
       # this weird shuffling is so that direct followup queries
       # get handled first
       }
    },
    on_exticmd => sub {
       my ($ns, $buf) = @_;
-      my $msg = eval { from_json $buf };
+      my $msg = eval { $ns->{json_coder}->decode ($buf) };
       if (ref $msg) {
          if (my $cb = $EXTICMD{$msg->{msgtype}}) {
             if (my %reply = $cb->($ns, $msg)) {
                $reply{msgid} = $msg->{msgid};
-               $ns->send ("ext " . cf::to_json \%reply);
+               $ns->send ("ext " . $ns->{json_coder}->encode (\%reply));
             }
          }
       } else {
          warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
       }
    load_facedata "$DATADIR/facedata"
       or die "unable to load facedata\n";
 }
 sub reload_archetypes {
+   load_resource_file "$DATADIR/archetypes"
+      or die "unable to load archetypes\n";
+   #d# NEED to laod twice to resolve forward references
+   # this really needs to be done in an extra post-pass
+   # (which needs to be synchronous, so solve it differently)
    load_resource_file "$DATADIR/archetypes"
       or die "unable to load archetypes\n";
 }
 sub reload_treasures {

Diff Legend

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

Comparing deliantra/server/lib/cf.pm (file contents): Revision 1.287 by root, Mon Jun 25 05:43:45 2007 UTC vs. Revision 1.292 by root, Tue Jul 3 00:54:57 2007 UTC

Diff Legend

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.287 by root, Mon Jun 25 05:43:45 2007 UTC vs.
Revision 1.292 by root, Tue Jul 3 00:54:57 2007 UTC