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.76 by root, Mon Oct 2 15:28:36 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
774sub cf::player::exists($) { 775sub cf::player::exists($) {
775 cf::player::find $_[0] 776 cf::player::find $_[0]
776 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;
777} 778}
778 779
779=item $object->reply ($npc, $msg[, $flags]) 780=item $player_object->reply ($npc, $msg[, $flags])
780 781
781Sends 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>
782can 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
783dialogue with the given NPC character. 784dialogue with the given NPC character.
784 785
811 $msg{msgid} = $id; 812 $msg{msgid} = $id;
812 813
813 $self->send ("ext " . to_json \%msg); 814 $self->send ("ext " . to_json \%msg);
814} 815}
815 816
816=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}
817 832
818=cut 833=cut
819 834
820############################################################################# 835#############################################################################
821 836
823 838
824Functions that provide a safe environment to compile and execute 839Functions that provide a safe environment to compile and execute
825snippets of perl code without them endangering the safety of the server 840snippets of perl code without them endangering the safety of the server
826itself. Looping constructs, I/O operators and other built-in functionality 841itself. Looping constructs, I/O operators and other built-in functionality
827is not available in the safe scripting environment, and the number of 842is not available in the safe scripting environment, and the number of
828functions and methods that cna be called is greatly reduced. 843functions and methods that can be called is greatly reduced.
829 844
830=cut 845=cut
831 846
832our $safe = new Safe "safe"; 847our $safe = new Safe "safe";
833our $safe_hole = new Safe::Hole; 848our $safe_hole = new Safe::Hole;
969 984
970Immediately write the database to disk I<if it is dirty>. 985Immediately write the database to disk I<if it is dirty>.
971 986
972=cut 987=cut
973 988
989our $DB;
990
974{ 991{
975 my $db;
976 my $path = cf::localdir . "/database.pst"; 992 my $path = cf::localdir . "/database.pst";
977 993
978 sub db_load() { 994 sub db_load() {
979 warn "loading database $path\n";#d# remove later 995 warn "loading database $path\n";#d# remove later
980 $db = stat $path ? Storable::retrieve $path : { }; 996 $DB = stat $path ? Storable::retrieve $path : { };
981 } 997 }
982 998
983 my $pid; 999 my $pid;
984 1000
985 sub db_save() { 1001 sub db_save() {
986 warn "saving database $path\n";#d# remove later 1002 warn "saving database $path\n";#d# remove later
987 waitpid $pid, 0 if $pid; 1003 waitpid $pid, 0 if $pid;
988 if (0 == ($pid = fork)) { 1004 if (0 == ($pid = fork)) {
989 $db->{_meta}{version} = 1; 1005 $DB->{_meta}{version} = 1;
990 Storable::nstore $db, "$path~"; 1006 Storable::nstore $DB, "$path~";
991 rename "$path~", $path; 1007 rename "$path~", $path;
992 cf::_exit 0 if defined $pid; 1008 cf::_exit 0 if defined $pid;
993 } 1009 }
994 } 1010 }
995 1011
1009 $idle->start; 1025 $idle->start;
1010 } 1026 }
1011 1027
1012 sub db_get($;$) { 1028 sub db_get($;$) {
1013 @_ >= 2 1029 @_ >= 2
1014 ? $db->{$_[0]}{$_[1]} 1030 ? $DB->{$_[0]}{$_[1]}
1015 : ($db->{$_[0]} ||= { }) 1031 : ($DB->{$_[0]} ||= { })
1016 } 1032 }
1017 1033
1018 sub db_put($$;$) { 1034 sub db_put($$;$) {
1019 if (@_ >= 3) { 1035 if (@_ >= 3) {
1020 $db->{$_[0]}{$_[1]} = $_[2]; 1036 $DB->{$_[0]}{$_[1]} = $_[2];
1021 } else { 1037 } else {
1022 $db->{$_[0]} = $_[1]; 1038 $DB->{$_[0]} = $_[1];
1023 } 1039 }
1024 db_dirty; 1040 db_dirty;
1025 } 1041 }
1026 1042
1027 attach_global 1043 attach_global
1144register "<global>", __PACKAGE__; 1160register "<global>", __PACKAGE__;
1145 1161
1146unshift @INC, $LIBDIR; 1162unshift @INC, $LIBDIR;
1147 1163
1148$TICK_WATCHER = Event->timer ( 1164$TICK_WATCHER = Event->timer (
1149 prio => 1, 1165 prio => 1,
1166 async => 1,
1150 at => $NEXT_TICK || 1, 1167 at => $NEXT_TICK || 1,
1151 cb => sub { 1168 cb => sub {
1152 cf::server_tick; # one server iteration 1169 cf::server_tick; # one server iteration
1153 1170
1154 my $NOW = Event::time; 1171 my $NOW = Event::time;
1155 $NEXT_TICK += $TICK; 1172 $NEXT_TICK += $TICK;
1156 1173
1157 # if we are delayed by four ticks, skip them all 1174 # if we are delayed by four ticks or more, skip them all
1158 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1175 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
1159 1176
1160 $TICK_WATCHER->at ($NEXT_TICK); 1177 $TICK_WATCHER->at ($NEXT_TICK);
1161 $TICK_WATCHER->start; 1178 $TICK_WATCHER->start;
1162 }, 1179 },
1163); 1180);
1164 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
11651 11891
1166 1190

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines