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.80 by root, Tue Nov 7 16:30:55 2006 UTC

… …
523 unlink $filename; 523 unlink $filename;
524 unlink "$filename.pst"; 524 unlink "$filename.pst";
525 } 525 }
526} 526}
527 527
528sub object_freezer_as_string {
529 my ($rdata, $objs) = @_;
530
531 use Data::Dumper;
532
533 "$$rdata\n" . Dumper $objs
534}
535
528sub object_thawer_load { 536sub object_thawer_load {
529 my ($filename) = @_; 537 my ($filename) = @_;
530 538
531 local $/; 539 local $/;
532 540
… …
775sub cf::player::exists($) { 783sub cf::player::exists($) {
776 cf::player::find $_[0] 784 cf::player::find $_[0]
777 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 785 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
778} 786}
779 787
780=item $object->reply ($npc, $msg[, $flags]) 788=item $player_object->reply ($npc, $msg[, $flags])
781 789
782Sends a message to the player, as if the npc C<$npc> replied. C<$npc> 790Sends 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 791can be C<undef>. Does the right thing when the player is currently in a
784dialogue with the given NPC character. 792dialogue with the given NPC character.
785 793
… …
812 $msg{msgid} = $id; 820 $msg{msgid} = $id;
813 821
814 $self->send ("ext " . to_json \%msg); 822 $self->send ("ext " . to_json \%msg);
815} 823}
816 824
817=back 825=item $player_object->may ("access")
826
827Returns wether the given player is authorized to access resource "access"
828(e.g. "command_wizcast").
829
830=cut
831
832sub cf::object::player::may {
833 my ($self, $access) = @_;
834
835 $self->flag (cf::FLAG_WIZ) ||
836 (ref $cf::CFG{"may_$access"}
837 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
838 : $cf::CFG{"may_$access"})
839}
818 840
819=cut 841=cut
820 842
821############################################################################# 843#############################################################################
822 844
… …
824 846
825Functions that provide a safe environment to compile and execute 847Functions that provide a safe environment to compile and execute
826snippets of perl code without them endangering the safety of the server 848snippets of perl code without them endangering the safety of the server
827itself. Looping constructs, I/O operators and other built-in functionality 849itself. Looping constructs, I/O operators and other built-in functionality
828is not available in the safe scripting environment, and the number of 850is not available in the safe scripting environment, and the number of
829functions and methods that cna be called is greatly reduced. 851functions and methods that can be called is greatly reduced.
830 852
831=cut 853=cut
832 854
833our $safe = new Safe "safe"; 855our $safe = new Safe "safe";
834our $safe_hole = new Safe::Hole; 856our $safe_hole = new Safe::Hole;
… …
970 992
971Immediately write the database to disk I<if it is dirty>. 993Immediately write the database to disk I<if it is dirty>.
972 994
973=cut 995=cut
974 996
997our $DB;
998
975{ 999{
976 my $db;
977 my $path = cf::localdir . "/database.pst"; 1000 my $path = cf::localdir . "/database.pst";
978 1001
979 sub db_load() { 1002 sub db_load() {
980 warn "loading database $path\n";#d# remove later 1003 warn "loading database $path\n";#d# remove later
981 $db = stat $path ? Storable::retrieve $path : { }; 1004 $DB = stat $path ? Storable::retrieve $path : { };
982 } 1005 }
983 1006
984 my $pid; 1007 my $pid;
985 1008
986 sub db_save() { 1009 sub db_save() {
987 warn "saving database $path\n";#d# remove later 1010 warn "saving database $path\n";#d# remove later
988 waitpid $pid, 0 if $pid; 1011 waitpid $pid, 0 if $pid;
989 if (0 == ($pid = fork)) { 1012 if (0 == ($pid = fork)) {
990 $db->{_meta}{version} = 1; 1013 $DB->{_meta}{version} = 1;
991 Storable::nstore $db, "$path~"; 1014 Storable::nstore $DB, "$path~";
992 rename "$path~", $path; 1015 rename "$path~", $path;
993 cf::_exit 0 if defined $pid; 1016 cf::_exit 0 if defined $pid;
994 } 1017 }
995 } 1018 }
996 1019
… …
1010 $idle->start; 1033 $idle->start;
1011 } 1034 }
1012 1035
1013 sub db_get($;$) { 1036 sub db_get($;$) {
1014 @_ >= 2 1037 @_ >= 2
1015 ? $db->{$_[0]}{$_[1]} 1038 ? $DB->{$_[0]}{$_[1]}
1016 : ($db->{$_[0]} ||= { }) 1039 : ($DB->{$_[0]} ||= { })
1017 } 1040 }
1018 1041
1019 sub db_put($$;$) { 1042 sub db_put($$;$) {
1020 if (@_ >= 3) { 1043 if (@_ >= 3) {
1021 $db->{$_[0]}{$_[1]} = $_[2]; 1044 $DB->{$_[0]}{$_[1]} = $_[2];
1022 } else { 1045 } else {
1023 $db->{$_[0]} = $_[1]; 1046 $DB->{$_[0]} = $_[1];
1024 } 1047 }
1025 db_dirty; 1048 db_dirty;
1026 } 1049 }
1027 1050
1028 attach_global 1051 attach_global
… …
1154 cf::server_tick; # one server iteration 1177 cf::server_tick; # one server iteration
1155 1178
1156 my $NOW = Event::time; 1179 my $NOW = Event::time;
1157 $NEXT_TICK += $TICK; 1180 $NEXT_TICK += $TICK;
1158 1181
1159 # if we are delayed by four ticks, skip them all 1182 # if we are delayed by four ticks or more, skip them all
1160 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1183 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
1161 1184
1162 $TICK_WATCHER->at ($NEXT_TICK); 1185 $TICK_WATCHER->at ($NEXT_TICK);
1163 $TICK_WATCHER->start; 1186 $TICK_WATCHER->start;
1164 }, 1187 },

Diff Legend

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