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

Diff Legend

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