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.94 by root, Thu Dec 21 23:02:54 2006 UTC vs.
Revision 1.95 by root, Fri Dec 22 02:04:20 2006 UTC

… …
758 758
759=head2 CORE EXTENSIONS 759=head2 CORE EXTENSIONS
760 760
761Functions and methods that extend core crossfire objects. 761Functions and methods that extend core crossfire objects.
762 762
763=head3 cf::player
764
763=over 4 765=over 4
764 766
765=item cf::player::exists $login 767=item cf::player::exists $login
766 768
767Returns true when the given account exists. 769Returns true when the given account exists.
… …
771sub cf::player::exists($) { 773sub cf::player::exists($) {
772 cf::player::find $_[0] 774 cf::player::find $_[0]
773 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 775 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
774} 776}
775 777
778=item $player->ext_reply ($msgid, $msgtype, %msg)
779
780Sends an ext reply to the player.
781
782=cut
783
784sub cf::player::ext_reply($$$%) {
785 my ($self, $id, %msg) = @_;
786
787 $msg{msgid} = $id;
788
789 $self->send ("ext " . to_json \%msg);
790}
791
792=back
793
794=head3 cf::object::player
795
796=over 4
797
776=item $player_object->reply ($npc, $msg[, $flags]) 798=item $player_object->reply ($npc, $msg[, $flags])
777 799
778Sends a message to the player, as if the npc C<$npc> replied. C<$npc> 800Sends a message to the player, as if the npc C<$npc> replied. C<$npc>
779can be C<undef>. Does the right thing when the player is currently in a 801can be C<undef>. Does the right thing when the player is currently in a
780dialogue with the given NPC character. 802dialogue with the given NPC character.
781 803
782=cut 804=cut
783 805
784# rough implementation of a future "reply" method that works 806# rough implementation of a future "reply" method that works
785# with dialog boxes. 807# with dialog boxes.
808#TODO: the first argument must go, split into a $npc->reply_to ( method
786sub cf::object::player::reply($$$;$) { 809sub cf::object::player::reply($$$;$) {
787 my ($self, $npc, $msg, $flags) = @_; 810 my ($self, $npc, $msg, $flags) = @_;
788 811
789 $flags = cf::NDI_BROWN | cf::NDI_UNIQUE unless @_ >= 4; 812 $flags = cf::NDI_BROWN | cf::NDI_UNIQUE unless @_ >= 4;
790 813
… …
794 $msg = $npc->name . " says: $msg" if $npc; 817 $msg = $npc->name . " says: $msg" if $npc;
795 $self->message ($msg, $flags); 818 $self->message ($msg, $flags);
796 } 819 }
797} 820}
798 821
799=item $player->ext_reply ($msgid, $msgtype, %msg)
800
801Sends an ext reply to the player.
802
803=cut
804
805sub cf::player::ext_reply($$$%) {
806 my ($self, $id, %msg) = @_;
807
808 $msg{msgid} = $id;
809
810 $self->send ("ext " . to_json \%msg);
811}
812
813=item $player_object->may ("access") 822=item $player_object->may ("access")
814 823
815Returns wether the given player is authorized to access resource "access" 824Returns wether the given player is authorized to access resource "access"
816(e.g. "command_wizcast"). 825(e.g. "command_wizcast").
817 826
… …
824 (ref $cf::CFG{"may_$access"} 833 (ref $cf::CFG{"may_$access"}
825 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} 834 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
826 : $cf::CFG{"may_$access"}) 835 : $cf::CFG{"may_$access"})
827} 836}
828 837
829=cut 838=head3 cf::client
830 839
831############################################################################# 840=over 4
841
842=item $client->send_drawinfo ($text, $flags)
843
844Sends a drawinfo packet to the client. Circumvents output buffering so
845should not be used under normal circumstances.
846
847=cut
848
849sub cf::client::send_drawinfo {
850 my ($self, $text, $flags) = @_;
851
852 utf8::encode $text;
853 $self->send_packet (sprintf "drawinfo %d %s", $flags, $text);
854}
855
856
857=item $success = $client->query ($flags, "text", \&cb)
858
859Queues a query to the client, calling the given callback with
860the reply text on a reply. flags can be C<cf::CS_QUERY_YESNO>,
861C<cf::CS_QUERY_SINGLECHAR> or C<cf::CS_QUERY_HIDEINPUT> or C<0>.
862
863Queries can fail, so check the return code. Or don't, as queries will become
864reliable at some point in the future.
865
866=cut
867
868sub cf::client::query {
869 my ($self, $flags, $text, $cb) = @_;
870
871 return unless $self->state == ST_PLAYING
872 || $self->state == ST_SETUP
873 || $self->state == ST_CUSTOM;
874
875 $self->state (ST_CUSTOM);
876
877 utf8::encode $text;
878 push @{ $self->{query_queue} }, [(sprintf "query %d %s", $flags, $text), $cb];
879
880 $self->send_packet ($self->{query_queue}[0][0])
881 if @{ $self->{query_queue} } == 1;
882}
883
884cf::client->attach (
885 on_reply => sub {
886 my ($ns, $msg) = @_;
887
888 # this weird shuffling is so that direct followup queries
889 # get handled first
890 my $queue = delete $ns->{query_queue};
891
892 (shift @$queue)->[1]->($msg);
893
894 push @{ $ns->{query_queue} }, @$queue;
895
896 if (@{ $ns->{query_queue} } == @$queue) {
897 if (@$queue) {
898 $ns->send_packet ($ns->{query_queue}[0][0]);
899 } else {
900 $ns->state (ST_PLAYING);
901 }
902 }
903 },
904);
905
906=back
907
832 908
833=head2 SAFE SCRIPTING 909=head2 SAFE SCRIPTING
834 910
835Functions that provide a safe environment to compile and execute 911Functions that provide a safe environment to compile and execute
836snippets of perl code without them endangering the safety of the server 912snippets of perl code without them endangering the safety of the server

Diff Legend

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