--- deliantra/server/lib/cf.pm	2007/01/05 20:04:02	1.140
+++ deliantra/server/lib/cf.pm	2007/01/08 14:11:05	1.149
@@ -19,7 +19,7 @@
 
 use Digest::MD5;
 use Fcntl;
-use IO::AIO 2.31 ();
+use IO::AIO 2.32 ();
 use YAML::Syck ();
 use Time::HiRes;
 
@@ -49,10 +49,11 @@
 our $UPTIME; $UPTIME ||= time;
 our $RUNTIME;
 
-our %MAP; # all maps
+our %PLAYER; # all users
+our %MAP;    # all maps
 our $LINK_MAP; # the special {link} map
 our $RANDOM_MAPS = cf::localdir . "/random";
-our %EXT_CORO;
+our %EXT_CORO; # coroutines bound to extensions
 
 binmode STDOUT;
 binmode STDERR;
@@ -119,7 +120,7 @@
       $msg .= "\n"
          unless $msg =~ /\n$/;
 
-      LOG llevError, "cfperl: $msg";
+      LOG llevError, $msg;
    };
 }
 
@@ -275,10 +276,7 @@
       })->prio (Coro::PRIO_MAX);
 
       while ($busy) {
-         unless (Coro::cede) {
-            Coro::nready ? Event::one_event 0 : Event::one_event;
-            Coro::cede_notself unless Coro::cede;
-         }
+         Coro::cede or Event::one_event;
       }
 
       wantarray ? @res : $res[0]
@@ -1076,19 +1074,106 @@
 
 Functions and methods that extend core crossfire objects.
 
+=cut
+
+package cf::player;
+
 =head3 cf::player
 
 =over 4
 
-=item cf::player::exists $login
+=item cf::player::find $login
 
-Returns true when the given account exists.
+Returns the given player object, loading it if necessary (might block).
 
 =cut
 
-sub cf::player::exists($) {
-   cf::player::find $_[0]
-      or -f sprintf "%s/%s/%s/%s.pl", cf::localdir, cf::playerdir, ($_[0]) x 2;
+sub playerdir($) {
+   cf::localdir
+     . "/"
+     . cf::playerdir
+     . "/"
+     . (ref $_[0] ? $_[0]->ob->name : $_[0])
+}
+
+sub path($) {
+   my $login = ref $_[0] ? $_[0]->ob->name : $_[0];
+
+   (playerdir $login) . "/$login.pl"
+}
+
+sub find_active($) {
+   $cf::PLAYER{$_[0]}
+      and $cf::PLAYER{$_[0]}->active
+      and $cf::PLAYER{$_[0]}
+}
+
+sub exists($) {
+   my ($login) = @_;
+
+   $cf::PLAYER{$login}
+      or cf::sync_job { !aio_stat $login }
+}
+
+sub find($) {
+   return $cf::PLAYER{$_[0]} || do {
+      my $login = $_[0];
+
+      my $guard = cf::lock_acquire "user_find:$login";
+
+      $cf::PLAYER{$login} ||= (load_pl path $login or return);
+   };
+}
+
+sub save($) {
+   my ($pl) = @_;
+
+   return if $pl->{deny_save};
+
+   my $path = path $pl;
+   my $guard = cf::lock_acquire "user_save:$path";
+
+   return if $pl->{deny_save};
+
+   Coro::AIO::aio_mkdir playerdir $pl, 0770;
+   $pl->{last_save} = $cf::RUNTIME;
+
+   $pl->save_pl ($path);
+   Coro::cede;
+}
+
+sub new($) {
+   my ($login) = @_;
+
+   my $self = create;
+
+   $self->ob->name ($login);
+   $self->{deny_save} = 1;
+
+   $cf::PLAYER{$login} = $self;
+
+   $self
+}
+
+sub quit_character {
+   my ($pl) = @_;
+
+   $pl->{deny_save} = 1;
+   $pl->password ("*"); # this should lock out the player until we nuked the dir
+
+   $pl->invoke (cf::EVENT_PLAYER_LOGOUT, 1) if $pl->active;
+   $pl->deactivate;
+   $pl->invoke (cf::EVENT_PLAYER_QUIT);
+   $pl->ns->destroy if $pl->ns;
+
+   my $path = playerdir $pl;
+   my $temp = "$path~$cf::RUNTIME~deleting~";
+   IO::AIO::aio_rename $path, $temp, sub {
+      delete $cf::PLAYER{$pl->ob->name};
+      $pl->destroy;
+
+      IO::AIO::aio_rmtree $temp;
+   };
 }
 
 =item $player->ext_reply ($msgid, $msgtype, %msg)
@@ -1097,14 +1182,16 @@
 
 =cut
 
-sub cf::player::ext_reply($$$%) {
+sub ext_reply($$$%) {
    my ($self, $id, %msg) = @_;
 
    $msg{msgid} = $id;
 
-   $self->send ("ext " . to_json \%msg);
+   $self->send ("ext " . cf::to_json \%msg);
 }
 
+package cf;
+
 =back
 
 
@@ -1309,6 +1396,10 @@
 
    local $self->{last_access} = $self->last_access;#d#
 
+   cf::async {
+      $_->contr->save for $self->players;
+   };
+
    if ($uniq) {
       $self->save_objects ($save, cf::IO_HEADER | cf::IO_OBJECTS);
       $self->save_objects ($uniq, cf::IO_UNIQUES);
@@ -1415,14 +1506,19 @@
 sub emergency_save {
    my $freeze_guard = cf::freeze_mainloop;
 
-   warn "enter emergency map save\n";
+   warn "enter emergency perl save\n";
 
    cf::sync_job {
+      warn "begin emergency player save\n";
+      $_->save for values %cf::PLAYER;
+      warn "end emergency player save\n";
+
       warn "begin emergency map save\n";
       $_->save for values %cf::MAP;
+      warn "end emergency map save\n";
    };
 
-   warn "end emergency map save\n";
+   warn "leave emergency perl save\n";
 }
 
 package cf;
@@ -1531,6 +1627,7 @@
 
    $map->load;
 
+   return unless $self->contr->active;
    $self->activate_recursive;
    $self->enter_map ($map, $x, $y);
 }
@@ -1552,7 +1649,6 @@
       # try to abort aborted map switching on player login :)
       # should happen only on crashes
       if ($pl->ob->{_link_pos}) {
-
          $pl->ob->enter_link;
          (async {
             # we need this sleep as the login has a concurrent enter_exit running
@@ -1586,7 +1682,8 @@
 #      warn "entering ", $map->path, " at ($x, $y)\n"
 #         if $map;
 
-      $map or $self->message ("The exit is closed", cf::NDI_UNIQUE | cf::NDI_RED);
+      $map or $map->cluck ("oy");#d#
+      $map or $self->message ("The exit to '" . ($path->visible_name) . "' is closed", cf::NDI_UNIQUE | cf::NDI_RED);
 
       $self->leave_link ($map, $x, $y);
    })->prio (1);
@@ -2004,7 +2101,7 @@
 
    if (exists $CFG{mlockall}) {
       eval {
-         $CFG{mlockall} ? &mlockall : &munlockall
+         $CFG{mlockall} ? eval "mlockall()" : eval "munlockall()"
             and die "WARNING: m(un)lockall failed: $!\n";
       };
       warn $@ if $@;
@@ -2108,6 +2205,7 @@
       # reattach attachments to objects
       warn "reattach";
       _global_reattach;
+      reattach $_ for values %MAP;
    };
 
    if ($@) {
@@ -2133,7 +2231,7 @@
 
    # dirty hack because... archetypes are not yet loaded
    Event->timer (
-      after => 2,
+      after => 10,
       cb    => sub {
          $_[0]->w->cancel;