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.80 by root, Tue Nov 7 16:30:55 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
… …
522 unlink $filename; 523 unlink $filename;
523 unlink "$filename.pst"; 524 unlink "$filename.pst";
524 } 525 }
525} 526}
526 527
528sub object_freezer_as_string {
529 my ($rdata, $objs) = @_;
530
531 use Data::Dumper;
532
533 "$$rdata\n" . Dumper $objs
534}
535
527sub object_thawer_load { 536sub object_thawer_load {
528 my ($filename) = @_; 537 my ($filename) = @_;
529 538
530 local $/; 539 local $/;
531 540
… …
774sub cf::player::exists($) { 783sub cf::player::exists($) {
775 cf::player::find $_[0] 784 cf::player::find $_[0]
776 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;
777} 786}
778 787
779=item $object->reply ($npc, $msg[, $flags]) 788=item $player_object->reply ($npc, $msg[, $flags])
780 789
781Sends 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>
782can 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
783dialogue with the given NPC character. 792dialogue with the given NPC character.
784 793
… …
811 $msg{msgid} = $id; 820 $msg{msgid} = $id;
812 821
813 $self->send ("ext " . to_json \%msg); 822 $self->send ("ext " . to_json \%msg);
814} 823}
815 824
816=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}
817 840
818=cut 841=cut
819 842
820############################################################################# 843#############################################################################
821 844
… …
823 846
824Functions that provide a safe environment to compile and execute 847Functions that provide a safe environment to compile and execute
825snippets of perl code without them endangering the safety of the server 848snippets of perl code without them endangering the safety of the server
826itself. Looping constructs, I/O operators and other built-in functionality 849itself. Looping constructs, I/O operators and other built-in functionality
827is not available in the safe scripting environment, and the number of 850is not available in the safe scripting environment, and the number of
828functions and methods that cna be called is greatly reduced. 851functions and methods that can be called is greatly reduced.
829 852
830=cut 853=cut
831 854
832our $safe = new Safe "safe"; 855our $safe = new Safe "safe";
833our $safe_hole = new Safe::Hole; 856our $safe_hole = new Safe::Hole;
… …
969 992
970Immediately write the database to disk I<if it is dirty>. 993Immediately write the database to disk I<if it is dirty>.
971 994
972=cut 995=cut
973 996
997our $DB;
998
974{ 999{
975 my $db;
976 my $path = cf::localdir . "/database.pst"; 1000 my $path = cf::localdir . "/database.pst";
977 1001
978 sub db_load() { 1002 sub db_load() {
979 warn "loading database $path\n";#d# remove later 1003 warn "loading database $path\n";#d# remove later
980 $db = stat $path ? Storable::retrieve $path : { }; 1004 $DB = stat $path ? Storable::retrieve $path : { };
981 } 1005 }
982 1006
983 my $pid; 1007 my $pid;
984 1008
985 sub db_save() { 1009 sub db_save() {
986 warn "saving database $path\n";#d# remove later 1010 warn "saving database $path\n";#d# remove later
987 waitpid $pid, 0 if $pid; 1011 waitpid $pid, 0 if $pid;
988 if (0 == ($pid = fork)) { 1012 if (0 == ($pid = fork)) {
989 $db->{_meta}{version} = 1; 1013 $DB->{_meta}{version} = 1;
990 Storable::nstore $db, "$path~"; 1014 Storable::nstore $DB, "$path~";
991 rename "$path~", $path; 1015 rename "$path~", $path;
992 cf::_exit 0 if defined $pid; 1016 cf::_exit 0 if defined $pid;
993 } 1017 }
994 } 1018 }
995 1019
… …
1009 $idle->start; 1033 $idle->start;
1010 } 1034 }
1011 1035
1012 sub db_get($;$) { 1036 sub db_get($;$) {
1013 @_ >= 2 1037 @_ >= 2
1014 ? $db->{$_[0]}{$_[1]} 1038 ? $DB->{$_[0]}{$_[1]}
1015 : ($db->{$_[0]} ||= { }) 1039 : ($DB->{$_[0]} ||= { })
1016 } 1040 }
1017 1041
1018 sub db_put($$;$) { 1042 sub db_put($$;$) {
1019 if (@_ >= 3) { 1043 if (@_ >= 3) {
1020 $db->{$_[0]}{$_[1]} = $_[2]; 1044 $DB->{$_[0]}{$_[1]} = $_[2];
1021 } else { 1045 } else {
1022 $db->{$_[0]} = $_[1]; 1046 $DB->{$_[0]} = $_[1];
1023 } 1047 }
1024 db_dirty; 1048 db_dirty;
1025 } 1049 }
1026 1050
1027 attach_global 1051 attach_global
… …
1144register "<global>", __PACKAGE__; 1168register "<global>", __PACKAGE__;
1145 1169
1146unshift @INC, $LIBDIR; 1170unshift @INC, $LIBDIR;
1147 1171
1148$TICK_WATCHER = Event->timer ( 1172$TICK_WATCHER = Event->timer (
1149 prio => 1, 1173 prio => 1,
1174 async => 1,
1150 at => $NEXT_TICK || 1, 1175 at => $NEXT_TICK || 1,
1151 cb => sub { 1176 cb => sub {
1152 cf::server_tick; # one server iteration 1177 cf::server_tick; # one server iteration
1153 1178
1154 my $NOW = Event::time; 1179 my $NOW = Event::time;
1155 $NEXT_TICK += $TICK; 1180 $NEXT_TICK += $TICK;
1156 1181
1157 # if we are delayed by four ticks, skip them all 1182 # if we are delayed by four ticks or more, skip them all
1158 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1183 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
1159 1184
1160 $TICK_WATCHER->at ($NEXT_TICK); 1185 $TICK_WATCHER->at ($NEXT_TICK);
1161 $TICK_WATCHER->start; 1186 $TICK_WATCHER->start;
1162 }, 1187 },
1163); 1188);
1164 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
11651 11971
1166 1198

Diff Legend

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