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.72 by root, Sun Oct 1 11:41:37 2006 UTC vs.
Revision 1.82 by root, Sun Dec 3 20:59:52 2006 UTC

… …
5use Storable; 5use Storable;
6use Opcode; 6use Opcode;
7use Safe; 7use Safe;
8use Safe::Hole; 8use Safe::Hole;
9 9
10use IO::AIO ();
10use YAML::Syck (); 11use YAML::Syck ();
11use Time::HiRes; 12use Time::HiRes;
12use Event; 13use Event;
13$Event::Eval = 1; # no idea why this is required, but it is 14$Event::Eval = 1; # no idea why this is required, but it is
14 15
… …
26our $TICK = MAX_TIME * 1e-6; 27our $TICK = MAX_TIME * 1e-6;
27our $TICK_WATCHER; 28our $TICK_WATCHER;
28our $NEXT_TICK; 29our $NEXT_TICK;
29 30
30our %CFG; 31our %CFG;
32
33our $uptime;
34
35$uptime ||= time;
31 36
32############################################################################# 37#############################################################################
33 38
34=head2 GLOBAL VARIABLES 39=head2 GLOBAL VARIABLES
35 40
… …
518 unlink $filename; 523 unlink $filename;
519 unlink "$filename.pst"; 524 unlink "$filename.pst";
520 } 525 }
521} 526}
522 527
528sub object_freezer_as_string {
529 my ($rdata, $objs) = @_;
530
531 use Data::Dumper;
532
533 $$rdata . Dumper $objs
534}
535
523sub object_thawer_load { 536sub object_thawer_load {
524 my ($filename) = @_; 537 my ($filename) = @_;
525 538
526 local $/; 539 local $/;
527 540
… …
629 . "#line 1 \"$path\"\n{\n" 642 . "#line 1 \"$path\"\n{\n"
630 . (do { local $/; <$fh> }) 643 . (do { local $/; <$fh> })
631 . "\n};\n1"; 644 . "\n};\n1";
632 645
633 eval $source 646 eval $source
634 or die "$path: $@"; 647 or die $@ ? "$path: $@\n"
648 : "extension disabled.\n";
635 649
636 push @exts, $pkg; 650 push @exts, $pkg;
637 $ext_pkg{$base} = $pkg; 651 $ext_pkg{$base} = $pkg;
638 652
639# no strict 'refs'; 653# no strict 'refs';
… …
770sub cf::player::exists($) { 784sub cf::player::exists($) {
771 cf::player::find $_[0] 785 cf::player::find $_[0]
772 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;
773} 787}
774 788
775=item $player->reply ($npc, $msg[, $flags]) 789=item $player_object->reply ($npc, $msg[, $flags])
776 790
777Sends 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>
778can 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
779dialogue with the given NPC character. 793dialogue with the given NPC character.
780 794
… …
807 $msg{msgid} = $id; 821 $msg{msgid} = $id;
808 822
809 $self->send ("ext " . to_json \%msg); 823 $self->send ("ext " . to_json \%msg);
810} 824}
811 825
812=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}
813 841
814=cut 842=cut
815 843
816############################################################################# 844#############################################################################
817 845
… …
819 847
820Functions that provide a safe environment to compile and execute 848Functions that provide a safe environment to compile and execute
821snippets of perl code without them endangering the safety of the server 849snippets of perl code without them endangering the safety of the server
822itself. Looping constructs, I/O operators and other built-in functionality 850itself. Looping constructs, I/O operators and other built-in functionality
823is not available in the safe scripting environment, and the number of 851is not available in the safe scripting environment, and the number of
824functions and methods that cna be called is greatly reduced. 852functions and methods that can be called is greatly reduced.
825 853
826=cut 854=cut
827 855
828our $safe = new Safe "safe"; 856our $safe = new Safe "safe";
829our $safe_hole = new Safe::Hole; 857our $safe_hole = new Safe::Hole;
… …
965 993
966Immediately write the database to disk I<if it is dirty>. 994Immediately write the database to disk I<if it is dirty>.
967 995
968=cut 996=cut
969 997
998our $DB;
999
970{ 1000{
971 my $db;
972 my $path = cf::localdir . "/database.pst"; 1001 my $path = cf::localdir . "/database.pst";
973 1002
974 sub db_load() { 1003 sub db_load() {
975 warn "loading database $path\n";#d# remove later 1004 warn "loading database $path\n";#d# remove later
976 $db = stat $path ? Storable::retrieve $path : { }; 1005 $DB = stat $path ? Storable::retrieve $path : { };
977 } 1006 }
978 1007
979 my $pid; 1008 my $pid;
980 1009
981 sub db_save() { 1010 sub db_save() {
982 warn "saving database $path\n";#d# remove later 1011 warn "saving database $path\n";#d# remove later
983 waitpid $pid, 0 if $pid; 1012 waitpid $pid, 0 if $pid;
984 if (0 == ($pid = fork)) { 1013 if (0 == ($pid = fork)) {
985 $db->{_meta}{version} = 1; 1014 $DB->{_meta}{version} = 1;
986 Storable::nstore $db, "$path~"; 1015 Storable::nstore $DB, "$path~";
987 rename "$path~", $path; 1016 rename "$path~", $path;
988 cf::_exit 0 if defined $pid; 1017 cf::_exit 0 if defined $pid;
989 } 1018 }
990 } 1019 }
991 1020
… …
1005 $idle->start; 1034 $idle->start;
1006 } 1035 }
1007 1036
1008 sub db_get($;$) { 1037 sub db_get($;$) {
1009 @_ >= 2 1038 @_ >= 2
1010 ? $db->{$_[0]}{$_[1]} 1039 ? $DB->{$_[0]}{$_[1]}
1011 : ($db->{$_[0]} ||= { }) 1040 : ($DB->{$_[0]} ||= { })
1012 } 1041 }
1013 1042
1014 sub db_put($$;$) { 1043 sub db_put($$;$) {
1015 if (@_ >= 3) { 1044 if (@_ >= 3) {
1016 $db->{$_[0]}{$_[1]} = $_[2]; 1045 $DB->{$_[0]}{$_[1]} = $_[2];
1017 } else { 1046 } else {
1018 $db->{$_[0]} = $_[1]; 1047 $DB->{$_[0]} = $_[1];
1019 } 1048 }
1020 db_dirty; 1049 db_dirty;
1021 } 1050 }
1022 1051
1023 attach_global 1052 attach_global
… …
1029} 1058}
1030 1059
1031############################################################################# 1060#############################################################################
1032# the server's main() 1061# the server's main()
1033 1062
1034sub load_cfg { 1063sub cfg_load {
1035 open my $fh, "<:utf8", cf::confdir . "/config" 1064 open my $fh, "<:utf8", cf::confdir . "/config"
1036 or return; 1065 or return;
1037 1066
1038 local $/; 1067 local $/;
1039 *CFG = YAML::Syck::Load <$fh>; 1068 *CFG = YAML::Syck::Load <$fh>;
1040
1041 use Data::Dumper; warn Dumper \%CFG;
1042} 1069}
1043 1070
1044sub main { 1071sub main {
1045 load_cfg; 1072 cfg_load;
1046 db_load; 1073 db_load;
1047 load_extensions; 1074 load_extensions;
1048 Event::loop; 1075 Event::loop;
1049} 1076}
1050 1077
… …
1102 1129
1103 # reload cf.pm 1130 # reload cf.pm
1104 $msg->("reloading cf.pm"); 1131 $msg->("reloading cf.pm");
1105 require cf; 1132 require cf;
1106 1133
1107 # load database again 1134 # load config and database again
1135 cf::cfg_load;
1108 cf::db_load; 1136 cf::db_load;
1109 1137
1110 # load extensions 1138 # load extensions
1111 $msg->("load extensions"); 1139 $msg->("load extensions");
1112 cf::load_extensions; 1140 cf::load_extensions;
… …
1141register "<global>", __PACKAGE__; 1169register "<global>", __PACKAGE__;
1142 1170
1143unshift @INC, $LIBDIR; 1171unshift @INC, $LIBDIR;
1144 1172
1145$TICK_WATCHER = Event->timer ( 1173$TICK_WATCHER = Event->timer (
1146 prio => 1, 1174 prio => 1,
1175 async => 1,
1147 at => $NEXT_TICK || 1, 1176 at => $NEXT_TICK || 1,
1148 cb => sub { 1177 cb => sub {
1149 cf::server_tick; # one server iteration 1178 cf::server_tick; # one server iteration
1150 1179
1151 my $NOW = Event::time; 1180 my $NOW = Event::time;
1152 $NEXT_TICK += $TICK; 1181 $NEXT_TICK += $TICK;
1153 1182
1154 # if we are delayed by four ticks, skip them all 1183 # if we are delayed by four ticks or more, skip them all
1155 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1184 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
1156 1185
1157 $TICK_WATCHER->at ($NEXT_TICK); 1186 $TICK_WATCHER->at ($NEXT_TICK);
1158 $TICK_WATCHER->start; 1187 $TICK_WATCHER->start;
1159 }, 1188 },
1160); 1189);
1161 1190
1191IO::AIO::max_poll_time $TICK * 0.2;
1192
1193Event->io (fd => IO::AIO::poll_fileno,
1194 poll => 'r',
1195 prio => 5,
1196 cb => \&IO::AIO::poll_cb);
1197
11621 11981
1163 1199

Diff Legend

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