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.308 by root, Mon Jul 16 14:09:40 2007 UTC vs.
Revision 1.313 by root, Sun Jul 22 14:17:58 2007 UTC

… …
166=item cf::wait_for_tick, cf::wait_for_tick_begin 166=item cf::wait_for_tick, cf::wait_for_tick_begin
167 167
168These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only 168These are functions that inhibit the current coroutine one tick. cf::wait_for_tick_begin only
169returns directly I<after> the tick processing (and consequently, can only wake one process 169returns directly I<after> the tick processing (and consequently, can only wake one process
170per tick), while cf::wait_for_tick wakes up all waiters after tick processing. 170per tick), while cf::wait_for_tick wakes up all waiters after tick processing.
171
172=item @cf::INVOKE_RESULTS
173
174This array contains the results of the last C<invoke ()> call. When
175C<cf::override> is called C<@cf::INVOKE_RESULTS> is set to the parameters of
176that call.
171 177
172=back 178=back
173 179
174=cut 180=cut
175 181
… …
866 "; 872 ";
867 die if $@; 873 die if $@;
868} 874}
869 875
870our $override; 876our $override;
871our @invoke_results = (); # referenced from .xs code. TODO: play tricks with reify and mortals? 877our @INVOKE_RESULTS = (); # referenced from .xs code. TODO: play tricks with reify and mortals?
872 878
873sub override { 879sub override {
874 $override = 1; 880 $override = 1;
875 @invoke_results = (); 881 @INVOKE_RESULTS = (@_);
876} 882}
877 883
878sub do_invoke { 884sub do_invoke {
879 my $event = shift; 885 my $event = shift;
880 my $callbacks = shift; 886 my $callbacks = shift;
881 887
882 @invoke_results = (); 888 @INVOKE_RESULTS = ();
883 889
884 local $override; 890 local $override;
885 891
886 for (@$callbacks) { 892 for (@$callbacks) {
887 eval { &{$_->[1]} }; 893 eval { &{$_->[1]} };
… …
904 910
905Generate an object-specific event with the given arguments. 911Generate an object-specific event with the given arguments.
906 912
907This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be 913This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be
908removed in future versions), and there is no public API to access override 914removed in future versions), and there is no public API to access override
909results (if you must, access C<@cf::invoke_results> directly). 915results (if you must, access C<@cf::INVOKE_RESULTS> directly).
910 916
911=back 917=back
912 918
913=cut 919=cut
914 920
915############################################################################# 921#############################################################################
916# object support 922# object support
923#
924
925sub _can_merge {
926 my ($ob1, $ob2) = @_;
927
928 local $Storable::canonical = 1;
929 my $fob1 = Storable::freeze $ob1;
930 my $fob2 = Storable::freeze $ob2;
931
932 $fob1 eq $fob2
933}
917 934
918sub reattach { 935sub reattach {
919 # basically do the same as instantiate, without calling instantiate 936 # basically do the same as instantiate, without calling instantiate
920 my ($obj) = @_; 937 my ($obj) = @_;
921 938
… …
2419 2436
2420 utf8::encode $text; 2437 utf8::encode $text;
2421 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text); 2438 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
2422} 2439}
2423 2440
2424=item $client->send_msg ($color, $type, $msg, [extra...]) 2441=item $client->send_msg ($channel, $msg, $color, [extra...])
2425 2442
2426Send a drawinfo or msg packet to the client, formatting the msg for the 2443Send a drawinfo or msg packet to the client, formatting the msg for the
2427client if neccessary. C<$type> should be a string identifying the type of 2444client if neccessary. C<$type> should be a string identifying the type of
2428the message, with C<log> being the default. If C<$color> is negative, suppress 2445the message, with C<log> being the default. If C<$color> is negative, suppress
2429the message unless the client supports the msg packet. 2446the message unless the client supports the msg packet.
2430 2447
2431=cut 2448=cut
2432 2449
2433sub cf::client::send_msg { 2450sub cf::client::send_msg {
2434 my ($self, $color, $type, $msg, @extra) = @_; 2451 my ($self, $channel, $msg, $color, @extra) = @_;
2435 2452
2436 $msg = $self->pl->expand_cfpod ($msg); 2453 $msg = $self->pl->expand_cfpod ($msg);
2437 2454
2455 $color &= ~cf::NDI_UNIQUE; # just in case...
2456
2457 if (ref $channel) {
2458 # send meta info to client, if not yet sent
2459 unless (exists $self->{channel}{$channel->{id}}) {
2460 $self->{channel}{$channel->{id}} = $channel;
2461 $self->ext_event (channel_info => %$channel);
2462 }
2463
2464 $channel = $channel->{id};
2465 }
2466
2438 return unless @extra || length $msg; 2467 return unless @extra || length $msg;
2439 2468
2440 if ($self->can_msg) { 2469 if ($self->can_msg) {
2441 $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $type, $msg, @extra])); 2470 $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $channel, $msg, @extra]));
2442 } else { 2471 } else {
2443 # replace some tags by gcfclient-compatible ones 2472 # replace some tags by gcfclient-compatible ones
2444 for ($msg) { 2473 for ($msg) {
2445 1 while 2474 1 while
2446 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/ 2475 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/

Diff Legend

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