ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/lib/cf.pm
(Generate patch)

Comparing deliantra/server/lib/cf.pm (file contents):
Revision 1.289 by root, Sat Jun 30 03:00:54 2007 UTC vs.
Revision 1.296 by root, Wed Jul 4 07:09:06 2007 UTC

… …
248 248
249Converts a perl data structure into its JSON representation. 249Converts a perl data structure into its JSON representation.
250 250
251=cut 251=cut
252 252
253our $json_coder = JSON::XS->new->convert_blessed->utf8->max_size (1e6); # accept ~1mb max 253our $json_coder = JSON::XS->new->utf8->max_size (1e6); # accept ~1mb max
254 254
255sub to_json ($) { $json_coder->encode ($_[0]) } 255sub to_json ($) { $json_coder->encode ($_[0]) }
256sub from_json ($) { $json_coder->decode ($_[0]) } 256sub from_json ($) { $json_coder->decode ($_[0]) }
257 257
258=item cf::lock_wait $string 258=item cf::lock_wait $string
… …
1086 cf::override; 1086 cf::override;
1087 }, 1087 },
1088 on_extcmd => sub { 1088 on_extcmd => sub {
1089 my ($pl, $buf) = @_; 1089 my ($pl, $buf) = @_;
1090 1090
1091 my $msg = eval { from_json $buf }; 1091 my $msg = eval { $pl->ns->{json_coder}->decode ($buf) };
1092 1092
1093 if (ref $msg) { 1093 if (ref $msg) {
1094 if (my $cb = $EXTCMD{$msg->{msgtype}}) { 1094 if (my $cb = $EXTCMD{$msg->{msgtype}}) {
1095 if (my %reply = $cb->($pl, $msg)) { 1095 if (my %reply = $cb->($pl, $msg)) {
1096 $pl->ext_reply ($msg->{msgid}, %reply); 1096 $pl->ext_reply ($msg->{msgid}, %reply);
… …
1400 # replace G<male|female> tags 1400 # replace G<male|female> tags
1401 || s{G<([^>|]*)\|([^>]*)>}{ 1401 || s{G<([^>|]*)\|([^>]*)>}{
1402 $self->gender ? $2 : $1 1402 $self->gender ? $2 : $1
1403 }ge 1403 }ge
1404 # replace H<hint text> 1404 # replace H<hint text>
1405 || s/H<([^\>]*)>/<fg name="lightblue">[$1]<\/fg>/g; 1405 || s{H<([^\>]*)>}
1406 {
1407 ("<fg name=\"lightblue\">[$1 (Use hintmode to suppress hints)]</fg>",
1408 "<fg name=\"lightblue\">[Hint suppressed, see hintmode]</fg>",
1409 "")
1410 [$self->{hintmode}]
1411 }ge;
1406 1412
1407 # create single paragraphs (very hackish) 1413 # create single paragraphs (very hackish)
1408 s/(?<=\S)\n(?=\w)/ /g; 1414 s/(?<=\S)\n(?=\w)/ /g;
1409 1415
1416 # compress some whitespace
1417 s/\s+\n/\n/g; # ws line-ends
1418 s/\n\n+/\n/g; # double lines
1419 s/^\n+//; # beginning lines
1420 s/\n+$//; # ending lines
1421
1410 $_ 1422 $_
1423}
1424
1425sub hintmode {
1426 $_[0]{hintmode} = $_[1] if @_ > 1;
1427 $_[0]{hintmode}
1411} 1428}
1412 1429
1413=item $player->ext_reply ($msgid, %msg) 1430=item $player->ext_reply ($msgid, %msg)
1414 1431
1415Sends an ext reply to the player. 1432Sends an ext reply to the player.
… …
1418 1435
1419sub ext_reply($$%) { 1436sub ext_reply($$%) {
1420 my ($self, $id, %msg) = @_; 1437 my ($self, $id, %msg) = @_;
1421 1438
1422 $msg{msgid} = $id; 1439 $msg{msgid} = $id;
1423 $self->send ("ext " . cf::to_json \%msg); 1440 $self->send ("ext " . $self->ns->{json_coder}->encode (\%msg));
1424} 1441}
1425 1442
1426=item $player->ext_event ($type, %msg) 1443=item $player->ext_event ($type, %msg)
1427 1444
1428Sends an ext event to the client. 1445Sends an ext event to the client.
… …
2340 my $hp = $exit->stats->hp; 2357 my $hp = $exit->stats->hp;
2341 my $sp = $exit->stats->sp; 2358 my $sp = $exit->stats->sp;
2342 2359
2343 $self->enter_link; 2360 $self->enter_link;
2344 2361
2362 # if exit is damned, update players death & WoR home-position
2363 $self->contr->savebed ($slaying, $hp, $sp)
2364 if $exit->flag (FLAG_DAMNED);
2365
2345 (async { 2366 (async {
2346 $self->deactivate_recursive; # just to be sure 2367 $self->deactivate_recursive; # just to be sure
2347 unless (eval { 2368 unless (eval {
2348 $self->goto ($slaying, $hp, $sp); 2369 $self->goto ($slaying, $hp, $sp);
2349 2370
… …
2390sub cf::client::send_msg { 2411sub cf::client::send_msg {
2391 my ($self, $color, $type, $msg, @extra) = @_; 2412 my ($self, $color, $type, $msg, @extra) = @_;
2392 2413
2393 $msg = $self->pl->expand_cfpod ($msg); 2414 $msg = $self->pl->expand_cfpod ($msg);
2394 2415
2416 return unless @extra || length $msg;
2417
2395 if ($self->can_msg) { 2418 if ($self->can_msg) {
2396 $self->send_packet ("msg " . cf::to_json [$color, $type, $msg, @extra]); 2419 $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $type, $msg, @extra]));
2397 } else { 2420 } else {
2398 # replace some tags by gcfclient-compatible ones 2421 # replace some tags by gcfclient-compatible ones
2399 for ($msg) { 2422 for ($msg) {
2400 1 while 2423 1 while
2401 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/ 2424 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
… …
2424 2447
2425sub cf::client::ext_event($$%) { 2448sub cf::client::ext_event($$%) {
2426 my ($self, $type, %msg) = @_; 2449 my ($self, $type, %msg) = @_;
2427 2450
2428 $msg{msgtype} = "event_$type"; 2451 $msg{msgtype} = "event_$type";
2429 $self->send_packet ("ext " . cf::to_json \%msg); 2452 $self->send_packet ("ext " . $self->{json_coder}->encode (\%msg));
2430} 2453}
2431 2454
2432=item $success = $client->query ($flags, "text", \&cb) 2455=item $success = $client->query ($flags, "text", \&cb)
2433 2456
2434Queues a query to the client, calling the given callback with 2457Queues a query to the client, calling the given callback with
… …
2457 2480
2458 1 2481 1
2459} 2482}
2460 2483
2461cf::client->attach ( 2484cf::client->attach (
2485 on_connect => sub {
2486 my ($ns) = @_;
2487
2488 $ns->{json_coder} = JSON::XS->new->utf8->max_size (1e6)->convert_blessed;
2489 },
2462 on_reply => sub { 2490 on_reply => sub {
2463 my ($ns, $msg) = @_; 2491 my ($ns, $msg) = @_;
2464 2492
2465 # this weird shuffling is so that direct followup queries 2493 # this weird shuffling is so that direct followup queries
2466 # get handled first 2494 # get handled first
… …
2481 } 2509 }
2482 }, 2510 },
2483 on_exticmd => sub { 2511 on_exticmd => sub {
2484 my ($ns, $buf) = @_; 2512 my ($ns, $buf) = @_;
2485 2513
2486 my $msg = eval { from_json $buf }; 2514 my $msg = eval { $ns->{json_coder}->decode ($buf) };
2487 2515
2488 if (ref $msg) { 2516 if (ref $msg) {
2489 if (my $cb = $EXTICMD{$msg->{msgtype}}) { 2517 if (my $cb = $EXTICMD{$msg->{msgtype}}) {
2490 if (my %reply = $cb->($ns, $msg)) { 2518 if (my %reply = $cb->($ns, $msg)) {
2491 $reply{msgid} = $msg->{msgid}; 2519 $reply{msgid} = $msg->{msgid};
2492 $ns->send ("ext " . cf::to_json \%reply); 2520 $ns->send ("ext " . $ns->{json_coder}->encode (\%reply));
2493 } 2521 }
2494 } 2522 }
2495 } else { 2523 } else {
2496 warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n"; 2524 warn "client " . ($ns->pl ? $ns->pl->ob->name : $ns->host) . " sent unparseable exti message: <$buf>\n";
2497 } 2525 }

Diff Legend

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