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.314 by root, Mon Jul 23 16:53:15 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
… …
316 }; 322 };
317 $TICK_WATCHER->stop; 323 $TICK_WATCHER->stop;
318 $guard 324 $guard
319} 325}
320 326
327=item cf::get_slot $time[, $priority]
328
329Allocate $time seconds of blocking CPU time at priority C<$priority>:
330This call blocks and returns only when you have at least C<$time> seconds
331of cpu time till the next tick. The slot is only valid till the next cede.
332
333Useful for short background jobs.
334
335=cut
336
337our @SLOT_QUEUE;
338our $SLOT_QUEUE;
339
340$SLOT_QUEUE->cancel if $SLOT_QUEUE;
341$SLOT_QUEUE = Coro::async {
342 my $signal = new Coro::Signal;
343
344 while () {
345 next_job:
346 my $avail = cf::till_tick;
347 if ($avail > 0.01) {
348 for (0 .. $#SLOT_QUEUE) {
349 if ($SLOT_QUEUE[$_][0] < $avail) {
350 my $job = splice @SLOT_QUEUE, $_, 1, ();
351 $job->[2]->send;
352 Coro::cede;
353 goto next_job;
354 }
355 }
356 }
357
358 if (@SLOT_QUEUE) {
359 # we do not use wait_For_tick() as it returns immediately when tick is inactive
360 push @cf::WAIT_FOR_TICK, $signal;
361 $signal->wait;
362 } else {
363 Coro::schedule;
364 }
365 }
366};
367
368sub get_slot($;$) {
369 my ($time, $pri) = @_;
370
371 push @SLOT_QUEUE, [$time, $pri, my $sig = new Coro::Signal];
372 @SLOT_QUEUE = sort { $b->[1] <=> $a->[1] } @SLOT_QUEUE;
373 $SLOT_QUEUE->ready;
374 $sig->wait;
375}
376
321=item cf::async { BLOCK } 377=item cf::async { BLOCK }
322 378
323Currently the same as Coro::async_pool, meaning you cannot use 379Currently the same as Coro::async_pool, meaning you cannot use
324C<on_destroy>, C<join> or other gimmicks on these coroutines. The only 380C<on_destroy>, C<join> or other gimmicks on these coroutines. The only
325thing you are allowed to do is call C<prio> on it. 381thing you are allowed to do is call C<prio> on it.
… …
866 "; 922 ";
867 die if $@; 923 die if $@;
868} 924}
869 925
870our $override; 926our $override;
871our @invoke_results = (); # referenced from .xs code. TODO: play tricks with reify and mortals? 927our @INVOKE_RESULTS = (); # referenced from .xs code. TODO: play tricks with reify and mortals?
872 928
873sub override { 929sub override {
874 $override = 1; 930 $override = 1;
875 @invoke_results = (); 931 @INVOKE_RESULTS = (@_);
876} 932}
877 933
878sub do_invoke { 934sub do_invoke {
879 my $event = shift; 935 my $event = shift;
880 my $callbacks = shift; 936 my $callbacks = shift;
881 937
882 @invoke_results = (); 938 @INVOKE_RESULTS = ();
883 939
884 local $override; 940 local $override;
885 941
886 for (@$callbacks) { 942 for (@$callbacks) {
887 eval { &{$_->[1]} }; 943 eval { &{$_->[1]} };
… …
904 960
905Generate an object-specific event with the given arguments. 961Generate an object-specific event with the given arguments.
906 962
907This API is preliminary (most likely, the EVENT_CLASS_xxx prefix will be 963This 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 964removed in future versions), and there is no public API to access override
909results (if you must, access C<@cf::invoke_results> directly). 965results (if you must, access C<@cf::INVOKE_RESULTS> directly).
910 966
911=back 967=back
912 968
913=cut 969=cut
914 970
915############################################################################# 971#############################################################################
916# object support 972# object support
973#
974
975sub _can_merge {
976 my ($ob1, $ob2) = @_;
977
978 local $Storable::canonical = 1;
979 my $fob1 = Storable::freeze $ob1;
980 my $fob2 = Storable::freeze $ob2;
981
982 $fob1 eq $fob2
983}
917 984
918sub reattach { 985sub reattach {
919 # basically do the same as instantiate, without calling instantiate 986 # basically do the same as instantiate, without calling instantiate
920 my ($obj) = @_; 987 my ($obj) = @_;
921 988
… …
2419 2486
2420 utf8::encode $text; 2487 utf8::encode $text;
2421 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text); 2488 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
2422} 2489}
2423 2490
2424=item $client->send_msg ($color, $type, $msg, [extra...]) 2491=item $client->send_msg ($channel, $msg, $color, [extra...])
2425 2492
2426Send a drawinfo or msg packet to the client, formatting the msg for the 2493Send 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 2494client 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 2495the message, with C<log> being the default. If C<$color> is negative, suppress
2429the message unless the client supports the msg packet. 2496the message unless the client supports the msg packet.
2430 2497
2431=cut 2498=cut
2432 2499
2433sub cf::client::send_msg { 2500sub cf::client::send_msg {
2434 my ($self, $color, $type, $msg, @extra) = @_; 2501 my ($self, $channel, $msg, $color, @extra) = @_;
2435 2502
2436 $msg = $self->pl->expand_cfpod ($msg); 2503 $msg = $self->pl->expand_cfpod ($msg);
2437 2504
2505 $color &= ~cf::NDI_UNIQUE; # just in case...
2506
2507 if (ref $channel) {
2508 # send meta info to client, if not yet sent
2509 unless (exists $self->{channel}{$channel->{id}}) {
2510 $self->{channel}{$channel->{id}} = $channel;
2511 $self->ext_event (channel_info => %$channel);
2512 }
2513
2514 $channel = $channel->{id};
2515 }
2516
2438 return unless @extra || length $msg; 2517 return unless @extra || length $msg;
2439 2518
2440 if ($self->can_msg) { 2519 if ($self->can_msg) {
2441 $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $type, $msg, @extra])); 2520 $self->send_packet ("msg " . $self->{json_coder}->encode ([$color, $channel, $msg, @extra]));
2442 } else { 2521 } else {
2443 # replace some tags by gcfclient-compatible ones 2522 # replace some tags by gcfclient-compatible ones
2444 for ($msg) { 2523 for ($msg) {
2445 1 while 2524 1 while
2446 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/ 2525 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/

Diff Legend

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