--- deliantra/server/lib/cf.pm	2006/10/01 10:59:30	1.71
+++ deliantra/server/lib/cf.pm	2006/12/11 01:30:41	1.83
@@ -7,10 +7,15 @@
 use Safe;
 use Safe::Hole;
 
+use IO::AIO ();
+use YAML::Syck ();
 use Time::HiRes;
 use Event;
 $Event::Eval = 1; # no idea why this is required, but it is
 
+# work around bug in YAML::Syck - bad news for perl6, will it be as broken wrt. unicode?
+$YAML::Syck::ImplicitUnicode = 1;
+
 use strict;
 
 _init_vars;
@@ -25,12 +30,21 @@
 
 our %CFG;
 
+our $uptime;#d#
+our $UPTIME;
+$UPTIME ||= $uptime;#d#
+$UPTIME ||= time;
+
 #############################################################################
 
 =head2 GLOBAL VARIABLES
 
 =over 4
 
+=item $cf::UPTIME
+
+The timestamp of the server start (so not actually an uptime).
+
 =item $cf::LIBDIR
 
 The perl library directory, where extensions and cf-specific modules can
@@ -516,6 +530,14 @@
    }
 }
 
+sub object_freezer_as_string {
+   my ($rdata, $objs) = @_;
+
+   use Data::Dumper;
+
+   $$rdata . Dumper $objs
+}
+
 sub object_thawer_load {
    my ($filename) = @_;
 
@@ -627,7 +649,8 @@
       . "\n};\n1";
 
    eval $source
-      or die "$path: $@";
+      or die $@ ? "$path: $@\n"
+                : "extension disabled.\n";
 
    push @exts, $pkg;
    $ext_pkg{$base} = $pkg;
@@ -768,7 +791,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<undef>. Does the right thing when the player is currently in a
@@ -805,7 +828,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
 
@@ -817,7 +854,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
 
@@ -963,13 +1000,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;
@@ -978,8 +1016,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;
       }
@@ -1003,15 +1041,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;
    }
@@ -1027,7 +1065,16 @@
 #############################################################################
 # the server's main()
 
+sub cfg_load {
+   open my $fh, "<:utf8", cf::confdir . "/config"
+      or return;
+
+   local $/;
+   *CFG = YAML::Syck::Load <$fh>;
+}
+
 sub main {
+   cfg_load;
    db_load;
    load_extensions;
    Event::loop;
@@ -1089,7 +1136,8 @@
       $msg->("reloading cf.pm");
       require cf;
 
-      # load database again
+      # load config and database again
+      cf::cfg_load;
       cf::db_load;
 
       # load extensions
@@ -1128,15 +1176,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);
@@ -1144,5 +1193,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