#! perl

# Access levels are:
# 0 = read
# 1 = write/remove
sub access {
   my ($ob, $guild) = @_;
 
   return 1
      if $ob->flag (cf::FLAG_WIZ);

   List::Util::max
      map $_->type == cf::FORCE && $_->slaying eq "$guild master" ? 1 : 0,
         $ob->inv
}

sub do_help {
   my ($guildrules, $who, $npc) = @_;
   $who->reply ($npc,
      "Help for $guildrules\n"
     ."List of commands:\n\n"
     ."- list\n"
     ."- write <message>\n"
     ."- remove <id>\n"
   );
}

sub do_write {
   my ($guildrules, $msg, $who, $npc) = @_;
   my $guild = $guildrules;
   $guild =~ s/Rules for //;
   return $who->reply ($npc, "Access denied.")
      unless access $who, $guild;

   if ($msg =~ /\S/) {
      CFguildrules::put_entry ($guildrules, $who->name, $msg);
      $who->reply ($npc, "Added entry.");
   } else {
      $who->reply ($npc, "Usage: write <message>\n");
   }
   1
}

sub do_list {
   my ($guildrules, $who, $npc) = @_;
   my $cont = CFguildrules::get ($guildrules);
   if (@{$cont || []}) {
      $who->reply ($npc, "My content:");
      my $idx = 0;
      for (@$cont) {
         $who->reply ($npc, "<$idx> $_->[0]: $_->[1]");
         $idx++;
      }
   } else {
      $who->reply ($npc, "There are no rules.");
   }
   1
}

sub do_remove {
   my ($guildrules, $idx, $who, $npc) = @_;

   my $entry = CFguildrules::get_entry ($guildrules, $idx);
   unless (defined $entry) {
      $who->reply ($npc, "No such entry.");
      return 1;
   }

   if ($entry->[0] eq $who->name or $who->flag (cf::FLAG_WIZ)) {
      my $e = CFguildrules::remove_entry ($guildrules, $idx);
      $who->reply ($npc, "Removed entry $idx ($e->[0]: $e->[1]).");
   } else {
      $who->reply ($npc, "Access denied.");
   }

   1
}

# this is the main command interface for the IPO NPC
cf::register_script_function "guildrules::command" => sub {
   my ($who, $msg, $npc) = @_;
   my $guildrules = $npc->name;

   if ($msg =~ /^list$/i) {
      do_list ($guildrules, $who, $npc);
   } elsif ($msg =~ /^write (.+)$/i) {
      do_write ($guildrules, $1, $who, $npc);
   } elsif ($msg =~ /^remove (\d+)$/i) {
      do_remove ($guildrules, $1, $who, $npc);
   } else {
      do_help ($guildrules, $who, $npc);
   }

   1
};

cf::object::attachment guildrules =>
   on_apply => sub {
      my ($npc, $who) = @_;
      $who->reply ($npc, "Hello, I'm a rules sign. Say 'help' for a list of commands.");
      do_list ($npc->name, $who, $npc);
      cf::override;
   },
;

package CFguildrules;

use POSIX qw/strftime/;
use CFDB;

my $GUILDRULESDB = Compress::LZF::sthaw cf::db_get guildrules => "data";

sub get {
   my ($guildrules) = @_;

   $GUILDRULESDB->{"msg_$guildrules"} ||= []
}

sub get_entry {
   my ($guildrules, $idx) = @_;

   $GUILDRULESDB->{"msg_$guildrules"}[$idx]
}

sub remove_entry {
   my ($guildrules, $idx) = @_;

   my $entry = splice @{ $GUILDRULESDB->{"msg_$guildrules"} ||= [] }, $idx, 1;
   cf::db_put guildrules => data => Compress::LZF::sfreeze_cr $GUILDRULESDB;
   $entry
}

sub clear {
   my ($guildrules) = @_;

   delete $GUILDRULESDB->{"msg_$guildrules"};
   cf::db_put guildrules => data => Compress::LZF::sfreeze_cr $GUILDRULESDB;
}

sub put_entry {
   my ($guildrules, $from, $message) = @_;

   my $entries = $GUILDRULESDB->{"msg_$guildrules"} ||= [];
   push @$entries, [$from, $message];
   cf::db_put guildrules => data => Compress::LZF::sfreeze_cr $GUILDRULESDB;
}

1;