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.77 by root, Sun Nov 5 11:13:01 2006 UTC vs.
Revision 1.79 by root, Tue Nov 7 14:58:35 2006 UTC

… …
775sub cf::player::exists($) { 775sub cf::player::exists($) {
776 cf::player::find $_[0] 776 cf::player::find $_[0]
777 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 777 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
778} 778}
779 779
780=item $object->reply ($npc, $msg[, $flags]) 780=item $player_object->reply ($npc, $msg[, $flags])
781 781
782Sends a message to the player, as if the npc C<$npc> replied. C<$npc> 782Sends a message to the player, as if the npc C<$npc> replied. C<$npc>
783can be C<undef>. Does the right thing when the player is currently in a 783can be C<undef>. Does the right thing when the player is currently in a
784dialogue with the given NPC character. 784dialogue with the given NPC character.
785 785
… …
812 $msg{msgid} = $id; 812 $msg{msgid} = $id;
813 813
814 $self->send ("ext " . to_json \%msg); 814 $self->send ("ext " . to_json \%msg);
815} 815}
816 816
817=back 817=item $player_object->may ("access")
818
819Returns wether the given player is authorized to access resource "access"
820(e.g. "command_wizcast").
821
822=cut
823
824sub cf::object::player::may {
825 my ($self, $access) = @_;
826
827 $self->flag (cf::FLAG_WIZ) ||
828 (ref $cf::CFG{"may_$access"}
829 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
830 : $cf::CFG{"may_$access"})
831}
818 832
819=cut 833=cut
820 834
821############################################################################# 835#############################################################################
822 836
… …
824 838
825Functions that provide a safe environment to compile and execute 839Functions that provide a safe environment to compile and execute
826snippets of perl code without them endangering the safety of the server 840snippets of perl code without them endangering the safety of the server
827itself. Looping constructs, I/O operators and other built-in functionality 841itself. Looping constructs, I/O operators and other built-in functionality
828is not available in the safe scripting environment, and the number of 842is not available in the safe scripting environment, and the number of
829functions and methods that cna be called is greatly reduced. 843functions and methods that can be called is greatly reduced.
830 844
831=cut 845=cut
832 846
833our $safe = new Safe "safe"; 847our $safe = new Safe "safe";
834our $safe_hole = new Safe::Hole; 848our $safe_hole = new Safe::Hole;
… …
970 984
971Immediately write the database to disk I<if it is dirty>. 985Immediately write the database to disk I<if it is dirty>.
972 986
973=cut 987=cut
974 988
989our $DB;
990
975{ 991{
976 my $db;
977 my $path = cf::localdir . "/database.pst"; 992 my $path = cf::localdir . "/database.pst";
978 993
979 sub db_load() { 994 sub db_load() {
980 warn "loading database $path\n";#d# remove later 995 warn "loading database $path\n";#d# remove later
981 $db = stat $path ? Storable::retrieve $path : { }; 996 $DB = stat $path ? Storable::retrieve $path : { };
982 } 997 }
983 998
984 my $pid; 999 my $pid;
985 1000
986 sub db_save() { 1001 sub db_save() {
987 warn "saving database $path\n";#d# remove later 1002 warn "saving database $path\n";#d# remove later
988 waitpid $pid, 0 if $pid; 1003 waitpid $pid, 0 if $pid;
989 if (0 == ($pid = fork)) { 1004 if (0 == ($pid = fork)) {
990 $db->{_meta}{version} = 1; 1005 $DB->{_meta}{version} = 1;
991 Storable::nstore $db, "$path~"; 1006 Storable::nstore $DB, "$path~";
992 rename "$path~", $path; 1007 rename "$path~", $path;
993 cf::_exit 0 if defined $pid; 1008 cf::_exit 0 if defined $pid;
994 } 1009 }
995 } 1010 }
996 1011
… …
1010 $idle->start; 1025 $idle->start;
1011 } 1026 }
1012 1027
1013 sub db_get($;$) { 1028 sub db_get($;$) {
1014 @_ >= 2 1029 @_ >= 2
1015 ? $db->{$_[0]}{$_[1]} 1030 ? $DB->{$_[0]}{$_[1]}
1016 : ($db->{$_[0]} ||= { }) 1031 : ($DB->{$_[0]} ||= { })
1017 } 1032 }
1018 1033
1019 sub db_put($$;$) { 1034 sub db_put($$;$) {
1020 if (@_ >= 3) { 1035 if (@_ >= 3) {
1021 $db->{$_[0]}{$_[1]} = $_[2]; 1036 $DB->{$_[0]}{$_[1]} = $_[2];
1022 } else { 1037 } else {
1023 $db->{$_[0]} = $_[1]; 1038 $DB->{$_[0]} = $_[1];
1024 } 1039 }
1025 db_dirty; 1040 db_dirty;
1026 } 1041 }
1027 1042
1028 attach_global 1043 attach_global
… …
1154 cf::server_tick; # one server iteration 1169 cf::server_tick; # one server iteration
1155 1170
1156 my $NOW = Event::time; 1171 my $NOW = Event::time;
1157 $NEXT_TICK += $TICK; 1172 $NEXT_TICK += $TICK;
1158 1173
1159 # if we are delayed by four ticks, skip them all 1174 # if we are delayed by four ticks or more, skip them all
1160 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1175 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
1161 1176
1162 $TICK_WATCHER->at ($NEXT_TICK); 1177 $TICK_WATCHER->at ($NEXT_TICK);
1163 $TICK_WATCHER->start; 1178 $TICK_WATCHER->start;
1164 }, 1179 },
1165); 1180);
1166 1181
1167IO::AIO::max_poll_time $TICK * 0.2; 1182eval { IO::AIO::max_poll_time $TICK * 0.2 }; #d# remove eval after restart
1168 1183
1169Event->io (fd => IO::AIO::poll_fileno, 1184Event->io (fd => IO::AIO::poll_fileno,
1170 poll => 'r', 1185 poll => 'r',
1171 prio => 5, 1186 prio => 5,
1172 cb => \&IO::AIO::poll_cb); 1187 cb => \&IO::AIO::poll_cb);

Diff Legend

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