package MUser;
use strict;

use vars qw(
  %Cache
  %Dirty
);

use MCoreTools;

# FIXME
# To do: need a way of decaching not recently used users
# implementation of such should implement a warning upon accessing a stale user object

### Class methods ##################################

sub exists {
  my ($class, $name) = @_;
  $name = lc $name;
  
  return $Cache{$name} || rexists _ufilename($name);
}

sub initialize {}

### Constructors & writing ##########################################################

sub new {
  my ($class, $origname) = @_;
  my $name = lc $origname;
  
  if ($class->exists($name)) {
    croak "CFAIL:That user already exists.";
  }
  
  my $self = bless {
    name => $origname,
  }, $class;
  
  $Cache{$name} = $Dirty{$self} = $self;
  
  return $self;
}

sub _thaw {
  my ($class, $name) = @_;
  
  my $self = $Cache{lc $name} = MFreezer::thaw_from_file(_ufilename($name));  
  bless $self, $class;
  $self->{name} ||= $name;
  return $self;
}

### Dual methods ################################################

sub get { if (ref $_[0]) {
  # clones to avoid the problem of the returned value being modified
  return MFreezer::clone($_[0]{$_[1]});
} else {
  my ($class, $name) = @_;
  $name = lc $name;
  
  if ($Cache{$name}) {
    return $Cache{$name};
  } elsif (rexists _ufilename($name)) {
    return $class->_thaw($name);
  } else {
    croak "CFAIL:No such user.";
  }
}}

sub sync {
  my ($self) = @_;
  
  if (!ref $self) {
    foreach (values %Dirty) {
      $_->sync;
    }
    return;
  }
  
  #mudlog "Writing user $self->{name}";
  MFreezer::freeze_to_file(_ufilename($self->{name}), $self);
  delete $Dirty{$self};
  return;
}

### Instance methods ############################################

sub delete {
  my ($self) = @_;
  
  unlink rfile _ufilename($self->{name});
  delete $Cache{lc $self->{name}};
  delete $Dirty{$self};
  return; # so we don't hand out the stale user object
}

sub set {
  my ($self, $k, $v) = @_;
  $self->{$k} = $v;
  #mudlog "$self->{name} dirty because $k > $v";
  return $Dirty{$self} = $self;
}

## Convenient accessors

sub authenticate {
  my ($self, $pass) = @_;

  my $realpass = $self->{password} or return 1;
  return (_my_crypt($pass, substr($realpass, 0, 2)) eq $realpass);
}

sub has_password {$_[0]{password} ? 1 : 0}

sub set_password {
  my ($self, $newpass) = @_;

  $self->{password} = _my_crypt($newpass, chr(rand(128-32)+32) . chr(rand(128-32)+32));
  $self->sync();
  return;
}

sub name {$_[0]{name}}

sub privileged { my $p = shift()->{privileges} || {}; return not grep !$p->{$_}, @_; }

sub activate {
  my ($self, $con) = @_;
  $self->set('user_last_active', time());
  call_hooks('user_active', $self->name, $con);
}

sub inactivate {
  my ($self, $con) = @_;
  $self->set('user_last_inactive', time());
  call_hooks('user_inactive', $self->name, $con);
}

### Other ############################################

sub _ufilename {"$::Config{db_path}/users/".lc($_[0]).".user"}

sub _my_crypt ($$) {
  my ($str, $salt) = @_;

  my $ret;
  eval {$ret = crypt $str, $salt};
  return $ret unless $@ =~ /paranoia/;
  return $str;
}


1;