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.603 by root, Tue Nov 13 01:12:23 2012 UTC vs.
Revision 1.614 by root, Mon Nov 26 15:12:16 2012 UTC

… …
597 my $busy; 597 my $busy;
598 598
599 while () { 599 while () {
600 next_job: 600 next_job:
601 601
602 Coro::cede;
603
602 my $avail = cf::till_tick; 604 my $avail = cf::till_tick;
603 605
604 for (0 .. $#SLOT_QUEUE) { 606 for (0 .. $#SLOT_QUEUE) {
605 if ($SLOT_QUEUE[$_][0] <= $avail) { 607 if ($SLOT_QUEUE[$_][0] <= $avail) {
606 $busy = 0; 608 $busy = 0;
607 my $job = splice @SLOT_QUEUE, $_, 1, (); 609 my $job = splice @SLOT_QUEUE, $_, 1, ();
608 $job->[2]->send; 610 $job->[2]->send;
609 Coro::cede;
610 goto next_job; 611 goto next_job;
611 } else { 612 } else {
612 $SLOT_QUEUE[$_][0] *= $SLOT_DECAY; 613 $SLOT_QUEUE[$_][0] *= $SLOT_DECAY;
613 } 614 }
614 } 615 }
615 616
616 if (@SLOT_QUEUE) { 617 if (@SLOT_QUEUE) {
617 # we do not use wait_for_tick() as it returns immediately when tick is inactive 618 wait_for_tick;
618 $WAIT_FOR_TICK->wait;
619 } else { 619 } else {
620 $busy = 0; 620 $busy = 0;
621 Coro::schedule; 621 Coro::schedule;
622 } 622 }
623 } 623 }
… …
2742=item $player_object->may ("access") 2742=item $player_object->may ("access")
2743 2743
2744Returns wether the given player is authorized to access resource "access" 2744Returns wether the given player is authorized to access resource "access"
2745(e.g. "command_wizcast"). 2745(e.g. "command_wizcast").
2746 2746
2747This is implemented by checking a config setting of C<may_access> where
2748C<access> is replaced by the access string. The following alternatives are
2749possible (and are tested in order):
2750
2751=over 4
2752
2753=item * Player is DM
2754
2755The request will succeed.
2756
2757=item * may_access is an array reference
2758
2759If either the player nickname or UUID is in the array, the request will
2760succeed, otherwise it will fail.
2761
2762=item * may_access is a true value
2763
2764The request will succeed.
2765
2766=item * may_access is missing or false
2767
2768The request will fail.
2769
2770=back
2771
2747=cut 2772=cut
2748 2773
2749sub cf::object::player::may { 2774sub cf::object::player::may {
2750 my ($self, $access) = @_; 2775 my ($self, $access) = @_;
2751 2776
2752 $self->flag (cf::FLAG_WIZ) || 2777 $self->flag (cf::FLAG_WIZ) ||
2753 (ref $cf::CFG{"may_$access"} 2778 (ref $cf::CFG{"may_$access"}
2754 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 2779 ? scalar grep $self->name eq $_ || $self->uuid eq $_, @{$cf::CFG{"may_$access"}}
2755 : $cf::CFG{"may_$access"}) 2780 : $cf::CFG{"may_$access"})
2756} 2781}
2757 2782
2758=item $player_object->enter_link 2783=item $player_object->enter_link
2759 2784
… …
3042 3067
3043=head3 cf::client 3068=head3 cf::client
3044 3069
3045=over 4 3070=over 4
3046 3071
3047=item $client->send_drawinfo ($text, $flags)
3048
3049Sends a drawinfo packet to the client. Circumvents output buffering so
3050should not be used under normal circumstances.
3051
3052=cut
3053
3054sub cf::client::send_drawinfo {
3055 my ($self, $text, $flags) = @_;
3056
3057 utf8::encode $text;
3058 $self->send_packet (sprintf "drawinfo %d %s", $flags || cf::NDI_BLACK, $text);
3059}
3060
3061=item $client->send_big_packet ($pkt) 3072=item $client->send_big_packet ($pkt)
3062 3073
3063Like C<send_packet>, but tries to compress large packets, and fragments 3074Like C<send_packet>, but tries to compress large packets, and fragments
3064them as required. 3075them as required.
3065 3076
… …
3083 $self->send_packet ($pkt); 3094 $self->send_packet ($pkt);
3084} 3095}
3085 3096
3086=item $client->send_msg ($channel, $msg, $color, [extra...]) 3097=item $client->send_msg ($channel, $msg, $color, [extra...])
3087 3098
3088Send a drawinfo or msg packet to the client, formatting the msg for the 3099Send a msg packet to the client, formatting the msg for the client if
3089client if neccessary. C<$type> should be a string identifying the type of 3100necessary. C<$type> should be a string identifying the type of the
3090the message, with C<log> being the default. If C<$color> is negative, suppress 3101message, with C<log> being the default. If C<$color> is negative, suppress
3091the message unless the client supports the msg packet. 3102the message unless the client supports the msg packet.
3092 3103
3093=cut 3104=cut
3094 3105
3095# non-persistent channels (usually the info channel) 3106# non-persistent channels (usually the info channel)
… …
3200 id => "death", 3211 id => "death",
3201 title => "Death", 3212 title => "Death",
3202 reply => undef, 3213 reply => undef,
3203 tooltip => "Reason for and more info about your most recent death", 3214 tooltip => "Reason for and more info about your most recent death",
3204 }, 3215 },
3216 "c/fatal" => {
3217 id => "fatal",
3218 title => "Fatal Error",
3219 reply => undef,
3220 tooltip => "Reason for the server disconnect",
3221 },
3205 "c/say" => $SAY_CHANNEL, 3222 "c/say" => $SAY_CHANNEL,
3206 "c/chat" => $CHAT_CHANNEL, 3223 "c/chat" => $CHAT_CHANNEL,
3207); 3224);
3208 3225
3209sub cf::client::send_msg { 3226sub cf::client::send_msg {
… …
3282 3299
3283 $self->send_packet ($self->{query_queue}[0][0]) 3300 $self->send_packet ($self->{query_queue}[0][0])
3284 if @{ $self->{query_queue} } == 1; 3301 if @{ $self->{query_queue} } == 1;
3285 3302
3286 1 3303 1
3304}
3305
3306=item $client->update_command_faces
3307
3308=cut
3309
3310our %COMMAND_FACE;
3311
3312sub cf::client::update_command_faces {
3313 my ($self) = @_;
3314
3315 my @faces = grep $_,
3316 $COMMAND_FACE{preferred},
3317 $COMMAND_FACE{standard},
3318 $COMMAND_FACE{skill},
3319 $self->pl->ob->flag (cf::FLAG_WIZ) ? $COMMAND_FACE{dm} : (),
3320 $COMMAND_FACE{emote},
3321 ;
3322
3323 $self->send_face ($_)
3324 for @faces;
3325 $self->flush_fx;
3326
3327 $self->ext_msg (command_list => @faces);
3328}
3329
3330=item cf::client::set_command_face $type, $commands
3331
3332=cut
3333
3334sub cf::client::set_command_face {
3335 my ($type, $list) = @_;
3336
3337 my $idx = &cf::face::set ( #d# ugly forward reference
3338 "command_list/$type" => cf::FT_RSRC,
3339 JSON::XS->new->utf8->encode ([ sort @$list ])
3340 );
3341
3342 $COMMAND_FACE{$type} = $idx;
3287} 3343}
3288 3344
3289cf::client->attach ( 3345cf::client->attach (
3290 on_connect => sub { 3346 on_connect => sub {
3291 my ($ns) = @_; 3347 my ($ns) = @_;
… …
3532 my ($name, $type, $data) = @_; 3588 my ($name, $type, $data) = @_;
3533 3589
3534 my $idx = cf::face::find $name; 3590 my $idx = cf::face::find $name;
3535 3591
3536 if ($idx) { 3592 if ($idx) {
3537 delete $HASH{cf::face::get_chksum $idx}; 3593 delete $HASH{cf::face::get_csum $idx};
3538 } else { 3594 } else {
3539 $idx = cf::face::alloc $name; 3595 $idx = cf::face::alloc $name;
3540 } 3596 }
3541 3597
3542 my $hash = cf::face::mangle_csum Digest::MD5::md5 $data; 3598 my $hash = cf::face::mangle_csum Digest::MD5::md5 $data;
… …
3757 cf::face::set 3813 cf::face::set
3758 "res/spell_paths" => FT_RSRC, 3814 "res/spell_paths" => FT_RSRC,
3759 JSON::XS->new->utf8->canonical->encode ( 3815 JSON::XS->new->utf8->canonical->encode (
3760 [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1] 3816 [map [cf::spellpathnames ($_)], 0 .. NRSPELLPATHS - 1]
3761 ); 3817 );
3818
3819 # command completion
3820 my @commands;
3821
3822 for (0..cf::arch::skillvec_size - 1) {
3823 my $skill = cf::arch::skillvec $_;
3824 my $name = $skill->name;
3825 my $flags = cf::skill_flags $skill->subtype;
3826
3827 push @commands, "ready_skill $name" if $flags & (SF_COMBAT | SF_RANGED | SF_GRACE);
3828 push @commands, "use_skill $name" if $flags & (SF_USE | SF_AUTARK | SF_GRACE);
3829 }
3830
3831 cf::client::set_command_face skill => \@commands;
3762} 3832}
3763 3833
3764sub reload_treasures { 3834sub reload_treasures {
3765 load_resource_file "$DATADIR/treasures" 3835 load_resource_file "$DATADIR/treasures"
3766 or die "unable to load treasurelists\n"; 3836 or die "unable to load treasurelists\n";

Diff Legend

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