package MDefList;
use strict;
use vars qw(@ISA $Root);
use MInitializable;
@ISA = qw(MInitializable);

use MCoreTools;

use constant PERSISTENT_SOURCE => 'P';

sub _initialize {
  require MFreezer; initialize MFreezer;
  $Root = MDefList->new(type => 'MDefList');
  $Root->{DL_path} = '';
}

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

=item C<MDefList-E<gt>new(PARAMS)>

Creates a new MDefList object. Parameters are key-value pairs as follows:

=over 4

=item type (string)

If set, only this type of reference will be allowed as a value in the list.
There may later be extensions to further specify the type.

=item multiple (boolean)

If set, multiple values for the same key are allowed; they must be from
different sources.

=item add_callback (subroutine)

Called when a key is added, with (SOURCE, KEY, VALUE) as arguments.

=item remove_callback (subroutine)

Called when a key is removed, with (SOURCE, KEY, VALUE) as arguments.

=item validator (subroutine)

Called to check whether a key is allowed in the list, with (SOURCE, KEY) as
arguments. Should die() if the key is invalid, and return if the key is valid;
the return value is ignored.

=back

=cut

sub new {
  my ($class, %param) = @_;
  $class->initialized or croak "MDefList not yet initialized";
  
  my $self = bless {
    DL_type => $param{type},
    DL_multiple => $param{multiple},
    DL_mirror => $param{mirror},
    DL_add_hook => $param{add_callback},
    DL_remove_hook => $param{remove_callback},
    DL_validator => $param{validator},
  }, $class;
  
  if ($param{name}) {
    # 'name' parameter means that the deflist is going to be put into another
    # deflist under that key. The other deflist is specified by the 'into'
    # parameter, or is the root list.

    my $into = $param{into} || '/';
    ($class->path($into) or croak "into $into invalid")->add(
      ($param{source} || croak "Named list must have source"),
      $param{name} => $self
    );
  }
  
  delete $self->{DL_dirty};
  
  return $self;
}

sub root {
  $Root;
}

sub persistent_source {PERSISTENT_SOURCE}

sub path {
  my ($class, @path) = @_;
  
  my @item = $class->root;
  my $tpath = '';
  foreach ($class->path_parse(@path)) {
    $tpath .= "/$_";
    UNIVERSAL::isa($item[0], $class) or croak "CFAIL:$tpath isn't a deflist.";
    @item = $item[0]->get($_) or croak "CFAIL:$tpath doesn't exist.";
  }
  if (@item > 1 and not wantarray) {
    carp "path() called in scalar context for multiple-value def list item";
    return $item[0];
  }
  return wantarray ? @item : $item[0];
}
  
  
sub path_parse {
  my ($class, @in) = @_;
  @in = map {split m#/#, $_, -1} @in;
  
  my @out;
  for (@in) {
    if ($_ eq '..') {
      pop @out;
    } elsif ($_ eq '.') {
    } elsif ($_ eq '') {
      @out = ();
    } else {
      push @out, $_;
    }
  }

  return @out;
}

sub path_format {
  my ($class, @path) = @_;
  return '/' . join '/', @path;
}

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

sub _set_path {
  my ($self, $into, $name) = @_;

  $name or croak "Deflist must have name";
  ($self->{DL_name} = $name) =~ m#^[^/.]+$# or croak "Name of list cannot contain slashes or periods";

  $into =~ s#/$##;
  
  $self->{DL_path} = my $dlpath = "$into/$self->{DL_name}";
  if (rexists(my $file = $::Config{db_path} . "/list" . $dlpath . ".dlp")) {PREAD:{
    mudlog "Loading $dlpath persistent deflist items";
    my $data = eval {MFreezer::thaw_from_file($file)}
      or mudlog "ERROR/DB: Couldn't open $file:\n$@", last PREAD;
    while (my ($k, $v) = each %$data) {
      $self->add(PERSISTENT_SOURCE, $k, $v);
    }      
  }}
}

sub type {$_[0]{DL_type}}
sub multiple {$_[0]{DL_multiple}}
sub mirrored {!!$_[0]{DL_mirror}}
sub hooked {$_[0]{DL_add_hook} || $_[0]{DL_remove_hook} || $_[0]{DL_validator}}

sub add {
  my ($self, $source, $key, $value) = @_;
  
  (defined $key and defined $value and defined $source)
    or croak 'Usage: $list->add(source, key, value)';
  
  $key =~ /^DL_/ and croak "Definition list keys may not begin with DL_"; 
  
  {
    local $Carp::CarpLevel = $Carp::CarpLevel + 1;
    $self->{DL_validator}->($source, $key, $value) if $self->{DL_validator};
  }  

  if ($self->{DL_type}) {
    ref $value eq $self->{DL_type} or croak "Value is not a $self->{DL_type} reference";
  }
  
  if ($self->{DL_multiple}) {
    $self->{DL_mirror}->{$key}{$source} = $value
      if $self->{DL_mirror};
  } else {
    if ($self->{$key}) {
      croak "Key '$key' already exists";
    }
    $self->{DL_mirror}->{$key} = $value
      if $self->{DL_mirror};
  }

  $self->{$key}{$source} = $value;
  $self->{DL_add_hook}->($source, $key, $value) if $self->{DL_add_hook};
  $self->{DL_dirty} = 1 if $source eq PERSISTENT_SOURCE;
  
  if (ref $value eq ref $self) {
    $value->_set_path($self->{DL_path}, $key);
  }
  
  $value;
}

sub addFromList {
  my ($self, $otherlist) = @_;
  
  ref $otherlist eq ref $self or die "can't copy deflist items from non-MDefList";
  foreach (keys %$otherlist) {
    $self->{$_} = $otherlist->{$_} unless /^DL_/;
  }
  return;
}

sub remove {
  my ($self, $source, $key) = @_;

  ($key and $source)
    or croak 'Usage: $list->remove(source, key)';
  
  $key =~ /^DL_/ and croak "Definition list keys may not begin with DL_"; 
  
  if (exists $self->{$key} and not exists $self->{$key}{$source}) {
    # this is security for non-multiple deflists: you
    # can't delete an entry without specifying the same
    # source it was added with
    croak "Key '$key' wasn't added by source '$source'";
  }
  
  if ($self->{DL_multiple}) {
    if ($self->{DL_mirror}) {
      delete $self->{DL_mirror}->{$key}{$source};
      delete $self->{DL_mirror}->{$key} unless keys %{$self->{DL_mirror}->{$key}};
    }
  } else {
    delete $self->{DL_mirror}->{$key}
      if $self->{DL_mirror};
  }
  
  my $value = delete $self->{$key}{$source};
  delete $self->{$key} unless keys %{$self->{$key}};
  $self->{DL_remove_hook}->($source, $key, $value) if $self->{DL_remove_hook};
  $self->{DL_dirty} = 1 if $source eq PERSISTENT_SOURCE;
  1;
}

sub get {
  my ($self, $key) = @_;
  
  $key or return;
  
  ($self->{DL_multiple} and !wantarray)
    and carp "get() called in scalar context for multiple-value def list";
   
  my @res = $self->{$key} ? values %{$self->{$key}} : ();
  return wantarray ? @res : $res[0];
}

sub get_source {
  my ($self, $key) = @_;
  
  $key or return;
  
  ($self->{DL_multiple} and !wantarray)
    and carp "get_source() called in scalar context for multiple-value def list";
   
  my @res = $self->{$key} ? keys %{$self->{$key}} : ();
  return wantarray ? @res : $res[0];
}

sub keys {
  my ($self) = @_;
  return grep !/^DL_/, CORE::keys %$self;
}

sub values {
  my ($self) = @_;
  return map values %{$self->{$_}}, grep !/^DL_/, CORE::keys %$self;
}

sub prefix {
  my ($self, $str) = @_;
  return grep /^\Q$str/, CORE::keys %$self;
}

sub sync {
  my ($self) = @_;
  
  if (not ref $self) {
    $self->root->sync;
    return;
  }
  if ($self->{DL_type} and $self->{DL_type} eq ref $self) {
    for (map CORE::values %$_, grep ref $_ eq 'HASH', CORE::values %$self) {
      $_->sync;
    }
    return;
  }

  my $dlpath = $self->{DL_path} || '';
  
  return unless $self->{DL_dirty};
  mudlog "Syncing deflist $dlpath";
  
  my $stuff = {};
  while (my ($key, $values) = each %$self) {
    $key =~ /^DL_/ and next;
    #mudlog "key=$key vals=$values";
    my $value = $values->{(PERSISTENT_SOURCE)} or next;
    mudlog "Found persistent item for key $key";
    $stuff->{$key} = $value;
  }
  
  my $path = $::Config{db_path} . "/list" . $dlpath . ".dlp";
  (my $dir = $path) =~ s#/[^/]+$##;
  rmkpath($dir);
  MFreezer::freeze_to_file($path, $stuff);
  delete $self->{DL_dirty};
}  

1;
