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.457 by root, Wed Oct 1 05:50:19 2008 UTC vs.
Revision 1.465 by root, Thu Jan 8 00:54:55 2009 UTC

… …
32use Opcode; 32use Opcode;
33use Safe; 33use Safe;
34use Safe::Hole; 34use Safe::Hole;
35use Storable (); 35use Storable ();
36 36
37use Guard ();
37use Coro (); 38use Coro ();
38use Coro::State; 39use Coro::State;
39use Coro::Handle; 40use Coro::Handle;
40use Coro::EV; 41use Coro::EV;
41use Coro::AnyEvent; 42use Coro::AnyEvent;
42use Coro::Timer; 43use Coro::Timer;
43use Coro::Signal; 44use Coro::Signal;
44use Coro::Semaphore; 45use Coro::Semaphore;
46use Coro::SemaphoreSet;
45use Coro::AnyEvent; 47use Coro::AnyEvent;
46use Coro::AIO; 48use Coro::AIO;
47use Coro::BDB 1.6; 49use Coro::BDB 1.6;
48use Coro::Storable; 50use Coro::Storable;
49use Coro::Util (); 51use Coro::Util ();
… …
330Wait until the given lock is available. See cf::lock_acquire. 332Wait until the given lock is available. See cf::lock_acquire.
331 333
332=item my $lock = cf::lock_acquire $string 334=item my $lock = cf::lock_acquire $string
333 335
334Wait until the given lock is available and then acquires it and returns 336Wait until the given lock is available and then acquires it and returns
335a Coro::guard object. If the guard object gets destroyed (goes out of scope, 337a L<Guard> object. If the guard object gets destroyed (goes out of scope,
336for example when the coroutine gets canceled), the lock is automatically 338for example when the coroutine gets canceled), the lock is automatically
337returned. 339returned.
338 340
339Locks are *not* recursive, locking from the same coro twice results in a 341Locks are *not* recursive, locking from the same coro twice results in a
340deadlocked coro. 342deadlocked coro.
… …
346 348
347Return true if the lock is currently active, i.e. somebody has locked it. 349Return true if the lock is currently active, i.e. somebody has locked it.
348 350
349=cut 351=cut
350 352
351our %LOCK; 353our $LOCKS = new Coro::SemaphoreSet;
352our %LOCKER;#d#
353 354
354sub lock_wait($) { 355sub lock_wait($) {
355 my ($key) = @_; 356 $LOCKS->wait ($_[0]);
356
357 if ($LOCKER{$key} == $Coro::current) {#d#
358 Carp::cluck "lock_wait($key) for already-acquired lock";#d#
359 return;#d#
360 }#d#
361
362 # wait for lock, if any
363 while ($LOCK{$key}) {
364 #local $Coro::current->{desc} = "$Coro::current->{desc} <waiting for lock $key>";
365 push @{ $LOCK{$key} }, $Coro::current;
366 Coro::schedule;
367 }
368} 357}
369 358
370sub lock_acquire($) { 359sub lock_acquire($) {
371 my ($key) = @_; 360 $LOCKS->guard ($_[0])
372
373 # wait, to be sure we are not locked
374 lock_wait $key;
375
376 $LOCK{$key} = [];
377 $LOCKER{$key} = $Coro::current;#d#
378
379 Coro::guard {
380 delete $LOCKER{$key};#d#
381 # wake up all waiters, to be on the safe side
382 $_->ready for @{ delete $LOCK{$key} };
383 }
384} 361}
385 362
386sub lock_active($) { 363sub lock_active($) {
387 my ($key) = @_; 364 $LOCKS->count ($_[0]) < 1
388
389 ! ! $LOCK{$key}
390} 365}
391 366
392sub freeze_mainloop { 367sub freeze_mainloop {
393 tick_inhibit_inc; 368 tick_inhibit_inc;
394 369
395 Coro::guard \&tick_inhibit_dec; 370 &Guard::guard (\&tick_inhibit_dec);
396} 371}
397 372
398=item cf::periodic $interval, $cb 373=item cf::periodic $interval, $cb
399 374
400Like EV::periodic, but randomly selects a starting point so that the actions 375Like EV::periodic, but randomly selects a starting point so that the actions
… …
1193 aio_rename "$filename~", $filename; 1168 aio_rename "$filename~", $filename;
1194 1169
1195 $filename =~ s%/[^/]+$%%; 1170 $filename =~ s%/[^/]+$%%;
1196 aio_pathsync $filename if $cf::USE_FSYNC; 1171 aio_pathsync $filename if $cf::USE_FSYNC;
1197 } else { 1172 } else {
1198 warn "FATAL: $filename~: $!\n"; 1173 warn "unable to save objects: $filename~: $!\n";
1199 } 1174 }
1200 } else { 1175 } else {
1201 aio_unlink $filename; 1176 aio_unlink $filename;
1202 aio_unlink "$filename.pst"; 1177 aio_unlink "$filename.pst";
1203 } 1178 }
… …
1887 1862
1888 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go; 1863 (my $path = $_[0]{path}) =~ s/\//$PATH_SEP/go;
1889 "$UNIQUEDIR/$path" 1864 "$UNIQUEDIR/$path"
1890} 1865}
1891 1866
1892# and all this just because we cannot iterate over
1893# all maps in C++...
1894sub change_all_map_light {
1895 my ($change) = @_;
1896
1897 $_->change_map_light ($change)
1898 for grep $_->outdoor, values %cf::MAP;
1899}
1900
1901sub decay_objects { 1867sub decay_objects {
1902 my ($self) = @_; 1868 my ($self) = @_;
1903 1869
1904 return if $self->{deny_reset}; 1870 return if $self->{deny_reset};
1905 1871
… …
1987sub find { 1953sub find {
1988 my ($path, $origin) = @_; 1954 my ($path, $origin) = @_;
1989 1955
1990 $path = normalise $path, $origin && $origin->path; 1956 $path = normalise $path, $origin && $origin->path;
1991 1957
1992 cf::lock_wait "map_data:$path";#d#remove 1958 my $guard1 = cf::lock_acquire "map_data:$path";#d#remove
1993 cf::lock_wait "map_find:$path"; 1959 my $guard2 = cf::lock_acquire "map_find:$path";
1994 1960
1995 $cf::MAP{$path} || do { 1961 $cf::MAP{$path} || do {
1996 my $guard1 = cf::lock_acquire "map_data:$path"; # just for the fun of it
1997 my $guard2 = cf::lock_acquire "map_find:$path";
1998
1999 my $map = new_from_path cf::map $path 1962 my $map = new_from_path cf::map $path
2000 or return; 1963 or return;
2001 1964
2002 $map->{last_save} = $cf::RUNTIME; 1965 $map->{last_save} = $cf::RUNTIME;
2003 1966
… …
2070 2033
2071 unless ($self->{deny_activate}) { 2034 unless ($self->{deny_activate}) {
2072 $self->decay_objects; 2035 $self->decay_objects;
2073 $self->fix_auto_apply; 2036 $self->fix_auto_apply;
2074 $self->update_buttons; 2037 $self->update_buttons;
2075 cf::cede_to_tick;
2076 $self->set_darkness_map;
2077 cf::cede_to_tick; 2038 cf::cede_to_tick;
2078 $self->activate; 2039 $self->activate;
2079 } 2040 }
2080 2041
2081 $self->{last_save} = $cf::RUNTIME; 2042 $self->{last_save} = $cf::RUNTIME;
… …
2808 id => "infobox", 2769 id => "infobox",
2809 title => "Body Parts", 2770 title => "Body Parts",
2810 reply => undef, 2771 reply => undef,
2811 tooltip => "Shows which body parts you posess and are available", 2772 tooltip => "Shows which body parts you posess and are available",
2812 }, 2773 },
2774 "c/statistics" => {
2775 id => "infobox",
2776 title => "Statistics",
2777 reply => undef,
2778 tooltip => "Shows your primary statistics",
2779 },
2813 "c/skills" => { 2780 "c/skills" => {
2814 id => "infobox", 2781 id => "infobox",
2815 title => "Skills", 2782 title => "Skills",
2816 reply => undef, 2783 reply => undef,
2817 tooltip => "Shows your experience per skill and item power", 2784 tooltip => "Shows your experience per skill and item power",
2785 },
2786 "c/resistances" => {
2787 id => "infobox",
2788 title => "Resistances",
2789 reply => undef,
2790 tooltip => "Shows your resistances",
2791 },
2792 "c/pets" => {
2793 id => "infobox",
2794 title => "Pets",
2795 reply => undef,
2796 tooltip => "Shows information abotu your pets/a specific pet",
2818 }, 2797 },
2819 "c/uptime" => { 2798 "c/uptime" => {
2820 id => "infobox", 2799 id => "infobox",
2821 title => "Uptime", 2800 title => "Uptime",
2822 reply => undef, 2801 reply => undef,
… …
2832 id => "party", 2811 id => "party",
2833 title => "Party", 2812 title => "Party",
2834 reply => "gsay ", 2813 reply => "gsay ",
2835 tooltip => "Messages and chat related to your party", 2814 tooltip => "Messages and chat related to your party",
2836 }, 2815 },
2816 "c/death" => {
2817 id => "death",
2818 title => "Death",
2819 reply => undef,
2820 tooltip => "Reason for and more info about your most recent death",
2821 },
2822 "c/say" => $SAY_CHANNEL,
2823 "c/chat" => $CHAT_CHANNEL,
2837); 2824);
2838 2825
2839sub cf::client::send_msg { 2826sub cf::client::send_msg {
2840 my ($self, $channel, $msg, $color, @extra) = @_; 2827 my ($self, $channel, $msg, $color, @extra) = @_;
2841 2828
… …
2846 2833
2847 # check predefined channels, for the benefit of C 2834 # check predefined channels, for the benefit of C
2848 if ($CHANNEL{$channel}) { 2835 if ($CHANNEL{$channel}) {
2849 $channel = $CHANNEL{$channel}; 2836 $channel = $CHANNEL{$channel};
2850 2837
2851 $self->ext_msg (channel_info => $channel) 2838 $self->ext_msg (channel_info => $channel);
2852 if $self->can_msg;
2853
2854 $channel = $channel->{id}; 2839 $channel = $channel->{id};
2855 2840
2856 } elsif (ref $channel) { 2841 } elsif (ref $channel) {
2857 # send meta info to client, if not yet sent 2842 # send meta info to client, if not yet sent
2858 unless (exists $self->{channel}{$channel->{id}}) { 2843 unless (exists $self->{channel}{$channel->{id}}) {
2859 $self->{channel}{$channel->{id}} = $channel; 2844 $self->{channel}{$channel->{id}} = $channel;
2860 $self->ext_msg (channel_info => $channel) 2845 $self->ext_msg (channel_info => $channel);
2861 if $self->can_msg;
2862 } 2846 }
2863 2847
2864 $channel = $channel->{id}; 2848 $channel = $channel->{id};
2865 } 2849 }
2866 2850
2867 return unless @extra || length $msg; 2851 return unless @extra || length $msg;
2868 2852
2869 if ($self->can_msg) {
2870 # default colour, mask it out 2853 # default colour, mask it out
2871 $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF) 2854 $color &= ~(cf::NDI_COLOR_MASK | cf::NDI_DEF)
2872 if $color & cf::NDI_DEF; 2855 if $color & cf::NDI_DEF;
2873 2856
2874 my $pkt = "msg " 2857 my $pkt = "msg "
2875 . $self->{json_coder}->encode ( 2858 . $self->{json_coder}->encode (
2876 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra] 2859 [$color & cf::NDI_CLIENT_MASK, $channel, $msg, @extra]
2877 ); 2860 );
2878 2861
2879 # try lzf for large packets 2862 # try lzf for large packets
2880 $pkt = "lzf " . Compress::LZF::compress $pkt 2863 $pkt = "lzf " . Compress::LZF::compress $pkt
2881 if 1024 <= length $pkt and $self->{can_lzf}; 2864 if 1024 <= length $pkt and $self->{can_lzf};
2882 2865
2883 # split very large packets 2866 # split very large packets
2884 if (8192 < length $pkt and $self->{can_lzf}) { 2867 if (8192 < length $pkt and $self->{can_lzf}) {
2885 $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt; 2868 $self->send_packet ("frag $_") for unpack "(a8192)*", $pkt;
2886 $pkt = "frag"; 2869 $pkt = "frag";
2887 } 2870 }
2888 2871
2889 $self->send_packet ($pkt); 2872 $self->send_packet ($pkt);
2890 } else {
2891 if ($color >= 0) {
2892 # replace some tags by gcfclient-compatible ones
2893 for ($msg) {
2894 1 while
2895 s/<b>([^<]*)<\/b>/[b]${1}[\/b]/
2896 || s/<i>([^<]*)<\/i>/[i]${1}[\/i]/
2897 || s/<u>([^<]*)<\/u>/[ul]${1}[\/ul]/
2898 || s/<tt>([^<]*)<\/tt>/[fixed]${1}[\/fixed]/
2899 || s/<fg name=\"([^"]+)\">([^<]*)<\/fg>/[color=$1]${2}[\/color]/;
2900 }
2901
2902 $color &= cf::NDI_COLOR_MASK;
2903
2904 utf8::encode $msg;
2905
2906 if (0 && $msg =~ /\[/) {
2907 # COMMAND/INFO
2908 $self->send_packet ("drawextinfo $color 10 8 $msg")
2909 } else {
2910 $msg =~ s/\[\/?(?:b|i|u|fixed|color)[^\]]*\]//g;
2911 $self->send_packet ("drawinfo $color $msg")
2912 }
2913 }
2914 }
2915} 2873}
2916 2874
2917=item $client->ext_msg ($type, @msg) 2875=item $client->ext_msg ($type, @msg)
2918 2876
2919Sends an ext event to the client. 2877Sends an ext event to the client.
… …
3429 3387
3430 cf::init_experience; 3388 cf::init_experience;
3431 cf::init_anim; 3389 cf::init_anim;
3432 cf::init_attackmess; 3390 cf::init_attackmess;
3433 cf::init_dynamic; 3391 cf::init_dynamic;
3434 cf::init_block;
3435 3392
3436 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority 3393 $Coro::current->prio (Coro::PRIO_MAX); # give the main loop max. priority
3437 3394
3438 # we must not ever block the main coroutine 3395 # we must not ever block the main coroutine
3439 local $Coro::idle = sub { 3396 local $Coro::idle = sub {

Diff Legend

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