--- deliantra/server/lib/cf.pm 2006/10/01 15:59:29 1.74 +++ deliantra/server/lib/cf.pm 2006/11/07 17:38:22 1.81 @@ -7,6 +7,7 @@ use Safe; use Safe::Hole; +use IO::AIO (); use YAML::Syck (); use Time::HiRes; use Event; @@ -29,6 +30,10 @@ our %CFG; +our $uptime; + +$uptime ||= time; + ############################################################################# =head2 GLOBAL VARIABLES @@ -520,6 +525,14 @@ } } +sub object_freezer_as_string { + my ($rdata, $objs) = @_; + + use Data::Dumper; + + $$rdata . Dumper $objs +} + sub object_thawer_load { my ($filename) = @_; @@ -772,7 +785,7 @@ or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2; } -=item $player->reply ($npc, $msg[, $flags]) +=item $player_object->reply ($npc, $msg[, $flags]) Sends a message to the player, as if the npc C<$npc> replied. C<$npc> can be C. Does the right thing when the player is currently in a @@ -809,7 +822,21 @@ $self->send ("ext " . to_json \%msg); } -=back +=item $player_object->may ("access") + +Returns wether the given player is authorized to access resource "access" +(e.g. "command_wizcast"). + +=cut + +sub cf::object::player::may { + my ($self, $access) = @_; + + $self->flag (cf::FLAG_WIZ) || + (ref $cf::CFG{"may_$access"} + ? scalar grep $self->name eq $_, @{$cf::CFG{"may_$access"}} + : $cf::CFG{"may_$access"}) +} =cut @@ -821,7 +848,7 @@ snippets of perl code without them endangering the safety of the server itself. Looping constructs, I/O operators and other built-in functionality is not available in the safe scripting environment, and the number of -functions and methods that cna be called is greatly reduced. +functions and methods that can be called is greatly reduced. =cut @@ -967,13 +994,14 @@ =cut +our $DB; + { - my $db; my $path = cf::localdir . "/database.pst"; sub db_load() { warn "loading database $path\n";#d# remove later - $db = stat $path ? Storable::retrieve $path : { }; + $DB = stat $path ? Storable::retrieve $path : { }; } my $pid; @@ -982,8 +1010,8 @@ warn "saving database $path\n";#d# remove later waitpid $pid, 0 if $pid; if (0 == ($pid = fork)) { - $db->{_meta}{version} = 1; - Storable::nstore $db, "$path~"; + $DB->{_meta}{version} = 1; + Storable::nstore $DB, "$path~"; rename "$path~", $path; cf::_exit 0 if defined $pid; } @@ -1007,15 +1035,15 @@ sub db_get($;$) { @_ >= 2 - ? $db->{$_[0]}{$_[1]} - : ($db->{$_[0]} ||= { }) + ? $DB->{$_[0]}{$_[1]} + : ($DB->{$_[0]} ||= { }) } sub db_put($$;$) { if (@_ >= 3) { - $db->{$_[0]}{$_[1]} = $_[2]; + $DB->{$_[0]}{$_[1]} = $_[2]; } else { - $db->{$_[0]} = $_[1]; + $DB->{$_[0]} = $_[1]; } db_dirty; } @@ -1142,15 +1170,16 @@ unshift @INC, $LIBDIR; $TICK_WATCHER = Event->timer ( - prio => 1, - at => $NEXT_TICK || 1, - cb => sub { + prio => 1, + async => 1, + at => $NEXT_TICK || 1, + cb => sub { cf::server_tick; # one server iteration my $NOW = Event::time; $NEXT_TICK += $TICK; - # if we are delayed by four ticks, skip them all + # if we are delayed by four ticks or more, skip them all $NEXT_TICK = $NOW if $NOW >= $NEXT_TICK + $TICK * 4; $TICK_WATCHER->at ($NEXT_TICK); @@ -1158,5 +1187,12 @@ }, ); +IO::AIO::max_poll_time $TICK * 0.2; + +Event->io (fd => IO::AIO::poll_fileno, + poll => 'r', + prio => 5, + cb => \&IO::AIO::poll_cb); + 1