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.81 by root, Tue Nov 7 17:38:22 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
… …
770sub cf::player::exists($) { 783sub cf::player::exists($) {
771 cf::player::find $_[0] 784 cf::player::find $_[0]
772 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;
773} 786}
774 787
775=item $player->reply ($npc, $msg[, $flags]) 788=item $player_object->reply ($npc, $msg[, $flags])
776 789
777Sends 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>
778can 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
779dialogue with the given NPC character. 792dialogue with the given NPC character.
780 793
… …
807 $msg{msgid} = $id; 820 $msg{msgid} = $id;
808 821
809 $self->send ("ext " . to_json \%msg); 822 $self->send ("ext " . to_json \%msg);
810} 823}
811 824
812=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}
813 840
814=cut 841=cut
815 842
816############################################################################# 843#############################################################################
817 844
… …
819 846
820Functions that provide a safe environment to compile and execute 847Functions that provide a safe environment to compile and execute
821snippets of perl code without them endangering the safety of the server 848snippets of perl code without them endangering the safety of the server
822itself. Looping constructs, I/O operators and other built-in functionality 849itself. Looping constructs, I/O operators and other built-in functionality
823is not available in the safe scripting environment, and the number of 850is not available in the safe scripting environment, and the number of
824functions and methods that cna be called is greatly reduced. 851functions and methods that can be called is greatly reduced.
825 852
826=cut 853=cut
827 854
828our $safe = new Safe "safe"; 855our $safe = new Safe "safe";
829our $safe_hole = new Safe::Hole; 856our $safe_hole = new Safe::Hole;
… …
965 992
966Immediately write the database to disk I<if it is dirty>. 993Immediately write the database to disk I<if it is dirty>.
967 994
968=cut 995=cut
969 996
997our $DB;
998
970{ 999{
971 my $db;
972 my $path = cf::localdir . "/database.pst"; 1000 my $path = cf::localdir . "/database.pst";
973 1001
974 sub db_load() { 1002 sub db_load() {
975 warn "loading database $path\n";#d# remove later 1003 warn "loading database $path\n";#d# remove later
976 $db = stat $path ? Storable::retrieve $path : { }; 1004 $DB = stat $path ? Storable::retrieve $path : { };
977 } 1005 }
978 1006
979 my $pid; 1007 my $pid;
980 1008
981 sub db_save() { 1009 sub db_save() {
982 warn "saving database $path\n";#d# remove later 1010 warn "saving database $path\n";#d# remove later
983 waitpid $pid, 0 if $pid; 1011 waitpid $pid, 0 if $pid;
984 if (0 == ($pid = fork)) { 1012 if (0 == ($pid = fork)) {
985 $db->{_meta}{version} = 1; 1013 $DB->{_meta}{version} = 1;
986 Storable::nstore $db, "$path~"; 1014 Storable::nstore $DB, "$path~";
987 rename "$path~", $path; 1015 rename "$path~", $path;
988 cf::_exit 0 if defined $pid; 1016 cf::_exit 0 if defined $pid;
989 } 1017 }
990 } 1018 }
991 1019
… …
1005 $idle->start; 1033 $idle->start;
1006 } 1034 }
1007 1035
1008 sub db_get($;$) { 1036 sub db_get($;$) {
1009 @_ >= 2 1037 @_ >= 2
1010 ? $db->{$_[0]}{$_[1]} 1038 ? $DB->{$_[0]}{$_[1]}
1011 : ($db->{$_[0]} ||= { }) 1039 : ($DB->{$_[0]} ||= { })
1012 } 1040 }
1013 1041
1014 sub db_put($$;$) { 1042 sub db_put($$;$) {
1015 if (@_ >= 3) { 1043 if (@_ >= 3) {
1016 $db->{$_[0]}{$_[1]} = $_[2]; 1044 $DB->{$_[0]}{$_[1]} = $_[2];
1017 } else { 1045 } else {
1018 $db->{$_[0]} = $_[1]; 1046 $DB->{$_[0]} = $_[1];
1019 } 1047 }
1020 db_dirty; 1048 db_dirty;
1021 } 1049 }
1022 1050
1023 attach_global 1051 attach_global
… …
1029} 1057}
1030 1058
1031############################################################################# 1059#############################################################################
1032# the server's main() 1060# the server's main()
1033 1061
1034sub load_cfg { 1062sub cfg_load {
1035 open my $fh, "<:utf8", cf::confdir . "/config" 1063 open my $fh, "<:utf8", cf::confdir . "/config"
1036 or return; 1064 or return;
1037 1065
1038 local $/; 1066 local $/;
1039 *CFG = YAML::Syck::Load <$fh>; 1067 *CFG = YAML::Syck::Load <$fh>;
1040
1041 use Data::Dumper; warn Dumper \%CFG;
1042} 1068}
1043 1069
1044sub main { 1070sub main {
1045 load_cfg; 1071 cfg_load;
1046 db_load; 1072 db_load;
1047 load_extensions; 1073 load_extensions;
1048 Event::loop; 1074 Event::loop;
1049} 1075}
1050 1076
… …
1102 1128
1103 # reload cf.pm 1129 # reload cf.pm
1104 $msg->("reloading cf.pm"); 1130 $msg->("reloading cf.pm");
1105 require cf; 1131 require cf;
1106 1132
1107 # load database again 1133 # load config and database again
1134 cf::cfg_load;
1108 cf::db_load; 1135 cf::db_load;
1109 1136
1110 # load extensions 1137 # load extensions
1111 $msg->("load extensions"); 1138 $msg->("load extensions");
1112 cf::load_extensions; 1139 cf::load_extensions;
… …
1141register "<global>", __PACKAGE__; 1168register "<global>", __PACKAGE__;
1142 1169
1143unshift @INC, $LIBDIR; 1170unshift @INC, $LIBDIR;
1144 1171
1145$TICK_WATCHER = Event->timer ( 1172$TICK_WATCHER = Event->timer (
1146 prio => 1, 1173 prio => 1,
1174 async => 1,
1147 at => $NEXT_TICK || 1, 1175 at => $NEXT_TICK || 1,
1148 cb => sub { 1176 cb => sub {
1149 cf::server_tick; # one server iteration 1177 cf::server_tick; # one server iteration
1150 1178
1151 my $NOW = Event::time; 1179 my $NOW = Event::time;
1152 $NEXT_TICK += $TICK; 1180 $NEXT_TICK += $TICK;
1153 1181
1154 # if we are delayed by four ticks, skip them all 1182 # if we are delayed by four ticks or more, skip them all
1155 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1183 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
1156 1184
1157 $TICK_WATCHER->at ($NEXT_TICK); 1185 $TICK_WATCHER->at ($NEXT_TICK);
1158 $TICK_WATCHER->start; 1186 $TICK_WATCHER->start;
1159 }, 1187 },
1160); 1188);
1161 1189
1190IO::AIO::max_poll_time $TICK * 0.2;
1191
1192Event->io (fd => IO::AIO::poll_fileno,
1193 poll => 'r',
1194 prio => 5,
1195 cb => \&IO::AIO::poll_cb);
1196
11621 11971
1163 1198

Diff Legend

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