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.73 by root, Sun Oct 1 11:46:51 2006 UTC vs.
Revision 1.78 by root, Tue Nov 7 00:15:27 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 $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
… …
965 970
966Immediately write the database to disk I<if it is dirty>. 971Immediately write the database to disk I<if it is dirty>.
967 972
968=cut 973=cut
969 974
975our $DB;
976
970{ 977{
971 my $db;
972 my $path = cf::localdir . "/database.pst"; 978 my $path = cf::localdir . "/database.pst";
973 979
974 sub db_load() { 980 sub db_load() {
975 warn "loading database $path\n";#d# remove later 981 warn "loading database $path\n";#d# remove later
976 $db = stat $path ? Storable::retrieve $path : { }; 982 $DB = stat $path ? Storable::retrieve $path : { };
977 } 983 }
978 984
979 my $pid; 985 my $pid;
980 986
981 sub db_save() { 987 sub db_save() {
982 warn "saving database $path\n";#d# remove later 988 warn "saving database $path\n";#d# remove later
983 waitpid $pid, 0 if $pid; 989 waitpid $pid, 0 if $pid;
984 if (0 == ($pid = fork)) { 990 if (0 == ($pid = fork)) {
985 $db->{_meta}{version} = 1; 991 $DB->{_meta}{version} = 1;
986 Storable::nstore $db, "$path~"; 992 Storable::nstore $DB, "$path~";
987 rename "$path~", $path; 993 rename "$path~", $path;
988 cf::_exit 0 if defined $pid; 994 cf::_exit 0 if defined $pid;
989 } 995 }
990 } 996 }
991 997
… …
1005 $idle->start; 1011 $idle->start;
1006 } 1012 }
1007 1013
1008 sub db_get($;$) { 1014 sub db_get($;$) {
1009 @_ >= 2 1015 @_ >= 2
1010 ? $db->{$_[0]}{$_[1]} 1016 ? $DB->{$_[0]}{$_[1]}
1011 : ($db->{$_[0]} ||= { }) 1017 : ($DB->{$_[0]} ||= { })
1012 } 1018 }
1013 1019
1014 sub db_put($$;$) { 1020 sub db_put($$;$) {
1015 if (@_ >= 3) { 1021 if (@_ >= 3) {
1016 $db->{$_[0]}{$_[1]} = $_[2]; 1022 $DB->{$_[0]}{$_[1]} = $_[2];
1017 } else { 1023 } else {
1018 $db->{$_[0]} = $_[1]; 1024 $DB->{$_[0]} = $_[1];
1019 } 1025 }
1020 db_dirty; 1026 db_dirty;
1021 } 1027 }
1022 1028
1023 attach_global 1029 attach_global
… …
1035 open my $fh, "<:utf8", cf::confdir . "/config" 1041 open my $fh, "<:utf8", cf::confdir . "/config"
1036 or return; 1042 or return;
1037 1043
1038 local $/; 1044 local $/;
1039 *CFG = YAML::Syck::Load <$fh>; 1045 *CFG = YAML::Syck::Load <$fh>;
1040
1041 use Data::Dumper; warn Dumper \%CFG;
1042} 1046}
1043 1047
1044sub main { 1048sub main {
1045 cfg_load; 1049 cfg_load;
1046 db_load; 1050 db_load;
… …
1142register "<global>", __PACKAGE__; 1146register "<global>", __PACKAGE__;
1143 1147
1144unshift @INC, $LIBDIR; 1148unshift @INC, $LIBDIR;
1145 1149
1146$TICK_WATCHER = Event->timer ( 1150$TICK_WATCHER = Event->timer (
1147 prio => 1, 1151 prio => 1,
1152 async => 1,
1148 at => $NEXT_TICK || 1, 1153 at => $NEXT_TICK || 1,
1149 cb => sub { 1154 cb => sub {
1150 cf::server_tick; # one server iteration 1155 cf::server_tick; # one server iteration
1151 1156
1152 my $NOW = Event::time; 1157 my $NOW = Event::time;
1153 $NEXT_TICK += $TICK; 1158 $NEXT_TICK += $TICK;
1154 1159
1155 # if we are delayed by four ticks, skip them all 1160 # if we are delayed by four ticks or more, skip them all
1156 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; 1161 $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4;
1157 1162
1158 $TICK_WATCHER->at ($NEXT_TICK); 1163 $TICK_WATCHER->at ($NEXT_TICK);
1159 $TICK_WATCHER->start; 1164 $TICK_WATCHER->start;
1160 }, 1165 },
1161); 1166);
1162 1167
1168eval { IO::AIO::max_poll_time $TICK * 0.2 }; #d# remove eval after restart
1169
1170Event->io (fd => IO::AIO::poll_fileno,
1171 poll => 'r',
1172 prio => 5,
1173 cb => \&IO::AIO::poll_cb);
1174
11631 11751
1164 1176

Diff Legend

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