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.79 by root, Tue Nov 7 14:58:35 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
… …
770sub cf::player::exists($) { 775sub cf::player::exists($) {
771 cf::player::find $_[0] 776 cf::player::find $_[0]
772 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; 777 or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
773} 778}
774 779
775=item $player->reply ($npc, $msg[, $flags]) 780=item $player_object->reply ($npc, $msg[, $flags])
776 781
777Sends a message to the player, as if the npc C<$npc> replied. C<$npc> 782Sends 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 783can be C<undef>. Does the right thing when the player is currently in a
779dialogue with the given NPC character. 784dialogue with the given NPC character.
780 785
… …
807 $msg{msgid} = $id; 812 $msg{msgid} = $id;
808 813
809 $self->send ("ext " . to_json \%msg); 814 $self->send ("ext " . to_json \%msg);
810} 815}
811 816
812=back 817=item $player_object->may ("access")
818
819Returns wether the given player is authorized to access resource "access"
820(e.g. "command_wizcast").
821
822=cut
823
824sub cf::object::player::may {
825 my ($self, $access) = @_;
826
827 $self->flag (cf::FLAG_WIZ) ||
828 (ref $cf::CFG{"may_$access"}
829 ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}}
830 : $cf::CFG{"may_$access"})
831}
813 832
814=cut 833=cut
815 834
816############################################################################# 835#############################################################################
817 836
… …
819 838
820Functions that provide a safe environment to compile and execute 839Functions that provide a safe environment to compile and execute
821snippets of perl code without them endangering the safety of the server 840snippets of perl code without them endangering the safety of the server
822itself. Looping constructs, I/O operators and other built-in functionality 841itself. Looping constructs, I/O operators and other built-in functionality
823is not available in the safe scripting environment, and the number of 842is not available in the safe scripting environment, and the number of
824functions and methods that cna be called is greatly reduced. 843functions and methods that can be called is greatly reduced.
825 844
826=cut 845=cut
827 846
828our $safe = new Safe "safe"; 847our $safe = new Safe "safe";
829our $safe_hole = new Safe::Hole; 848our $safe_hole = new Safe::Hole;
… …
965 984
966Immediately write the database to disk I<if it is dirty>. 985Immediately write the database to disk I<if it is dirty>.
967 986
968=cut 987=cut
969 988
989our $DB;
990
970{ 991{
971 my $db;
972 my $path = cf::localdir . "/database.pst"; 992 my $path = cf::localdir . "/database.pst";
973 993
974 sub db_load() { 994 sub db_load() {
975 warn "loading database $path\n";#d# remove later 995 warn "loading database $path\n";#d# remove later
976 $db = stat $path ? Storable::retrieve $path : { }; 996 $DB = stat $path ? Storable::retrieve $path : { };
977 } 997 }
978 998
979 my $pid; 999 my $pid;
980 1000
981 sub db_save() { 1001 sub db_save() {
982 warn "saving database $path\n";#d# remove later 1002 warn "saving database $path\n";#d# remove later
983 waitpid $pid, 0 if $pid; 1003 waitpid $pid, 0 if $pid;
984 if (0 == ($pid = fork)) { 1004 if (0 == ($pid = fork)) {
985 $db->{_meta}{version} = 1; 1005 $DB->{_meta}{version} = 1;
986 Storable::nstore $db, "$path~"; 1006 Storable::nstore $DB, "$path~";
987 rename "$path~", $path; 1007 rename "$path~", $path;
988 cf::_exit 0 if defined $pid; 1008 cf::_exit 0 if defined $pid;
989 } 1009 }
990 } 1010 }
991 1011
… …
1005 $idle->start; 1025 $idle->start;
1006 } 1026 }
1007 1027
1008 sub db_get($;$) { 1028 sub db_get($;$) {
1009 @_ >= 2 1029 @_ >= 2
1010 ? $db->{$_[0]}{$_[1]} 1030 ? $DB->{$_[0]}{$_[1]}
1011 : ($db->{$_[0]} ||= { }) 1031 : ($DB->{$_[0]} ||= { })
1012 } 1032 }
1013 1033
1014 sub db_put($$;$) { 1034 sub db_put($$;$) {
1015 if (@_ >= 3) { 1035 if (@_ >= 3) {
1016 $db->{$_[0]}{$_[1]} = $_[2]; 1036 $DB->{$_[0]}{$_[1]} = $_[2];
1017 } else { 1037 } else {
1018 $db->{$_[0]} = $_[1]; 1038 $DB->{$_[0]} = $_[1];
1019 } 1039 }
1020 db_dirty; 1040 db_dirty;
1021 } 1041 }
1022 1042
1023 attach_global 1043 attach_global
… …
1029} 1049}
1030 1050
1031############################################################################# 1051#############################################################################
1032# the server's main() 1052# the server's main()
1033 1053
1034sub load_cfg { 1054sub cfg_load {
1035 open my $fh, "<:utf8", cf::confdir . "/config" 1055 open my $fh, "<:utf8", cf::confdir . "/config"
1036 or return; 1056 or return;
1037 1057
1038 local $/; 1058 local $/;
1039 *CFG = YAML::Syck::Load <$fh>; 1059 *CFG = YAML::Syck::Load <$fh>;
1040
1041 use Data::Dumper; warn Dumper \%CFG;
1042} 1060}
1043 1061
1044sub main { 1062sub main {
1045 load_cfg; 1063 cfg_load;
1046 db_load; 1064 db_load;
1047 load_extensions; 1065 load_extensions;
1048 Event::loop; 1066 Event::loop;
1049} 1067}
1050 1068
… …
1102 1120
1103 # reload cf.pm 1121 # reload cf.pm
1104 $msg->("reloading cf.pm"); 1122 $msg->("reloading cf.pm");
1105 require cf; 1123 require cf;
1106 1124
1107 # load database again 1125 # load config and database again
1126 cf::cfg_load;
1108 cf::db_load; 1127 cf::db_load;
1109 1128
1110 # load extensions 1129 # load extensions
1111 $msg->("load extensions"); 1130 $msg->("load extensions");
1112 cf::load_extensions; 1131 cf::load_extensions;
… …
1141register "<global>", __PACKAGE__; 1160register "<global>", __PACKAGE__;
1142 1161
1143unshift @INC, $LIBDIR; 1162unshift @INC, $LIBDIR;
1144 1163
1145$TICK_WATCHER = Event->timer ( 1164$TICK_WATCHER = Event->timer (
1146 prio => 1, 1165 prio => 1,
1166 async => 1,
1147 at => $NEXT_TICK || 1, 1167 at => $NEXT_TICK || 1,
1148 cb => sub { 1168 cb => sub {
1149 cf::server_tick; # one server iteration 1169 cf::server_tick; # one server iteration
1150 1170
1151 my $NOW = Event::time; 1171 my $NOW = Event::time;
1152 $NEXT_TICK += $TICK; 1172 $NEXT_TICK += $TICK;
1153 1173
1154 # if we are delayed by four ticks, skip them all 1174 # if we are delayed by four ticks or more, skip them all
1155 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1175 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
1156 1176
1157 $TICK_WATCHER->at ($NEXT_TICK); 1177 $TICK_WATCHER->at ($NEXT_TICK);
1158 $TICK_WATCHER->start; 1178 $TICK_WATCHER->start;
1159 }, 1179 },
1160); 1180);
1161 1181
1182eval { IO::AIO::max_poll_time $TICK * 0.2 }; #d# remove eval after restart
1183
1184Event->io (fd => IO::AIO::poll_fileno,
1185 poll => 'r',
1186 prio => 5,
1187 cb => \&IO::AIO::poll_cb);
1188
11621 11891
1163 1190

Diff Legend

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