package MLoaders;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
  load_fileref
  save_fileref
  call_hooks
);

@EXPORT_OK = qw(
  $ModuleLoadContext
);

use strict;
use Carp;
use MCoreTools;
use File::Path;
use MZone;

use vars qw(
  %ModuleSources
  $ModuleEvalContext
  $ModuleEvalName
  %ModuleHooks
);

sub load_stuff {
  mudlog "Loading modules...";
  MLoaders->load_modules;

  mudlog "Loading help...";
  MLoaders->load_help;

  MZone->initialize;
}

### Directory scanners ##########################################################################################

sub load_texts {
  mudlog "Loading text files...";
  local *TDIR;
  opendir TDIR, relfpath("data/texts") or die "Couldn't open texts directory: $!";
  while (defined (local $_ = readdir TDIR)) {
    next unless /^(.*)\.txt$/;
    load_fileref("txt:$1");
  }
  closedir TDIR;
}

sub load_help {
  my $hdir = "data/texts/help";
  local *HDIR;
  opendir HDIR, relfpath($hdir) or die $!;
  while (defined (my $f = readdir HDIR)) {
    next unless $f =~ /\.help$/;
    proc_help_file(relfpath("$hdir/$f"), \%::Help);
  }
  closedir HDIR;
  opendir HDIR, relfpath("$hdir/!immortal") or die $!;
  while (defined (my $f = readdir HDIR)) {
    next unless $f =~ /\.help$/;
    proc_help_file(relfpath("$hdir/!immortal/$f"), \%::ImmHelp);
  }
  closedir HDIR;
}

sub load_modules {
  local *MODDIR;
  opendir MODDIR, "modules" or die $!;
  while (defined (local $_ = readdir MODDIR)) {
    next unless /^(.*)\.mod$/;
    load_fileref("mod:$1");
  }
  closedir MODDIR;
}

### Loaders/unloaders/writers ##########################################################################################

sub load_fileref {
  my ($ref, %opt) = @_;

  # MConnection->listen_idle(.001);
  my ($type, $path, $filepath) = parse_file_ref($ref)
    or warn "load_fileref called with bad fileref" and return;

  if (-e $filepath) {
    mudlog "Loading $type:$path";

    if ($type eq 'obj' || $type eq 'room' || $type eq 'zinf') {
      MZone->by_path($path)->load_file($type);
    } elsif ($type eq 'mod') {
      MLoaders->load_module($ref);
    } elsif ($type eq 'txt') {
      MLoaders->load_text($ref);
    } else {
      mudlog "Bad fileref type in load_fileref: '$type'";
      return 0;
    }
  } else {
    mudlog "File not found: $type:$path ($filepath)" unless $opt{'no_fnf'};
    return 0;
  }    
  return 1;
}

sub save_fileref {
  my ($ref, %opt) = @_;

  my ($type, $path, $filepath) = parse_file_ref($ref)
    or carp "save_fileref called with bad fileref" and return;

  mudlog "Saving $type:$path";

  if ($type eq 'obj') {
    MObject->save_prototypes($ref);
  } elsif ($type eq 'zinf') {
    (MZone->by_path($path) || die "Nonexistent zone in save_zone: '$path'")
      ->save_zinf();
  } elsif ($type eq 'room') {
    MLoaders->save_rooms($ref);
  } elsif ($type eq 'mod') {
    carp "Modules can't be saved!\n";
  } elsif ($type eq 'txt') {
    MLoaders->save_text($ref);
  } else {
    die "Bad fileref type in save_fileref: '$type'";
  }
  return 1;
}

sub load_text {
  my ($class, $ref) = @_;

  my ($type, $path, $filepath) = parse_file_ref($ref, 'txt');
  $type eq 'txt' or die "load_text() called with non-text file reference";
  my $fh = IO::File->new($filepath) or do {
    mudlog("$type:$path - module file not found");
    return;
  };
  { local $/; $::Texts{$path} = <$fh>; }
  #print "text file - path is <$path>, data is <$::Texts{$path}>\n";
  chomp $::Texts{$path} if $path =~ /socket|name|timescale/;
  #print "after chomp data is <$::Texts{$path}>\n";
  $fh->close;
}

sub proc_help_file {
  my ($file, $table) = @_;

  local *HELP;
  open HELP, $file or die "$file: $!";
  my $buf = <HELP>;
  my @keywords = split /\s+/, $buf;
  $buf = "&c;$buf&n;";
  my $line;
  $buf .= $line while defined($line = <HELP>);
  foreach (@keywords) {
    $table->{lc $_} = \$buf;
  }
  close HELP;
}

sub load_module {
  my ($self, $ref) = @_;

  my ($type, $path, $filepath) = parse_file_ref($ref, 'mod');
  $type eq 'mod' or die "load_module() called with non-module file reference";
  my $fh = IO::File->new($filepath) or do {
    mudlog("$type:$path - module file not found");
    return;
  };
  $fh->untaint; # Safe to eval code stored on local disk, and the file path
                # has been checked by parse_file_ref.
  my $code = "package MLoaders::ModuleContext;use MCoreTools;use MLoaders;\n#line 1 \"$filepath\"\n";
  $code .= <$fh> until $fh->eof;
  my $ccopy = $code;
  close $fh;
  local $ModuleEvalContext = 'load';
  local $ModuleEvalName = $path;
  eval $code;
  if ($@) {
    warn $@ unless $@ =~ "module load failed";
  } else {
    $ModuleSources{$path} = $ccopy;
  }
}

sub unload_module {
  my ($self, $ref) = @_;

  my ($type, $path, $filepath) = parse_file_ref($ref, 'mod');
  $type eq 'mod' or die "unload_module() called with non-module file reference";
  return unless exists $ModuleSources{$path};
  local $ModuleEvalContext = 'unload';
  local $ModuleEvalName = $path;
  eval $ModuleSources{$path};
  die $@ if $@;
  delete $ModuleSources{$path};
}

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

  return exists $ModuleSources{$name};
}

sub load_rooms {
  my ($class, $ref) = @_;

  my ($type, $path, $filepath) = parse_file_ref($ref, 'room');
  return unless $type eq 'room';

  my %fobj = MLoaders->read_objset($filepath);
  while (my ($oname, $odata) = each %fobj) {
    my ($r, @c);
    if ($r = $::Rooms{"$path/$oname"}) {
      @c = @{$r->contents};
      foreach my $o (@c) {
        $o->_gsend_local("&fm;&sb;the world shifts around you.&n;");
      }
      $r->remove_contents(@c); # Must remove objects before disposing, or the objects
                               # will get destroyed with the room.
      $r->dispose;
    }

    $r = $::Rooms{"$path/$oname"} = MObject->thaw($odata);
    $r->roomname("$path/$oname");
    $r->add_contents(@c);
  }
  delete $::DirtyFiles{"$type:$path"};
  1;
}

sub save_rooms {
  my ($class, $ref) = @_;
  $ref or Carp::confess "no path passed to save_rooms";
  my ($type, $path, $filepath) = parse_file_ref($ref, 'room');
  return unless $type eq 'room' and $filepath;

  #print("DEBUG ", join ',', map (($_->roomname =~ m#/([^/]+)$#)[0], $_), MZone->by_path($path)->all_things('room'));
  MLoaders->write_objset(
    $filepath,
    {
      map {($_->roomname =~ m#/([^/]+)$#)[0], $_}
        MZone->by_path($path)->all_things('room')
    },
    no_content => 1,
  );
  delete $::DirtyFiles{"$type:$path"};
}

sub read_objset {
  my ($class, $filepath) = @_;
  
  my $fh = IO::File->new($filepath, '<') or do {
    mudlog("$filepath - file not found");
    return;
  };
  binmode $fh;
  
  my %objects;
  local $/ = ":";
  while (defined (my $line = <$fh>)) {
    if ($line =~ /^\s*(\w+)\s*(\d+)\s*:\Z/) {
      my ($oname, $data_length) = ($1, $2);
      my $amt_read = read $fh, my($buf), $data_length;
      $amt_read == $data_length or do {
        mudlog "$filepath - in record '$oname', tried to read $data_length bytes of object data but only got $amt_read bytes";
        return;
      };
      # FIXME: untaint - I really shouldn't do this, but it's necessary
      # for allowing Data::Dumper to be used for freezing objects.
      $buf =~ /^(.*)$/s;
      $objects{$oname} = $1;
    }
  }
  $fh->close;
  %objects;
}

sub write_objset {
  my ($class, $filepath, $objects, %params) = @_;

  MCoreTools->make_enclosing($filepath);
  my $fh = IO::File->new($filepath, '>', DATA_PERMS) or do {
    mudlog("$filepath - couldn't open for writing: $!");
    return;
  };
  binmode $fh;
  
  for my $oname (keys %{$objects}) {
    my $data = $params{no_content} ? $objects->{$oname}->freeze_without_contents : $objects->{$oname}->freeze;
    print $fh "$oname @{[length $data]}:$data";
  }
  close $fh;
}

### Module hooks ##########################################################################################

sub Hooks {
  my ($class, %hooks) = @_;
  $ModuleEvalContext or die 'MLoaders::Hooks called outside of module eval context';
  if ($ModuleEvalContext eq 'unload') {
    foreach (keys %hooks) {delete $ModuleHooks{$_}{$ModuleEvalName};}
  } else {
    foreach (keys %hooks) {
      $ModuleHooks{$_}{$ModuleEvalName} = $hooks{$_};
    }
  }
}

sub call_hooks {
  my $hookname = shift;
  my @ret;
  foreach (values %{$ModuleHooks{$hookname}}) {
    push @ret, $_->(@_);
  }
  @ret;
}

1;
