package YAMLDB;
use YAML qw/LoadFile DumpFile Dump/;
use POSIX qw/strftime/;

sub new {
   my ($class, %arg) = @_;

   my $self = bless {
      %arg,
   }, $class;

   $self->{last_check} = (-M $self->{db_file}) + 1;
   unless (-x $self->{db_file}) {
      DumpFile ($self->{db_file}, {});
   }
   $self->check_maildb ();

   $self;
}

sub check_maildb {
   my ($self) = @_;

   if ($self->{last_check} > (-M $self->{db_file})) {
      $self->{last_check} = -M $self->{db_file};

      my $maildb = eval { my $m = LoadFile ($self->{db_file}); return $m };
      if ($@) {
         warn "ERROR when reading mail database $self->{db_file}: $@\n";
         $self->{db_file} = $self->{db_file} . ".after_failure";
      } else {
         $self->{maildb} = $maildb;
      }
   }
}

# This is not thread or multiprocess safe!
# XXX: A second process will (of course) terribly damage the maildatabase
# but i assume there wont be any second process.
sub sync_maildb {
   my ($self) = @_;

   eval {
      DumpFile ("$self->{db_file}.tmp", $self->{maildb});
   };
   if ($@) {
      warn "ERROR when writing mail database $self->{db_file}.tmp: $@\n";
   } else {
      rename "$self->{db_file}.tmp", $self->{db_file};
      $self->{last_check} = -M $self->{db_file};
   }
}

sub get {
   my ($self, $key) = @_;
   $self->check_maildb;
   $self->{maildb}->{$key};
}

sub clear {
   my ($self, $key) = @_;
   $self->check_maildb;
   delete $self->{maildb}->{$key};
   $self->sync_maildb;
}

sub set {
   my ($self, $key, $value) = @_;
   $self->check_maildb;
   $self->{maildb}->{$key} = $value;
   $self->sync_maildb;
}
1