package MObjectDB;

use strict;
use vars qw(%ObjCache %Config $NextID %ChunkLastAccess %DirtyChunks %LoadedChunks);

use MCoreTools;
use MObject;
use MObjectRef;
use File::Path;
use MIndex;
use MEvent::Message;

sub initialize {
  my ($class) = @_;

  my @ckeys = grep /^db_/, keys %main::Config;
  @Config{@ckeys} = @main::Config{@ckeys};
  rmkpath($Config{db_path});

  if (my $fh = IO::File->new(rfile("$Config{db_path}/db_nextid"))) {
    <$fh> =~ /^(\d+)$/;
    $NextID = $1;
  }
  $NextID ||= 1;

  #MEvent::Message->new(name => 'Ager', reschedule => 60, no_catch_up => 1,
  #                     target => 'MObjectDB', method => 'do_aging')->schedule;
  #MEvent::Message->new(name => 'DB Sync', reschedule => 60*60,
  #                     target => 'MObjectDB', method => 'sync')->schedule;
  MScheduler->add_task(name => 'Ager', hook => sub {
    MScheduler->reset_me_from_now(60); 
    MObjectDB->do_aging();
  });
  MScheduler->add_task(name => 'DB Sync', hook => sub {
    MScheduler->reset_me(10*60); 
    MObjectDB->sync();
  });
}

sub sync {
  my ($class) = @_;
  # mudlog "DEBUG: writing NextID";
  (
    IO::File->new(rfile("$Config{db_path}/db_nextid"), '>', DATA_PERMS) or do {warn $!; $::Quit = 'fatal error'; return}
  )->print($NextID) if $NextID;
  # mudlog "DEBUG: writing chunks";
  foreach (keys %LoadedChunks) {
    $class->chunk_write($_) if $DirtyChunks{$_};
  }
  MIndex->sync;
}

sub close {
  my ($class) = @_;
  $class->sync;
  undef $NextID; # must be before decaching so log messages don't trigger recaching
  foreach (keys %LoadedChunks) {
    $class->chunk_decache($_);
  }
}

sub is_open {!!$NextID}

sub register_object {
  my ($class, $obj) = @_;
  
  $NextID or confess "DB not initialized";
  my $id = $NextID++;
  $class->chunk_cache(_chunk_find($id));
  $obj->id($id);
  $ObjCache{$id} = $obj;
  $class->changed_id($id);
}

sub unregister_object {
  my ($class, $obj) = @_;

  $NextID or confess "DB not initialized";

  delete $ObjCache{my $id = $obj->id};
  $obj->reset_val('id');
  
  $class->changed_id($id);
}

sub changed_id {
  my ($class, $id) = @_;
  
  $NextID or confess "DB not initialized";

  my $chunk = _chunk_find($id);
  if (!$DirtyChunks{$chunk}) {
    mudlog "DB: #$id changed, chunk $chunk marked dirty";
  }
  $DirtyChunks{$chunk} = 1;
  $ChunkLastAccess{$chunk} = time();
}

sub get {
  my ($class, $id) = @_;
  $NextID or confess "DB not initialized";
  if ($id !~ /^\d+$/) {
    croak "ERROR/CORE: Non-numeric ID passed to MObjectDB::get()";
  }
  return $class->get_real($id) ? MObjectRef->new($id) : undef;
}

sub get_real {
  my ($class, $id) = @_;
  
  $NextID or confess "DB not initialized";

  return $ObjCache{$id} if $ObjCache{$id};

  my $chunk = _chunk_find($id);
  if (!$LoadedChunks{$chunk}) {
    $class->chunk_cache($chunk);
  }
  $ChunkLastAccess{$chunk} = time();

  return $ObjCache{$id};
}

sub _chunk_find {int($_[0] / $::Config{db_file_size})}

sub chunk_file {
  my ($class, $ch) = @_;
  
  (my $chunk) = $ch =~ /^([0-9]*)$/;
  defined $chunk or croak "Bad chunk ID";
  (join '/', $Config{db_path}, split(//, $chunk)) . '.odb';
}

sub chunk_cache {
  my ($class, $chunk) = @_;
  return unless !$LoadedChunks{$chunk};
  my $csize = $Config{db_file_size};
  my $start = $chunk * $csize;
  my $end = ($chunk+1) * $csize;
  #mudlog "DB: Reading chunk $chunk";
  $LoadedChunks{$chunk} = 1;
  my $in = IO::File->new(rfile($class->chunk_file($chunk)), '<') or do {
    if ($! =~ /No such file/) {
      return;
    } else {
      warn "Couldn't read DB chunk $chunk: $!";
      $::Quit = 'database error';
      exit;
    }
  };
  local $/ = ':';
  for (my $i = $start; $i < $end; $i++) {
    my $data_length = <$in>;
    chomp $data_length;
    my $amt_read = read $in, my($buf), $data_length;
    $amt_read == $data_length or do {
      mudlog "DB: in chunk $chunk, tried to read $data_length bytes of object data but only got $amt_read bytes";
      $::Quit = 'database corruption';
      return;
    };

    if (length $buf) {
      $buf =~ /^(.*)$/s; # yecch
      eval {$ObjCache{$i} = MObject->db_thaw($1)};
      $@ and mudlog "DB: Couldnt thaw #$i:\n$@";
    }
  }
  mudlog "DB: Read chunk $chunk";
}

sub chunk_write {
  my ($class, $chunk) = @_;
  return unless $LoadedChunks{$chunk};
  my $csize = $Config{db_file_size};
  my $start = $chunk * $csize;
  my $end = $chunk * $csize + $csize;
  mudlog "DB: Writing chunk $chunk";
  my $file = $class->chunk_file($chunk);
  (my $dir = $file) =~ s#/[^/]+$##;
  rmkpath($dir);
  my $out = IO::File->new(rfile($file), '>', DATA_PERMS);
  for (my $i = $start; $i < $end; $i++) {
    my $data;
    if ($ObjCache{$i}) {
      $data = $ObjCache{$i}->freeze;
    } else {
      $data = '';
    }
    $out->print(length($data) . ':' . $data);
  }
  $out->close;
  delete $DirtyChunks{$chunk};
}

sub chunk_decache {
  my ($class, $chunk) = @_;
  $class->chunk_write($chunk) if $DirtyChunks{$chunk};
  mudlog "DB: Decaching chunk $chunk";
  my $csize = $Config{db_file_size};
  my $start = $chunk * $csize;
  my $end = $chunk * $csize + $csize;
  for (my $i = $start; $i < $end; $i++) {
    next unless $ObjCache{$i};
    $ObjCache{$i}->reset_val('id');
    delete $ObjCache{$i};
  }
  delete $LoadedChunks{$chunk};
}

sub do_aging {
  my $now = MScheduler::mudclock();
  foreach (values %ObjCache) {
    my $delta = $now - ($_->{_last_age_time} || $now);
    call_hooks('object_aging', $_, $delta);
    $_->{_last_age_time} = $now;
  }
}

sub cache_cleanup {
  my ($class) = @_;
  return if (scalar keys %LoadedChunks) < (my $siz = $Config{db_cache_size});
  my @chunks = sort {$ChunkLastAccess{$a} <=> $ChunkLastAccess{$b}} keys %LoadedChunks;
  splice @chunks, (@chunks - $siz), $siz;
  foreach (@chunks) {
    $class->chunk_decache($_);
  }
}

1;
__END__
