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.84 by root, Mon Dec 11 02:54:57 2006 UTC

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

Diff Legend

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