--- deliantra/server/ext/login.ext	2007/01/07 02:39:14	1.11
+++ deliantra/server/ext/login.ext	2007/01/09 21:32:42	1.24
@@ -23,10 +23,10 @@
 }
 
 sub can_cleanup {
-   my ($playerfile, $mtime) = @_;
+   my ($pl, $mtime) = @_;
 
    my $age = time - $mtime;
-   my $level = $playerfile =~ /^level (\d+)$/m ? $1 : return;
+   my $level = $pl->ob->level;
 
    ($level <= 3 && $age > 7 * 86400)		# 7 days for level 0..3
    || ($level <= 9 && $age > 90 * 86400)        # 3 months for level 4..9
@@ -147,21 +147,20 @@
          check_playing $ns, $user and next;
 
          # try to read the user file and check the password
-         if (my $fh = aio_open cf::player::path $user, O_RDONLY, 0) {
-            my $mtime = (stat $fh)[9];
+         if (my $pl = cf::player::find $user) {
+            aio_stat $pl->path and next;
+            my $mtime = (stat _)[9];
+            my $hash = $pl->password;
 
-            0 < aio_read $fh, 0, 16384, my $buf, 0 or next;
-            $buf =~ /^password (\S+)$/m            or next;
-            my $hash = $1;
-
-            if ($hash eq crypt $pass, $hash) {
+            if ($cf::CFG{ext_login_nocheck} or $hash eq crypt $pass, $hash) {
                nuke_str $pass;
                # password matches, wonderful
                my $pl = cf::player::find $user or next;
                $pl->connect ($ns);
                check_clean_save $pl;
+               $pl->{clean_save} = 1;
                last;
-            } elsif (can_cleanup $buf, $mtime) {
+            } elsif (can_cleanup $pl, $mtime) {
                Coro::Timer::sleep 1;
 
                $ns->send_drawinfo (
@@ -179,7 +178,7 @@
                aio_stat cf::player::path $user and next;
                $mtime == (stat _)[9] or next;
 
-               nuke_playerdir $user;
+               $pl->quit_character;
 
                # fall through to creation
             } else {
@@ -257,9 +256,34 @@
    });
 }
 
-# "Quitting will delete your character PERMANENTLY. If you are sure you want to do this, then use the quit_character command instead of quit."
-# "Quitting will delete your character.\nAre you sure you want to quit (y/n):"
-# quit, quit_character, save
+cf::register_command quit => sub {
+   my ($ob, $arg) = @_;
+
+   $ob->reply (undef,
+               "Quitting will delete your character PERMANENTLY: It will be gone forever and any progress will be lost. "
+               . "If you are sure you want to do this, then use the quit_character command instead of quit.",
+               cf::NDI_UNIQUE | cf::NDI_RED);
+};
+
+cf::register_command quit_character => sub {
+   my ($ob, $arg) = @_;
+
+   my $pl = $ob->contr;
+
+   $pl->ns->query (cf::CS_QUERY_SINGLECHAR, "Do you want to PERMANENTLY delete your character and all associated data (y/n)?", sub {
+      if ($_[0] !~ /^[yY]/) {
+         $ob->reply (undef,
+                     "Ok, not not quitting then.",
+                     cf::NDI_UNIQUE | cf::NDI_RED);
+      } else {
+         $ob->reply (undef,
+                     "Ok, quitting, hope to see you again.",
+                     cf::NDI_UNIQUE | cf::NDI_RED);
+         $pl->ns->flush;
+         $pl->quit_character;
+      }
+   });
+};
 
 cf::object->attach (
    type     => cf::SAVEBED,
@@ -268,10 +292,11 @@
 
       return cf::override 0 unless $ob->type == cf::PLAYER;
 
-      my $pl = $ob->pl;
+      my $pl = $ob->contr;
 
       # update respawn position
       $pl->savebed ($bed->map->path, $bed->x, $bed->y);
+      cf::async { $pl->save };
 
       $pl->killer ("left");
       $ob->check_score;
@@ -284,10 +309,7 @@
             $pl->deactivate;
             $pl->ns->destroy;
          } else {
-            cf::async {
-               $pl->{clean_save} = 1;
-               $pl->save;
-            };
+            cf::async { $pl->save };
          }
       });
    },
@@ -308,6 +330,7 @@
          $_->ob->message ("$name left the game.", cf::NDI_DK_ORANGE | cf::NDI_UNIQUE) for cf::player::list;
       } else {
          $_->ob->message ("$name uncerimoniously disconnected.", cf::NDI_DK_ORANGE | cf::NDI_UNIQUE) for cf::player::list;
+         delete $pl->{clean_save};
       }
    },
 );
@@ -318,10 +341,8 @@
 
 #############################################################################
 
-our $SCHEDULE_INTERVAL  =   10; # time the player scheduler sleeps between runs
-our $SWAP_TIMEOUT       =   30; # time after which an unused player is evicted form memory
-our $SAVE_TIMEOUT       =   20; # save players every n seconds
-our $SAVE_INTERVAL      =  0.1; # save at max. one player every $SAVE_INTERVAL
+our $SCHEDULE_INTERVAL  =  10; # time the player scheduler sleeps between runs
+our $SAVE_TIMEOUT       =  20; # save players every n seconds
 
 our $SCHEDULER = cf::async_ext {
    while () {
@@ -339,8 +360,34 @@
 
          eval {
             if ($pl->{last_save} + $SAVE_TIMEOUT <= $cf::RUNTIME) {
+               $cf::WAIT_FOR_TICK_ONE->wait;
                $pl->save;
-               Coro::Timer::sleep $SAVE_INTERVAL;
+
+               unless ($pl->active) {
+                  # check refcounts, this is tricky and needs to be adjusted to fit server internals
+                  my $ob = $pl->ob;
+                  Scalar::Util::weaken $pl;
+                  Scalar::Util::weaken $ob;
+                  my $a_ = $pl->refcnt;#d#
+                  my $b_ = $ob->refcnt;#d#
+                  my $pl_ref = $pl->refcnt_cnt;
+                  my $ob_ref = $ob->refcnt_cnt;
+
+                  ## pl_ref == one from object + one from cf::PLAYER
+                  ## ob_ref == one from simply being an object
+                  if ($pl_ref == 2 && $ob_ref == 1) {
+                     warn "player-scheduler destroy ", $ob->name;#d#
+
+                     # remove from sight and get fresh "copies"
+                     $pl = delete $cf::PLAYER{$ob->name};
+                     $ob = $pl->ob;
+
+                     $ob->destroy;
+                     $pl->destroy;
+                  } else {
+                     warn "player-scheduler refcnt ", $ob->name, " $pl_ref,$a_ $ob_ref,$b_\n";#d#
+                  }
+               }
             }
          };
          warn $@ if $@;